DELPHI
DELPHI
Voilà une liste de quelques trucs et astuces pour vous aider à
faire des programmes sous Borland Delphi ...
Si vous désirez la compléter,
la corriger, n'hésitez pas à m'écrire : Vos remarques sont
les bien venues !
1) Créer
la dynamique d'un boutton
2) Vérifier
qu'il y a une disquette dans le lecteur
3) Autoriser/Interdire
le Ctrl+Alt+Suppr et le Alt+tab
4) Supprimer
la barre des tâches pendant le déroulement d'un prog.
5) Optimisation
du code
6) Récupérer
un numéro de série
7) Supprimer
le beep d'un Tedit quand on valide Enter
8) Récupérer
les coordonnées du curseur dans un edit
9) Lancer
un fichier avec son prog. par défaut
10) Lancer
une URL
11) Envoyer
un mail
12) Connaitre
la version de Windows
13) Envoyer
des données sur port série
14) Connaitre
la memoire libre disponible
15)
Connaitre le repertoire temporaire par défaut de Windows
16) Code
des touches
17) Voir
le texte qui est dans le ClipBoard
18) Mettre
le focus sur le composant suivant
19) Changer
la vitesse d'affichage du curseur texte
20) Positionner
le pointeur de la souris
21) Faire
scroller un RichEdit
22)
Lancer l'éconnomiseur d'écran
23) Cacher
un prog. de la barre des tâches
24) Tester
si le Caps Lock est actif
25) Faire
une pause
26) Lancement
de la fenêtre de config. de l'heure
27) Lancement
de la fenêtre propriétés systeme
28) Mancement
de la fenêtre propriété mot de passe
29) Changer
la résolution de l'écran sans rebooter
30) Contrôler
l'alim. du moniteur
31) Contrôler
le tiroir du lecteur CD ROM
32) Connaitre
la résolution de l'écran
33) Faire
un Copier/Coller vertical dans l'éditeur Delphi
34) Changer
le papier peint Windows
35) Ecrire
en diagonale sur le canevas de la form
36) Effacer
de facon simple un bitmap
37) Faire
un prog. compatible avec le menu "Envoyer vers"
38) Créer
et utiliser un fichier .INI
39) Ecrire
dans la base de registre
40) Jouer
un fichier .WAV
41) Rebooter/relancer
Windows
42) Déplacer
un composant à l'exécution
43) Spécifier
les paramètres régionaux
44) Connaitre
la version du système d'exploitation
45) Afficher
la liste des tâches de Windows
46)
Créer une fenêtre éliptique
47) Créer
une fenêtre transparente
48) Créer
un fond dégradé
49) Cacher/afficher
le menu démarrer
50) Dessiner
sur le bureau
51) Utiliser
un curseur personnalisé
52) Scanner
les programmes en cours d'éxécution
53) Connaitre
le nombre de sous-répertoires d'un Rep.
54) Copier
un fichier
55) Transformer
une couleur en code Hexadécimal
56) Connaitre
la taille du bureau
57) Bouger
les composants pendant l'execution
58) Avoir
une icone comme curseur
59) Formater
un disque
60) Utiliser
le CPU a 100% pour son prog.
61) Remplacer
le bureau Windows par votre application
62) Eviter
les messages d'erreur critique Windows
63) Mettre
le PC en veille
64) Connaitre
le runtime de Windows
65) Connaitre
la langue de Windows
66) Enregistrer
un fichier *.wav
67) Crypter
un Password
68)
69)
70)
71)
procedure creerbouton;
Var
MonBouton : TButton;
BEGIN
MonBouton := TButton.Create(Form1);
with MonBouton do begin
Parent := MyForm;
height := 20;
width := 2000;
caption := 'nouveau bouton';
left := 20;
top := 20;
end;
END;
2.Vérifier
qu'il y a une disquette dans le lecteur
function
Diskpret: Boolean;
var
mode : Word;
begin
result := false;
mode := SetErrorMode(SEM_FAILCRITICALERRORS);
if DiskSize(1)<>-1 then result := true;
SetErrorMode(mode);
end;
3.Autoriser
ou interdire le alt+tab et ctrl+alt+suppr
// interdire
procedure TForm1.Button1Click(Sender: TObject);
var
oldVal : LongInt;
begin
SystemParametersInfo (97, Word (True), @OldVal, 0);
end;
// autoriser
procedure TForm1.Button2Click(Sender: TObject);
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (False), @OldVal, 0);
end;
4.supprimer la barre de tache pendant le déroulement d'un
programme
definir barretache : HWND; dans les declarations de variable
de la forme et rajouter les deux evenements suivant dans la
forme :
procedure TForm1.FormCreate(Sender: TObject);
begin
barretache := FindWindow('Shell_TrayWnd', nil);
ShowWindow(barretache, SW_HIDE);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowWindow(barretache, SW_SHOW);
end;
on peut ecrire plus simplement le code suivant :
Label1.Caption := Chaine[1];
Label2.Caption := Chaine[2];
Label3.Caption := Chaine[3];
Label4.Caption := Chaine[4];
Label5.Caption := Chaine[5];
il suffit d'écrire :
for
i:=1 to 5 do (FindComponent('Label'+IntToStr(i)) as TLabel).Caption:=Chaine[i];
6.Récuperer le numero de série d'une disquette
function
litnumser:string;
var
NumSerie : DWORD;
MaxComp, SySflags : integer;
begin
GetVolumeInformation('A:', nil, 0,@NumSerie,MaxComp, SysFlags,nil, 0);
result:=NumSerie;
end;
7.Supprimer le beep dans un Tedit quand on appuie sur enter
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = Chr(VK_RETURN) then key:= #0;
end;
8.Récupérer
les coordonnées du curseur dans un mémo
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
var
line,col :integer;
begin
line:=sendMessage(memo1.Handle,EM_LineFromChar,memo1.SelStart,0);
col:=memo1.Selstart-sendMessage(memo1.Handle,EM_LineIndex,line,0)+1;
edit1.text:='Ligne n#176;: '+inttostr(line+1)+' Colonne
n#176;: '+inttostr(col);
end;
note : cela fonctionne aussi avec un richedit
9.Lancer un fichier avec son programme par défaut
uses WinTypes, ShellAPI;
begin
ShellExecute( 0, Nil, PChar('c:\my_docs\report.txt'),Nil, Nil, SW_NORMAL
);
end.
( toujours avec la commande ShellExecute ! )
uses WinTypes, ShellAPI;
begin
ShellExecute( 0, Nil, PChar('http://multimania.com/offset'),Nil, Nil, SW_NORMAL
);
end;
1ere Methode
:
Pour cette méthode,
vous devez avoir le composant "TNMSMPT" dans "Internet".
Ce composant
est inclu dans Delphi 4 et 5 Pro et Entreprises.
procedure TForm1.Button1Click(Sender:
TObject);
begin
NMSMTP1.Host
:= 'mail.host.com';
NMSMTP1.UserID
:= 'username';
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress
:= 'webmaster@hotmail';
NMSMTP1.PostMessage.ToAddress.Text
:= 'user@host.com';
NMSMTP1.PostMessage.Body.Text
:= 'Message a envoyer ici';
NMSMTP1.PostMessage.Subject
:= 'Sujet du mail ici';
NMSMTP1.SendMail;
showmessage('Mail
envoyé !');
end;
2eme Méthode :
( et encore la commande ShellExecute ! )
uses WinTypes, ShellAPI;
begin
ShellExecute( 0, Nil, PChar('mailto:offset@hotmail.com'),Nil, Nil, SW_NORMAL
);
end;
12.Connaitre
la version de windows
Var
versions: TOSVERSIONINFO;
ver:integer;
begin
versions.dwOSVersionInfoSize:=sizeof(versions);
GetVersionEx(versions);
ver:=versions.dwPlatformId;
if ver=VER_PLATFORM_WIN32s then label1.caption:='Windows
3.1 avec Win32s';
if ver=VER_PLATFORM_WIN32_WINDOWS then label1.caption:='Windows 95';
if ver=VER_PLATFORM_WIN32_NT then label1.caption:='Windows NT';
label1.caption:=label1.caption+' ('+inttostr(versions.dwMajorVersion)+
'.'+inttostr(versions.dwMinorVersion)+' )';
end;
13.Envoyer
des données sur le port série
procedure sendtoserial(data:string);
var
serial:textfile;
begin
assignefile(serial,'com1');
rewrite(serial);
write(serial,data);
// ou read pour lire
closefile(serial);
end;
14.Connaitre
la mémoire libre disponible
procedure
TForm1.Button1Click(Sender: TObject);
var
Memory : tMemoryStatus;
begin
memory.dwLength := sizeof(memory);
GlobalMemoryStatus(memory);
label1.caption:='memoire totale : '+inttostr(memory.dwTotalPhys)+' octets';
label2.caption:='memoire libre : '+inttostr(memory.dwAvailPhys)+'
octets';
end;
15.Connaitre
le répertoire temporaire par défaut de windows
procedure
TForm1.Button1Click(Sender: TObject);
var
b: array[0..512] of Char;
begin
GetTempPath(511,b);
label1.caption:=b;
end;
VK_LBUTTON
($01) : bouton Gauche Souris
VK_RBUTTON ($02) : bouton Droite Souris
VK_CANCEL ($03) : Arrêt Exec. programme
VK_MBUTTON ($04) : bouton Central Souris
VK_BACK ($08) : Retour Arrière
VK_TAB ($09) : Tabulation
VK_RETURN ($0D) : Entrée
VK_SHIFT ($10) : Touche de contrôle MAJ
VK_CONTROL ($11) : Touche de contrôle CTRL
VK_MENU ($12) : Touche de contrôle ALT
VK_PAUSE ($13) : Pause
VK_CAPITAL ($14) : Verrouillage majuscules
VK_ESCAPE ($1B) : Echappement
VK_SPACE ($20) : Barre d'espacement
VK_PRIOR ($21) : Page Haut
VK_NEXT ($22) : Page Bas
VK_END ($23) : Fin
VK_HOME ($24) : Début
VK_LEFT ($25) : Flèche gauche
VK_UP ($26) : Flèche haut
VK_RIGHT ($27) : Flèche droite
VK_DOWN ($28) : Flèche bas
vk_Select($29):??
vk_Print($2A):??
vk_Execute($2B);
VK_SNAPSHOT ($2C) : Impression d'écran
VK_INSERT ($2D) : Insérer
VK_DELETE ($2E) : Supprimer
VK_HELP ($2F) : Aide
VK_NUMPAD0 ($60) : Touche pavé numérique 0
VK_NUMPAD1 ($61) : Touche pavé numérique 1
VK_NUMPAD2 ($62) : Touche pavé numérique 2
VK_NUMPAD3 ($63) : Touche pavé numérique 3
VK_NUMPAD4 ($64) : Touche pavé numérique 4
VK_NUMPAD5 ($65) : Touche pavé numérique 5
VK_NUMPAD6 ($66) : Touche pavé numérique 6
VK_NUMPAD7 ($67) : Touche pavé numérique 7
VK_NUMPAD8 ($68) : Touche pavé numérique 8
VK_NUMPAD9 ($69) : Touche pavé numérique 9
VK_MULTIPLY ($6A) : Touche pavé numérique *
VK_ADD ($6B) : Touche pavé numérique +
VK_SEPARATOR ($6C) : Touche pavé numérique Entrée
VK_SUBTRACT ($6D) : Touche pavé numérique -
VK_DECIMAL ($6E) : Touche pavé numérique . (décimal)
VK_DIVIDE ($6F) : Touche pavé numérique /
VK_F1 ($70) : Touches de fonction F1
VK_F2 ($71) : Touches de fonction F2
VK_F3 ($72) : Touches de fonction F3
VK_F4 ($73) : Touches de fonction F4
VK_F5 ($74) : Touches de fonction F5
VK_F6 ($75) : Touches de fonction F6
VK_F7 ($76) : Touches de fonction F7
VK_F8 ($77) : Touches de fonction F8
VK_F9 ($78) : Touches de fonction F9
VK_F10 ($79) : Touches de fonction F10
VK_F11 ($7A) : Touches de fonction F11
VK_F12 ($7B) : Touches de fonction F12
VK_F13 ($7C) : Touches de fonction F13
VK_F14 ($7D) : Touches de fonction F14
VK_F15 ($7E) : Touches de fonction F15
VK_F16 ($7F) : Touches de fonction F16
VK_F17 ($80) : Touches de fonction F17
VK_F18 ($81) : Touches de fonction F18
VK_F19 ($82) : Touches de fonction F19
VK_F20 ($83) : Touches de fonction F20
VK_F21 ($84) : Touches de fonction F21
VK_F22 ($85) : Touches de fonction F22
VK_F23 ($86) : Touches de fonction F23
VK_F24 ($87) : Touches de fonction F24
VK_NUMLOCK ($90) : Verrouillage pavé numérique
VK_SCROLL ($91) : Verrouillage scrolling
VK_A à VK_Z sont équivalents à 'A' à 'Z'
VK_0 à VK_9 sont équivalents à '0' à '9'
17.Voir le texte qui est dans le clipboard
function litclipboard:string;
begin
if (Clipboard.HasFormat(CF_TEXT)) then result:=Clipboard.astext;
end;
18.Mettre le
focus sur le composant suivant
SendMessage(Form1.Handle, WM_NEXTDLGCTL, 0, 0);
pour mettre le focus sur un composant précis , utiliser la
méthode SetFocus du composant :
Button1.SetFocus;
19.Changer
la vitesse d'affichage du curseur texte
Appeler la procédure windows suivante ( temps en milliseconde ) :
SetCaretBlinkTime(250);
20.Positionner
le pointeur sourie
Appeler la procédure windows suivante :
SetCursorPos(100,100);
Appeler la procédure windows suivante :
sendmessage(richedit1.handle,WM_VScroll,SB_LINEDOWN,0);
Pour faire scroller vers le haut , utiliser SB_LINEUP
22.Lancer
l'économiseur d'écran
Appeler la procédure windows suivante :
PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
23.Cacher un programme de la barre de tache
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowWindow (Form1.Handle, SW_Hide);
showwindow(Application.handle,Sw_hide);
end;
rajouter la ligne suivante pour cacher la Form
Application.ShowMainForm:=False;
24.Teste si
le Caps Lock est actif
function
IsCapsLockOn : boolean;
begin
Result := 0 <> (GetKeyState(VK_CAPITAL) and $01);
end;
2
solution : la fonction sleep ( qui bloque le programme
pendant x millisecondes )
Sleep( 1000 );
ou la procédure suivante qui traite les messages de la fenetre :
procedure delay(t:integer); // t en secondes
var NowTime : TDateTime;
begin
NowTime:=Now;
repeat
Application.ProcessMessages;
until NowTime + t / (24 * 3600) < Now;
end;
26.Lancement
de la fenetre de config de l'heure
rajouter Shellapi dans la clause USES
WinExec('rundll32.exe shell32.dll,Control_RunDLL timedate.cpl',SW_SHOWNORMAL);
27.Lancement
de la fenetre proprietes systeme
rajouter Shellapi dans la clause USES
WinExec('rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl',SW_SHOWNORMAL);
28.Lancement
de la fenetre proprietes de mots de passe
rajouter Shellapi dans la clause USES
WinExec('rundll32.exe shell32.dll,Control_RunDLL password.cpl',SW_SHOWNORMAL);
29.Changer
la résolution de l'écran sans rebooter
//
change la resolution en 640*480
procedure changeres;
var
mode:TDeviceMode;
i:integer;
begin
mode.dmSize := sizeof (MODE);
mode.dmPelsWidth := 640;
mode.dmPelsHeight := 480;
mode.dmBitsPerPel := 16;
mode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
i := ChangeDisplaySettings(mode, CDS_TEST);
if i=DISP_CHANGE_SUCCESSFUL then ChangeDisplaySettings(mode, 0)
end;
30.Controler
l'alimentation du moniteur
Cette commande permet de mettre le moniteur en veille
SendMessage(Application.Handle, WM_SYSCOMMAND,SC_MONITORPOWER,0)
ou de le remettre en fonctionnement
SendMessage(Application.Handle, WM_SYSCOMMAND,SC_MONITORPOWER,-1);
31.Controler
le tiroir du lecteur de CDROM
Cette commande permet d'ouvrir le tiroir
mciSendString('Set cdaudio door open wait', nil, 0, 0);
ou de le fermer
mciSendString('Set cdaudio door closed wait', nil, 0, 0);
32.Connaitre
la résolution de l'écran
procedure
TForm1.Button1Click(Sender: TObject);
var
hh:hdc;
larg,haut:integer;
begin
hh:=getdc(GetDesktopWindow);
larg:=getdevicecaps(hh,HORZRES);
haut:=getdevicecaps(hh,VERTRES);
end;
33.Faire un
copier/coller vertical dans l'éditeur de Delphi
Au
clavier , faire ALT+SHIFT+les touches de directions
A la sourie , faire ALT+bouton gauche
Pour revenir au copier coller standard , refaire un selection normale à
la sourie
34.Changer le papier peint de windows
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar('C:\Div33.bmp'),SPIF_SENDWININICHANGE);
35.Ecrire
en diagonale sur le canvas de la form
procedure TForm1.Button1Click(Sender: TObject);
var
LgFnt : TLogFont;
Fnt : TFont;
begin
Form1.Canvas.Font.Name := 'Arial';
Form1.Canvas.Font.Size := 18;
Fnt := TFont.Create;
Fnt.Assign(Form1.Canvas.Font);
GetObject(Fnt.Handle, sizeof(LgFnt), @LgFnt);
LgFnt.lfEscapement := 180;
LgFnt.lfOrientation := 180;
Fnt.Handle := CreateFontIndirect(LgFnt);
Form1.Canvas.Font.Assign(Fnt);
Form1.Canvas.Font.color:=clNavy;
Fnt.Free;
Form1.Canvas.TextOut(30,60,'Super!');
end;
36.Effacer
de façon simple un bitmap
with bitmap.canvas do FillRect(ClipRect);
37.Faire
que son programme soit compatible avec le menu
Pop-up 'Envoyer vers'
La partie programmation : récupérer le nom du fichier
var
fichier:string
begin
if paramcount>0 then fichier:=ParamStr(1);
end;
La partie windows : mettre un raccourci pointant vers
l'éxécutable dans le répèrtoire "C:\WINDOWS\SendTo"
38.Créer
et utiliser un fichier .INI :
Uses
inifiles;
Procedure TForm1.EcrireFichierINI;
Begin
With TIniFile.Create('Fichier.INI') do
Begin
WriteString('Section','Ident1',Str1));
WriteInteger('Section','Ident2',Int1));
free;
End
End;
Procedure
TForm1.LireFichierINI;
Begin
With TIniFile.Create('Fichier.INI') do
Begin
Str1 := ReadString('Section','Ident1','Val par default');
Int1:= ReadInteger('Section','Ident2',100');
free;
End
End;
39.Ecrire dans la
base de registre :
Uses
Registry;
procedure TForm1.EcrireDansLaBaseDeRegistre;
var
Reg :TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if KeyExists('\Software') then
begin
if OpenKey('\Software\MonAppli', true) then
begin
WriteString('Nom', 'Toto');
WriteBool('Val1', true);
WriteString('Val2', 'Test');
end;
end;
finally
free;
end;
end;
end;
Uses
MMSystem;
Procedure PlayWave ( FichierWave:String ; Mode:Integer ) ;
Var
FichWav : Array [0..100] of Char;
Begin
StrPcopy(FichWav,FichierWave);
SndPlaySound(FichWav,Mode);
End;
41.Rebooter / relancer
windows :
Procedure RebootSysteme;
Begin
ExitWindows(EW_REBOOTSYSTEM,0);
End;
Procedure RelancerWindows;
Begin
ExitWindows(EW_RESTARTWINDOWS,0);
End;
42.Déplacer
un composant à l'éxecution :
Procedure
MonObjetMouseDown(Sender: TObject;...)
Begin
ReleaseCapture;
MonObj.perform(WM_Syscommand, $F012,0);
End;
43.Spéifier
les parametres régionaux :
DecimalSeparator := ',';
ShortDateFormat := 'dd/dd/yyyy';
44.Connaître
la version du système d'exploitation :
Procedure AfficheInfoVersion;
Var
InfosVersion : TOSVersionInfo;
Begin
InfosVersion.dwOSVersionInfoSize:=sizeof(InfosVersion);
GetVersionEx(InfosVersion);
Case InfosVersion.dwPlatformId of
VER_PLATFORM_WIN32s : Systeme.caption:='Système : Microsoft Windows
3.1 / Win32s ';
VER_PLATFORM_WIN32_WINDOWS : Systeme.caption:='Système : Microsoft
Windows 95';
VER_PLATFORM_WIN32_NT : Systeme.caption:='Système : Microsoft Windows
NT';
End;
VersionWin.caption:='Version n° : '+ inttostr(InfosVersion.dwMajorVersion)
+'.'+inttostr(InfosVersion.dwMinorVersion)
+'.'+inttostr(loword(InfosVersion.dwBuildNumber))
+' '+InfosVersion.szCSDVersion ;
End;
45.Afficher la liste
des tâches de Windows :
function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean; Export; {$ifdef
Win32} StdCall; {$endif}
var
Buffer : Array[0..99] of char;
begin
GetWindowText(Wnd,Buffer,100);
if StrLen(Buffer) <> 0 then
Form1.memo1.lines.Add(StrPas(Buffer));
Result := True;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,LongInt(Self));
end;
46.Créer une
fenêtre elliptique :
var
hR : THandle;
begin
hR := CreateEllipticRgn(0,0,Form1.Width,Form1.Height);
SetWindowRgn(Handle,hR,True);
end;
47.Créer une
fenêtre transparente :
Procedure
TForm1.FormCreate(Sender: TObject);
begin
Form1.Brush.Style := bsClear;
Form1.BorderStyle := bsNone;
end;
Procedure Form1.FormPaint(Sender: TObject);
Var
Ligne : integer;
Begin
For Ligne:=0 to Form1.Height do
Begin
Form1.Canvas.pen.color:=RGB(0,MulDiv( Ligne,255,Form1.height),0); //vert
Form1.Canvas.MoveTo(0, Ligne);
Form1.Canvas.LineTo(Form1.Width, Ligne) ;
End;
End;
// ( rouge : RGB(MulDiv( Ligne,255,Form1.height),0,0)
/ ( bleu : RGB(0,0,MulDiv( Ligne,255,Form1.height)) )
49.Cacher / afficher
le bouton Démarrer:
Procedure TForm1.CacherBtnDemarrerClick(Sender: TObject);
var
Rgn : hRgn;
Begin
Rgn := CreateRectRgn(0, 0, 0, 0);
SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button',
nil), Rgn, true);
End;
Procedure TForm1.AfficherBtnDemarrerClick(Sender: TObject);
Begin
SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button',
nil), 0, true);
End;
Procedure TForm1.Button1Click(Sender: TObject);
Var
dc : hdc;
Begin
dc := GetDc(0);
MoveToEx(Dc, 0, 0, nil);
LineTo(Dc, 300, 300);
ReleaseDc(0, Dc);
End;
51.Utiliser un curseur
personnalisé
Il faut créer
un fichier ressource (avec imageEditor) dans lequel vous il y a le dessin
du Curseur perso
Ajouter {$R
tonfichier.RES} dans le source du programme
Déclarer
une constante curseur unique (pas celles utilisées par Delphi)
par exemple
crMonCurseur = 1;
En fin d'unité
:
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.
52.Scanner les programmes
en coues d'éxécution
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;
53.Connaitre le nombre
de sous-repertoires d'un Répertoire
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;
55) Transformer une
couleur en code Hexadécimal
function ColorToHex(const AColor : integer) : string;
begin
Result
:= IntToHex(AColor, 8);
end; {ColorToHex}
Cette fonction convertira un Tcolor (Qui est un type integer) en un code hexa: (exemple du bleu)
ColorDialog.CustomColors.Add('ColorA=' + ColorToHex(clBlue));
56)
Trouver la taille du bureau
procedure
TForm1.Button1Click(Sender: TObject);
var
R : TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
Label1.Caption := IntToStr(r.Top);
Label2.Caption := IntToStr(r.Left);
Label3.Caption := IntToStr(r.Bottom);
Label4.Caption := IntToStr(r.Right);
end;
57) Bouger les composants
pendant l'execution
procedure TForm1.MoveControl(Sender:TObject;
Button:TMouseButton;
Shift:TShiftState; X,Y:Integer);
var
TempPanel : TPanel;
Control :
TControl;
begin
ReleaseCapture;
if Sender is TWinControl
then
TWinControl(Sender).Perform(WM_SysCommand,$F012,0)
else
try
Control :=
TControl(Sender);
TempPanel
:= TPanel.Create(Self);
with TempPanel
do begin
Caption := '';
BevelOuter := bvNone;
SetBounds(Control.Left,Control.Top,Control.Width,Control.Height);
Parent := Control.Parent;
Control.Parent := TempPanel;
Perform(WM_SysCommand,$F012,0);
Control.Parent := Parent;
Control.Left := Left;
Control.Top := Top;
end;
finally
TempPanel.Free;
end;
end;
58) Avoir une icone
comme curseur
Var HCursor : THandle;
begin
//Donne le handle
du curseur courrant
HCursor := Screen.Cursors[
Ord(Screen.Cursor) ];
//Dessine l'icone sur
un canvas
DrawIconEx( Form1.Canvas.Handle,
XPos, YPos, HCursor, 32, 32,
0, 0, DI_NORMAL);
end;
Faire tres attention avec ce tip !
procedure FormatDriveDialog;
begin
ShellExecute(Application.Handle,
'Open',
'C:\Windows\Rundll32.exe',
'Shell32.dll,SHFormatDrive',
'C:\Windows',
SW_SHOWNORMAL);
end;
function SHFormatDrive(hWnd :
HWnd;
Drive, fmtID, Options : LongInt):longint;
stdcall; external 'shell32.dll';
procedure QuietFormatDrive;
const
SHFMT_ID_DEFAULT
= $FFFF;
SHFMT_OPT_QUICK
= $0000;
SHFMT_OPT_FULL
= $0001;
SHFMT_OPT_SYSONLY = $0002;
SHFMT_ERROR
= $FFFFFFFF;
SHFMT_CANCEL
= $FFFFFFFE;
SHFMT_NOFORMAT
= $FFFFFFFD;
begin
case SHFormatDrive(Handle,
0, SHFMT_ID_DEFAULT, SHFMT_OPT_FULL) of
SHFMT_ERROR
: ShowMessage('Error on last format, drive may be formatable');
SHFMT_CANCEL
: ShowMessage('Last format was canceled');
SHFMT_NOFORMAT
: ShowMessage('Drive is not formatable');
end;
end;
60) Utiliser le CPU
a 100% pour son prog.
var
H : THandle;
begin
H := GetCurrentProcess();
SetPriorityClass(H,REALTIME_PRIORITY_CLASS);
end;
61) Remplacer le
bureau Windows par votre application
Windows NT
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows
NT\CurrentVersion\Winlogon
Insérez la valeur c:\votrechemin\votreappli.exe
Windows95
Editez Win.Ini, Sous [Desktop] mettez
Shell=c:\votrechemin\votreappli.exe
62) Eviter les messages
d'erreur critique de Windows
var
wOldErrorMode
: Word;
begin
wOldErrorMode
:=SetErrorMode(SEM_FAILCRITICALERRORS );
try
//Error code here
finally
SetErrorMode(
wOldErrorMode );
end;
SetSystemPowerState(FALSE,FALSE);
64) Connaitre le runtime
de Windows
Pour savoir depuis combien d temps Windows est lancé :
Label1.caption := IntToStr(GetTickCount);
65) Connaitre la langue
de Windows
function Language:string;
var
IdiomaID:LangID;
Idioma:
array [0..100] of char;
begin
{Obtiene
el ID del idioma del sistema}
{Get
System ID}
IdiomaID:=GetSystemDefaultLangID;
{Obtiene
el nombre del idioma}
{Get
Language Name}
VerLanguageName(IdiomaID,Idioma,100);
Result:=String(Idioma);
end;
66) Enregistrer un
fichier *.wav
uses mmSystem;
....
procedure TForm1.Button1Click(Sender:
TObject);
begin
mciSendString('OPEN
NEW TYPE WAVEAUDIO ALIAS mysound', nil, 0, handle); //Enregistre
mciSendString('SET
mysound TIME FORMAT MS '+ // format...
'BITSPERSAMPLE 8 '+
// 8 Bit
'CHANNELS 1 '+
// MONO
'SAMPLESPERSEC 8000 '+
// 8 KHz
'BYTESPERSEC 8000',
// 8000 Bytes/s
nil, 0, handle);
mciSendString('RECORD
mysound', nil, 0, handle); // enregistrement
end;
procedure TForm1.Button2Click(Sender:
TObject); // Stop
begin
mciSendString('STOP
mysound', nil, 0, handle)
end;
procedure TForm1.Button3Click(Sender:
TObject); // Sauvegarde
var verz: string;
begin
GetDir(0,
verz);
mciSendString(PChar('SAVE
mysound ' + verz + '/test.wav'), nil, 0, handle);
mciSendString('CLOSE
mysound', nil, 0, handle)
end;
procedure TForm1.Button1Click(Sender:TObject);
var
s : string[255];
c : array[0..255]
of Byte absolute s;
i:Integer;
begin
{encode}
s:='siro_com
developers';
For i:=1
to ord(s[0]) do c[i] := 23 XOr c[i];
Label1.Caption:=s;
{Decode}
s:=Label1.Caption;
For i:=1
to Length(s) do s[i] := 23 XOr ord(s[i]));
Label2.Caption:=s;
end;
Retour à la page
principale(prog)
Retour à la page d'accueil