Formulardarstellungen

[Uncle Cracker]

Hiermit kannste deine Form einer Bitmap anpassen:

Delphi-Quellcode:

var
  BM   : TBitmap;



function PictureToRGN(Bitmap: TBitmap): hRgn;
var B: TBitmap;
    C: Byte;
    R: hRgn;
    P: PByte;
    S,E,Y: Integer;
begin
 B := TBitmap.Create;
 try
 B.HandleType := bmDIB;
 B.PixelFormat := pf24Bit;
 B.Width := BitMap.Width;
 B.Height := BitMap.Height;
 B.Canvas.Draw(0, 0, BitMap);
 B.Mask(B.TransparentColor);
 B.PixelFormat := pf8Bit;
 C := PByte(B.Scanline[0])^;
 Result := CreateRectRgn(0, 0, B.Width, B.Height);
  for Y := B.Height-1 downto 0 do begin
   P := B.ScanLine[Y];
   S := 0;
   E := 0;
   repeat
    while (P^ = C) and (E < B.Width) do begin
     Inc(P);
     Inc(E);
    end;
    R := CreateRectRgn(S, Y, E, Y+1);
    try
     CombineRgn(Result, Result, R, RGN_DIFF);
    finally
     DeleteObject(R);
    end;
    while (P^ <> C) and (E < B.Width) do begin
     Inc(P);
     Inc(E);
    end;
    S := E;
   until E >= B.Width;
   if S <> E then begin
    R := CreateRectRgn(S, Y, E, Y+1);
    try
     CombineRgn(Result, Result, R, RGN_DIFF);
    finally
     DeleteObject(R);
    end;
   end;
  end;
 finally
  B.Free;
 end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
 BM := TBitMap.Create;
 BM.LoadFromFile('c:\test.bmp');
 SetWindowRgn(Form1.Handle, PictureToRGN(BM), true);
end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 BM.Free;
end;

Und hiermit verschiedenes Aussehen:

Delphi-Quellcode:

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

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

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

// als Stern:
procedure TForm2.FormCreate(Sender: TObject);
var r:HRgn;
p:array[0..7]of TPoint;
begin
width:=400;
height:=400;
p[0]:=point(0,height div 2);
p[1]:=point(width div 3,height div 3);
p[2]:=point(width div 2, 0);
p[3]:=point((width div 3)*2, height div 3);
p[4]:=point(width,height div 2);
p[5]:=point((width div 3)*2,(height div 3)*2);
p[6]:=point(width div 2,height);
p[7]:=point(width div 3,(height div 3)*2);
r:=CreatePolygonRgn(p,8,WINDING);
setwindowRgn(handle,r,true);
end;

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