Stempel erzeugen - CombineRgn zu langsam

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