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
| procedure TForm1.Button1Click(Sender: TObject);
var
Start: DWORD;
bmp: TBitmap;
p: pRGBQuad;
OffsetToDatas, VersionHeader, biBitCount: integer;
function GetVersionHeader(biSize: integer): integer;
begin
case biSize of
12: Result:=9; // perso : pour os/2
40: Result:=1;
52: Result:=2; // non documenté, utilisé par Adobe
56: Result:=3; // non documenté, utilisé par Adobe
108: Result:=4;
124: Result:=5;
else Result:=0;
end;
end;
procedure GetHeaderInfos(f: string; b: TBitmap);
var
bs: TBytesStream;
begin
bs := TBytesStream.Create;
if b = nil then bs.LoadFromFile(f);
if f = '' then b.SaveToStream(bs);
bs.Position := 10; // bfOffBits @0A
OffsetToDatas := bs.ReadDWord;
bs.Position := 14; // biSize @0E
VersionHeader := GetVersionHeader(bs.ReadDWord);
bs.Position := 28; // biBitCount @1C
biBitCount := bs.ReadWord;
bs.Free;
end;
procedure WorkWithMitchell(Filename: String);
var
w,h: Integer;
begin
ci := TCompactImage.Create(0,0);
ci.LoadFromFile(FileName);
with img do begin
Picture := nil;
Width := ci.Width;
Height:= ci.Height;
end;
lclci := TLCLCompactImage.Create(ci); // Update des dimensions inclus dans le Create
//Memo1.Text:=lclci.Description;
GetHeaderInfos(filename, nil);
bmp:=TBitmap.Create;
with bmp do begin
//PixelFormat et dimensions inutiles, positionnés par Assign
Assign(lclci.ImageBitmap);
if biBitCount = 32 then begin // +1 et PAS PixelFormat qui est tjrs à 32 !
BeginUpdate();
for h := 0 to Height-1 do begin
p := pRGBQuad(RawImage.GetLineStart(h));
for w := 0 to Width-1 do begin
if p[w].rgbReserved = 0
then p[w].rgbReserved := 255
else if (p[w].rgbReserved < 255) then p[w].rgbReserved := 255-p[w].rgbReserved;
// < 255 car si 00 dans le fichier alors Mitchell inverse à 255. Des heures là-dessus...
end;
end; //for h
EndUpdate();
end; //if BC
if ckbxSave.Checked then SaveToFile('/chemin/test.bmp');
end; //with bmp
img.Picture.Bitmap.Assign(bmp);
if ckbxShowInfos.Checked then
Memo1.Text:=StringReplace(img.Picture.Bitmap.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]);
bmp.Free;
lclci.Free;
ci.Free;
end;
begin
if opd.Execute then begin
Start := GetTickCount;
WorkWithMitchell(opd.Filename);
Caption := IntToStr(GetTickCount-Start) + ' millisec';
end;
end; |
) qui peut à ce point perturber la copie img.Picture.Bitmap.Canvas.Draw(10,10,Bmp); à tel point que le PixelFormat en soit changé ?
Répondre avec citation
)...
Envoyé par BeanzMaster
...
).
) à cause de Projet / Options / Chemins / Nom du fichier cible qui contient "../Test" et j'ai viré "../".
et oui j'ai eu le temp de faire quelques tests avec ma liste de bmp (Merci Yves pour tes tests et tes fichiers de resultats. Voici le mien avec un TImage et les méthodes de Lazarus : 
)
Partager