Stempel erzeugen - CombineRgn zu langsam

[Captnemo]

(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;

[Uwe Raabe]

Was beabsichtigst du denn überhaupt zu erreichen?

[Captnemo]

Ich will eine Art "Stempel" über die Form legen, so als wenn tatsächlich einer mit einem Stempel schräg draufgedonnert hat

Edit: Eine Bearbeitung der darunter liegenden Controls aufrecht zu erhalten wäre nicht zwingen notwendig.
Edit2: Aber lesen sollte man sie können.

[stahli]

Vielleicht kommst Du besser weg, wenn Du erst ein Polygon berechnest und daraus die Region erzeugst.
-> http://www.delphipraxis.net/185374-r...ml#post1304439

Allerdings wird das bei komplexen Bitmaps vermutlich auch nicht so einfach (bis zu unmöglich).


EDIT: Oder was mir gerade einfällt...
Du könntest die Region für jedes Bitmap einmal wie gehabt berechnen und die Region-Daten als Polygon in eine Datei sichern.
Dann kannst Du prüfen, ob Du für das aktuelle Bitmap schon gespeicherte Daten hast und kannst diese direkt laden. Wenn nicht, muss berechnet werden.

[Captnemo]

Zitat von stahli:

Du könntest die Region für jedes Bitmap einmal wie gehabt berechnen und die Region-Daten als Polygon in eine Datei sichern.
Dann kannst Du prüfen, ob Du für das aktuelle Bitmap schon gespeicherte Daten hast und kannst diese direkt laden. Wenn nicht, muss berechnet werden.

Das ist ja mal gar keine schlechte Idee....das ich da nicht selber draufgekommen bin Dann spielen die 10 Sekunden auch nicht wirklich eine Rolle.

[Uwe Raabe]

Ich kann jetzt nicht kontrollieren, ob das auch schon unter Delphi 7 geht, aber dieses kleine Projekt funktioniert under Berlin ganz gut.

[Captnemo]

Danke Uwe. Das werde ich auch mal ausprobieren.

[Captnemo]

Der Vollständigkeitshalber poste ich hier mal meine Code, wie ich es dann gelöst habe, damit andere, die evtl. mal ähnliches Vorhaben bei der Suche auch einen Lösungsansatz finden.
Ich habe mich für die Idee von Stahli entschieden, weil das bei mir auf Grund der Tatsache, dass ich den Stempel in einer DB speichern will, am sinnvollsten ist. Aber auch die Lösung von Uwe funktioniert (auch unter D7 mit geringfügigen Anpassungen).

In diesem Sinne: Dank an Stahli und Uwe

Delphi-Quellcode:

procedure Tfrm_terminNeu.MakeStamp;
  function SaveRgn(Rgn: HRGN; Stream: TMemoryStream): Boolean;
  var
    RgnSize: Cardinal;
  begin
    Result:=False;
    RgnSize:=GetRegionData(Rgn, 1, nil);
    if RgnSize>0 then begin
      Stream.Position:=0;
      Stream.SetSize(RgnSize);
      if GetRegionData(Rgn, RgnSize, PRgnData(Stream.Memory)) <> 0 then
        Result:=True else Result:=False;
    end;
  end;
  function LoadRgn(AHandle: HWND; Stream: TMemoryStream): Boolean;
  var
    Rgn: HRGN;
  begin
    Result:=False;
    if Stream.Size>0 then begin
      Stream.Position:=0;
      Rgn:=ExtCreateRegion(nil, Stream.Size, TRgnData(Stream.Memory^));
      try
        if Rgn<>0 then
          if SetWindowRgn(AHandle, Rgn, True)<>0 then Result:=True;
      finally
        DeleteObject(Rgn);
      end;
    end;
  end;
var
  X, Y : Integer;
  Rgn, Rgn2 : THandle;
  pRgb: PRGBTriple;
  Transp: TRGBTriple;
begin
  if not LoadRgn(pnl1.Handle, frm_main.Settings.global.Binaries.StempelGestrichen) then begin
    Rgn := CreateRectRgn(0, 0, pnl1.Width, pnl1.Height);
    if Rgn <> 0 then
    begin
      FillChar(Transp, SizeOf(Transp), 255);
      img3.Picture.Bitmap.PixelFormat := pf24Bit;
      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);
              DeleteObject(Rgn2);
            end;
          end;
          inc(pRgb);
        end;
      end;
      SaveRgn(Rgn, frm_main.Settings.global.Binaries.StempelGestrichen);
      frm_main.Settings.global.Binaries.SaveToDB(dm1.Con);
      Windows.SetWindowRgn(pnl1.Handle, rgn, True);
      DeleteObject(Rgn);
    end;
  end;
end;

[Frickler]

Zitat von Captnemo:

Ich will eine Art "Stempel" über die Form legen, so als wenn tatsächlich einer mit einem Stempel schräg draufgedonnert hat

Mit dem passenden Geräusch?

[Captnemo]

Hmmm....auch keine schlechte Idee
Aber möglicherweise denken dann die Kunden meiner Kunden sie wären auf dem Amt