gradform.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsGradientForm v2.03                                                       }
{ A form to provide gradient filled caption bars ala Microsoft Office.         }
{ You will notice that some of the initial comment characters are followed by  }
{ a colon, and those sometimes contains some odd looking things that resemble  }
{ HTML codes.  These comments are used by the Time2Help application that I     }
{ used to build the help file.                                                 }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See GradForm.txt for notes, known issues, and revision history.              }
{------------------------------------------------------------------------------}
{ Date last modified:  June 27, 2001                                           }
{------------------------------------------------------------------------------}


{: This unit provides the TdfsGradientForm class, and all supporting elements. }
unit GradForm;

{$IFNDEF DFS_WIN32}
  Error!  This unit is only available for Win32.
{$ENDIF}

interface

uses
  {$IFDEF DFS_COMPILER_6_UP}
  RTLConsts,
  {$ELSE}
  Consts,
  {$ENDIF}
  Windows, Messages, SysUtils, Forms, Classes, Graphics, Controls, Dialogs;

const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION             = 'TdfsGradientForm v2.03';

  {: The minimum number of colors that can be assigned to the
     <See Property=TdfsGradientForm.GradientColors Text=GradientColors> property.
     Any less than 8 colors doesn't look much like a gradient.
     <Related A=MAX_GRADIENT_COLORS;DEF_GRADIENT_COLORS>
  }
  MIN_GRADIENT_COLORS               = 8;
  {: The maximum number of colors that can be assigned to the
     <See Property=TdfsGradientForm.GradientColors Text=GradientColors> property.
     Any more than 512 colors is not noticeable, and just slows the painting
     down. <Related A=MIN_GRADIENT_COLORS;DEF_GRADIENT_COLORS> }
  MAX_GRADIENT_COLORS               = 512;
  {: The default number of colors for the
     <See Property=TdfsGradientForm.GradientColors Text=GradientColors> property.
     This is a good compromise between speed and appearance.
     <Related A=MAX_GRADIENT_COLORS;MIN_GRADIENT_COLORS>}
  DEF_GRADIENT_COLORS               = 64;
  DEF_CAPTION_TEXT_COLOR            = clWhite;
  DEF_INACTIVE_CAPTION_TEXT_COLOR   = clWhite;
  DEF_GRADIENT_START_COLOR          = clBlack;
  DEF_GRADIENT_STOP_COLOR           = clActiveCaption;
  DEF_GRADIENT_INACTIVE_START_COLOR = clBlack;
  DEF_GRADIENT_INACTIVE_STOP_COLOR  = clInactiveCaption;
  DEF_USE_WIN98_GRADIENT            = FALSE;
  DEF_USE_DITHERING                 = TRUE;

type
  {: For some reason, you can not pass HWND and HDC type parameters from
     C++Builder source code to a Delphi component.  For some reason, C++B wants
     to treat these parameters as "void *" (pointer) types, and you will get
     unresolved external linker errors from Builder if you have methods that
     take HWND and/or HDC parameters in other than the private section.

     I have delcared this type so that it makes the code cleaner below. }

  {$IFDEF DFS_CPPB}
  DFS_HDC = pointer;
  {$ELSE}
  DFS_HDC = HDC;
  {$ENDIF}
  
  {: This enumerated type is used by the
     <See Property=TdfsGradientForm.PaintGradient Text=PaintGradient> property to
     indicate when the caption should be painted as a gradient.<BR>
     <UL>
     <LI>gfpAlways <TAB> The gradient should always be drawn.
     <LI>gfpActive <TAB> Only draw the gradient when the form is active.
     <LI>gfpNever  <TAB> Never draw the gradient.
     </UL>
     <Related A=PaintGradient>}
  TGFPaintWhen = (gfpAlways, gfpActive, gfpNever);
  TGFLogoAlign = (laLeft, laRight);

const
  DEF_PAINT_GRADIENT = gfpAlways;

type
  {: Describes the parameters used by an
     <See Event=TdfsGradientForm.OnCaptionPaint Text=OnCaptionPaint> event handler.
     <BR><BR><B>Sender</B> is the TdfsGradientForm that is being painted.<BR><BR>
     <B>Canvas</B> 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.<BR><BR>
     <B>R</B> 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.
     <Related A=OnCaptionPaint>}
  TGFOnCaptionPaint = procedure(Sender: TObject; Canvas: TCanvas;
     var R: TRect) of object;

//CE_Desc_Begin(TdfsGradientForm)
{TdfsGradientForm 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. }
//CE_Desc_End
  TdfsGradientForm = class(TForm)
  private
    // Internal variables
    Colors: array[0..1, 0..MAX_GRADIENT_COLORS-1] of TColorRef;
//**    CaptionFontHandle: HFONT;
    FGradDefClientProc: TFarProc;
    FGradClientInstance: TFarProc;
    // Property variables
    FCaptionTextColor: TColor;
    FInactiveCaptionTextColor: TColor;
    FGradientStartColor: TColor;
    FGradientStopColor: TColor;
    FGradientInactiveStartColor: TColor;
    FGradientInactiveStopColor: TColor;
    FGradientColors: integer;
    FPaintGradient: TGFPaintWhen;
    FCaptionText: string;
    FOnCaptionPaint: TGFOnCaptionPaint;
    FUsingDefaultGradientStopColor: boolean;
    FUsingDefaultGradientInactiveStopColor: boolean;
    FUseWin98Gradient: boolean;
    FRunningOnWin98: boolean;
    FChangingActivationState: boolean;
    FPaint16Color: boolean;
    FSystemIs16Color: boolean;
    FCaptionFont: TFont;
    FUseSystemCaptionFont: boolean;
    FCreating: boolean;
    FUseDithering: boolean;
    FLogo: TBitmap;
    FLogoAlign: TGFLogoAlign;
    FLogoLayered: Boolean;
    FInactiveLogo: TBitmap;

    // Internal methods
    function IsActiveWindow: boolean;
//**    procedure CreateCaptionFontHandle;
    // Window message handlers
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
    procedure WMNCPaint(var Msg: TMessage); message WM_NCPAINT;
    procedure WMSysColorChange(var Msg: TWMSysColorChange);
       message WM_SYSCOLORCHANGE;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
    procedure WMGetText(var Msg: TWMGetText); message WM_GETTEXT;
    procedure WMGetTextLength(var Msg: TWMGetTextLength);
       message WM_GETTEXTLENGTH;
    procedure WMSettingChange(var Msg: TMessage); message WM_SETTINGCHANGE;
    procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
       message WM_NCLBUTTONDOWN;
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMEnterIdle(var Msg: TWMEnterIdle); message WM_ENTERIDLE;
    procedure WMWindowPosChanging(var Msg: TWMWindowPosChanging);
       message WM_WINDOWPOSCHANGING;
    // MDI Client Window Procedure
    procedure GradClientWndProc(var Message: TMessage);
    function GetInhibitGradient: boolean;
    procedure SetCaptionFont(const Value: TFont);
    // Misc
    function GetSysCaptionLogFont: TLogFont;
    procedure SetUseSystemCaptionFont(const Value: boolean);
  protected
    // Virtual methods useful for descandants
    function GetCaptionRect: TRect; virtual;
    procedure InvalidateCaption;
    function DrawCaption(FormDC: DFS_HDC; Active: boolean): TRect; virtual;
    procedure PaintMenuIcon(DC: DFS_HDC; var R: TRect; Active: boolean); virtual;
    procedure FillRectSolid(DC: DFS_HDC; const R: TRect; Active: boolean;
      ActiveColor, InactiveColor : TColor); virtual;
    procedure FillRectGradient(DC: DFS_HDC; const R: TRect;
       Dithered, Active: boolean); virtual;
    procedure PaintCaptionText(DC: DFS_HDC; R: TRect; Active: boolean); virtual;
    procedure PaintCaptionButtons(DC: DFS_HDC; var Rect: TRect); virtual;
    procedure CalculateColors; virtual;
    // Overriden methods
    procedure Loaded; override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure Activate; override;
    procedure Deactivate; override;
    procedure DoShow; override;
    // Property methods
    procedure SetCaptionTextColor(Color: TColor);
    procedure SetInactiveCaptionTextColor(Color: TColor);
    procedure SetGradientStartColor(Color : TColor);
    procedure SetGradientStopColor(Color : TColor);
    procedure SetGradientInactiveStartColor(Color : TColor);
    procedure SetGradientInactiveStopColor(Color : TColor);
    procedure SetGradientColors(Val: integer);
    procedure SetPaintGradient(Val: TGFPaintWhen);
    procedure SetCaptionText(const Val: string);
    procedure SetUseWin98Gradient(Val: boolean);
    procedure SetUseDithering(Val: boolean);
    procedure SetPaint16Color(const Value: boolean);
    procedure SetLogo(const Value: TBitmap);
    procedure SetLogoAlign(const Value: TGFLogoAlign);
    procedure SetLogoLayered(const Value: Boolean);
    procedure SetInactiveLogo(const Value: TBitmap);
    function GetVersion: string;
    procedure SetVersion(const Val: string);
    // Property storage qualifing methods
    function StoreGradientStopColor: boolean;
    function StoreGradientInactiveStopColor: boolean;
    // Utility methods
    function Win98Check: boolean; virtual;
    procedure UpdateCaptionFont; virtual;
  public
    function GetSystemColorBitDepth: integer;
    { This procedure is used to paint the caption gradient. }
    procedure Draw(Active: boolean); virtual;
    // Overridden methods
    { Create creates and initializes an instance of TdfsGradientForm. }
    constructor Create(AOwner: TComponent); override;
    { Destroy destroys an instance of TdfsGradientForm. }
    destructor Destroy; override;

    property InhibitGradient: boolean
       read GetInhibitGradient;
    property Paint16Color: boolean
       read FPaint16Color
       write SetPaint16Color;
    property SystemIs16Color: boolean
       read FSystemIs16Color;
  published
    // Properties
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    {: Caption specifies a text string that appears in the caption bar. }
    property Caption: string
       read FCaptionText
       write SetCaptionText
       stored TRUE;
    property CaptionFont: TFont
       read FCaptionFont
       write SetCaptionFont;
    property UseSystemCaptionFont: boolean
       read FUseSystemCaptionFont
       write SetUseSystemCaptionFont;
    {: 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.
       <Related A=MAX_GRADIENT_COLORS;MIN_GRADIENT_COLORS;DEF_GRADIENT_COLORS> }
    property GradientColors: integer
       read FGradientColors
       write SetGradientColors
       default DEF_GRADIENT_COLORS;
    {: 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
       <See Property=TdfsGradientForm.GradientStartColor Text=GradientStartColor>
       to something other than the default of clBlack.
       <Related A=GradientStartColor;GradientStopColor;Caption>}
    property CaptionTextColor: TColor
       read FCaptionTextColor
       write SetCaptionTextColor
       default DEF_CAPTION_TEXT_COLOR;
    property InactiveCaptionTextColor: TColor
       read FInactiveCaptionTextColor
       write SetInactiveCaptionTextColor
       default DEF_INACTIVE_CAPTION_TEXT_COLOR;
    {: 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
       <See Property=TdfsGradientForm.GradientStopColor Text=GradientStopColor>.
       <Related A=GradientStopColor;GradientColors> }
    property GradientStartColor: TColor