// Hiermit kan man den Rand einer Form nach Wunsch 2D oder 3D-artig  bearbeiten.
// Bei der 2D Darstellung kann man auf Wunsch einen dünnen Aussenrand zeichnen.
// Bei der 3D Darstellung kann zusätzlich bestimmt werden, ob noch eine kleine
// Innenfläche gezeichnet wird, oder ob der Rand in voller Breite abgeschrägt
// dargestellt werden soll.

// Getestet mit D4 unter Win98

unit rand;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button4: TButton;
Button3: TButton;
Button2: TButton;
Button1: TButton;
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
procedure RegionDa;
procedure RegionWeg;
procedure rand_2d(Ffarbe,Rfarbe:TColor;mitRand:boolean);
procedure rand_3d(li,ob,re,un,fl:TColor;innenrand:boolean);
public
{ Public-Deklarationen}
end;


const
farbe2D:TColor=clred;
farbe2DRand:TColor=cllime;
links:TColor=clyellow;
oben:TColor=claqua;
rechts:TColor=clblack;
unten:TColor=clmaroon;
flaeche:TColor=clwhite;
randart:byte=0;

var
Form1: TForm1;
h:HDC;
rnd:integer;
r1,r2:HRgn;
rct:TRect;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
rnd:=GetSystemMetrics(SM_CYFRAME);
end;

procedure TForm1.RegionDa;
begin
rct:=rect(0,0,width,height);
h:=GetWindowDC(handle);
r1:=createrectrgn(0,0,width,height);
r2:=createrectrgn(rnd,rnd,width-rnd,height-rnd);
combinergn(r2,r1,r2,rgn_xor);
SelectClipRgn(h,r2);
end;

procedure TForm1.RegionWeg;
begin
SelectClipRgn(h,0);
deleteobject(r2);
deleteobject(r1);
releasedc(handle,h);
end;

procedure TForm1.rand_2d(Ffarbe,Rfarbe:TColor;mitRand:boolean);
var br,brr:HBrush;
begin
randart:=1+ord(mitrand);
br:=CreateSolidBrush(Ffarbe);
brr:=CreateSolidBrush(Rfarbe);
regionda;
fillrect(h,rct,br);
if mitrand then framerect(h,rct,brr);
regionweg;
deleteobject(brr);
deleteobject(br);
end;

procedure TForm1.rand_3d(li,ob,re,un,fl:TColor;innenrand:boolean);
var eins,zwei,drei,vier:HPen;
flch:HBrush;
x:integer;
z:integer;
begin
randart:=3+ord(innenrand);
flch:=CreateSolidBrush(fl);
eins:=CreatePen(PS_SOLID,1,li);
zwei:=CreatePen(PS_SOLID,1,ob);
drei:=CreatePen(PS_SOLID,1,re);
vier:=CreatePen(PS_SOLID,1,un);
regionda;
if innenrand then fillrect(h,rct,flch);
z:=ord(innenrand)*3;
selectobject(h,eins);
for x:=0 to rnd-z do begin
movetoex(h,x,x,nil);
lineto(h,x,height-x);
end;
selectobject(h,zwei);
for x:=0 to rnd-z do begin
movetoex(h,x,x,nil);
lineto(h,width-x,x);
end;
selectobject(h,drei);
for x:=0 to rnd-z do begin
movetoex(h,width-x-1,x,nil);
lineto(h,width-x-1,height-x);
end;
selectobject(h,vier);
for x:=0 to rnd-z do begin
movetoex(h,x,height-x-1,nil);
lineto(h,width-x,height-x-1);
end;
regionweg;
deleteobject(vier);
deleteobject(drei);
deleteobject(zwei);
deleteobject(eins);
deleteobject(flch);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
case randart of
1:rand_2d(farbe2D,farbe2DRand,false);
2:rand_2d(farbe2D,farbe2DRand,true);
3:rand_3d(links,oben,rechts,unten,flaeche,false);
4:rand_3d(links,oben,rechts,unten,flaeche,true);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
rand_2d(farbe2D,farbe2DRand,false);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
rand_2d(farbe2D,farbe2DRand,true);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
rand_3d(links,oben,rechts,unten,flaeche,false);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
rand_3d(links,oben,rechts,unten,flaeche,true);
end;

end.

//--------------------------------------------------
// Wem der Aufwand mit den Regionen zu groß erscheint, für den habe
// ich hier noch ein einfaches Lösungsprinzip, bei dem man sich aber
// selbst darum kümmern muss, dass nicht die Fläche des Fensters
// versehntlich übermalt wird.

...

var
Form1: TForm1;

implementation

{$R *.DFM}

var
c:TCanvas;
hnd:HWND;

procedure TForm1.FormCreate(Sender: TObject);
begin
c:=TCanvas.create;
hnd:=GetWindowDC(handle);
c.handle:=hnd;
c.pen.Color:=clred;
c.pen.width:=7;
c.brush.style:=bsclear;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
c.free;
releasedc(handle,hnd);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
c.rectangle(0,0,width,height);
// oder was halt auf dem Rand geschehen soll
end;