 Home |
13B. Graphic Controls Making Graphic Controls, that do NOT have a Window. |
Home |
There are several "Controls" in the Delphi VCL like TLabel and TSpeedButton that are "Graphic" controls and are not a system "Window", but are just an Image painted on the parents DC. These graphic controls have properties like width and height and some have events like OnMouseDown and OnClick. But since there is no system Window for these controls, all of the appearence and functionality comes from the parents system messages and drawing the control in the WM_PAINT message of it's parent. In this Graphic Controls, GrafCtrls.pas, Unit, there is code for several "Image" only controls, these controls are Not system windows but are just drawn on their parents window in it's WM_PAINT message. These "Graphic" controls include a GLabel, a GButton, a GArrow, and a GBorder. These image controls may not have any usefullness for you, these are mostly for a "How To" example. You may want to create your own code for a Graphic type that you would commonly use. |
Types of Graphic Controls There are four types of graphic controls in this unit, a text display called GLabel, a clickable button called GButton, an Arrow shape called GArrow, and a rectangular border called GBorder. These are here as examples for you to use to make your own re-usable code unit, with image areas (controls) that you have needed or coded in your GUI design. I will not use any "Delphi TObject" creation for these controls, I did not need these graphic controls to have many properties or have many "Options". So to try and keep it simple, I use functions to get and set the properties of a control, like the API functions that use a "Handle" to get and set window properties. All of these controls are Identified by a Number returned from their creation function, which is used much like a system "Handle". I have separate functions for each control type of control, that will create and change that control type. There are three functions (procedures) that can be used on 3 types of controls, much like the API window functions. They are - MoveGCtrl( ), , ShowGCtrl( ), , isGCtrlVisible( ). These 3 functions work on the GButton, GArrow and GBorder controls, but NOT on the GLabel controls. The first graphic control is a GLabel, You have seen this type of thing before in the In Units lesson, there was a ApiFormU.pas unit that had an array of TLabelRec to draw text in the main window's WM_PAINT message, to look like a text STATIC control. I hope that you could see how this "Array of Control Information" method could be used for other types of image areas or controls. The GLabel here is very much like the text draw label in APIformU.pas unit, so you should look at the code an explanation for the Labels in that lesson. The GLabels have an array of image information (position, parent) that is "Public" and can be accessed and changed by code. The other G controls in this do Not allow user access to the array of image information, like the GLabels does. You must use a function or procedure to change any of the properties (array data) for these G controls. I beleive for your own graphic control unit you would want to always have the control's "Array" of image data be public. All of these graphic controls have a function to create them, I use the word "Make" for my creation functions here, like MakeGButton( ). All of these Make functions will return an Identification number for the control that was created. This ID number is used in the other G control functions to identify which control to change. Each "Make" function will have parameters for the parent window handle and it's position (usually a Left and Top) and other parameters needed for that control. If the control has text there will be a Caption parameter, and if a Color is used a Color paramter. Each control has several more functions to change or get information for that control. You will notice that in this unit there are is NO way to destroy a G control once it has be created, if you need this you can add a function for it. There are many other options and properties you can add, but remember that this also adds bytes to your programs file size. The four Make functions - function MakeGLabel(hParent,Left,Top:Integer;const Caption:String;
Color1:Cardinal=0;hFont:Integer=-1):Integer;
function MakeGButton(hParent,Left,Top:Integer;Width,Height: Word;
const Caption:String;OnClick:TGButProc):Integer;
function MakeGArrow(hParent,PointX,PointY:Integer;Width,Length: Word;
ArrowKind:TArrowKind;Color:Integer=0):Integer;
function MakeGBorder(hParent,Left,Top:Integer;Width,Height:Word;
Kind:TBorderKind;Color:Cardinal;HiLoOff:Byte):Integer;The hParent parameter in all of these must be the parent window handle. The other parameters should be be recognized by their names. You will need to look at the code for any of these functions that you are interested in and figure out how they work, so you can get some ideas on how to make your own graphic display control.G Controls need to be Painted in Parents WM_PAINT Message DrawGLabels( ) Without these procedures being called you will not see anything on the GUI. Each of these procedures needs the parameters for the message window's handle (hWnd), the BeginPaint DC (hDC), and the BeginPaint area rectangle (PaintRect). Like this code - function MessageFunc(hWnd,Msg,wParam,lParam:Integer):Integer; stdcall;
var
PaintS: TPaintStruct;
begin
Result := Zero;
case Msg of
WM_PAINT:
begin
BeginPaint(hWnd, PaintS);
DrawGLabels(hWnd, PaintS.hDC, PaintS.rcPaint);
EndPaint(hWnd,PaintS);
Exit;
end;
end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;The GButton will get user input from a Left mouse button click, so you must place it's 2 procedures for mouse messages in it's parents left button mouse message handlers. The GButLDown( ) in the WM_LBUTTONDOWN message, , and the GButLUp( ) in the WM_LBUTTONUP message.
Code Examples If you are interested in this type of graphic control, you will need to look at the code in the unit below to get ideas to help you in your methods for making your own display controls. There are comments in the units code to give a few hints about what a function does, but you should have knowledge of the methods used here already from previous lessons here at Delphi Zeus. You might try and create your own visual control first, and then look at these examples for ideas about methods to create, size and draw it. On the next page Using GrafCtrls Program there is code for a program to show you how to use these G controls. |
unit GrafCtrls;
// unit for Images that act like a control
interface
uses Windows; // the ONLY unit in the uses clause is Windows
{These Graphic Controls are NOT meant to be a complete "Add On" unit for
your projects, this is an example unit, with some code to show some methods
for using a painted area to look like a "control". You will notice that
none of these G controls have any way to Delete or Destroy a G control
once it has been created, although you can hide them}
{I will draw on the DC of the "Parent" window, in the WM_PAINT message for
all of these Graphic controls, by looping through an Array of control
information for each different type of control. All of these controls
have a creation function with the word "Make", like MakeGButton( ). All of
these Make functions will return an Identification number (like a Handle)
to be used in other functions to tell it which control to access. . All
of these controls also have a function with the word "Draw", like
DrawGArrow( ) that MUST be placed in all of the parent windows WM_PAINT
message that have those graphic controls on them. All of these controls
have a function with the word "Change", like ChangeGLabel( ), which will
change some display of a single control}
{the only control here to use any user input is the GButton, which will
get left button mouse clicks, There are two procedures GButLDown and GButLUp
that MUST be placed in all of the GButton parent windows WM_LBUTTONDOWN and
WM_LBUTTONUP messages}
type
PGLabelRec = ^TGLabelRec;
TGLabelRec = Record
hParent1: Integer; // Parent of Label
GRect: TRect; // Bounds Rectangle of Label
Hide: Boolean; // Will only draw if false
TextColor: Cardinal; // Label text color
FontHnd: Integer; // font used to draw text
Text: String; // text to draw on Label
end;
// this TGLabelRec is a record of Information used to Draw a GLabel
// GRect is the name for a TRect that will have the Bounds of a G Control
// Hide is True if a G control is Hidden (negative of Visible)
PGButProc = ^TGButProc;
TGButProc = procedure(GButton: Integer);
// a TGButProc is a procedure called for button Clicks on a GButtons
PArrowKind = ^TArrowKind;
TArrowKind = (akRight, akLeft, akUp, akDown, akNon);
// TArrowKind wiil indicate the direction a GArrow will point, Right, Left
// Up and Down, the akNon is a NON-Change or "Null"
PBorderKind = ^TBorderKind;
TBorderKind = (bkFlat, bkDown, bkOut, bkGrove, bkBump, bkNon);
// TBorderKind sets the look of the GBorder, the Flat is solid color, no 3D,
// Down looks depressed, Out looks like a button, the bkNon is for
// NON-Change, a Null
{All of these controls work by creating a ARRAY of a controls position
and parent Record. The only array I have made "Public" is for the GLabel.
The other arrays are in the implementation and can not be accessed in code.}
var
AryGLabel: Array of TGLabelRec;
// = = = = = = = = = = = = = = = = =
//// GLabel functions
function MakeGLabel(hParent, Left, Top: Integer; const Caption: String;
Color1: Cardinal = 0; hFont: Integer = -1): Integer;
// Creates a GLabel and returns an ID number for that GLabel
procedure ChangeGLabel(iGLabel: Integer; const Caption: String;
hFont: Integer = -2);
// Changes the Caption or font of GLabel, the GLabel parameter is the
// GLabel ID number from the MakeGLabel function
procedure RefreshGLabel(iGLabel: Integer; Visible: Boolean = True);
// the RefreshGLabel does InvalidateRect on the parent for bounds Rect
procedure DoGLabelRect(iGLabel: Integer);
// this DoGLabelRect will calculate the Bounds Rect for that Label
// according to it's text length and Font
// this DrawGLabels must be placed in the labels's parent WM_PAINT message
procedure DrawGLabels(hWnd, hDC: Integer; const PaintRect: TRect);
// the hWnd is from the parent message function, the hDC is from the
// BeginPaint and the PaintRect is from the TPaintStruct rcPaint
// Common C Control Functions
// these three functions work on the 3 G Controls
// below, GButton, GArrow and GBorder, does NOT do GLabels
procedure MoveGCtrl(iGControl, Left, Top: Integer; Width, Height: Word);
// will move a G Control to a new position or size
// you can set the Width or Height to Zero if you do NOT want them to change
procedure ShowGCtrl(iGControl: Integer; Show: Boolean = True);
// will Show or Hide a G Control
function isGCtrlVisible(iGControl: Integer): Boolean;
// returns True if the G Control is visible
//// GButton functions
function MakeGButton(hParent, Left, Top: Integer; Width, Height: Word;
const Caption: String; OnClick: TGButProc): Integer;
// Creates a GButton, you need a TGButProc procedure for that Button Click
procedure setGButtonFont(iGButton, hFont: Integer; TextColor: Integer = -1);
// sets the Font and text Color for a GButton
procedure ChangeGButton(iGButton: Integer; const Caption: String;
Enable: Boolean = True);
// changes the Text or enabled for a GButton
function GetGButBounds(iGButton: Integer): TRect;
// gets the placement , bounds, in a rectangle
function isGButEnabled(iGButton: Integer): Boolean;
// returns True if GButton is Enabled
function GButCaption(iGButton: Integer): String;
// returns the text caption of GButton
// the next three procedures are placed in the GButton's Parent Message Proc
procedure DrawGBut(hWnd, hDC: Integer; const PaintRect: TRect);
// WM_PAINT for drawing the GButton
procedure GButLDown(hWnd, lParam: Integer);
// WM_LBUTTONDOWN to record a mouse down
procedure GButLUp(hWnd: Integer);
// WM_LBUTTONUP to call the TGButProc click procedure
//// GArrow Functions
function MakeGArrow(hParent, PointX, PointY: Integer; Width, Length: Word;
ArrowKind: TArrowKind; Color: Integer = 0): Integer;
// creates a GArrow
function GetGArrow(iGArrow: Integer; pPosition: PPoint; pBounds: PRect;
pKind: PArrowKind): Integer;
// in this GetGArrow, I use Pointers instead of Types, so I can have a nil
// if I do not need to Get a value of the GArrow
procedure GArrowColor(iGArrow: Integer; Color: Integer);
// sets the GArrow Color
procedure ChangeGArrow(iGArrow: Integer; Width, Length: Word;
ArrowKind: TArrowKind);
// changes the width, length and kind of GArrow
// this DrawGArrow must be placed in the arrow's parent WM_PAINT message
procedure DrawGArrow(hWnd, hDC: Integer; const PaintRect: TRect);
// functions for GBorder
function MakeGBorder(hParent, Left, Top: Integer; Width, Height: Word;
Kind: TBorderKind; Color: Cardinal; HiLoOff: Byte): Integer;
// creates a GBorder, the HiLoOff is the "Offset" or Difference between the
// hilight and shadow colors
procedure GBorderColors(iGBorder, HiColor, LoColor: Integer);
// use GBorderColors to assign your own "Special" light and dark colors
// I have the Colors as Integers, so you can not use the color HiByte
procedure ChangeGBorder(iGBorder, Color: Integer; Kind: TBorderKind; HiLoOff: Byte);
// changes the Color, kind and color offset of a GBorder
function GetGBorderRect(iGBorder: Integer): TRect;
// will return the bounds rectangle for a GBorder
// this DrawGBorder must be placed in the arrow's parent WM_PAINT message
procedure DrawGBorder(hWnd, hDC: Integer; const PaintRect: TRect);
// = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
implementation
const
Zero = 0;
One = 1;
mOne = -1;
Two = 2;
mTwo = -2;
white = $FFFFFF;
GButConst = $020000;
GArrowConst = $030000;
GBorderConst = $040000;
type
// position record for a GButton
TGButRec = record
hParent1: Integer;
GRect: TRect;
Hide: Boolean;
Color: Cardinal;
hFont1: Integer;
Enable1: Boolean;
ClickProc: TGButProc;
Caption1: String;
end;
TArwPoints = Array[Zero..7] of TPoint;
// position record for a GArrow
TArrowRec = record
hParent1: Integer;
GRect: TRect;
Hide: Boolean;
Color1: Integer;
AKind: TArrowKind;
ArwPnts: TArwPoints;
end;
// position record for a GBorder
TBorderRec = record
hParent1: Integer;
GRect: TRect;
Hide: Boolean;
Color1, HiColor, LoColor: Cardinal;
Off: Byte;
Dark: Boolean;
bKind: TBorderKind;
end;
var
// the 4 Count variables below keep the number of controls created
LabelCount: Integer = Zero;
GButCount: Integer = Zero;
GArrowCount: Integer = Zero;
GBorderCount: Integer = Zero;
// the Arrays below store all of the position records for controls created
AryGBut: Array of TGButRec;
AryGArrow: Array of TArrowRec;
AryGBorder: Array of TBorderRec;
// ButDown will record which GButton got a Left button dowm message
ButDown: Integer = mOne;
// Label functions / / / / / / / / / / / / / / / / / / / / / /
procedure DoGLabelRect(iGLabel: Integer);
var
Size1: TSize;
sDC: Integer;
begin
// this procedure will calculate the bounds rectangle for the text block
// of the font used in a GLabel
if ((iGLabel < Zero) or (iGLabel > High(AryGLabel))) then Exit;
sDC := GetDC(Zero); // text calculation are done on the screen DC
with AryGLabel[iGLabel] do
begin
if FontHnd > Zero then
SelectObject(sDC, FontHnd);
if Text = '' then
begin
GRect.Right := GRect.Left+One;
GRect.Bottom := GRect.Top+One;
end else
if GetTextExtentPoint32(sDC, PChar(Text), Length(Text), Size1) then
begin
GRect.Right := GRect.Left+Size1.cx;
GRect.Bottom := GRect.Top+Size1.cy;
end else
begin
GRect.Right := GRect.Left + (Length(Text)*8);
GRect.Bottom := GRect.Top+25;
end;
end;
ReleaseDC(Zero, sDC);
end;
function MakeGLabel(hParent, Left, Top: Integer; const Caption: String;
Color1: Cardinal = Zero; hFont: Integer = mOne): Integer;
begin
// creates a GLabel, and uses DoGLabelRect( ) to get the size of it's display
Result := mOne;
if not IsWindow(hParent) then Exit;
SetLength(AryGLabel, LabelCount+One);
with AryGLabel[LabelCount] do
begin
hParent1 := hParent;
TextColor := Color1;
GRect.Left := Left;
GRect.Top := Top;
if hFont < Zero then
FontHnd := GetStockObject(ANSI_VAR_FONT)
else
if hFont = Zero then
FontHnd := GetStockObject(SYSTEM_FONT)
else
FontHnd := hFont;
Hide := False;
Text := Caption;
end;
DoGLabelRect(LabelCount);
Result := LabelCount;
Inc(LabelCount);
end;
procedure ChangeGLabel(iGLabel: Integer; const Caption: String;
hFont: Integer = mTwo);
begin
// used to change the Text or font of a GLabel
with AryGLabel[iGLabel] do
begin
if ((iGLabel < Zero) or (iGLabel > High(AryGLabel))) or
((Text = Caption) and (hFont = mTwo)) then Exit;
InvalidateRect(hParent1, @GRect, True);
if hFont > mTwo then
if hFont = mOne then
FontHnd := GetStockObject(ANSI_VAR_FONT)
else
if hFont = Zero then
FontHnd := GetStockObject(SYSTEM_FONT)
else
FontHnd := hFont;
if Caption <> '' then
Text := Caption;
DoGLabelRect(iGLabel);
InvalidateRect(hParent1, @GRect, True);
end;
end;
procedure RefreshGLabel(iGLabel: Integer; Visible: Boolean = True);
begin
// called to repaint a GLabel
if ((iGLabel < Zero) or (iGLabel > High(AryGLabel))) then Exit;
AryGLabel[iGLabel].Hide := not Visible;
InvalidateRect(AryGLabel[iGLabel].hParent1, @AryGLabel[iGLabel].GRect, True);
end;
procedure DrawGLabels(hWnd, hDC: Integer; const PaintRect: TRect);
var
LN: Integer;
begin
{you will need to call this function in every window's WM_PAINT message in the
Window Proc that has any labels on it, this procedure loops through the
Labeles info array and draws them on the parents windows DC}
SetBkMode(hDC, TRANSPARENT);
// I set the DC to transparent and do NOT reset it
for LN := Zero to High(AryGLabel) do
if hWnd = AryGLabel[LN].hParent1 then
with AryGLabel[LN] do
begin
if Hide or
(PaintRect.Bottom < GRect.Top) or
(PaintRect.Right < GRect.Left) or
(PaintRect.Top > GRect.Bottom) or
(PaintRect.Left > GRect.Right) or
(Text = '') then Continue;
SelectObject(hDC, FontHnd);
SetTextColor(hDC, TextColor);
TextOut(hDC, GRect.Left, GRect.Top,
PChar(Text), Length(Text));
end;
end;
// GButton functions / / / / / / / / / / / / / / / / / / / / /
procedure GButPaint(index, hDC: Integer; Down: Boolean = False);
var
dRect: TRect;
begin
// this procedure will use the DrawFrameControl function to draw a button
with AryGBut[index] do
begin
if Down then
DrawFrameControl(hDC, GRect,DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_PUSHED)
else
DrawFrameControl(hDC, GRect,DFC_BUTTON, DFCS_BUTTONPUSH);
if Caption1 = '' then Exit;
SetBkMode(hDC, TRANSPARENT);
SelectObject(hDC, hFont1);
dRect := GRect;
InflateRect(dRect, mTwo, mTwo);
if Enable1 then
SetTextColor(hDC, Color)
else
begin
OffsetRect(dRect, One,One);
SetTextColor(hDC, GetSysColor(COLOR_BTNHILIGHT));
DrawText(hDC, PChar(Caption1), mOne, dRect,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
SetTextColor(hDC, GetSysColor(COLOR_GRAYTEXT));
OffsetRect(dRect, mOne, mOne);
end;
if Down then
OffsetRect(dRect, One, One);
DrawText(hDC, PChar(Caption1), mOne, dRect,
DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;
end;
procedure DrawGBut(hWnd, hDC: Integer; const PaintRect: TRect);
var
GN: Integer;
begin
{you will nedd to call this function in every window's WM_PAINT message in the
Window Proc that has any labels on it, this procedure loops through the
Labeles and draws them on the parents windows DC}
for GN := Zero to High(AryGBut) do
if hWnd = AryGBut[GN].hParent1 then
with AryGBut[GN] do
begin
if (PaintRect.Bottom < GRect.Top) or
(PaintRect.Right < GRect.Left) or
(PaintRect.Top > GRect.Bottom) or
(PaintRect.Left > GRect.Right) or
Hide then Continue;
GButPaint(GN, hDC);
end;
end;
procedure GButLDown(hWnd, lParam: Integer);
var
Pnt1: TPoint;
i, hDC: Integer;
begin
// this procedure is called in the parent's windows WM_LBUTTONDOWN message
Pnt1.x := SmallInt(lParam and $FFFF);
Pnt1.y := SmallInt(lParam shr 16);
for i := Zero to High(AryGBut) do
with AryGBut[i] do
begin
if (hWnd <> hParent1) or Hide then Continue;
if PtInRect(GRect, Pnt1) then
begin
if not Enable1 then Exit;
ButDown := i;
SetCapture(hWnd);
hDC := GetDC(hWnd);
GButPaint(i, hDC, True);
ReleaseDC(hWnd, hDC);
Break;
end;
end
end;
procedure GButLUp(hWnd: Integer);
var
hDC: Integer;
begin
// this procedure is called in the parent's windows WM_LBUTTONUP message
if ButDown = mOne then Exit;
ReleaseCapture;
hDC := GetDC(hWnd);
GButPaint(ButDown, hDC);
ReleaseDC(hWnd, hDC);
if @AryGBut[ButDown].ClickProc <> nil then
AryGBut[ButDown].ClickProc(GButConst+ButDown);
ButDown := mOne;
end;
function MakeGButton(hParent, Left, Top: Integer; Width, Height: Word;
const Caption: String; OnClick: TGButProc): Integer;
begin
// creates a GButton and returns the ID number for it
Result := mOne;
if not IsWindow(hParent) then Exit;
SetLength(AryGBut, GButCount+One);
if Width < 10 then Width := 10;
if height < 10 then Height := 10;
with AryGBut[GButCount] do
begin
hParent1 := hParent;
Color := GetSysColor(COLOR_BTNTEXT);
GRect.Left := Left;
GRect.Top := Top;
GRect.Right := Left+Width;
GRect.Bottom := Top+Height;
hFont1 := GetStockObject(SYSTEM_FONT);
Enable1 := True;
Hide := False;
ClickProc := OnClick;
Caption1 := Caption;
end;
Result := GButConst + GButCount;
Inc(GButCount);
end;
function NoButIndex(var GBut: Integer): Boolean;
var
index: Integer;
begin
// determines if the ID number is in range of array
index := GBut - GButConst;
if (index < Zero) or (index > High(aryGBut)) then
Result := True
else
begin
GBut := index;
Result := False;
end;
end;
procedure setGButtonFont(iGButton, hFont: Integer; TextColor: Integer = mOne);
begin
// sets the font of a GButton
if NoButIndex(iGButton) then Exit;
if hFont > -1 then
AryGBut[iGButton].hFont1 := hFont;
if TextColor > -1 then
AryGBut[iGButton].Color := TextColor;
InvalidateRect(AryGBut[iGButton].hParent1, @AryGBut[iGButton].GRect, False);
end;
procedure ChangeGButton(iGButton: Integer; const Caption: String;
Enable: Boolean = True);
var
Draw: Boolean;
begin
// changes the Text or enables a GButton
if NoButIndex(iGButton) then Exit;
Draw := False;
with AryGBut[iGButton] do
begin
if Caption <> '' then
begin
Caption1 := Caption;
Draw := True;
end;
if Enable1 <> Enable then
Draw := True;
Enable1 := Enable;
if Draw then
InvalidateRect(hParent1, @GRect, False);
end;
end;
function GetGButBounds(iGButton: Integer): TRect;
begin
// returns the bounds rect for the GButton
if NoButIndex(iGButton) then
begin
SetRectEmpty(Result);
Exit;
end;
Result := AryGBut[iGButton].GRect;
end;
function isGButEnabled(iGButton: Integer): Boolean;
begin
// returns True if GButton is enabled
if NoButIndex(iGButton) then
begin
Result := False;
Exit;
end;
Result :=AryGBut[iGButton].Enable1;
end;
function GButCaption(iGButton: Integer): String;
begin
// returns the GButton caption string
if NoButIndex(iGButton) then
begin
Result := '';
Exit;
end;
Result := AryGBut[iGButton].Caption1;
end;
// GArrow Functions
procedure SetGArrow(index, Width, Length: Word);
const
Six = 6;
var
HalfHWidth, HalfTWidth: Integer;
ALPt, EndPnt: TPoint;
i: Integer;
begin
// this will calculate the 7 points used to drawn a GArrow
if Width < Six then
Width := Six;
if Length < Width+4 then
Length := Width+4;
HalfHWidth := Width shr One{div 2};
HalfTWidth := Trunc(HalfHWidth / 2.5);
with AryGArrow[index] do
case AKind of
akRight..akLeft:
begin
ALPt.y := ArwPnts[Zero].y;
EndPnt.y := ALPt.y;
if AKind = akRight then
begin
ALPt.x := ArwPnts[Zero].x-Width;
EndPnt.x := ArwPnts[Zero].x-Length;
GRect.Left := EndPnt.x;
GRect.Right := ArwPnts[Zero].x+One;
end else
begin
ALPt.x := ArwPnts[Zero].x+Width;
EndPnt.x := ArwPnts[Zero].x+Length;
GRect.Left := ArwPnts[Zero].x;
GRect.Right := EndPnt.x+One;
end;
for i := One to Six do
if (i = 3) or (i = 4) then
ArwPnts[i].x := EndPnt.x
else
ArwPnts[i].x := ALPt.x;
ArwPnts[One].y := ALPt.y-HalfHWidth;
ArwPnts[Two].y := ALPt.y-HalfTWidth;
ArwPnts[3].y := EndPnt.y-HalfTWidth;
ArwPnts[4].y := EndPnt.y+HalfTWidth;
ArwPnts[5].y := ALPt.y+HalfTWidth;
ArwPnts[Six].y := ALPt.y+HalfHWidth;
GRect.Top := ArwPnts[One].y;
GRect.Bottom := ArwPnts[Six].y+One;
end;
akUp..akDown:
begin
ALPt.x := ArwPnts[Zero].x;
EndPnt.x := ArwPnts[Zero].x;
if AryGArrow[index].AKind = akUp then
begin
ALPt.y := ArwPnts[Zero].y+Width;
EndPnt.y := ArwPnts[Zero].y+Length;
GRect.Bottom := EndPnt.y+One;
GRect.Top := ArwPnts[Zero].y;
end else
begin
ALPt.y := ArwPnts[Zero].y-Width;
EndPnt.y := ArwPnts[Zero].y-Length;
GRect.Bottom := ArwPnts[Zero].y+One;
GRect.Top := EndPnt.y;
end;
for i := One to Six do
if (i = 3) or (i = 4) then
ArwPnts[i].y := EndPnt.y
else
ArwPnts[i].y := ALPt.y;
ArwPnts[One].x := ALPt.x+HalfHWidth;
ArwPnts[Two].x := ALPt.x+HalfTWidth;
ArwPnts[3].x := EndPnt.x+HalfTWidth;
ArwPnts[4].x := EndPnt.x-HalfTWidth;
ArwPnts[5].x := ALPt.x-HalfTWidth;
ArwPnts[Six].x := ALPt.x-HalfHWidth;
GRect.Left := ArwPnts[Six].x;
GRect.Right := ArwPnts[One].x+One;
end;
end;
end;
function MakeGArrow(hParent, PointX, PointY: Integer; Width, Length: Word;
ArrowKind: TArrowKind; Color: Integer = Zero): Integer;
begin
// adds a GArrow info Record to the AryGArrow array
Result := mOne;
if not IsWindow(hParent) then Exit;
SetLength(AryGArrow, GArrowCount+One);
with AryGArrow[GArrowCount] do
begin
hParent1 := hParent;
Color1 := Color;
Hide := False;
if ArrowKind = akNon then
ArrowKind := akLeft;
AKind := ArrowKind;
ArwPnts[Zero].x := PointX;
ArwPnts[Zero].y := PointY;
ArwPnts[7] := AryGArrow[GArrowCount].ArwPnts[Zero];
end;
SetGArrow(GArrowCount, Width, Length);
Result := GArrowConst + GArrowCount;
Inc(GArrowCount);
end;
function NoArwIndex(var GArw: Integer): Boolean;
var
index: Integer;
begin
// tests to see if the index is valid
index := GArw - GArrowConst;
if (index < Zero) or (index > High(AryGArrow)) then
Result := True
else
begin
GArw := index;
Result := False;
end;
end;
function GetGArrow(iGArrow: Integer; pPosition: PPoint; pBounds: PRect;
pKind: PArrowKind): Integer;
begin
// this fuction can return several of the GArrow properties
// I have used pointers here like PPoint so if you do NOT need that information
// you just place a nil in that parameter
// this returns the arrow color or a minus one if the index is out of range
Result := mOne;
if NoArwIndex(iGArrow) then Exit;
with AryGArrow[iGArrow] do
begin
Result := Integer(Color1);
if pPosition <> nil then
begin
pPosition^.x := ArwPnts[Zero].x;
pPosition^.y := ArwPnts[Zero].y;
end;
if pBounds <> nil then
pBounds^ := GRect;
if pKind <> nil then
pKind^ := AKind;
end;
end;
procedure ChangeGArrow(iGArrow: Integer; Width, Length: Word;
ArrowKind: TArrowKind);
begin
// this will change the width, height and Kind for a GArrow
if NoArwIndex(iGArrow) then Exit;
with AryGArrow[iGArrow] do
begin
if not Hide then
InvalidateRect(hParent1, @GRect, True);
if ArrowKind <> akNon then
AKind := ArrowKind;
SetGArrow(iGArrow, Width, Length);
if not Hide then
InvalidateRect(hParent1, @GRect, True);
end;
end;
procedure GArrowColor(iGArrow: Integer; Color: Integer);
begin
// this only changes the Color of a GArrow
if NoArwIndex(iGArrow) then Exit;
if Color <> AryGArrow[iGArrow].Color1 then
begin
AryGArrow[iGArrow].Color1 := Color;
if not AryGArrow[iGArrow].Hide then
InvalidateRect(AryGArrow[iGArrow].hParent1, @AryGArrow[iGArrow].GRect, True);
end;
end;
// you Must place this DrawGArrow in the GArrow's parents message function
procedure DrawGArrow(hWnd, hDC: Integer; const PaintRect: TRect);
var
AN, oBrush, Brush, oPen, Pen: Integer;
begin
for AN := Zero to High(AryGArrow) do
if hWnd = AryGArrow[AN].hParent1 then
with AryGArrow[AN] do
begin
if (PaintRect.Bottom < GRect.Top) or
(PaintRect.Right < GRect.Left) or
(PaintRect.Top > GRect.Bottom) or
(PaintRect.Left > GRect.Right) or
Hide then Continue;
Brush := CreateSolidBrush(Color1);
Pen := CreatePen(PS_SOLID,Zero,Color1);
oBrush := SelectObject(hDC, Brush);
oPen := SelectObject(hDC, Pen);
Polygon(hDC, ArwPnts, 8);
DeleteObject(SelectObject(hDC, oBrush));
DeleteObject(SelectObject(hDC, oPen));
end;
end;
// GBorder functions
procedure SetBorColors(GBorder, Color: Integer; cOff: Byte);
const
red = $FF;
green = $FF00;
blue = $FF0000;
var
r,g,b: Integer;
begin
// this will calculate the HighLight and Shadow colors for the GBorder
r := ((Color and red) + cOff)-Two;
if r > red then
r := red;
g := (Color and green) + ((cOff+4) shl 8);
if g > green then
g := green;
b := ((Color and blue) + (cOff shl 16))-$20000;
if b > blue then
b := blue;
AryGBorder[GBorder].HiColor := r or g or b;
r := ((Color and red) - cOff)+Two;
if r < Zero then
r := Zero;
g := (Color and green) - ((cOff+4) shl 8);
if g < $100 then
g := Zero;
b := ((Color and blue) - (cOff shl 16))+$20000;
if b < $10000 then
b := Zero;
AryGBorder[GBorder].LoColor := r or g or b;
r := Color and red;
g := (Color and green) shr 8;
b := (Color and blue) shr 16;
r := Round((r*0.9)+(g*1.5)+(b*0.6)) div 3;
if r < $8F then
AryGBorder[GBorder].Dark := True
else
AryGBorder[GBorder].Dark := False;
end;
function MakeGBorder(hParent, Left, Top: Integer; Width, Height: Word;
Kind: TBorderKind; Color: Cardinal; HiLoOff: Byte): Integer;
begin
// this will add a GBorder to the AryGBorder array
Result := mOne;
if not IsWindow(hParent) then Exit;
SetLength(AryGBorder, GBorderCount+One);
if Width < 8 then Width := 8;
if Height < 8 then Height := 8;
with AryGBorder[GBorderCount] do
begin
hParent1 := hParent;
if HiLoOff = Zero then
HiLoOff := $1A;
Off := HiLoOff;
Color1 := Color and white;
if Kind = bkNon then Kind := bkFlat;
if Kind = bkFlat then
begin
HiColor := Color1;
LoColor := Color1;
end else
SetBorColors(GBorderCount, Color1, HiLoOff);
GRect.Left := Left;
GRect.Top := Top;
GRect.Right := Left+Width;
GRect.Bottom := Top+Height;
bKind := Kind;
Hide := False;
end;
Result := GBorderConst + GBorderCount;
Inc(GBorderCount);
end;
function NoBorIndex(var GBor: Integer): Boolean;
var
index: Integer;
begin
// tests to see if the GBor is in the Index of the array
index := GBor - GBorderConst;
if (index < Zero) or (index > High(AryGBorder)) then
Result := True
else
begin
GBor := index;
Result := False;
end;
end;
procedure GBorderColors(iGBorder, HiColor, LoColor: Integer);
begin
// this will set the HighLight and Shadow colors to any custom colors
if NoBorIndex(iGBorder) then Exit;
if HiColor > Zero then
AryGBorder[iGBorder].HiColor := HiColor and white;
if LoColor > Zero then
AryGBorder[iGBorder].LoColor := LoColor and white;
if not AryGBorder[iGBorder].Hide then
InvalidateRect(AryGBorder[iGBorder].hParent1, @AryGBorder[iGBorder].GRect, False);
end;
procedure ChangeGBorder(iGBorder, Color: Integer; Kind: TBorderKind; HiLoOff: Byte);
begin
// changes the GBorder Color, Kind and color offset
if NoBorIndex(iGBorder) then Exit;
with AryGBorder[iGBorder] do
begin
if HiLoOff > Zero then
Off := HiLoOff;
if Kind <> bkNon then
bKind := Kind;
if Color > mOne then
Color1 := Color and white;
if not ((Color < Zero) and (HiLoOff = Zero)) then
if bKind = bkFlat then
begin
HiColor := Color1;
LoColor := Color1;
end else
SetBorColors(iGBorder, Color1, Off);
if not Hide then
InvalidateRect(hParent1, @GRect, True);
end;
end;
function GetGBorderRect(iGBorder: Integer): TRect;
begin
// gets the bounds Rect of a GBorder
if NoBorIndex(iGBorder) then
begin
SetRectEmpty(Result);
Exit;
end;
Result := AryGBorder[iGBorder].GRect;
end;
// you Must place this DrawGBorder in the GBorder's parents message function
procedure DrawGBorder(hWnd, hDC: Integer; const PaintRect: TRect);
var
BN, oBrush, oPen, Pen: Integer;
Color: Cardinal;
begin
// draws the rectangles for a GBorder
oPen := Zero;
for BN := Zero to High(AryGBorder) do
if hWnd = AryGBorder[BN].hParent1 then
with AryGBorder[BN] do
begin
if (PaintRect.Bottom < GRect.Top) or
(PaintRect.Right < GRect.Left) or
(PaintRect.Top > GRect.Bottom) or
(PaintRect.Left > GRect.Right) or
Hide then Continue;
case bKind of
bkFlat:
begin
Pen := CreatePen(PS_SOLID or PS_INSIDEFRAME,Two,HiColor);
oPen := SelectObject(hDC, Pen);
oBrush := SelectObject(hDC, GetStockObject(NULL_BRUSH));
Rectangle(hDc, GRect.Left, GRect.Top, GRect.Right, GRect.Bottom);
SelectObject(hDC, oBrush);
end;
bkDown..bkOut:
begin
if bKind = bkDown then
Color := HiColor
else
Color := LoColor;
Pen := CreatePen(PS_SOLID,Two, Color);
oPen := SelectObject(hDC, Pen);
MovetoEx(hDC, GRect.Right-One, GRect.Top+One, nil);
LineTo(hDC, GRect.Right-One, GRect.Bottom-One);
LineTo(hDC, GRect.Left+One, GRect.Bottom-One);
if bKind = bkDown then
Color := LoColor
else
begin
if Dark then
Color := Zero
else
Color := $708080;
Pen := CreatePen(PS_SOLID,Zero, Color);
oPen := SelectObject(hDC, Pen);
MovetoEx(hDC, GRect.Right-One, GRect.Top+Two, nil);
LineTo(hDC, GRect.Right-One, GRect.Bottom-One);
LineTo(hDC, GRect.Left+Two, GRect.Bottom-One);
Color := HiColor;
end;
Pen := CreatePen(PS_SOLID,Two, Color);
DeleteObject(SelectObject(hDC, Pen));
MovetoEx(hDC, GRect.Left+One, GRect.Bottom-One, nil);
LineTo(hDC, GRect.Left+One, GRect.Top+One);
LineTo(hDC, GRect.Right-One, GRect.Top+One);
if bKind = bkOut then
begin
SetPixel(hDC, GRect.Left+One, GRect.Bottom-One, LoColor);
SetPixel(hDC, GRect.Right-One, GRect.Top+One, LoColor);
end else
begin
if Dark then
Color := Zero
else
Color := $708080;
Pen := CreatePen(PS_SOLID,Zero, Color);
DeleteObject(SelectObject(hDC, Pen));
MovetoEx(hDC, GRect.Left+One, GRect.Bottom-3, nil);
LineTo(hDC, GRect.Left+One, GRect.Top+One);
LineTo(hDC, GRect.Right-Two, GRect.Top+One);
end;
end;
bkGrove..bkBump:
begin
if bKind = bkGrove then
Color := LoColor
else
Color := HiColor;
Pen := CreatePen(PS_SOLID,Zero, Color);
oPen := SelectObject(hDC, Pen);
oBrush := SelectObject(hDC, GetStockObject(NULL_BRUSH));
Rectangle(hDc, GRect.Left, GRect.Top, GRect.Right-One, GRect.Bottom-One);
if bKind = bkGrove then
Color := HiColor
else
Color := LoColor;
Pen := CreatePen(PS_SOLID ,Zero, Color);
DeleteObject(SelectObject(hDC, Pen));
Rectangle(hDc, GRect.Left+One, GRect.Top+One, GRect.Right, GRect.Bottom);
SelectObject(hDC, oBrush);
end;
end;
DeleteObject(SelectObject(hDC, oPen));
end;
end;
// G Control functions
{there are 3 Common procedures and function, which can access G controls
of more than One type, they are the MoveGCtrl, ShowGCtrl, and isGCtrlVisible,
which are below, these 3 can do a GArrow, a GButton and a GBorder, they will
not handle a GLabel}
procedure MoveGCtrl(iGControl, Left, Top: Integer; Width, Height: Word);
var
i, offX, offY: Integer;
begin
// this will change the position of a G Control
{in order to have One function for several control types, you will need to
test the iGControl in all 3 of the index test functions -
NoButIndex
NoArwIndex
NoBorIndex}
if not NoButIndex(iGControl) then
with AryGBut[iGControl] do
begin
if Width < 10 then
Width := GRect.Right-GRect.Left;
if Height < 10 then
Height := GRect.Bottom-GRect.Top;
if (GRect.Left = Left) and
(GRect.Top = Top) and
(GRect.Right = Left+Width) and
(GRect.Bottom = Top+Height) then Exit;
if not Hide then
InvalidateRect(hParent1, @GRect, True);
GRect.Left := Left;
GRect.Top := Top;
GRect.Right := Left+Width;
GRect.Bottom := Top+Height;
if not Hide then
InvalidateRect(hParent1, @GRect, False);
Exit;
end;
if not NoArwIndex(iGControl) then
with AryGArrow[iGControl] do
begin
offX := Left - ArwPnts[Zero].x;
offY := Top - ArwPnts[Zero].y;
if (offX = Zero) and (offY = Zero) then Exit;
if not Hide then
InvalidateRect(hParent1, @GRect, True);
for i := Zero to 7 do
begin
ArwPnts[i].x := ArwPnts[i].x + offX;
ArwPnts[i].y := ArwPnts[i].y + offY;
end;
OffSetRect(GRect, offX, offY);
if not Hide then
InvalidateRect(hParent1, @GRect, True);
Exit;
end;
if not NoBorIndex(iGControl) then
with AryGBorder[iGControl] do
begin
if Width < 8 then
Width := GRect.Right-GRect.Left;
if Height < 8 then
Height := GRect.Bottom-GRect.Top;
if (GRect.Left = Left) and
(GRect.Top = Top) and
(GRect.Right = Left+Width) and
(GRect.Bottom = Top+Height) then Exit;
if not Hide then
InvalidateRect(hParent1, @GRect, True);
GRect.Left := Left;
GRect.Top := Top;
GRect.Right := Left+Width;
GRect.Bottom := Top+Height;
if not Hide then
InvalidateRect(hParent1, @GRect, True);
end;
end;
procedure ShowGCtrl(iGControl: Integer; Show: Boolean = True);
begin
// shows and hides a G Control
if not NoButIndex(iGControl) then
with AryGBut[iGControl] do
begin
if Hide <> Show then Exit;
Hide := not Show;
InvalidateRect(hParent1, @GRect, True);
Exit;
end;
if not NoArwIndex(iGControl) then
with AryGArrow[iGControl] do
begin
if Hide <> Show then Exit;
Hide := not Show;
InvalidateRect(hParent1, @GRect, True);
Exit;
end;
if not NoBorIndex(iGControl) then
with AryGBorder[iGControl] do
begin
if Hide <> Show then Exit;
Hide := not Show;
InvalidateRect(hParent1, @GRect, True);
end;
end;
function isGCtrlVisible(iGControl: Integer): Boolean;
begin
// returns True if the G Control is visible
Result := False;
if not NoBorIndex(iGControl) then
Result := not AryGBorder[iGControl].Hide;
if not NoButIndex(iGControl) then
Result := not AryGBut[iGControl].Hide;
if not NoArwIndex(iGControl) then
Result := not AryGArrow[iGControl].Hide;
end;
initialization
finalization
Finalize(AryGLabel);
Finalize(AryGBut);
end. |
|
This should give you some ideas about including code for a graphical control, there can be such a variety of "Picture" and image display for controls, you can have fun making an image button or other visual controls.
You can create your own graphical control units and then try to make some that have your special look and visual style.
The next page will have some example code for a program using this GrafCtrls.pas unit. |
Next in Code Container Series
The following page shows you how to create a G control program, using this GrafCtrls unit.
13C. Using GrafCtrls Program
H O M E
