[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]
{ Frames unit - a set of comprehensive (for my purposes) functions for
drawing pretty 3-D frames of all types. Pretty simple stuff - I'm sure
you will be able to figure it out - but that's why I included it.
As always, you are welcome to do whatever with this unit. I only ask that
if you upload it somewhere modified, keep my name off it, so I don't have
to answer for your bad code <grin>. If you have any suggestions or
questions, by all means send them to me - I'd love to hear from a fellow
programmer.
Steve Willer
Mark Data Management
CIS: 70400,3667
AOL: SteveWill
}
unit frames;
interface
uses WinTypes,WinProcs,WinDOS;
procedure DrawBorderFrame(PaintDC:HDC;PaintR:TRect;Back:boolean);
procedure DrawOutFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
procedure DrawInFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
procedure DrawDivLine(PaintDC:HDC;Y:integer;Width:integer);
procedure DrawDotLine(PaintDC:HDC;PaintR:TRect;Incr:integer);
function MakeBorBrush(HWindow:HWnd;BackColor1,BackColor2:TColorRef):HBrush;
procedure DrawExplodeFrame(PaintDC:HDC;ExplR:TRect;PenColor,BrushColor:TColorRef;DrawBrush:boolean;Width:integer;
Steps:integer;Pause:longint);
implementation
procedure DrawBorderFrame(PaintDC:HDC;PaintR:TRect;Back:boolean);
var ThePen,OldPen:HPen;
FillBrush,OldBrush:HBrush;
begin
if Back then
begin
FillBrush := CreateSolidBrush($00C0C0C0);
OldBrush := SelectObject(PaintDC,FillBrush);
InflateRect(PaintR,-1,-1);
FillRect(PaintDC,PaintR,FillBrush);
InflateRect(PaintR,1,1);
SelectObject(PaintDC,OldBrush);
DeleteObject(FillBrush);
end;
OldBrush := SelectObject(PaintDC,GetStockObject(Null_Brush));
ThePen := CreatePen(ps_Solid,1,$00C0C0C0);
OldPen := SelectObject(PaintDC,ThePen);
PaintR.top:=PaintR.top+1;
PaintR.left:=PaintR.left-1;
Rectangle(PaintDC,PaintR.left,PaintR.top,PaintR.right,PaintR.bottom);
PaintR.top:=PaintR.top-1;
PaintR.left:=PaintR.left+1;
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
SelectObject(PaintDC,OldBrush);
ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo(PaintDC,PaintR.right,PaintR.top);
LineTo(PaintDC,PaintR.left,PaintR.top);
LineTo(PaintDC,PaintR.left,PaintR.bottom);
MoveTo(PaintDC,PaintR.left+2,PaintR.bottom-2);
LineTo(PaintDC,PaintR.right-2,PaintR.bottom-2);
LineTo(PaintDC,PaintR.right-2,PaintR.top+2);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo(PaintDC,PaintR.right-2,PaintR.top+2);
LineTo(PaintDC,PaintR.left+2,PaintR.top+2);
LineTo(PaintDC,PaintR.left+2,PaintR.bottom-3);
MoveTo(PaintDC,PaintR.left,PaintR.bottom);
LineTo(PaintDC,PaintR.right,PaintR.bottom);
LineTo(PaintDC,PaintR.right,PaintR.top);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
end;
procedure DrawOutFrame (PaintDC:HDC; PaintR:TRect; Back:boolean; Width:integer);
var
ThePen, OldPen:HPen;
FillBrush, OldBrush:HBrush;
count:integer;
CalcR:TRect;
begin
if Back then
begin
FillBrush := CreateSolidBrush ($00C0C0C0);
OldBrush := SelectObject(PaintDC,FillBrush);
InflateRect (PaintR, -1*(Width)+1, -1*(Width)+1);
FillRect (PaintDC,PaintR,FillBrush);
InflateRect (PaintR,Width-1,Width-1);
SelectObject (PaintDC,OldBrush);
DeleteObject (FillBrush);
end;
CalcR := PaintR;
for count:=0 to (Width-1) do
begin
PaintR := CalcR;
InflateRect (PaintR, -1*(count), -1*(count));
ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo (PaintDC,PaintR.right,PaintR.top);
LineTo (PaintDC,PaintR.left,PaintR.top);
LineTo (PaintDC,PaintR.left,PaintR.bottom+1);
SelectObject (PaintDC,OldPen);
DeleteObject (ThePen);
ThePen := CreatePen (ps_Solid,1,RGB(127,127,127));
OldPen := SelectObject (PaintDC,ThePen);
MoveTo (PaintDC,PaintR.right,PaintR.top+1);
LineTo (PaintDC,PaintR.right,PaintR.bottom);
LineTo (PaintDC,PaintR.left,PaintR.bottom);
SelectObject (PaintDC,OldPen);
DeleteObject (ThePen);
end;
end;
procedure DrawInFrame(PaintDC:HDC;PaintR:TRect;Back:boolean;Width:integer);
var ThePen,OldPen:HPen;
FillBrush,OldBrush:HBrush;
count:integer;
CalcR:TRect;
begin
if Back then
begin
FillBrush := CreateSolidBrush($00C0C0C0);
OldBrush := SelectObject(PaintDC,FillBrush);
InflateRect(PaintR,-1*(Width)+1,-1*(Width)+1);
FillRect(PaintDC,PaintR,FillBrush);
InflateRect(PaintR,Width-1,Width-1);
SelectObject(PaintDC,OldBrush);
DeleteObject(FillBrush);
end;
CalcR:=PaintR;
for count:=0 to (Width-1) do
begin
PaintR:=CalcR;
InflateRect(PaintR,-1*(count),-1*(count));
ThePen := CreatePen(ps_Solid,1,RGB(127,127,127));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo(PaintDC,PaintR.right,PaintR.top);
LineTo(PaintDC,PaintR.left,PaintR.top);
LineTo(PaintDC,PaintR.left,PaintR.bottom);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
ThePen := CreatePen(ps_Solid,1,RGB(255,255,255));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo(PaintDC,PaintR.right,PaintR.top+1);
LineTo(PaintDC,PaintR.right,PaintR.bottom);
LineTo(PaintDC,PaintR.left-1,PaintR.bottom);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
end;
end;
procedure DrawDivLine(PaintDC:HDC;Y:integer;Width:integer);
var ThePen,OldPen:HPen;
FillBrush,OldBrush:HBrush;
count:integer;
begin
ThePen := CreatePen(ps_Solid,Width,RGB(127,127,127));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo(PaintDC,GetSystemMetrics(sm_CXScreen),Y);
LineTo(PaintDC,0,Y);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
Y:=Y+Width;
ThePen := CreatePen(ps_Solid,Width,RGB(255,255,255));
OldPen := SelectObject(PaintDC,ThePen);
MoveTo(PaintDC,GetSystemMetrics(sm_CXScreen),Y);
LineTo(PaintDC,0,Y);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
end;
procedure DrawDotLine(PaintDC:HDC;PaintR:TRect;Incr:integer);
var ROP2:integer;
count:integer;
begin
ROP2 := GetROP2(PaintDC);
SetROP2(PaintDC,r2_Not);
count := PaintR.left;
while count < PaintR.right-1 do
begin
SetPixel(PaintDC,count,PaintR.top,$00000000);
SetPixel(PaintDC,count,PaintR.bottom-1,$00000000);
count := count + Incr;
end;
count := PaintR.top+2;
while count < PaintR.bottom-1 do
begin
SetPixel(PaintDC,PaintR.left,count,$00000000);
SetPixel(PaintDC,PaintR.right-1,count,$00000000);
count := count + Incr;
end;
SetROP2(PaintDC,ROP2);
end;
function MakeBorBrush(HWindow:HWnd;BackColor1,BackColor2:TColorRef):HBrush;
var DC,MemDC:HDC;
Bits:HBitmap;
FillR:TRect;
TheBrush,OldBrush:HBrush;
begin
DC:=CreateDC('display',nil,nil,nil);
MemDC:=CreateCompatibleDC(DC);
Bits:=CreateCompatibleBitmap(DC,8,8);
SelectObject(MemDC,Bits);
if Bits<>0 then
begin
TheBrush:=CreateSolidBrush(GetNearestColor(DC,BackColor2));
OldBrush:=SelectObject(MemDC,TheBrush);
PatBlt(MemDC,0,0,8,8,Blackness);
with FillR do begin
left:=0;right:=8;top:=0;bottom:=8;
end;
FillRect(MemDC,FillR,TheBrush);
SelectObject(MemDC,OldBrush);
DeleteObject(TheBrush);
SetPixel(MemDC,0,0,BackColor1);
SetPixel(MemDC,0,2,BackColor1);
SetPixel(MemDC,0,4,BackColor1);
SetPixel(MemDC,0,6,BackColor1);
SetPixel(MemDC,2,0,BackColor1);
SetPixel(MemDC,2,2,BackColor1);
SetPixel(MemDC,2,4,BackColor1);
SetPixel(MemDC,2,6,BackColor1);
SetPixel(MemDC,4,0,BackColor1);
SetPixel(MemDC,4,2,BackColor1);
SetPixel(MemDC,4,4,BackColor1);
SetPixel(MemDC,4,6,BackColor1);
SetPixel(MemDC,6,0,BackColor1);
SetPixel(MemDC,6,2,BackColor1);
SetPixel(MemDC,6,4,BackColor1);
SetPixel(MemDC,6,6,BackColor1);
MakeBorBrush:=CreatePatternBrush(Bits);
end else MakeBorBrush:=0;
DeleteDC(MemDC);
DeleteDC(DC);
DeleteObject(Bits);
end;
procedure DrawExplodeFrame(PaintDC:HDC;ExplR:TRect;PenColor,BrushColor:TColorRef;DrawBrush:boolean;Width:integer;
Steps:integer;Pause:longint);
var count:integer;
dX,dY:double;
ThePen,OldPen:HPen;
TheBrush,OldBrush:HBrush;
OrigR:TRect;
TimeCount:longint;
begin
ThePen := CreatePen(ps_Dot,Width,PenColor);
OldPen := SelectObject(PaintDC,ThePen);
if DrawBrush then
TheBrush:=CreateSolidBrush(BrushColor) else
TheBrush := GetStockObject(Null_Brush);
OldBrush:= SelectObject(PaintDC,TheBrush);
dY:=(ExplR.bottom-ExplR.top)/Steps;
dX:=(ExplR.right-ExplR.left)/Steps;
with ExplR do
begin
left:=left+((right-left) div 2);
top:=top+((bottom-top) div 2);
right:=left;bottom:=top;
end;
OrigR:=ExplR;
for count:=1 to steps do
begin
with ExplR do
begin
TimeCount := GetTickCount;
left:=OrigR.left-integer(Round(dX*count));
right:=OrigR.right+integer(Round(dX*count));
bottom:=OrigR.bottom-integer(Round(dY*count));
top:=OrigR.top+integer(Round(dY*count));
Rectangle(PaintDC,left,top,right,bottom);
while (GetTickCount - TimeCount) < Pause do begin end;
end;
end;
SelectObject(PaintDC,OldBrush);
DeleteObject(TheBrush);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
end;
begin
end.
[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]