@Echo offEcho ******* Building ******* if exist .cfg ren .cfg .cf~ if exist DCC32.cfg ren DCC32.cfg DCC32.cf~rem # Make console target, unless overridden laterecho -M -CC >> DCC32.cfgecho -$A+ >>...
Pour pouvoir terminer une application avec un bouton Caption : &quitter : begin Terminate.Application; end; Et voila, c tout :)
unit Unit1;interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) OpenDialog1: TOpenDialog; Button1: TButton; ...
//Exemple pour Internet Explorer var MyIcon: TIcon; begin MyIcon := TIcon.Create; try MyIcon.Handle := LoadIcon(0, IDI_ASTERISK); SendMessage(FindWindow('IEFrame', nil),...
//Placer des TButton, TEdit, ... sur Form1//Affecter à l'évenement OnEnter la procédure Edit1Enter//Déplacer la focallisation avec la touche TAB procedure TForm1.Edit1Enter(Sender: TObject);...
implementation{$R *.DFM} uses Richedit;type TCharacterFormat = (CFM_Superscript, CFM_Subscript, CFM_Normal); procedure RE_SetCharFormat(RichEdit: TRichEdit; CharacterFormat: TCharacterFormat); var...
type TForm1 = class(TForm) private procedure WMNCPaint( var Msg: TWMNCPaint); message WM_NCPAINT; public end; var Form1: TForm1;implementation{$r *.dfm} procedure TForm1.WMNCPaint( var...
procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean; Colors: array of TColor);type RGBArray = array[0..2] of Byte; var x, y, z, stelle, mx, bis, faColorsh, mass: Integer; ...
function FichierSize(Fichier: string; Unite: Boolean): string; var Sr: TSearchRec; Val: Extended; begin result := '0'; if FindFirst(Fichier, faAnyFile, sr) = 0 then if Unite...
Petit exemple sur la copie de fichiers vers a: avec changement de disquette lorsque ladisquette est pleine.
unit Unit1;interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private {...
uses ComObj; function ExcelSaveAsText(ExcelFile, TextFile: TFileName): Boolean; const xlText = -4158; var ExcelApp: OleVariant; vTemp1, vTemp2, vTemp3: OLEVariant; begin Result := False; ...
procedure TForm1.Button1Click(Sender: TObject); var f: TForm; begin f := Dialogs.CreateMessageDialog('Bonjour à tous', dialogs.mtInformation, dialogs.mbOKCancel); F.Caption:='Ma...
uses Printers, WinSpool; procedure TForm1.Button1Click(Sender: TObject); var Dev, Drv, Prt: Array[0..255] of Char; DM1: PDeviceMode; DM2: PDeviceMode; Sz: Integer; DevM: THandle; begin ...
uses WinInet; function FtpDownloadFile(strHost, strUser, strPwd: string; Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean; ...
procedure RestartProgram; var FullPrgmPath: PChar; begin FullPrgmPath := PChar(Application.ExeName); WinExec(FullPrgmPath, SW_SHOWMAXIMIZED); Application.Terminate; end;
unit Unit1;interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, commctrl;type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; ...
function Min(a, b: Longint): Longint; begin if a > b then Result := b else Result := a; end; function Max(a, b: Longint): Longint; begin if a > b then Result := a else Result :=...
unit Unit1;interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw, ActiveX;type TForm1 = class(TForm) WebBrowser1: TWebBrowser; ...
// - - - - - - - - - - - - -// SOURCE DE LA FONCTION// - - - - - - - - - - - - -// NECESSITE LA FONCTION "MAJUSCULE" (qui est au STRING que UPCASE est aux CHAR ) :Function Majuscule( S :...