Class TGradientForm (unit GradForm)

Inherits from

TForm

: TGradientForm is a descendant of the TForm class that paints it's caption bar in a gradient fill pattern, like the Microsoft Office applications. By default, it starts with black and moves gradually to the system defined caption color, although you can override these values. Also provided is an event to allow you to add your own custom painting on the caption bar.

Constructors


constructor Create(AOwner: TComponent);

Overridden methods { Create creates and initializes an instance of TGradientForm.


Functions

destructor Destroy;

Destroy destroys an instance of TGradientForm.

procedure Draw(Active: boolean);

This procedure is used to paint the caption gradient.

procedure Activate;

empty write method, just needed to get it to show up in Object Inspector

procedure CalculateColors;


procedure CreateWnd;

Create a font for the caption bar.

procedure Deactivate;


procedure DestroyWnd;

Create a font for the caption bar.

procedure DoShow;


function DrawCaption(FormDC: HDC; Active: boolean): TRect;

Help only shows up in bsDialog style, and bsSizeable, bsSingle when there is no min or max button.

procedure FillRectGradient(DC: HDC; const R: TRect; Active: boolean);

Paint the given rectangle with the gradient pattern.

procedure FillRectSolid(DC: HDC; const R: TRect; Active: boolean);

Paint the given rectangle with the system solid color.

function GetCaptionRect: TRect;

Virtual methods useful for descandants

The caption rect is the rectangle we are interested in painting.


function GetVersion: TDFSVersion;

Are we running under Win98, and should we let it do it for us?

procedure Loaded;

Overriden methods

Clean up the font we created.


procedure PaintCaptionButtons(DC: HDC; var Rect: TRect);

Paint the min/max/help/close buttons.

procedure PaintCaptionText(DC: HDC; R: TRect; Active: boolean);

Start filling bands

procedure PaintMenuIcon(DC: HDC; var R: TRect; Active: boolean);

Paint the icon for the system menu.

procedure SetCaptionText(const Val: string);

Make the non client area repaint.

procedure SetCaptionTextColor(Color: TColor);

Property methods

Make the non client area repaint.


procedure SetGradientColors(Val: integer);


procedure SetGradientInactiveStartColor(Color : TColor);

Make the non client area repaint.

procedure SetGradientInactiveStopColor(Color : TColor);

Make the non client area repaint.

procedure SetGradientStartColor(Color : TColor);

Make the non client area repaint.

procedure SetGradientStopColor(Color : TColor);

Make the non client area repaint.

procedure SetInactiveCaptionTextColor(Color: TColor);

Make the non client area repaint.

procedure SetPaintGradient(Val: TGFPaintWhen);

Make the non client area repaint.

procedure SetUseWin98Gradient(Val: boolean);

Need to cause main form's caption to be redrawn, not the MDI child.

procedure SetVersion(const Val: TDFSVersion);


function StoreGradientInactiveStopColor: boolean;


function StoreGradientStopColor: boolean;

Property storage qualifing methods

function Win98Check: boolean;

Utility methods

procedure CreateCaptionFont;

Use the percentage of each color to create each band color.

procedure GradClientWndProc(var Message: TMessage);

MDI Client Window Procedure

NEVER leave this hanging.


function IsActiveWindow: boolean;

Internal methods

hmmm, how to get it to show again in the IDE?


procedure WMEnterIdle(var Msg: TWMEnterIdle);


procedure WMGetText(var Msg: TWMGetText);

Don't do it if it was called from .

procedure WMGetTextLength(var Msg: TWMGetTextLength);


procedure WMNCActivate(var Msg: TWMNCActivate);

Window message handlers

Windows sends this message when the window has been activated or deactivated.


procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);

(Msg = WM_MDIREFRESHMENU) or

procedure WMNCPaint(var Msg: TMessage);

Windows sends this message whenever any part of the non-client area (caption, window border) needs repainting.

procedure WMSetCursor(var Msg: TWMSetCursor);

Windows would like to have a cursor displayed.

procedure WMSetText(var Msg: TWMSetText);

Wasn't anything we cared about, so tell Windows we didn't handle it.

procedure WMSettingChange(var Msg: TMessage);


procedure WMSize(var Msg: TWMSize);

The window has been resized.

procedure WMSysColorChange(var Msg: TWMSysColorChange);

Windows sends this message if the user changes any of the system colors.

procedure WMSysCommand (var Msg: TWMSysCommand);


Properties

property Caption : string

: Caption specifies a text string that appears in the caption bar.

property CaptionTextColor : TColor

: CaptionTextColor is the color that should be used for the text draw in the caption bar.

property GradientColors : integer

: Determines the number of colors used to paint the gradient pattern.

property GradientInactiveStartColor : TColor


property GradientInactiveStopColor : TColor


property GradientStartColor : TColor

: The leftmost gradient color.

property GradientStopColor : TColor

: The rightmost gradient color.

property InactiveCaptionTextColor : TColor


property PaintGradient : TGFPaintWhen

: Determines if and when the gradient caption should be painted.

property UseWin98Gradient : boolean


property Version : TDFSVersion

Properties

Events

event OnCaptionPaint : TGFOnCaptionPaint

: This event is fired after the icon, buttons and gradient are painted, but just before the text is painted.

Variables

CaptionFont : HFONT;


Colors : array[0..1, 0..MAX_GRADIENT_COLORS-1] of TColorRef;

Internal variables

FCaptionText : string;


FCaptionTextColor : TColor;

Property variables

FChangingActivationState : boolean;


FGradClientInstance : TFarProc;


FGradDefClientProc : TFarProc;


FGradientColors : integer;


FGradientInactiveStartColor : TColor;


FGradientInactiveStopColor : TColor;


FGradientStartColor : TColor;


FGradientStopColor : TColor;


FInactiveCaptionTextColor : TColor;


FOnCaptionPaint : TGFOnCaptionPaint;


FPaintGradient : TGFPaintWhen;


FRunningOnWin98 : boolean;


FUseWin98Gradient : boolean;


FUsingDefaultGradientInactiveStopColor : boolean;


FUsingDefaultGradientStopColor : boolean;



Constructors


constructor Create(AOwner: TComponent);

Overridden methods { Create creates and initializes an instance of TGradientForm.

: Create creates and initializes an instance of TGradientForm. Call Create to instantiate a TGradientForm at runtime. After calling the inherited constructor, Create initializes the following properties:


Functions


destructor Destroy;

Destroy destroys an instance of TGradientForm.

: Destroy destroys an instance of TGradientForm. Do not call Destroy directly in an application. Instead, call Free. Free verifies that the instance is not already freed, and only then calls Destroy.
Destroy is used to free resources allocated in the constructor.


procedure Draw(Active: boolean);

This procedure is used to paint the caption gradient.

: This procedure is used to paint the caption gradient. It is normally called internally, but it can be used any time a repaint of the caption is needed. The Active parameter is used to indicate whether the caption should be painted as the active window or an inactive window.


procedure Activate;

empty write method, just needed to get it to show up in Object Inspector


procedure CalculateColors;


procedure CreateWnd;

Create a font for the caption bar.


procedure Deactivate;


procedure DestroyWnd;

Create a font for the caption bar.


procedure DoShow;


function DrawCaption(FormDC: HDC; Active: boolean): TRect;

Help only shows up in bsDialog style, and bsSizeable, bsSingle when there is no min or max button.


procedure FillRectGradient(DC: HDC; const R: TRect; Active: boolean);

Paint the given rectangle with the gradient pattern.


procedure FillRectSolid(DC: HDC; const R: TRect; Active: boolean);

Paint the given rectangle with the system solid color.


function GetCaptionRect: TRect;

Virtual methods useful for descandants

The caption rect is the rectangle we are interested in painting. This will be the area that contains the caption icon, text and buttons.


function GetVersion: TDFSVersion;

Are we running under Win98, and should we let it do it for us?


procedure Loaded;

Overriden methods

Clean up the font we created.


procedure PaintCaptionButtons(DC: HDC; var Rect: TRect);

Paint the min/max/help/close buttons.


procedure PaintCaptionText(DC: HDC; R: TRect; Active: boolean);

Start filling bands


procedure PaintMenuIcon(DC: HDC; var R: TRect; Active: boolean);

Paint the icon for the system menu.


procedure SetCaptionText(const Val: string);

Make the non client area repaint.


procedure SetCaptionTextColor(Color: TColor);

Property methods

Make the non client area repaint.


procedure SetGradientColors(Val: integer);


procedure SetGradientInactiveStartColor(Color : TColor);

Make the non client area repaint.


procedure SetGradientInactiveStopColor(Color : TColor);

Make the non client area repaint.


procedure SetGradientStartColor(Color : TColor);

Make the non client area repaint.


procedure SetGradientStopColor(Color : TColor);

Make the non client area repaint.


procedure SetInactiveCaptionTextColor(Color: TColor);

Make the non client area repaint.


procedure SetPaintGradient(Val: TGFPaintWhen);

Make the non client area repaint.


procedure SetUseWin98Gradient(Val: boolean);

Need to cause main form's caption to be redrawn, not the MDI child.


procedure SetVersion(const Val: TDFSVersion);


function StoreGradientInactiveStopColor: boolean;


function StoreGradientStopColor: boolean;

Property storage qualifing methods


function Win98Check: boolean;

Utility methods


procedure CreateCaptionFont;

Use the percentage of each color to create each band color.


procedure GradClientWndProc(var Message: TMessage);

MDI Client Window Procedure

NEVER leave this hanging.


function IsActiveWindow: boolean;

Internal methods

hmmm, how to get it to show again in the IDE?


procedure WMEnterIdle(var Msg: TWMEnterIdle);


procedure WMGetText(var Msg: TWMGetText);

Don't do it if it was called from .SetCaption


procedure WMGetTextLength(var Msg: TWMGetTextLength);


procedure WMNCActivate(var Msg: TWMNCActivate);

Window message handlers

Windows sends this message when the window has been activated or deactivated.


procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);

(Msg = WM_MDIREFRESHMENU) or


procedure WMNCPaint(var Msg: TMessage);

Windows sends this message whenever any part of the non-client area (caption, window border) needs repainting.


procedure WMSetCursor(var Msg: TWMSetCursor);

Windows would like to have a cursor displayed. I know, you're wondering why the hell I care about this, aren't you? Well, in the inherited handling (default Windows processing) of this message, if the mouse is over a resizeable border section, Windows repaints the caption buttons. Why? I have absolutely no idea. However, that's not the important part. When it repaints those buttons, it also repaints the background around them in the last color it painted the caption in. Now, usually this would just result in losing a few bands of the caption gradient, which 99.44% of all users would never notice. However, because we don't always allow default processing of WM_NCACTIVATE, sometimes Windows doesn't have the right idea about which color is currently the background. This cause the background to get painted in the wrong color sometimes, which 99.44% of all users *will* notice. We fix it by setting the appropriate cursor and not allowing the default processing to occur.


procedure WMSetText(var Msg: TWMSetText);

Wasn't anything we cared about, so tell Windows we didn't handle it.


procedure WMSettingChange(var Msg: TMessage);


procedure WMSize(var Msg: TWMSize);

The window has been resized.


procedure WMSysColorChange(var Msg: TWMSysColorChange);

Windows sends this message if the user changes any of the system colors.


procedure WMSysCommand (var Msg: TWMSysCommand);


Properties


property Caption : string

: Caption specifies a text string that appears in the caption bar.


property CaptionTextColor : TColor

: CaptionTextColor is the color that should be used for the text draw in the caption bar. You may have to adjust this color if you change the to something other than the default of clBlack.


property GradientColors : integer

: Determines the number of colors used to paint the gradient pattern. The individual colors are determined by fading the start color into the stop color. The number of times this is done is controled by this property. The higher the number of colors, the smoother the gradient will appear. However, the more colors that are used, the more complex the painting will be.


property GradientInactiveStartColor : TColor


property GradientInactiveStopColor : TColor


property GradientStartColor : TColor

: The leftmost gradient color. This is the color that is used at the beginning of the caption (the far left), and is gradually faded into the .


property GradientStopColor : TColor

: The rightmost gradient color. This is the color that is used at the end of the caption (the far right), and is gradually faded from the .


property InactiveCaptionTextColor : TColor


property PaintGradient : TGFPaintWhen

: Determines if and when the gradient caption should be painted.


property UseWin98Gradient : boolean


property Version : TDFSVersion

Properties


Events


event OnCaptionPaint : TGFOnCaptionPaint

: This event is fired after the icon, buttons and gradient are painted, but just before the text is painted. It is not fired if the caption is painted but not as a gradient, that is if is gfpNever or gfpActive and the form is not active.

Sender is the TGradientForm that is being painted.

Canvas is the drawing surface that is being painted. Anything you want to appear on the caption must be drawn on this canvas. This canvas is not the actual caption canvas, it is a memory bitmap (non-visible). This prevents flicker as many things are being drawn since the actual visible drawing only happens when the entire drawing operation is complete.

R is a rectangle that describes the area in which you can draw. When the event is first fired, this rectangle will be the entire caption less the system icon on the left (if any) and the caption buttons on the right (if any). After performing your drawing operations, this value should be modified so that the area you have painted is subtracted out. This prevents the gradient from painting over what you have just done.


Variables


CaptionFont : HFONT;


Colors : array[0..1, 0..MAX_GRADIENT_COLORS-1] of TColorRef;

Internal variables


FCaptionText : string;


FCaptionTextColor : TColor;

Property variables


FChangingActivationState : boolean;


FGradClientInstance : TFarProc;


FGradDefClientProc : TFarProc;


FGradientColors : integer;


FGradientInactiveStartColor : TColor;


FGradientInactiveStopColor : TColor;


FGradientStartColor : TColor;


FGradientStopColor : TColor;


FInactiveCaptionTextColor : TColor;


FOnCaptionPaint : TGFOnCaptionPaint;


FPaintGradient : TGFPaintWhen;


FRunningOnWin98 : boolean;


FUseWin98Gradient : boolean;


FUsingDefaultGradientInactiveStopColor : boolean;


FUsingDefaultGradientStopColor : boolean;