FAQ LazarusConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Uses Classes, SysUtils, Process; 
  
Var Processus : TProcess; 
  
Begin 
  (* Création du processus *) 
  Processus := TProcess.Create(Nil); 
  (* Définition de la commande à exécuter *) 
  Processus.CommandLine := 'fpc'; 
  (* On Attendra la fin du programme externe avant de continuer *) 
  Processus.Options := Processus.Options + [poWaitOnExit]; 
  (* Tout est prêt pour l'exécution *) 
  Processus.Execute; 
  (* Libération du processus *) 
  Processus.Free;    
End.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Uses Classes, SysUtils, Process;  
  
Var Processus : TProcess;  
  
Begin  
  (* Création du processus *)  
  Processus := TProcess.Create(Nil);  
  (* Définition de la commande à exécuter *)  
  //Processus.CommandLine := 'fpc';   DEPRECATED  
  //Processus.ApplicationName:='fpc';   DEPRECATED 
  Processus.Executable:='fpc'; 
  (* On Attendra la fin du programme externe avant de continuer *)  
  Processus.Options := Processus.Options + [poWaitOnExit];  
  (* Tout est prêt pour l'exécution *)  
  Processus.Execute;  
  (* Libération du processus *)  
  Processus.Free;     
End.

1
2
3
4
5
6
Image2.Transparent := True; 
Image2.Picture.LoadFromFile('test.png'); 
Image1.Transparent := True; 
Image1.Canvas.Brush.Color := clGreen; 
Image1.Canvas.FillRect(Rect(0,0,1024,512)); 
Image1.Canvas.CopyRect(Rect(0,0,100,100),Image2.Canvas,Rect(0,0,100,100));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Procedure MyForm.MyButtonOnClick (Sender : TObject); 
Var 
  buffer : THandle; 
  bmp : TBitmap; 
  memstream : TMemoryStream; 
Begin 
  bmp := TBitmap.Create; 
  
  buffer := Windows.LoadBitmap(hInstance,MAKEINTRESOURCE(ResourceID)); 
  
  if (buffer = 0) then exit; // Error loading the bitmap 
  
  bmp.Handle := buffer; 
  memstream := TMemoryStream.create; 
  try 
    bmp.SaveToStream(memstream); 
    memstream.position := 0; 
    bmp.LoadFromStream(memstream); 
  finally 
    memstream.free; 
  end; 
  
  bmp.Transparent := True; 
  bmp.TransparentColor := clFuchsia; 
  
  MyCanvas.Draw(0,0,bmp); 
  
  bmp.Free; // Release allocated resource 
End;

1
2
3
4
5
6
Procedure TForm1.ListView1SelectItem (Sender : TObject; Item : TListItem; Selected : Boolean); 
Var 
  r : TRect; 
Begin 
  r := ListView1.ItemFocused.DisplayRect(drBounds); 
End;

1
2
TStringGrid(Sender).Canvas.TextStyle.SingleLine := false; 
TStringGrid(Sender).Canvas.TextStyle.WordBreak := true;

1
2
StringGrid1.SaveOptions := [soContent]; 
StringGrid1.LoadFromFile('TEST.TXT');

1
2
StringGrid1.SaveOptions := [soContent]; 
StringGrid1.SaveToFile('TEST.TXT');

TreeView1.Items.Add(nil,'la on met le texte qu''on veut');

1
2
TreeView1.Items.Item[0].ImageIndex := 0; 
TreeView1.Items.Item[1].SelectedIndex := 1;

1
2
3
4
5
6
7
8
9
10
11
TrayIcon1.Icon.TransparentColor := RGBToColor(255,255,255); 
  TrayIcon1.Icon.Transparent := True; 
{$ifdef linux} 
  TrayIcon1.Icon.LoadFromFile('l''emplacement de ton fichier ico sous linux'); 
{$else} 
  TrayIcon1.Icon.Handle := LoadIcon(hInstance, MAKEINTRESOURCE(IDI_ICON1)); 
{$endif} 
  TrayIcon1.Hint := 'ton hint'; 
  TrayIcon1.Show; 
  Application.ProcessMessages; 
  Visible := False;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
{$mode objfpc}{$H+} 
  
Interface 
  
Uses 
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Synaser, Buttons, ExtCtrls; 
  
Type 
  
  { TForm1 } 
  
  TForm1 = class(TForm) 
    ConnectButton : TButton; 
    SendButton : TButton; 
    ComboBoxNumeroPort : TComboBox; 
    ComboBoxBauds : TComboBox; 
    Trame : TEdit; 
    Label1 : TLabel; 
    Terminal : TMemo; 
    Timer1 : TTimer; 
  
    Procedure ConnectButtonClick (Sender : TObject); 
    Procedure SendButtonClick (Sender : TObject); 
    Procedure FormCreate (Sender : TObject); 
    Procedure Timer1Timer (Sender : TObject); 
  
  private 
    { private declarations } 
  public 
    { public declarations } 
  end;  
  
Var 
  Form1 : TForm1;  
  PortCom : TBlockSerial; 
  TimeOut : integer; 
  
Const 
  ligneMax = 30; 
  
Implementation 
  
{ TForm1 } 
  
Procedure TForm1.FormCreate (Sender : TObject); 
// Lister les ports disponibles 
Var l : String; 
    p : Integer; 
Begin 
  l := GetSerialPortNames; 
  if l > '' then repeat 
    begin 
    p :=  pos(',',l); 
    if p > 0 then 
      begin 
      form1.ComboBoxNumeroPort.Items.Add(copy(L,1,p-1)); 
      delete(L,1,p); 
      end 
    else 
      form1.ComboBoxNumeroPort.Items.Add(L); 
    end; 
    until p = 0; 
End; 
  
Procedure TForm1.ConnectButtonClick (Sender : TObject); 
Var 
  bauds: Integer; 
Const 
  ligneMax = 30; 
Begin 
  PortCom := TBlockSerial.Create; 
  PortCom.RaiseExcept := true; 
  with ComboBoxNumeroPort do PortCom.Connect(Items[itemindex]); 
  with ComboBoxBauds do bauds := StrToInt(Items[itemindex]); 
  PortCom.Config(bauds,8,'N',0,false,false); 
  TimeOut := LigneMax*10000 div bauds; 
  timer1.enabled := true; 
End; 
  
Procedure TForm1.Timer1Timer (Sender : TObject); 
// A l'écoute du péripherique 
Var 
  ligne : String; 
  WD : Integer; 
Begin 
  timer1.Enabled := false; 
  WD := PortCom.WaitingData; 
  if WD > 0 then  terminal.Lines.Add(PortCom.Recvstring(TimeOut)); 
  timer1.Enabled := true; 
End; 
  
Procedure TForm1.SendButtonClick (Sender : TObject); 
Begin 
  PortCom.SendString(Trame.Text+CRLF); 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Unit filedownload; 
  
{$mode objfpc}{$H+} 
  
{ 
   Download file via indy. 
   Copyright Marty ( neodivx@neodivx.be ) 
   2008/01/28 
} 
  
Interface 
  
Uses 
  Classes, SysUtils, Forms, idHTTP, IdComponent; 
  
Type 
  TFileDownloadEvent = Procedure (Sender :TObject; _position, _min, _max : Double) of Object; 
  TFileDownload = class(TComponent) 
  private 
    FFileDownloadEvent : TFileDownloadEvent; 
    FMax : Double; 
    FRunning : Boolean; 
    FHTTP : TidHTTP; 
    FStream : TFileStream; 
    FFileFrom, FFileTo : String; 
  private 
    Procedure CmMessage (_position,_min,_max:Double); 
    Procedure IdHTTP1WorkBegin (ASender : TObject; AWorkMode : TWorkMode; AWorkCountMax : Int64); 
    Procedure IdHTTP1Work (ASender : TObject; AWorkMode : TWorkMode; AWorkCount : Int64); 
    Procedure IdHTTP1WorkEnd (ASender : TObject; AWorkMode : TWorkMode); 
  public 
    Constructor Create (AOwner :TComponent); override; 
    Destructor Destroy; override; 
    Function Run :Boolean; 
  public 
    property OnFileDownload :TFileDownloadEvent read FFileDownloadEvent write FFileDownloadEvent; 
    property Running :Boolean read FRunning; 
    property FileFrom :String read FFileFrom write FFileFrom; 
    property FileTo :String read FFileTo write FFileTo; 
  end; 
  
Implementation 
  
Constructor TFileDownload.Create (AOwner :TComponent); 
begin 
  inherited Create(AOwner); 
  FRunning:=False; 
  FHTTP := TIdHTTP.create(nil); 
  FHTTP.OnWork:=@idHTTP1Work; 
  FHTTP.OnWorkBegin:=@idHTTP1WorkBegin; 
  FHTTP.OnWorkEnd:=@idHTTP1WorkEnd; 
end; 
  
Destructor TFileDownload.Destroy; 
Begin 
  try 
    FHTTP.Free; 
  except 
  end; 
  inherited Destroy; 
End; 
  
Procedure TFileDownload.CmMessage (_position, _min, _max : Double); 
Begin 
  if Assigned(FFileDownloadEvent) then begin 
    FFileDownloadEvent(Self,_position,_min,_max); 
  end; 
  Application.ProcessMessages; 
End; 
  
Procedure TFileDownload.IdHTTP1WorkBegin (ASender : TObject; AWorkMode : TWorkMode; AWorkCountMax : Int64); 
Begin 
  FRunning := True; 
  if AWorkMode = wmRead then begin 
    FMax := AWorkCountMax; 
    CmMessage(0,0,AWorkCountMax); 
  end; 
End; 
  
Procedure TFileDownload.IdHTTP1Work (ASender : TObject; AWorkMode : TWorkMode; AWorkCount : Int64); 
Begin 
  if AWorkMode = wmRead then begin 
    CmMessage(AWorkCount,0,FMax); 
  end; 
End; 
  
Procedure TFileDownload.IdHTTP1WorkEnd (ASender : TObject; AWorkMode : TWorkMode); 
Begin 
  FRunning := False; 
  if AWorkMode = wmRead then begin 
    CmMessage(FMax,0,FMax); 
  end; 
End; 
  
Function TFileDownload.Run : Boolean; 
Begin 
  FStream := TFileStream.Create(FFileTo,fmCreate or fmShareDenyNone); 
  FHTTP.Get(FFileFrom,FStream); 
  // correction 1 
  try 
     FStream.Free; 
  except 
  end; 
  Result := True; 
End; 
  
End.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Unit Unit1;  
  
{$mode objfpc}{$H+} 
  
Interface 
  
Uses 
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, ComCtrls, StdCtrls, filedownload; 
  
Type 
  
  { TForm1 } 
  
  TForm1 = class(TForm) 
    BitBtn1 : TBitBtn; 
    Label1 : TLabel; 
    ProgressBar1 : TProgressBar; 
    Procedure BitBtn1Click (Sender : TObject); 
  private 
    { private declarations } 
  public 
    { public declarations } 
    Procedure Update (Sender :TObject; _position, _min, _max : Double); 
  end; 
  
Var 
  Form1 : TForm1;  
  
Implementation 
  
{ TForm1 } 
  
Procedure TForm1.Update (Sender :TObject; _position, _min, _max : Double); 
Begin 
  Label1.Caption := Format('%f bytes',[_position]); 
  ProgressBar1.Max := Round(_max/1024); 
  ProgressBar1.Position := Round(_position/1024); 
  Application.ProcessMessages; 
End; 
  
Procedure TForm1.BitBtn1Click (Sender : TObject); 
Var 
  FileDownload1 : TFileDownload; 
Begin 
  FileDownload1 := TFileDownload.Create(Self); 
  FileDownload1.OnFileDownload := @Update; 
  FileDownload1.FileFrom := 'http://www.truc.be/filefrom.zip'; 
  FileDownload1.FileTo := '/tmp/test.zip'; 
  FileDownload1.Run; 
  while FileDownload1.Running do begin 
    Application.ProcessMessages; 
  end; 
  ShowMessage('Work''s done'); 
End; 
  
Initialization 
  {$I unit1.lrs} 
  
End.

WandExport = 'libWand';

WandExport = 'libwand';

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Procedure Tform1.chargementaffichageduneimage (filename : String); 
Var 
  status : MagickBooleanType; 
  wand : PMagickWand; 
Begin 
   MagickWandGenesis; 
     // Initialisation de la librairie 
   wand := NewMagickWand; 
     // Création du container 
   status := MagickReadImage(wand,PChar(filename)); 
     // Chargement du fichier dans le container et renvoi éventuel d'erreur 
   MagickResizeImage(wand,640,480,LanczosFilter,1.0); 
     // Changer la taille de l'image dans le container 
   status := MagickWriteImages(wand,'/tmp/image.png',MagickTrue); 
     // Sauver le container dans un fichier et renvoi éventuel d'erreur 
   Image1.Picture.LoadFromFile('/tmp/image.png'); 
     // Chargement du fichier container sauvé (attention image1 etant un composant Timage sur la form) 
   wand := DestroyMagickWand(wand); 
     // Libération du container 
   MagickWandTerminus; 
     // Libération de la librairie 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer; 
  aRect: TRect; aState: TGridDrawState); 
begin 
  if (gdFixed in aState) then 
    Exit; 
  with StringGrid1 do 
  begin 
    if Cells[aCol, aRow] = '0' then 
    begin 
      Canvas.Brush.Color := clBlack; // couleur du fond 
      Canvas.Font.Color := clWhite;  // couleur du texte 
      Canvas.FillRect(aRect); 
      Canvas.TextOut(aRect.Left + 2, aRect.Top + 2, Cells[aCol, ARow]); 
    end; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer; 
  aRect: TRect; aState: TGridDrawState); 
begin 
  with StringGrid1 do 
  begin 
    if gdFixed in aState then 
    begin 
      Canvas.Brush.Color := clBtnFace; 
      Canvas.Font.Color := clBlack; 
    end else 
      if Cells[aCol, aRow] = '0' then 
      begin 
        Canvas.Brush.Color := clBlack; // couleur du fond 
        Canvas.Font.Color := clWhite;  // couleur du texte 
      end 
      else 
      begin 
        Canvas.Brush.Color := clWhite; 
        Canvas.Font.Color := clBlack; 
      end; 
    Canvas.FillRect(aRect); 
    Canvas.TextOut(aRect.Left + 2, aRect.Top + 2, Cells[aCol, ARow]); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure InverseTriFileListBox(boiteListe: TFileListBox); 
var 
  liste: TStringList; 
  i: integer; 
begin 
  liste := TStringList.Create; 
  try 
    liste.Sorted := False; 
    for i := boiteListe.Count -1 downto 0 do 
    begin 
      liste.Add(boiteListe.Items.Strings[i]); 
    end; 
    boiteListe.Clear; 
    boiteListe.Sorted := False; 
    for i := 0 to liste.Count -1 do 
    begin 
      boiteListe.Items.Add(liste.Strings[i]); 
    end; 
  finally 
    liste.Free; 
  end; 
end;