Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#8

AW: "Polygon" Komponente

  Alt 14. Okt 2011, 14:32
ganz schnell, einfach und billig wenn Du eine Komponente bastelst der Du ein gegf. zur laufzeit erstelltest Bitmap zuweist: (im Beispiel wird ein vorhandenes genommen)
Delphi-Quellcode:
function CreateBMPRegion(Bmp: TBitmap): THandle;
Type
  RGBArray=Array [0..1000000] of TRGBTriple;
  pRGBArray=^RGBArray;
var
  X, Y, Beginn:Integer;
  Line: PRGBArray;
  Transp: TRGBTriple;
  Exclude: THandle;
begin
  Bmp.PixelFormat := pf24Bit;
  Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
  for Y := 0 to Bmp.Height - 1 do
  begin
    Line := Bmp.Scanline[Y];
    if Y = 0 then Transp := Line[0];
    Beginn := -1;
    for X := 0 to Bmp.Width do
    begin
        if (X <> Bmp.Width)
           and (Line[X].rgbtBlue = Transp.rgbtBlue)
           and (Line[X].rgbtGreen = Transp.rgbtGreen)
           and (Line[X].rgbtRed = Transp.rgbtRed)
           then
          begin
            if Beginn = -1 then Beginn := X;
          end
        else
          begin
            if Beginn > -1 then
            begin
              Exclude := CreateRectRGN(Beginn, Y, X, Y + 1);
              try
                CombineRGN(Result, Result, Exclude, RGN_DIFF);
                Beginn := -1;
              finally
                DeleteObject(Exclude);
              end;
            end;
          end;
    end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  rg:Hrgn;
begin
  rg := CreateBMPRegion(Image1.Picture.Bitmap);
  SetWindowRGN(Panel1.Handle,rg,true);
  DeleteObject(rg);
end;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat