Class TGradBtn (unit HDGradBtn) |
Inherits from
TCustomControl
constructor Create(AOwner : TComponent);
- Public declarations } {Almost all components override the constructor, so that default values for
new properties can be set.
destructor Destroy;
If no 3D effect is set, we just draw text in the center
procedure KeyPress(var Key: Char);
Protected declarations } {I added the following to allow the Enter key to behave as a Click.
procedure CMMouseEnter(var Msg:TMessage);
I had to add this to get the Caption to change while designingThe following two procedures process user code that can be specified in the
events for the component.
procedure CMMouseLeave(var Msg:TMessage);
procedure CMTextChanged(var Msg:TMessage);
procedure DoElliptic(fr, fg, fb, dr, dg, db : Integer);
the gradients.
procedure DoHorizCenter(fr, fg, fb, dr, dg, db : Integer);
procedure DoHorizontal(fr, fg, fb, dr, dg, db : Integer);
Choose gradient fill styleI'll explain a little about the Horizontal gradient, the other styles are all
consistent with their logic.
procedure DoInset(offset: Integer);
This draws the 3D Caption 'raised'This draws 'raised' 3D text for the Caption.
procedure DoNorm(offset: Integer);
This draws te 3D caption 'inset'
procedure DoRaise(offset: Integer);
Set preset values
procedure DoRectangle(fr, fg, fb, dr, dg, db : Integer);
The fr fg fb etcPlug colors into brush
procedure DoVertCenter(fr, fg, fb, dr, dg, db : Integer);
are color values.
procedure DoVertical(fr, fg, fb, dr, dg, db : Integer);
These all drawDraw on Bitmap
procedure KeyAccel(var Message: TCMDialogChar);
Mouse up and down are what I use to swap gradient colorsAdded handler for accelerator key
procedure MouseDown(Button:TMouseButton; Shift: TShiftState;
X, Y: Integer);
I added this to help reduce flicker and speed things up.
procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
X, Y: Integer);
the original stuff.
procedure Paint;
ABB caption w/out ampersand!Everything pretty much happens in the Paint procedure; a lot of it is farmed
out to other procedures just so the logic in the paint procedure can be
understood a little better.
procedure SetBeginClr(Value : TColor);
Set color for text 3D effect sadow
procedure SetBtnFrameSize(Value: Integer);
Set Color of right and bottom of frame
procedure SetBtnHilite(Value: TColor);
procedure SetBtnShadow(Value: TColor);
Set color of top and left of frame goes through its Paint procedure.
procedure SetEndClr(Value : TColor);
Set start color of gradient
procedure SetGradient(Value : TGradientStyle);
This draws the caption with no 3D
procedure SetPreset(Value: TPreset);
Set Caption shading typeWhen user selects a shade, set the variable to new type and do
an invalidate to force a re-paint of the component.
procedure SetShade(Value: TShadeType);
Set Caption 3D styleWhen user selects a style, set the variable to new style and do
an invalidate to force a re-paint of the component.
procedure SetShowFocus(Value : Boolean);
Swap the start-end true-false
procedure SetStyle(Value: TTextStyle);
Draw Rect when we have focus T/F
procedure SetSwap(Value : Boolean);
Set end color of gradient
procedure SetTxtHilite(Value: TColor);
Set size of 3D frame
procedure SetTxtShadow(Value: TColor);
Set color for text 3D effect hilite
procedure WMEraseBkgnd(Var Msg : TMessage);
Processing these messages allows events to fire when mouse enters or leaves
procedure WMKillFocus(Var Msg : TWMKillFocus);
procedure WMSetFocus(Var Msg : TWMSetFocus);
Override Paint - entire control is painted.
property BeginColor : TColor
property BtnFrameSize : Integer
property BtnHiliteClr : TColor
Published declarations } {This first batch of stuff is all the new properties I added for this
component.
property BtnShadowClr : TColor
property Caption :
property Enabled :
going through the browser.
property EndColor : TColor
property Font :
property GradientStyle : TGradientStyle
property PopupMenu :
property Presets : TPreset
property ShowFocus : Boolean
property ShowHint :
property SwapColors : Boolean
property TabOrder :
property TabStop :
property TextShadeType : TShadeType
property TextStyle : TTextStyle
property TxtHiliteClr : TColor
property TxtShadowClr : TColor
property Visible :
declare them yourself.
event OnClick :
Added these so they show up in the Obj Insp.
event OnEnter :
event OnExit :
event OnKeyDown :
event OnKeyPress :
event OnKeyUp :
event OnMouseDown :
When deriving from a Custom type control,
event OnMouseEnter : TNotifyEvent
event OnMouseLeave : TNotifyEvent
These show up in events
event OnMouseMove :
event OnMouseUp :
these don't normally show up unless you specifically
bm : TBitmap;
Flags for Mouse Up or Down
Caption2 : string;
Variable for presets
FBeginClr : TColor;
Text Shadow
FBtnFrameSize : Integer;
Shadow around button
FBtnHiliteClr : TColor;
Private declarations
FBtnShadowClr : TColor;
Hilite around button
FEndClr : TColor;
Start color for gradient
FGradientStyle : TGradientStyle;
Show indicator rectangle when we have focus?
FOnMouseEnter : TNotifyEvent;
Light or heavy text shading
FOnMouseLeave : TNotifyEvent;
Make the Mouse Enter and Leave available
FPreset : TPreset;
Holding area for Color during Mouse Down.
FShadeType : TShadeType;
Raised, Inset, or None
FShowFocus : Boolean;
Swap start-end colors on button press?
FSwapClr : Boolean;
End color for gradient
FTextStyle : TTextStyle;
One of six choices
FTxtHiliteClr : TColor;
Size of 3D Frame
FTxtShadowClr : TColor;
Text Hilite
mUp : Boolean;
TmpClr : TColor;
WorkHorse internal bmp
constructor Create(AOwner : TComponent);
Public declarations } {Almost all components override the constructor, so that default values for
new properties can be set. The destructor is usually overridden so cleanup
can be done - like releasing resources so they don't cause memory leaks.
destructor Destroy;
If no 3D effect is set, we just draw text in the center
procedure KeyPress(var Key: Char);
Protected declarations } {I added the following to allow the Enter key to behave as a Click.
I added the following to allow the Enter key to behave as a Click.} {If return key was pressed, do a 'Click'. This only happens if
we have the 'Focus'.
procedure CMMouseEnter(var Msg:TMessage);
I had to add this to get the Caption to change while designing
The following two procedures process user code that can be specified in the
events for the component. These are often used to change the color when the
mouse enters a control, or something like that. I made these into events so
the user can trigger whatever code they wish without modifying/creating a
component.
procedure CMMouseLeave(var Msg:TMessage);
procedure CMTextChanged(var Msg:TMessage);
procedure DoElliptic(fr, fg, fb, dr, dg, db : Integer);
the gradients.
Draw on Bitmap
procedure DoHorizCenter(fr, fg, fb, dr, dg, db : Integer);
procedure DoHorizontal(fr, fg, fb, dr, dg, db : Integer);
Choose gradient fill style
I'll explain a little about the Horizontal gradient, the other styles are all
consistent with their logic. The six R, G, and B values are passed to us.
We define some local variables we'll need: a rectangle, a FOR loop counter,
and our own RGB numbers. For a horizontal gradient, we'll draw a series of
rectangles, each one a little closer in color to the EndClr value. A horizontal
gradient rectangle will always be from the top to the bottom of the canvas,
so we set top to 0 and bottom to however tall our control is. Then, we draw
a series of 255 rectangles. The starting point and width of each will depend
on the actual width of our control. It starts out on the left, draws the
first rectangle in a color that's a percentage of the difference plus the
starting color. As I increments through the loop, the rectangles move to the
right and the color gets closer and closer to the EndClr.
procedure DoInset(offset: Integer);
This draws the 3D Caption 'raised'
This draws 'raised' 3D text for the Caption. Inset is the same principal,
the colors are just reversed. The brush style is set to Clear so the
background is not erased. The highlight colored text is drawn on the canvas
at -1 up and left of center. If heavy shading is set, the shadow colored
text is drawn at +1 rigt and down of center. Finally, the Font.Color colored
text is drawn in exact center. The offset parameter is used to 'move' the
whole shebang down and right 1 if the Mouse is Down.
procedure DoNorm(offset: Integer);
This draws te 3D caption 'inset'
procedure DoRaise(offset: Integer);
Set preset values
procedure DoRectangle(fr, fg, fb, dr, dg, db : Integer);
The fr fg fb etc
Plug colors into brush
procedure DoVertCenter(fr, fg, fb, dr, dg, db : Integer);
are color values.
Plug colors into brush
procedure DoVertical(fr, fg, fb, dr, dg, db : Integer);
These all draw
Draw on Bitmap
procedure KeyAccel(var Message: TCMDialogChar);
Mouse up and down are what I use to swap gradient colors
Added handler for accelerator key
procedure MouseDown(Button:TMouseButton; Shift: TShiftState;
X, Y: Integer);
I added this to help reduce flicker and speed things up.
procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
X, Y: Integer);
the original stuff. Hence, TmpClr
procedure Paint;
ABB caption w/out ampersand!
Everything pretty much happens in the Paint procedure; a lot of it is farmed
out to other procedures just so the logic in the paint procedure can be
understood a little better. Here's the basic process for creating a gradient:
Get the separate R, G, and B values of the BeginClr Color. Then, find the
difference between that and the R, G, and B values of the EndClr Color. Using
these two sets of values, draw a series of 'shapes' using a series of colors
between the begin and end. After the gradient is drawn, add a frame and the
Caption.
procedure SetBeginClr(Value : TColor);
Set color for text 3D effect sadow
procedure SetBtnFrameSize(Value: Integer);
Set Color of right and bottom of frame
procedure SetBtnHilite(Value: TColor);
procedure SetBtnShadow(Value: TColor);
Set color of top and left of frame
goes through its Paint procedure.
procedure SetEndClr(Value : TColor);
Set start color of gradient
procedure SetGradient(Value : TGradientStyle);
This draws the caption with no 3D
procedure SetPreset(Value: TPreset);
Set Caption shading type
When user selects a shade, set the variable to new type and do
an invalidate to force a re-paint of the component.
procedure SetShade(Value: TShadeType);
Set Caption 3D style
When user selects a style, set the variable to new style and do
an invalidate to force a re-paint of the component.
procedure SetShowFocus(Value : Boolean);
Swap the start-end true-false
procedure SetStyle(Value: TTextStyle);
Draw Rect when we have focus T/F
procedure SetSwap(Value : Boolean);
Set end color of gradient
procedure SetTxtHilite(Value: TColor);
Set size of 3D frame
procedure SetTxtShadow(Value: TColor);
Set color for text 3D effect hilite
procedure WMEraseBkgnd(Var Msg : TMessage);
Processing these messages allows events to fire when mouse enters or leaves
procedure WMKillFocus(Var Msg : TWMKillFocus);
procedure WMSetFocus(Var Msg : TWMSetFocus);
Override Paint - entire control is painted.
Windows it processed OK.
property BeginColor : TColor
property BtnFrameSize : Integer
property BtnHiliteClr : TColor
Published declarations } {This first batch of stuff is all the new properties I added for this
component. As long as the properties are part of the usual types, you
don't have to define your own property editor. I love Delphi.
property BtnShadowClr : TColor
property Caption :
property Enabled :
going through the browser.
property EndColor : TColor
property Font :
property GradientStyle : TGradientStyle
property PopupMenu :
property Presets : TPreset
property ShowFocus : Boolean
property ShowHint :
property SwapColors : Boolean
property TabOrder :
property TabStop :
property TextShadeType : TShadeType
property TextStyle : TTextStyle
property TxtHiliteClr : TColor
property TxtShadowClr : TColor
property Visible :
declare them yourself. You can find them by
event OnClick :
Added these so they show up in the Obj Insp.
event OnEnter :
event OnExit :
event OnKeyDown :
event OnKeyPress :
event OnKeyUp :
event OnMouseDown :
When deriving from a Custom type control,
event OnMouseEnter : TNotifyEvent
event OnMouseLeave : TNotifyEvent
These show up in events
event OnMouseMove :
event OnMouseUp :
these don't normally show up unless you specifically
bm : TBitmap;
Flags for Mouse Up or Down
Caption2 : string;
Variable for presets
FBeginClr : TColor;
Text Shadow
FBtnFrameSize : Integer;
Shadow around button
FBtnHiliteClr : TColor;
Private declarations
FBtnShadowClr : TColor;
Hilite around button
FEndClr : TColor;
Start color for gradient
FGradientStyle : TGradientStyle;
Show indicator rectangle when we have focus?
FOnMouseEnter : TNotifyEvent;
Light or heavy text shading
FOnMouseLeave : TNotifyEvent;
Make the Mouse Enter and Leave available
FPreset : TPreset;
Holding area for Color during Mouse Down.
FShadeType : TShadeType;
Raised, Inset, or None
FShowFocus : Boolean;
Swap start-end colors on button press?
FSwapClr : Boolean;
End color for gradient
FTextStyle : TTextStyle;
One of six choices
FTxtHiliteClr : TColor;
Size of 3D Frame
FTxtShadowClr : TColor;
Text Hilite
mUp : Boolean;
TmpClr : TColor;
WorkHorse internal bmp