Einzelnen Beitrag anzeigen

Benutzerbild von Captnemo
Captnemo

Registriert seit: 27. Jan 2003
Ort: Bodenwerder
1.126 Beiträge
 
Delphi XE4 Architect
 
#1

Stempel erzeugen - CombineRgn zu langsam

  Alt 24. Okt 2016, 11:51
(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;
Dieter
9 von 10 Stimmen in meinem Kopf sagen ich bin nicht verrückt. Die 10. summt dazu die Melodie von Supermario Bros.
MfG Captnemo
  Mit Zitat antworten Zitat