LES TRUCS & ASTUCES

Scanner les programme en cours d'exécution

Ajouter dans le uses ToolsHelp:

Procedure scanprog;
var taskInfo : TTaskEntry;
begin
	taskInfo.dwSize:=sizeof(taskInfo);
	if TaskFirst(@taskInfo) and (autorise) then
	repeat
		Listbox.item.add(taskInfo);
	until (not TaskNext(@taskInfo));
end;

Var line,col : integer;
Begin
	line:=SendMessage(Memo1.Handle,EM_LineFromChar,Memo1.SelStart,0);
	col:=Memo1.SelStart - SendMessage(Memo1.Handle,EM_LineIndex,line,0);
end;

if key = VK_RETURN then perform(WM_NEXTDLGCTL,0,0);

2) Modifier le séparateur de décimale à la volée dans l'événement OnKeyPress ajoutez

if key ='.' then key :=',';

ScreenCursors[crMonCurseur]:=LoadCurseur(hInstance,'NOMDUCURSEUR');

il reste plus qu'a affecter le nouveau curseur. exemple: TLabel.Cursor:=crMonCurseur;
Sachant que sous Delphi 1.0 (au moins) le NOMDUCURSEUR doit être en majuscule.

	Function Paques(Y:Integer) : TDateTime;
	Var C,n,k,i,j,l,m,d :Integer;
	Begin
		C:=Y div 100;
		N:=Y mod 19;
		K:=(C-17) div 25; I:=(C - C div 4 - (C-K) div 3 + 19*N + 15) mod 30;
		I:=I - (I div 28) * (1-( I div 28) * (29 div (I+1))*((21-N) div 11));
		J:=(Y + Y div 4 + I + 2 - C + C div 4) mod 7; L:=I -J;
		M:=3 + (L+40) div 44;
		D:=L + 28 - 31 * (M div 4);
		result:=EncodeDate(Y,M,D); 
	end; 

Pour l'Ascension ajouter 39 jours et la Pentecôte ajouter 49 jours.

Voici une Fonction qui compte le nombre de répertoire.
on lui passe en paramètre le répertoire (ca peut etre c: si on veut tout...)
et si on veut compter les sous répertoires ou non.

function Dir_CountDir(strPathName: String;bRecurseDir : Boolean):Integer;
var
	strTempPath : string;
	nCount : integer;
	hFindFile : THandle;
	FindData : TWin32FindData;
Begin
	nCount := 0;
	Result := 0;
	strTempPath := strPathName+'\*.*';
	hFindFile := Windows.FindFirstFile(PChar(strTempPath),FindData);
	if hFindFile = INVALID_HANDLE_VALUE then Exit;
	repeat
		if (IsChildDir(FindData)) then
		begin
			nCount := nCount+1;
			if bRecurseDir then
			begin
				strTempPath := strPathName+'\'+FindData.cFileName;
				nCount := nCount+Dir_CountDir(strTempPath,bRecurseDir);
			end;
		end;
	until (not Windows.FindNextFile(hFindFile,FindData));
	Windows.FindClose(hFindFile);
	Result := nCount;
end;

function IsChildDir (var lpFindData : TWin32FindData) : Boolean;
var
	b : boolean;
begin
	Result := ((lpFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <>0);
	b := (lpFindData.cFileName[0] <> '.');
	Result := (Result and b);
end;

function CopieFic(source,dest: String): Boolean;
var
	fSrc,fDst,len: Integer;
	size: Longint;
	buffer: packed array [0..2047] of Byte;
begin
	Result := False; { Assume that it WONT work }
	if source <> dest then 
	begin
		fSrc := FileOpen(source,fmOpenRead);
		if fSrc >= 0 then 
		begin
			size := FileSeek(fSrc,0,2);
			FileSeek(fSrc,0,0);
			fDst := FileCreate(dest);
			if fDst >= 0 then 
			begin
				while size > 0 do 
				begin
					len := FileRead(fSrc,buffer,sizeof(buffer));
					FileWrite(fDst,buffer,len);
					size := size - len;
				end;
				FileSetDate(fDst,FileGetDate(fSrc));
				FileClose(fDst);
				FileSetAttr(dest,FileGetAttr(source));
				Result := True;
			end;
			FileClose(fSrc);
		end;
	end;
end;

Cet algo fait appel à une fonction API "GETTEMPPATH"

function TForm1.GetTempDirectory: String;
var
	DossierTemp: array[0..255] of Char;
begin
	result:='';
	if GetTempPath(255, @DossierTemp)<>0 then
	Result := StrPas(DossierTemp);
end;

procedure TForm1.Button1Click(Sender: TObject);
var 
	monrep : string;
	i : integer;
begin
	MonRep:=extractfilepath(application.exename);
	For i := Length(MonRep) downTo 1 Do
	If MonRep[i] = '\' Then
	Begin
	showmessage(Copy(MonRep, 1, Pred(i)));
	exit;
	End;
end;

procedure TFiche_generale.FormCreate(Sender: TObject);
{à la création de la fenêtre principale}
var TDAG : TDBGrid;
begin
	TDAG := DBGrid1;   {remplacer DBGrid1 par le nom de la grille concernée}
	TDrawGrid(TDAG).FixedCols :=2;
	TDAG.Refresh;
end;

Comment garnir un tableau Word avec le résultat d'un Query ?
Avant, créer dans Word un modèle (ci-dessous 'MONMODELE') avec un
tableau de par ex. 7 colonnes;
Le truc c'est que si on est en fin de ligne et qu'on envoie
v.celluleSuiv;
une nouvelle ligne s'ouvre en dessous (pour l'adresse suivante);

EXEMPLE : OLE - ECRIRE UN FICHIER WORD AVEC MES ADRESSES

	(adr = array[1..7] of string);
	v:= CreateOleObject('Word.Basic');

EN FRANCAIS :
      	v.FichierNouveau('MONMODELE'); 
      	for a:=1 to 7 do v.CelluleSuiv;  	{ passer sur les titres des 7 colonnes }
                                   		{ ce qui ouvre une nouvelle ligne pour une adresse }
{LIRE LES DONNEES JUSQU'A EOF}
     	v.insertion(adr[1]);                    { 1 ère rubrique de l'adresse }
  	for a:=2 to 7 do 
	begin                  			{ le reste de l'adresse } 
     		v.CelluleSuiv; v.insertion(adr[a]);
  	end;
  	if not EOF then v.CelluleSuiv;      	{ ouvrir une nouvelle ligne si c'est pas fini }
{ENREGISTRER}    
     v.FichierEnregistrerSous('FIADR.DOC'); v. FichierFermer;

EN ANGLAIS :
	v.filenew('MONMODELE');                           
  	for a:=1 to 7 do v.NextCell;  
{LIRE LES DONNEES JUSQU'A EOF}
  	v.insert(alpha);
  	for a:=1 to 6 do 
	begin
     		v.NextCell; v.insert(lignes[a]);
  	end;
  	if not EOF then v.NextCell;
{ENREGISTRER}   
  	v.FileSaveAs('FIADR.DOC'); V.FileClose;

Si vous désirez récupérer le CHEMIN (Path) de votre
programme EXECUTABLE voici comment procéder.

C'est pas du neuf, mais ça peut toujours aider...

Var
    Path : String;        // VAR Contenant le chemin vers l'executable
    Name : String;      // VAR Contenant le Nom de l'executable
    Chemin : String;   // VAR Contenant le Chemin Complet
Begin
    // On recupere le Chemin et le Nom de l'executable (Chemin+Nom.EXE)
    Path := (ExtractFilePath(Application.ExeName));
    Name := (ExtractFileName(Application.ExeName));
    Chemin := (Path + Name);
end;

Vous desirez mettre un lien Hypertexte de votre Email ou votre site Web dans une boite A propos:
créez 1 TLabel sur votre boite et sur l'évennement Onclick insérez la command ShellExecute. N'oubliez pas d'ajouter dans le uses "SHELLAPPI"

Exemple de lien vers un site :

procedure TForm1.Label1Click(Sender: TObject);
Var S : String;
begin
 	S:='http://perso.club-internet.fr/fifi62/index.htm';
 	ShellExecute(GetDesktopWindow(), 'open', PChar(S), nil, nil, SW_SHOWNORMAL);
end;

Exemple de lien vers un Email :

procedure TForm1.Label2Click(Sender: TObject);
var S : String;
begin
	s:='mailto:fifi62@club-internet.fr';
	ShellExecute(GetDesktopWindow(), 'open',PChar(s), nil, nil, SW_SHOWNORMAL);

end;

Dans l'évennement OnDrawColumnCell de votre DBGrid:

procedure TForm1.dbgrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
	var i:integer;
begin
	if ((Table1.RecNo mod 2)=0) then
	begin
		dbgrid1.Canvas.Brush.Color := claqua;
		dbgrid1.Canvas.Font.Color := clblack;
		for i:=0 to dbgrid1.Columns.Count-1 do
		dbgrid1.DefaultDrawColumnCell(rect, i, column, state);
	end;
	dbgrid1.DefaultDrawColumnCell(rect, Datacol, column, state);
end;

procedure TForm1.Edit1Change(Sender: TObject);
Var posit : integer;
Begin
	posit:=Edit1.selstart; {sauve la position du curseur}
	table1.FindNearest([edit1.text]); {effectue la recherche}
	edit1.text:=table1.Fieldbyname('Company').asstring; {affecte le résultat dans le champ de recherche}
	Edit1.selstart:=posit; {repositionne le curseur}
	Edit1.sellength:=255; {selectionne de la postion sur un longueur de 255}
end;

unit Unit1;

interface

uses
Windows, Messages, Classes, Controls,StdCtrls, Forms,Menus,Dialogs, Buttons, ComCtrls;
type
	TForm1 = class(TForm)
	Button1: TButton;
	procedure Button1Click(Sender: TObject);
	private
	function formater : longint;

end;
function SHFormatDrive(hWnd : HWND;Drive : Word;fmtID : Word;Options : Word) : Longint 
			stdcall; external 'Shell32.dll' name 'SHFormatDrive';
const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;{formatage rapide}
const SHFMT_OPT_FULLFORMAT = 1;{formatage complet}
const SHFMT_OPT_SYSONLY = 2; {copier seulement les fichiers systémes
const SHFMT_ERROR = -1;{Erreur lors du formatage (disque protégé etc..}
const SHFMT_CANCEL = -2;{Annulation du formatage}
const SHFMT_NOFORMAT = -3;{Pas de formatage}
var
Form1: TForm1;

implementation

{$R *.DFM}
// Bouton qui fait appel à la fonction formater
procedure TForm1.Button1Click(Sender: TObject);
begin
	// Exécution et controle du code retour
	Case formater of
	    SHFMT_ERROR : ShowMessage('Erreur de formatage!!! changer de disquette ');
	    SHFMT_CANCEL : ShowMessage('Formatage annulé par l''utilisateur');
	    SHFMT_NOFORMAT : ShowMessage('Non formater');
	end;
end;
// Fonction de formatage utilisant l'API Shell32
function Tform1.formater : longint;
var FmtRes : longint;
begin
	result:= ShFormatDrive(Handle,SHFMT_DRV_A,SHFMT_ID_DEFAULT,SHFMT_OPT_QUICKFORMAT);
end;
end.