home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Windoware
/
WINDOWARE_1_6.iso
/
winutil
/
om301
/
buttons.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-01-09
|
7KB
|
227 lines
{Buttons - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit Buttons;
{************************ Interface ***********************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects;
type
PODButton = ^TODButton;
TODButton = object(TButton)
HBmp :HBitmap;
State:Integer;
constructor Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
destructor Done;virtual;
procedure DrawItem(var Msg:TMessage);virtual;
end;
type
PODRButton = ^TODRButton;
TODRButton = object(TRadioButton)
HBmp :HBitmap;
State:Integer;
constructor Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
X,Y,W,H:Integer;AGroup:PGroupBox;BMP:PChar);
destructor Done;virtual;
procedure DrawItem(var Msg:TMessage);virtual;
end;
PODGroupBox = ^TODGroupBox;
TODGroupbox = object(TGroupBox)
OldBNR:PODRButton;
OldBNRID:Integer;
constructor Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
X,Y,W,H:Integer);
procedure SelectionChanged(ControlID:Integer);virtual;
end;
{************************ Implementation **********************}
implementation
const
sr_Recessed = 1;
sr_Raised = 0;
{************************ DrawHiLites ****************************}
function DrawHilites(PaintDC:hDC;X1,Y1,X2,Y2,LW,State:Integer):Boolean;
var
LPts:Array[0..2] of TPoint;
RPts:Array[0..2] of TPoint;
Pen1:HPen;
Pen2:HPen;
OldBrush :HBrush;
OldPen:HPen;
OldBkMode:Integer;
DRect:TRect;
Ofs,W,H:Integer;
begin
Ofs := 0;
LPts[0].x := X1+Ofs; LPts[0].y := Y2-Ofs;
LPts[1].x := X1+Ofs; LPts[1].y := Y1+Ofs;
LPts[2].x := X2-Ofs; LPts[2].y := Y1+Ofs;
RPts[0].x := X1+Ofs; RPts[0].y := Y2-Ofs;
RPts[1].x := X2-Ofs; RPts[1].y := Y2-Ofs;
RPts[2].x := X2-Ofs; RPts[2].y := Y1+Ofs;
Pen1 := CreatePen(ps_Solid,2,$00000000); {Draw a surrounding blk frame}
OldPen := SelectObject(PaintDC,Pen1);
PolyLine(PaintDC,LPts,3);
PolyLine(PaintDC,RPts,3);
SelectObject(PaintDC,OldPen);
DeleteObject(Pen1);
If State = sr_Recessed then
Ofs := lw
else
Ofs := 0;
LPts[0].x := X1+Ofs; LPts[0].y := Y2-Ofs;
LPts[1].x := X1+Ofs; LPts[1].y := Y1+Ofs;
LPts[2].x := X2-Ofs; LPts[2].y := Y1+Ofs;
RPts[0].x := X1+Ofs; RPts[0].y := Y2-Ofs;
RPts[1].x := X2-Ofs; RPts[1].y := Y2-Ofs;
RPts[2].x := X2-Ofs; RPts[2].y := Y1+Ofs;
if State = sr_Raised then
begin
Pen1 := CreatePen(ps_Solid,LW,$00FFFFFF);
Pen2 := CreatePen(ps_Solid,LW,$00000000);
end
else
begin
Pen1 := CreatePen(ps_Solid,LW,$00000000);
Pen2 := CreatePen(ps_Solid,LW,$00FFFFFF);
end;
OldPen := SelectObject(PaintDC,Pen1); {Draw the highlights}
PolyLine(PaintDC,LPts,3);
SelectObject(PaintDC,Pen2);
DeleteObject(Pen1);
PolyLine(PaintDC,RPts,3);
SelectObject(PaintDC,OldPen);
DeleteObject(Pen2);
end;
constructor TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
begin
TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
Attr.Style := Attr.Style or bs_OwnerDraw;
HBmp := LoadBitmap(HInstance,BMP);
end;
destructor TODButton.Done;
begin
DeleteObject(HBmp);
TButton.Done;
end;
procedure TODButton.DrawItem(var Msg:TMessage);
var
TheDC,MemDC:HDc;
ThePen,Pen1,Pen2,OldPen:HPen;
TheBrush,OldBrush:HBrush;
OldBitMap:HBitMap;
LPts,RPts:Array[0..2] of TPoint;
PDIS :^TDrawItemStruct;
X,Y,W,H:Integer;
PenWidth,OffSet:Integer;
DBU:LongRec;
begin
LongInt(DBU) := GetDialogBaseUnits;
PDIS := Pointer(Msg.lParam);
if PDIS^.itemAction = oda_Focus then Exit;
if ((PDIS^.itemAction and oda_Select ) > 0) and
((PDIS^.itemState and ods_Selected) > 0) then
State := sr_Recessed else State := sr_Raised; {1 = depressed}
X := PDIS^.rcItem.left; Y := PDIS^.rcItem.top;
W := PDIS^.rcItem.right-PDIS^.rcItem.left;
H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
OffSet := Round((PDIS^.rcItem.bottom-PDIS^.rcItem.top) / (DBU.lo * 4)); {scale highlites based on size}
PenWidth := OffSet;
MemDC := CreateCompatibleDC(PDIS^.HDC);
OldBitMap := SelectObject(MemDC,HBMP);
if State = sr_Raised then BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
else BitBlt(PDIS^.HDC,X+OffSet,Y+OffSet,W,H, MemDC,0,0,SrcCopy);
SelectObject(MemDC,OldBitMap);
DeleteDC(MemDC);
DrawHiLites(PDIS^.hDC,X,Y,PDIS^.rcItem.Right,PDIS^.rcitem.Bottom,OffSet,State)
end;
{********************* TODRButton *****************************}
constructor TODRButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
X,Y,W,H:Integer;AGroup:PGroupBox;BMP:PChar);
begin
TRadioButton.Init(AParent,AnID,ATitle,X,Y,W,H,AGroup);
Attr.Style := Attr.Style or bs_OwnerDraw;
HBmp := LoadBitmap(HInstance,BMP);
State := sr_Raised;
end;
destructor TODRButton.Done;
begin
DeleteObject(HBmp);
TRadioButton.Done;
end;
procedure TODRButton.DrawItem(var Msg:TMessage);
var
TheDC,MemDC:HDc;
OldBitMap:HBitMap;
Offset:Integer;
LPts,RPts:Array[0..2] of TPoint;
PDIS :^TDrawItemStruct;
X,Y,W,H:Integer;
DBU:LongRec;
GKS:Integer;
begin
LongInt(DBU) := GetDialogBaseUnits;
PDIS := Pointer(Msg.lParam);
GKS := GetKeyState(vk_LButton);
If IsIconic(hWindow) then Exit;
if (PDIS^.itemAction = 1) then
State := State
else if (PDIS^.itemAction = 2) and (PDIS^.ItemState = 17)
then State := sr_Recessed
else if (PDIS^.itemAction = 2) and (PDIS^.ItemState = 16) and (GKS < 0)
then State := sr_Raised
else Exit;
X := PDIS^.rcItem.left; Y := PDIS^.rcItem.top;
W := PDIS^.rcItem.right-PDIS^.rcItem.left;
H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
OffSet := Round((PDIS^.rcItem.bottom-PDIS^.rcItem.top) / (DBU.lo * 4)); {scale highlites based on size}
MemDC := CreateCompatibleDC(PDIS^.HDC);
OldBitMap := SelectObject(MemDC,HBMP);
if State = 0 then BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
else BitBlt(PDIS^.HDC,X+OffSet,Y+OffSet,W,H, MemDC,0,0,SrcCopy);
SelectObject(MemDC,OldBitMap);
DeleteDC(MemDC);
DrawHiLites(PDIS^.hDC,X,Y,PDIS^.rcItem.Right,PDIS^.rcitem.Bottom,OffSet,State)
end;
{****************** TODGroupBox ******************************}
constructor TODGroupBox.Init(AParent:PWindowsObject;AnID:Integer;AText:PChar;
X,Y,W,H:Integer);
begin
TGroupBox.Init(AParent,AnId,AText,X,Y,W,H);
Attr.Style := Attr.Style and not ws_Visible;
OldBNR := nil;
OldBNRID := 0;
end;
procedure TODGroupBox.SelectionChanged(Controlid:Integer);
begin
TGroupBox.SelectionChanged(Controlid);
if ControlID = OldBNRID then
Exit;
If OldBNR = nil then
begin
OldBNR := PODRButton(Parent^.ChildWithID(ControlID));
OldBNRID := ControlID;
end
else
begin
OldBNR^.State := sr_Raised;
InvalidateRect(OldBNR^.HWindow,nil,True);
OldBNR := PODRButton(Parent^.ChildWithID(Controlid));
OldBNRID := ControlID;
end;
end;
end.