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:

Zitat von stahli (Beitrag 1351877)

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 :wall: 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:

Zitat von Captnemo (Beitrag 1351874)

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

[HolgerX]

Zitat:

Zitat von Captnemo (Beitrag 1351921)

try
if Rgn<>0 then
if SetWindowRgn(AHandle, Rgn, True)<>0 then Result:=True;
finally
DeleteObject(Rgn);
end;

..
Windows.SetWindowRgn(pnl1.Handle, rgn, True);
DeleteObject(Rgn);
[/DELPHI]

Ein Hinweis:
Niemals nach SetWindowRgn die Rgn mit DeleteObject freigeben!!!!!

https://msdn.microsoft.com/de-de/lib...(v=vs.85).aspx

Zitat:

After a successful call to SetWindowRgn, the system owns the region specified by the region handle hRgn. The system does not make a copy of the region. Thus, you should not make any further function calls with this region handle. In particular, do not delete this region handle. The system deletes the region handle when it no longer needed.

Sprich, Windows wird OWNER der Rgn und gibt diese auch frei!!
Wenn Du diese jedoch direkt wieder frei gibs, kann dies zu unerwarteten Anzeigen führen!!


Das hatten wir auch schon einmal hier im Forum diskutiert...

[Captnemo]

Danke Holger. Das werde ich noch berücksichtigen. Allerdings ist mir, in den 10 Jahren wo das bisher schon so ist, nie eine Fehlfunktion aufgefallen. Weil Windows das dann doch wohl irgendwie stillschweigend regelt. Aber wenn's da steht, ist's ja korrekt und wird auch so gemacht.
Naturgemäß hab ich als Delhianer früh gelernt meinen Dreck hinter mir wegzuräumen ;) (Das hat sogar schon meine Mutter gewusst:D). Von daher liegt das wohl im Blut.

[Blup]

Das geht so lange gut, bis dein Programm auf einen exotischen Grafiktreiber trifft, der die Handel-Nr. nicht fortlaufend vergibt, sondern freigegebene Handel-Nr. sofort für neue Objekte wiederverwendet. Gibt man dann ein Objekt wiederholt frei, wird das plötzlich nicht mehr abgefangen und irgend ein anderes gerade erstelltes Objekt freigegeben.