(D7) Mit folgender Procedure erzeuge ich mir ein Panel als eine Art Stempel aus einer Bitmap. Optisch ist das mal super. (Panel deswegen, weil nur ein Image sich nicht über alle Controls legen lässt). Und hat bisher lange seine guten Dienste geleistet.
Bisher benötigte ich diesen "Stempel" auch nur einmal im Programm, so dass er auch nur einmal erzeugt wurde, und zwar beim Programmstart, wo diese Zeitverzögerung zu verschmerzen war.
Nach einer notwendigen Änderung benötige ich ihn aber des öfteren in verschiedenen Formen, die zur Laufzeit erzeugt werden, und auch mit unterschiedlichem Inhalt. Nun führt dieses also zu einer Verzögerung, die ich so nicht lassen kann.
Im Grund geht alles recht fix. Einzig bei CombineRgn benötigt der Code jetzt 15-16 Millisekunden, wenn denn auf der Bitmap eben ein Bildpunkt gesetzt ist ist. Img3 ist 400x400 Pixel und hat 625 zu berücksichtigende Pixel, was bei 16 Millisekunden ca 10 Sekunden ergibt, bis die Prozudure durchlaufen ist.
ich suche jetzt nach einer Möglichkeit, das ganze etwas performanter zu gestallten. Der Code selbst ist nicht auf meiner Feder. Wo ich den aber her habe, kann ich nach 10 Jahren nicht mehr sagen.
Delphi-Quellcode:
procedure Tfrm_terminNeu.MakeStamp;
var
X, Y : Integer;
Rgn, Rgn2 : THandle;
pRgb: PRGBTriple;
Transp: TRGBTriple;
begin
FillChar(Transp, SizeOf(Transp), 255);
img3.Picture.Bitmap.PixelFormat := pf24Bit;
Rgn := CreateRectRgn(0, 0, pnl1.Width, pnl1.Height);
if Rgn <> 0 then
begin
for y := 0 to Img3.Picture.Bitmap.Height- 1 do
begin
pRgb:= Img3.Picture.Bitmap.ScanLine[Y];
for X := 0 to Img3.Picture.Bitmap.Width - 1 do
begin
if CompareMem(pRgb, @Transp, SizeOf(Transp)) then
begin
Rgn2 := CreateRectRgn(X, Y, X + 1, Y + 1);
if Rgn2 <> 0 then
begin
CombineRgn(Rgn, Rgn, Rgn2, RGN_XOR); //<-Dauert 15-16 Millisekunden
DeleteObject(Rgn2);
end;
end;
inc(pRgb);
end;
end;
Windows.SetWindowRgn(pnl1.Handle, rgn, True);
DeleteObject(Rgn);
end;
end;