Einzelnen Beitrag anzeigen

Benutzerbild von Captnemo
Captnemo

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

AW: Stempel erzeugen - CombineRgn zu langsam

  Alt 25. Okt 2016, 08:39
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;
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