Apprendre à créer des transitions d'image à image avec Lazarus et BGRABitmap

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
type

  { TMainForm }

  TMainForm = class(TForm)
    btnGo: TButton;
    cbOpacity: TCheckBox;
    imgFrom: TImage;
    imgTo: TImage;
    lblSpeed: TLabel;
    imgResult: TPanel; // Remplacement du TImage
    tbarSpeed: TTrackBar;
    procedure btnGoClick(Sender: TObject);
    procedure cbOpacityChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure imgResultPaint(Sender: TObject);
    procedure tbarSpeedChange(Sender: TObject);
  private
    fBGRAFrom, fBGRATo: TBGRABitmap;
    LBGRATemp: TBGRABitmap; // Ajout du tampon pour l'animation
    fSpeed: Byte;
    fStep: Byte;
    fWithOpacity: Boolean;
    procedure SetSpeed(AValue: Byte);
    procedure SetWithOpacity(AValue: Boolean);
  public
    function Opacity(Up: Boolean = True): Byte;
    property Speed: Byte read fSpeed write SetSpeed default C_DefaultSpeed;
    property WithOpacity: Boolean read fWithOpacity write SetWithOpacity;
  end;    

procedure TMainForm.btnGoClick(Sender: TObject);
// *** dessin ***
var

  LY, LX: Integer;
begin
  btnGo.Enabled := False;

  try
    LX := 0;
    LY := 0;
    fStep := 0;
    repeat
      Inc(fStep);
      LBGRATemp.FillRect(ClientRect, BGRABlack);
      LBGRATemp.PutImage(0, 0, fBGRAFrom, dmSet, Opacity(False));
      // traitement ici...
     // LY := - imgResult.ClientHeight + imgResult.ClientHeight * fStep div 100; // OVERDOWN
      LBGRATemp.PutImage(LX, LY, fBGRATo, dmDrawWithTransparency, Opacity);
      imgResult.Repaint;
      Application.ProcessMessages; // Envoi du message pour redessiner le TPanel imgResult
      sleep(100 - fSpeed);
    until fStep = 100;
  finally
   //
    btnGo.Enabled := True;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
// *** construction des objets de travail ***
begin
  Caption := rsTestName;
  fBGRAFrom := TBGRABitmap.Create(imgFrom.Picture.Bitmap);
  BGRAReplace(fBGRAFrom, fBGRAFrom.Resample(imgResult.ClientWidth, imgResult.ClientHeight));
  fBGRATo := TBGRABitmap.Create(imgTo.Picture.Bitmap);
  BGRAReplace(fBGRATo, fBGRATo.Resample(imgResult.ClientWidth, imgResult.ClientHeight));
  fSpeed := C_DefaultSpeed;
  tbarSpeed.Position:= Speed;
  LBGRATemp := TBGRABitmap.Create(imgResult.ClientWidth, imgResult.ClientHeight, BGRABlack); // Creation du tampon
end;

procedure TMainForm.FormDestroy(Sender: TObject);
// *** destruction des objets de travail ***
begin
  fBGRAFrom.Free;
  fBGRATo.Free;
  LBGRATemp.Free; // Liberation du tampon
end;

procedure TMainForm.imgResultPaint(Sender: TObject);
begin
    LBGRATemp.Draw(imgResult.Canvas, 0, 0); // Transfert du tampon à la surface d'affichage
end;