 Home |
13C. Using GrafCtrls Program Example code for Graphic Controls, in the GrafCtrls.pas unit |
Home |
Below is the code for a Program that uses the G Controls - GLabel, GButton, GArrow, and GBorder. This has code in it to show you how to use some of the functions in the GrafCtrls.pas unit from the previous page 13B. Graphic Controls. |
Code for the UseGrafCtrl.DPR program file -
This uses the MakeApp.pas unit from DelphiZeus Lesson 13. MakeApp Unit
program UseGrafCtrl;
uses
MakeApp,
UseGrafU in 'UseGrafU.pas';
{$R *.RES}
begin
if MakeProgram then
RunMsgLoop;
end. |
Code for the UseGrafU.pas Unit file -
| There are several examples in this unit for creating and changing the visual controls available in the GrafCtrl unit. All of the G control creation code is in the MakeControls procedure. Please notice that in the hForm1 window message procedure MessageFunc( ) all of the GControl "Draw" procedures are called in the WM_PAINT message handler. In all of the MakeGButton( ) functions, the GBut1Proc procedure is assigned to the TGButProc parameter, as the procedure to be called for button clicks. See the comments in the code for more information. |
unit UseGrafU;
{this unit will give examples of code to use the functions in the
GrafCtrls Unit for GLabels, GButtons, GArrows and GBorders}
interface
function MakeProgram: Boolean;
{the MakeProgram function will call some functions to create the windows
and controls for this Application.
If there is a creation error, it returns False}
implementation
uses
Windows, Messages, MakeApp, GrafCtrls, SmallUtils;
const
One = 1;
ID_ExitBut = 1000;
GroupColor: Cardinal = $5058EB;
var
hForm1: Integer = Zero;
Font1: Integer = Zero;
Font2: Integer = Zero;
{all of the Graphic Controls in the GrafCtrls unit have Integer ID
which I use Like a "Handle" in the GrafCtrls functions}
hButExit, gLabel1, gLabel2, gLabel3, gLabel4, gButArrow,
gButButton, gButLabel, gButBorder, gArrow1, gArrow2, gArrow3,
gBorder1, GroupBorder, FrameBorder: Integer;
procedure ChangeBorders;
begin
// this procedure changes the 3 graphic Borders
{there are 3 Graphic Control Functions
MoveGCtrl
ShowGCtrl
isGCtrlVisible
which will work on the three G Controls
GArrow, GButton, and GBorder}
if isGCtrlVisible(FrameBorder) then
begin
ShowGCtrl(FrameBorder, False); // changes the visible for FrameBorder
ChangeGBorder(gBorder1, -1, bkBump, Zero); // changes the type of Border1
GBorderColors(gBorder1, $00FFF0, $FF3333); // does special border colors
MoveGCtrl(gBorder1, 310, 110, 140, 118); // moves Border1
ChangeGBorder(GroupBorder, $3FD03F, bkGrove, $20);
// changes the type and Color of GroupBorder
end else
begin
ShowGCtrl(FrameBorder);
ChangeGBorder(gBorder1, GetSysColor(COLOR_BTNFACE), bkDown, $1A);
MoveGCtrl(gBorder1, 330, 120, 120, 100);
ChangeGBorder(GroupBorder, $D030D0, bkNon, $3F);
// by using bkNon in ChangeGBorder, the border Type is NOT changed
end;
end;
procedure GBut1Proc(GButton: Integer);
var
ArwPnt: TPoint;
bColor: Integer;
ShowB: Boolean;
ButStr: String;
begin
{This GBut1Proc procedure is a TGButProc type, with a single parameter GButton.
It has been Assigned to all of the GButtons in their MakeGButton functions.
the GButton will have the button Identifier for the button that was clicked}
if GButton = gButButton then
begin
// button Click to Change the G Buttons
ChangeGButton(gButLabel, '', not isGButEnabled(gButLabel));
// disable GButLabel
if isGCtrlVisible(gButArrow) then // returns the visible state of gButArrow
begin
ShowB := False; // variables used in the GButton functions below
bColor := $FF;
MoveGCtrl(gButBorder,24,214, Zero,Zero);
ButStr := 'UnDo GButtons';
end else
begin
ShowB := True;
bColor := $EF00;
MoveGCtrl(gButBorder,154,214, Zero,Zero);
ButStr := 'Do GButtons';
end;
ShowGCtrl(gButArrow, ShowB); // show and hide gButArrow
ChangeGButton(gButButton, ButStr);
setGButtonFont(gButBorder, DEF, bColor); // change color of gButBorder
end else
if GButton = gButLabel then
begin
{ button click for changing GLabels
GLabels are the only G control that has it's Array of position info
availible to the user, so there are less functions to use to change
the control, you will directly change the array values to change
the display of the G Label}
RefreshGLabel(gLabel2, AryGLabel[gLabel2].Hide);
// changes the visibility of Label2
if AryGLabel[gLabel4].GRect.Left = 160 then
begin
// I access the array AryLabel to change the properties of a Label
RefreshGLabel(gLabel4);
{if I change a Label's Position, I need to call RefreshLabel before
the change, to erase where the Label used to be}
AryGLabel[gLabel4].GRect.Left := 340;
// I cahnge the position, font, and color of Label4
AryGLabel[gLabel4].GRect.Top := 193;
AryGLabel[gLabel4].FontHnd := Font1;
AryGLabel[gLabel4].TextColor := $FFAA00;
DoGLabelRect(gLabel4); // you MUST call DoLabelRect to resize the Bounds Rect
RefreshGLabel(gLabel4);
// You MUST call RefreshLabel after to redraw the new Label
ChangeGLabel(gLabel3, 'Other Text on Label'); // change text for Label3
// ChangeLabel will call the DoLabelRect and RefreshLabel
ChangeGLabel(gLabel1, '', Zero); // change Font for Label1
end else
begin
RefreshGLabel(gLabel4);
AryGLabel[gLabel4].GRect.Left := 160;
AryGLabel[gLabel4].GRect.Top := 76;
AryGLabel[gLabel4].TextColor := $FFFFFF;
DoGLabelRect(gLabel4);
RefreshGLabel(gLabel4);
ChangeGLabel(gLabel3, 'Changed Text');
ChangeGLabel(gLabel1, '', DEF);
end;
end else
if GButton = gButArrow then
begin
// button click for changing G Labels
ArwPnt.x := 0;
{ the GetGArrow will get most of the Arrow properties, I have the Return
parameters as pointers, so if you do NOT need that property, then
just have NIL as that parameter}
bColor := GetGArrow(gArrow1, @ArwPnt, nil, nil);
{this GetGArrow will retrive only the Arrow Point Position and color, since
I do not need the Arrow Rectangle or Arrow Type , I have a NIL for those parameters}
if bColor < Zero then Exit;
// if the index is out of range GetGArrow gives a bColor as -1
if ArwPnt.x <> 417 then
begin
MoveGCtrl(gArrow1, 417, 177, Zero, Zero); // moves Arrow1
ChangeGArrow(gArrow1, 16, 36, akUp);
// changes the width and length and Arrow Type
if bColor = $DF33DF then
GArrowColor(gArrow1, $00DFFF) // change Arrow1 color
else
GArrowColor(gArrow1, $FFFFFF);
ChangeGArrow(gArrow2, 12, 22, akNon);
// a ChangeGArrow with atNon will NOT change the Arrow Type
ChangeGArrow(gArrow3, 12, 69, akRight);
end else
begin
MoveGCtrl(gArrow1, 347, 164, Zero, Zero);
ChangeGArrow(gArrow1, 16, 36, akDown);
GArrowColor(gArrow1, $DF33DF);
ChangeGArrow(gArrow2, 8, 20, akNon);
ChangeGArrow(gArrow3, 22, 50, akUp);
end;
end else
if GButton = gButBorder then ChangeBorders;
end;
function MessageFunc(hWnd,Msg,wParam,lParam:Integer):Integer; stdcall;
var
PaintS: TPaintStruct;
begin
Result := Zero;
case Msg of
WM_DESTROY: PostQuitMessage(Zero);
WM_PAINT:
begin
BeginPaint(hWnd, PaintS);
// IMPORTANT, you MUST call the Draw procedure for all of the
// different Graphic Controls you use in their parents WM_PAINT message
// in order to have the controls painted
DrawGBorder(hWnd, PaintS.hDC, PaintS.rcPaint);
DrawGLabels(hWnd, PaintS.hDC, PaintS.rcPaint);
DrawGArrow(hWnd, PaintS.hDC, PaintS.rcPaint);
DrawGBut(hWnd, PaintS.hDC, PaintS.rcPaint);
// the next code draws text for the Group Border
SelectObject(PaintS.hdc, VarFont);
SetBkColor(PaintS.hdc, GetSysColor(COLOR_BTNFACE));
SetBkMode(PaintS.hdc, OPAQUE);
SetTextColor(PaintS.hdc, GroupColor);
TextOut(PaintS.hdc, 24,92,' Group Border ',14);
EndPaint(hWnd,PaintS);
Exit;
end;
WM_COMMAND:
if LOWORD(wParam) = ID_ExitBut then
PostMessage(hForm1, WM_CLOSE, Zero, Zero);
{for the Graphic Buttons to have an OnClick event, you will need to
pass their parent's WM_LBUTTONDOWN and WM_LBUTTONUP message to the
GButLDown and GButLUp procedures}
WM_LBUTTONDOWN: GButLDown(hWnd, lParam);
WM_LBUTTONUP: GButLUp(hWnd);
end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;
procedure MakeControls;
var
CRect: TRect;
begin
Font1 := MakeFont(-15, 10, 'Arial');
Font2 := MakeFont(-17, 10, 'Comic Sans MS');
hButExit := MakeButton(382,238,84, 24, 'E X I T', hForm1, ID_ExitBut, Font1);
// there is only One system window control, the Exit button above
{Graphic Labels are created with the MakeLabel function, the Color and Font
parameters are optional, there are no width and height parameters, because
they are automatically calculated and placed in the AryGLabel GRect}
gLabel1 := MakeGLabel(hForm1, 8, 5, 'Label One');
gLabel2 := MakeGLabel(hForm1, 68, 106, 'Label In Group', GroupColor, Font1);
gLabel3 := MakeGLabel(hForm1, 210, 5, 'Label Three', Zero, Font2);
gLabel4 := MakeGLabel(hForm1, 160, 66, 'Label Four', $AF00, Zero);
MakeGLabel(hForm1, 137, 132, 'Click to change Labels', GroupColor);
{Graphic Buttons are made with the MakeGButton function, it has the standard
Left, Top, Width and Height parameters, and the Button Caption. In order to
get a button Click event for a Graphic Button you will need to include a
TGButProc procedure, I use the GBut1Proc procedure for all of these
GButtons, but you could use separate TGButProc for a GButton}
gButButton := MakeGButton(hForm1, 41,36, 168,28, 'Do Buttons', GBut1Proc);
{the setGButtonFont will change the Font and Text color for a G button}
setGButtonFont(GButButton, Font1, $FF33C7);
gButLabel := MakeGButton(hForm1, 24,128, 84,24, 'Change Labels', GBut1Proc);
setGButtonFont(GButLabel, VarFont, GroupColor);
gButArrow := MakeGButton(hForm1, 74,174, 112,26, 'Change Arrows', GBut1Proc);
gButBorder := MakeGButton(hForm1, 154,214, 94,24, 'Change Borders', GBut1Proc);
setGButtonFont(GButBorder, VarFont);
{Graphic Arrows are created with the MakeGArrow function, this does NOT have the
Top or Left parameters, instead it's position is from the PointX and PointY,
setting the position of the Arrow's Point, NOT the arrow bounds rectangle}
gArrow1 := MakeGArrow(hForm1, 377, 167, 16, 36, akDown, $FF00);
gArrow2 := MakeGArrow(hForm1, 112, 138, 8, 20, akLeft, GroupColor);
gArrow3 := MakeGArrow(hForm1, 326, 41, 20, 50, akUp, $C86870);
{Borders are created with the MakeGBorder function, it has the standard
Left, Top, Width, and Height parameters. You set the Kind parameter to the
TBorderKind you want the border to be. The Color parameter will be changed
by the HiLoOff parameter (a Byte value) for the difference between the
HighLight and Shadow (Dark) colors}
gBorder1 := MakeGBorder(hForm1, 330, 120, 120, 101, bkOut,
GetSysColor(COLOR_BTNFACE), $1A);
GroupBorder := MakeGBorder(hForm1, 16, 98, 248, 150, bkBump, GroupColor, $48);
GetClientRect(hForm1, CRect);
FrameBorder := MakeGBorder(hForm1, 1, 1, CRect.Right -2, CRect.Bottom-2,
bkGrove, $EF6F7F, $58);
SetFocus(hButExit);
end;
function MakeProgram: Boolean;
begin
Result := False;
if SetWinClass('GrafCtrl'#9'Class', @MessageFunc) = Zero then Exit;
hForm1 := MakeForm(DEF, DEF, 480, 281, 'Use GrafCtrls',
WS_TILEDWINDOW or WS_CLIPCHILDREN);
if hForm1 = Zero then Exit;
Result := True;
MakeControls; // control creation
end;
initialization
finalization
DeleteObject(Font1);
DeleteObject(Font2);
end.
|
| This should give you some ideas about using the GControls in the GrafCtrl.pas Unit. |
Next
The following lesson shows you how to create the system Open and Save Dialog Boxes.
14. Open and Save Dialogs
H O M E
