Discussion :

[Jipété]

Bonsoir,

je sens que cette vérole va m'occuper tout le week-end (alors que j'avais autre chose à faire...)

Je suis parti des 2 routines qui se trouvent à la fin de cette page, il m'a bien sûr fallu des heures et des heures pour les adapter du monde Delphi à l'univers Lazarus, et bien sûr au bout du compte ça coince et je ne sais plus où chercher.

L'idée c'est de dupliquer un bitmap dans un autre à coups d'array of Byte, GetLineStart (le remplaçant de Scanline) et autres joyeusetés à base de pointeurs.

Sur la copie d'écran (en haut XP, en bas Linux) il y a 3 images : de g. à dr., image1 qui affiche la source, image2 qui affiche(ra) la copie et image3 en contrôle.

Un clic sur le Button1 affiche une OpenPictureDialog permettant de choisir une image ou d'annuler et c'est l'image générée au FormCreate qui sera utilisée comme source de la copie, lancée avec Button2.
Rien de spécial, sauf les résultats :
image source carrée générée par code, tout va bien :


Même code mais générant une image rectangulaire (simple changement de la constante IMAGEHEIGHT), tout va toujours bien SAUF à la clôture sous Windows : access violation alors que FormClose ou FormDestroy sont vides et que les rares objets créés dans les procédures sont détruits en fin de procédure.

Et maintenant la catastrophe, en utilisant un fichier de 128x96 : ok sous Windows, une horreur sous Linux !


Essai avec un fichier carré = même problème, et avec un fichier carré avec des pixels de 32 bits (RGBA) = même problème.
Plus l'access violation à la clôture, encore, sous Windows :

Access violation qui n'existe plus si IMAGEHEIGHT > IMAGEWIDTH mais le processus non fermé continue à tourner en mémoire !

Bref, 3 TImage, 2 TButton, 1 TOpenPictureDialog, le code ci-dessous et le fichier arc-en-ciel : aec_128x96x72.zip

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    opd: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    procedure Load(Filename: String);
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
uses
  LCLtype; // pour pRGBQuad
 
type
  TMyByteArray = array of Byte;
 
var
  MyBytes: TMyByteArray;
 
function BytesPerPixel(APixelFormat: TPixelFormat): Integer;
begin
  Result := -1;
  case APixelFormat of
    pf8bit : Result := 1;
    pf16bit: Result := 2;
    pf24bit: Result := 3;
    pf32bit: Result := 4;
  end;
end;
 
// pour créer l'image de base, qui sera recopiée
procedure TForm1.FormCreate(Sender: TObject);
const
  IMAGEWIDTH  = 128;
  IMAGEHEIGHT = 128;
var
  h,w: Integer;
  aBmp: TBitmap;
  {$IFDEF WINDOWS}
  p   :  pRGBTriple; // assumes pf24bit scanlines
  {$ELSE}
  p   :  pRGBQuad;   // assumes pf24bit scanlines
  {$ENDIF}
  FUNCTION RGBtoRGBTriple(CONST red, green, blue:  BYTE):  TRGBTriple;
  BEGIN
    WITH RESULT DO
    BEGIN
      rgbtRed   := red;
      rgbtGreen := green;
      rgbtBlue  := blue
    END
  END {RGBtoRGBTriple};
 
  FUNCTION RGBAtoRGBAQuad(CONST red, green, blue, reserved: BYTE): TRGBQuad;
  BEGIN
    WITH RESULT DO BEGIN
      rgbRed   := red;
      rgbGreen := green;
      rgbBlue  := blue;
      rgbReserved := reserved;
    END
  END {RGBAtoRGBAQuad};
begin
  DoubleBuffered := True;
 
  aBmp := TBitmap.Create;
  with aBmp do begin
    PixelFormat := pf24bit;
    SetSize(IMAGEWIDTH, IMAGEHEIGHT);
 
    BeginUpdate();
    for h := 0 to IMAGEHEIGHT-1 do begin
      {$IFDEF WINDOWS}
      p := pRGBTriple(RawImage.GetLineStart(h));
      for w := 0 to IMAGEWIDTH-1 do
        p[w] := RGBtoRGBTriple(h, w, (h+w) div 2);
      {$ELSE}
      p := pRGBQuad(RawImage.GetLineStart(h));
      for w := 0 to IMAGEWIDTH-1 do
        p[w] := RGBAtoRGBAQuad(h, w, (h+w) div 2, 255);
      {$ENDIF}
    end;
    EndUpdate();
 
    image1.Picture.Assign(aBmp);
    Free;
  end;
end;
 
procedure BitmapToBytes(Bitmap: TBitmap; out Bytes: TMyByteArray);
var
  h, BPL, BPP: Integer;
begin
  BPP := BytesPerPixel(Bitmap.PixelFormat)+1; // +1 = /!\ /!\ /!\ /!\
  if BPP < 1 then
    raise Exception.Create('Unknown pixel format');
  SetLength(Bytes, Bitmap.Width * Bitmap.Height * BPP);
  BPL := Bitmap.Width * BPP; // = BytesPerLine
  for h := 0 to Bitmap.Height-1 do
    Move(Bitmap.RawImage.GetLineStart(h)^, Bytes[h * BPL], BPL);
end;
 
// Lazarus ne connait pas CopyMemory, donc Move, mais méfiance à l'ordre des paramètres !
// CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
//   <>  Move(Source^, Destination^, Length);     /!\ /!\ /!\ /!\
 
procedure BytesToBitmap(const Bytes: TMyByteArray; Bitmap: TBitmap;
  aPixelFormat: TPixelFormat; aWidth, aHeight: Integer);
var
  h, BPL, BPP: Integer;
begin
  BPP := BytesPerPixel(aPixelFormat)+1; // +1 = /!\ /!\ /!\ /!\
  if BPP < 1 then
    raise Exception.Create('Unknown pixel format');
  if (aWidth * aHeight * BPP) <> Length(Bytes) then
    raise Exception.Create('Bytes do not match target image properties');
  Bitmap.PixelFormat := aPixelFormat;
  Bitmap.Width  := aWidth;
  Bitmap.Height := aHeight;
  BPL := Bitmap.Width * BPP; // = BytesPerLine
  Bitmap.BeginUpdate();
  for h := 0 to Bitmap.Height-1 do
    Move(Bytes[h * BPL], Bitmap.RawImage.GetLineStart(h)^, BPL);
  Bitmap.EndUpdate();
end;
 
procedure TForm1.Load(Filename: String);
var
 Pict: TPicture;
begin
 Pict := TPicture.Create;
 Pict.LoadFromFile(Filename);
 with image1 do begin
   Width := Pict.Width;
   Height:= Pict.Height;
   Picture.Assign(Pict);
 end;
 Pict.Free
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if opd.Execute then begin
    Image1.Picture := nil;
    Load(opd.FileName);
  end;
  BitmapToBytes(Image1.Picture.Bitmap, MyBytes);
  Caption := 'Copie des datas faite';
  Button2.Enabled:=True;
  Button2.SetFocus;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  BytesToBitmap(MyBytes, Image2.Picture.Bitmap,
    Image1.Picture.Bitmap.PixelFormat,
    Image1.Picture.Bitmap.Width,
    Image1.Picture.Bitmap.Height);
  image3.Picture := image2.Picture; // pour contrôle
end;

Bon, je veux pas dire, hein, mais le graphisme bas niveau et multi-plateforme, c'est vraiment l'enfer