Tweet
Hallo zusammen, ich versuche (inzwischen verzweifelt) zwei Bitmaps, bzw. eigentlich Icons) zu vergleichen. Hintergrund ist, das eine Dokumentenverwaltung (Dokumente und inzwischen eben auch Icons in einer Datenbank) zu den Dokumenten auch Icons anzeigen kann. Wird ein Dokument importiert, hole ich das Systemicon dazu und will prüfen, ob ich dieses Icon bereits in der DB habe, um nicht irgendwann einige Hunbdert(tausend?) mal z.B. das Word.doc Icon in der gleichen Tabelle zu haben, ich habe von Scanline bis Canvas.Pixel alles mögliche und unmögliche versucht, das Problem ist aber, das das gleiche Icon beim Vergleich eben nicht mehr gleich ist?! Zur Zeit aktuell ist folgende Prozedur (beim Experimentieren mit Scanline ist übrigends hier und da der Debugger ordentlich durcheinander gekommen), x1 und 2 sind ganz hilfreich um mittels überwachter Ausdrücke und wiederholungszähler 32 die jeweilige Zeile zu sehen. Lässt man das free mal weg und hinterher die bmps irgendwo aufs Formular pinnen sind sie optisch identisch!
<pre>
procedure Tdvmain.AddFile(filename:String);
type TTest = TColor;
var sysImg,myImg : Integer;
icon : TIcon;
fn : String;
z1, z2 : PByteArray;
x1, x2 : TTest;
function iconsEqual:Boolean;
var x, y : Integer;
begin
result := true;
for y := 0 to bm1.height-1 do begin
x1 := bm1.Canvas.Pixels[y,0]; //(bm1.ScanLine[y]^);
x2 := bm2.Canvas.Pixels[y,0];//(bm2.ScanLine[y]^);
z1 := bm1.ScanLine[y];
z2 := bm2.ScanLine[y];
for x := 0 to bm1.width-1 do begin
if bm1.Canvas.Pixels[y,x] <> bm2.Canvas.Pixels[y,x] then begin
//if abs(z1[x]-z2[x]) <> 0 then begin
result := false;
exit;
end;
end;
end;
end;
begin
icon := TIcon.Create;
bm1 := Tbitmap.Create;
bm2 := TBitmap.Create;
try
sysImg := GetShellImage(filename);
sysIcons.GetIcon(sysImg,icon);
Bm1.Height := Icon.Height; Bm1.Width := Icon.Width;
Bm1.Canvas.Draw(0, 0, Icon);
bm1.PixelFormat := pf24Bit;
icons.First;
myImg := -1;
While not icons.Eof do begin
testImg.Picture.icon.Assign(iconsIcon);
application.ProcessMessages;
bm2.Width := 0; bm2.Height := 0;
bm2.FreeImage;
application.ProcessMessages;
bm2.Assign(bm1);
bm2.Canvas.Draw(0, 0, testImg.Picture.icon);
if iconsEqual then begin
myImg := iconsId.AsInteger;
break;
end;
icons.Next;
end;
....
finally
icon.free; bm1.free; bm2.free;
end;
</pre>
Kann jemand helfen?
<pre>
procedure Tdvmain.AddFile(filename:String);
type TTest = TColor;
var sysImg,myImg : Integer;
icon : TIcon;
fn : String;
z1, z2 : PByteArray;
x1, x2 : TTest;
function iconsEqual:Boolean;
var x, y : Integer;
begin
result := true;
for y := 0 to bm1.height-1 do begin
x1 := bm1.Canvas.Pixels[y,0]; //(bm1.ScanLine[y]^);
x2 := bm2.Canvas.Pixels[y,0];//(bm2.ScanLine[y]^);
z1 := bm1.ScanLine[y];
z2 := bm2.ScanLine[y];
for x := 0 to bm1.width-1 do begin
if bm1.Canvas.Pixels[y,x] <> bm2.Canvas.Pixels[y,x] then begin
//if abs(z1[x]-z2[x]) <> 0 then begin
result := false;
exit;
end;
end;
end;
end;
begin
icon := TIcon.Create;
bm1 := Tbitmap.Create;
bm2 := TBitmap.Create;
try
sysImg := GetShellImage(filename);
sysIcons.GetIcon(sysImg,icon);
Bm1.Height := Icon.Height; Bm1.Width := Icon.Width;
Bm1.Canvas.Draw(0, 0, Icon);
bm1.PixelFormat := pf24Bit;
icons.First;
myImg := -1;
While not icons.Eof do begin
testImg.Picture.icon.Assign(iconsIcon);
application.ProcessMessages;
bm2.Width := 0; bm2.Height := 0;
bm2.FreeImage;
application.ProcessMessages;
bm2.Assign(bm1);
bm2.Canvas.Draw(0, 0, testImg.Picture.icon);
if iconsEqual then begin
myImg := iconsId.AsInteger;
break;
end;
icons.Next;
end;
....
finally
icon.free; bm1.free; bm2.free;
end;
</pre>
Kann jemand helfen?
) den Benutzern nicht vorschreiben keine Spielzeugwindowsversionen zu benutzen (win98 andere Pfade als NT/2K/XP). Ist es denn nicht halbwegs vernünftig möglich, icons zu vergleichen
<br>
Comment