[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]