// 1. als Ellipse (bzw. Kreis): 

procedure TForm2.FormCreate(Sender: TObject); 
var r: HRgn; 
begin 
  width := 600; 
  height := 200; 
  r := CreateEllipticRgn(0, 0, width, height); 
  setwindowRgn(handle, r, true); 
end; 

//----------------------------------------------------------------

// 2. als Rechteck mit abrerundeten Ecken: 

procedure TForm2.FormCreate(Sender: TObject); 
var r: HRgn; 
begin 
  width := 400; 
  height := 400; 
  r := CreateRoundRectRgn(0, 0, width, height, 100, 100); 
  setwindowRgn(handle, r, true); 
end; 

//----------------------------------------------------------------
 
// 3. als Dreieck: 

procedure TForm2.FormCreate(Sender: TObject); 
var r: HRgn; 
  p: array[0..2] of TPoint; 
begin 
  width := 600; 
  height := 300; 
  p[0] := point(0, 0); 
  p[1] := point(width, 0); 
  p[2] := point(width div 2, height); 
  r := CreatePolygonRgn(p, 3, WINDING); 
  setwindowRgn(handle, r, true); 
end; 

//----------------------------------------------------------------

// 4. als gleichmäßiger Stern mit variabler Strahlenzahl (4..50):

var 
  rgn: HRGN; 
 
procedure CreateStarRegion(Rct: TRect; Strahlenzahl, Innenkreis: Word); 
var 
  i, x, y, mX, mY, R, Doppel: Integer; 
  Punkte: array[0..99] of TPoint; 
  Winkel: Double; 
begin 
  if Strahlenzahl in [4..50] then begin 
    mX := (Rct.Right - Rct.Left) div 2; 
    mY := (Rct.Bottom - Rct.Top) div 2; 
    if mY > mX then mY := mX; 
    if Innenkreis > mY then Innenkreis := mY else 
      if Innenkreis < 3 then Innenkreis := 3; 
    Doppel := Strahlenzahl shl 1; 
    for i := 0 to Doppel - 1 do begin 
      if odd(i) then R := mY 
      else R := Innenkreis; 
      Winkel := i * PI / Strahlenzahl; 
      x := mX + Round(cos(Winkel) * R); 
      y := mY - Round(sin(Winkel) * R); 
      Punkte[I].x := x; 
      Punkte[I].y := y; 
    end; 
    rgn := CreatePolygonRgn(Punkte, Doppel, WINDING); 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Borderstyle := bsNone; 
  CreateStarRegion(clientrect, 6, 100); 
  SetWindowRgn(handle, rgn, false); 
end;

//----------------------------------------------------------------

// 5. als Ring: 

procedure TForm2.FormCreate(Sender: TObject); 
var r1, r2: HRgn; 
begin 
  width := 400; 
  height := 400; 
  r1 := CreateEllipticRgn(0, 0, width, height); 
  r2 := CreateEllipticRgn(100, 100, width - 100, height - 100); 
  CombineRgn(r2, r1, r2, rgn_xor); 
  setwindowRgn(handle, r2, true); 
end; 
 
//----------------------------------------------------------------

// 6. Und hiermit kann man das Fenster an ein 
// Bild anpassen, also quasi eine Farbe "durchsichtig" machen. 
var 
  bitmap: TBitmap; 
  r1, r2: hrgn; 
 
procedure BildRegion(wc: TWinControl; bm: TBitmap; durchsichtig: TColor); 
var p: PBytearray; 
  y, x: integer; 
  ro, gr, bl: byte; 
  function kombine(a: integer): integer; 
  var b: integer; 
  begin 
    b := -1; 
    while a <= bm.width * 3 - 1 do begin 
      if (p[a] <> bl) or (p[a + 1] <> gr) or (p[a + 2] <> ro) 
        then begin 
        b := a div 3; 
        break; 
      end; 
      inc(a, 3); 
    end; 
    result := a; 
    if b < 0 then exit; 
    while a <= bm.width * 3 - 1 do begin 
      if (p[a] = bl) and (p[a + 1] = gr) and (p[a + 2] = ro) 
        then break; 
      inc(a, 3); 
    end; 
    result := a; 
    a := a div 3; 
    r2 := CreateRectRgn(b, y, a, y + 1); 
    CombineRgn(r1, r1, r2, RGN_OR); 
    DeleteObject(r2); 
  end; 
begin 
  bm.pixelformat := pf24bit; // wichtig 
  durchsichtig := colortorgb(durchsichtig); 
  ro := getrvalue(durchsichtig); 
  gr := getgvalue(durchsichtig); 
  bl := getbvalue(durchsichtig); 
  r1 := CreateRectRgn(0, 0, 0, 0); 
  for y := 0 to bm.height - 1 do begin 
    p := bm.ScanLine[y]; 
    x := 0; 
    while x <= bm.width * 3 - 1 do x := kombine(x); 
  end; 
  setwindowRgn(wc.handle, r1, true); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bitmap := TBitmap.create; 
  bitmap.loadfromfile('c:\test.bmp'); 
  borderstyle := bsnone; 
  width := bitmap.width; 
  height := bitmap.height; 
  brush.bitmap := bitmap; 
  bildregion(form1, bitmap, clwhite); // oder welche Farbe auch immer 
  bitmap.dormant; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  DeleteObject(r1); 
  bitmap.free; 
end; 
 

var 
  rgn: HRGN; 
  img: TImage; 
  Control: TWinControl; 
 
function MakeRegion(TCo: TControl; bm: TBitmap; Tranzparenz: Tcolor): HRGN; 
type 
  TRGBArray = array [0 .. 0] of tagRGBTRIPLE; 
var 
  r, g, b: Byte; 
  X, Y, st: Integer; 
  rgn, neu: HRGN; 
  zeile: ^TRGBArray; 
  RGBColor: Tcolor; 
begin 
  RGBColor := ColorToRGB(Tranzparenz); 
  bm.PixelFormat := pf24Bit; 
  r := GetRValue(RGBColor); 
  g := GetGValue(RGBColor); 
  b := GetBValue(RGBColor); 
  TCo.width := bm.width; 
  TCo.Height := bm.Height; 
  neu := CreateRectRGN(0, 0, bm.width, bm.Height); 
  for Y := 0 to pred(bm.Height) do 
  begin 
    zeile := bm.Scanline[Y]; 
    st := -1; 
    for X := 0 to bm.width - 1 do 
    begin 
      if (zeile[X].rgbtRed = r) and (zeile[X].rgbtGreen = g) and 
        (zeile[X].rgbtBlue = b) then 
      begin 
        if st < 0 then 
          st := X; 
      end 
      else if st > -1 then 
      begin 
        rgn := CreateRectRGN(st, Y, X, succ(Y)); 
        try 
          CombineRGN(neu, neu, rgn, RGN_DIFF); 
          st := -1; 
        finally 
          DeleteObject(rgn); 
        end; 
      end; 
    end; 
    if st > -1 then 
    begin 
      rgn := CreateRectRGN(st, Y, bm.width, succ(Y)); 
      CombineRGN(neu, neu, rgn, RGN_DIFF); 
      DeleteObject(rgn); 
    end; 
  end; 
  Result := neu; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Control := Panel1; // z.B. 
 
  if Control.handle = Self.handle then 
    Self.BorderStyle := bsNone; 
  img := TImage.create(Control); 
  img.parent := Control; 
  img.left := 0; 
  img.top := 0;  
  img.autosize := true; 
  img.Picture.Bitmap.LoadfromFile('D:\Bilder\2.bmp'); 
  TPanel(Control).autosize := true; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  img.Free; 
end; 


// Aufruf 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  rgn := MakeRegion(Control, img.Picture.Bitmap, img.Canvas.Pixels[0, 0]); 
  setwindowRgn(Control.handle, rgn, true); 
end;