dfsstatusbar.pas

动态提示控件

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

{------------------------------------------------------------------------------}
{ TdfsStatusBar v1.24                                                          }
{------------------------------------------------------------------------------}
{ A status bar that provides many common specialized panels and owning of      }
{ other components by the status bar.                                          }
{                                                                              }
{ Copyright 2000, 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 DFSStatusBar.txt for notes, known issues, and revision history.          }
{------------------------------------------------------------------------------}
{ Date last modified:  June 27, 2001                                           }
{------------------------------------------------------------------------------}


unit dfsStatusBar;

interface

uses
  {$IFDEF DFS_DEBUG}
  DFSDebug,
  {$ENDIF}
  Windows, Classes, Messages, Controls, ComCtrls, Graphics, Forms,
  ExtCtrls;

const
  WM_REFRESHLOCKINDICATORS = WM_APP + 230;
  { 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 = 'TdfsStatusBar v1.24';

type
  TdfsStatusPanelType = (
     sptNormal,            // Nothing special, same as a regular TStatusPanel
     sptCapsLock,          // Caps lock indicator.  Normal color if on, gray if
                           //   off
     sptNumLock,           // Num lock indicator.  Normal color if on, gray if
                           //   off
     sptScrollLock,        // Scroll lock indicator.  Normal color if on, gray
                           //   if off
     sptDate,              // Current date.  Uses DateFormat property for format
     sptTime,              // Current time.  Uses TimeFormat property for format
     sptDateTime,          // Current date and time.  Uses DateFormat and
                           //   TimeFormat properties for format
     sptTimeDate,          // Current time and date.  Uses DateFormat and
                           //   TimeFormat properties for format
     sptEllipsisText,      // Shorten text at the end with '...' when won't fit.
     sptEllipsisPath,      // Shorten by removing path info with '...' when
                           //   won't fit.
     sptGlyph,             // Displays a TPicture object in the panel.
     sptGauge,             // A progress meter.  Use GaugeAttrs to customize it.
     sptOwnerDraw          // Same as the old TStatusPanel.Style = psOwnerDraw.
    );

  TPercent = 0..100;

  TdfsGaugeStyle = (
     gsPercent,        // Your basic progress meeter.
     gsIndeterminate,  // A progress indicator where the min/max are not
                       //   known.  That is, you want to show something
                       //   going on, but don't know how long it will take.
                       //   It's a little ball that "bounces" back and forth.
     gsIndeterminate2  // Same as above, but looks more Netscape-ish.
    );
  TdfsGaugeStyles = set of TdfsGaugeStyle;

  TdfsStatusBar = class; // forward declaration
  TdfsStatusPanel = class; // forward declaration


  TdfsDrawPanelEvent = procedure(StatusBar: TdfsStatusBar;
     Panel: TdfsStatusPanel; const Rect: TRect) of object;
  TdfsPanelHintTextEvent = procedure (StatusBar: TdfsStatusBar;
     Panel: TdfsStatusPanel; var Hint: string) of object;


  TdfsGaugeAttrs = class(TPersistent)
  private
    FStyle: TdfsGaugeStyle;
    FOwner: TdfsStatusPanel;
    FPosition: TPercent;
    FSpeed: integer;
    FColor: TColor;
    FTextColor: TColor;
    procedure SetPosition(const Value: TPercent);
    procedure SetStyle(const Value: TdfsGaugeStyle);
    procedure SetSpeed(const Value: integer);
    procedure SetColor(const Value: TColor);
    procedure SetTextColor(const Value: TColor);
  public
    constructor Create(AOwner: TdfsStatusPanel);
    procedure Assign(Source: TPersistent); override;

    property Owner: TdfsStatusPanel
       read FOwner;
  published
    property Style: TdfsGaugeStyle
       read FStyle
       write SetStyle
       default gsPercent;
    property Position: TPercent
       read FPosition
       write SetPosition
       default 0;
    property Speed: integer
       read FSpeed
       write SetSpeed
       default 4;
    property Color: TColor
       read FColor
       write SetColor
       default clHighlight;
    property TextColor: TColor
       read FTextColor
       write SetTextColor
       default clHighlightText;
  end;

  TdfsStatusPanel = class(TCollectionItem)
  private
    FKeyOn: boolean;
    FPanelType: TdfsStatusPanelType;
    FAutoFit: boolean;
    FEnabled: boolean;
    FTimeFormat: string;
    FDateFormat: string;
    FText: string;
    FGlyph: TPicture;
    FGaugeLastPos: integer;
    FGaugeDirection: integer;
    FOnDrawPanel: TdfsDrawPanelEvent;
    FHint: string;
    FOnHintText: TdfsPanelHintTextEvent;
    FOnClick: TNotifyEvent;
    FGaugeAttrs: TdfsGaugeAttrs;
    FGaugeBitmap: TBitmap;
    FBorderWidth: TBorderWidth;

    procedure SetPanelType(const Val: TdfsStatusPanelType);
    function GetAlignment: TAlignment;
    function GetBevel: TStatusPanelBevel;
{$IFDEF DFS_COMPILER_4_UP}
    function IsBiDiModeStored: Boolean;
    function GetBiDiMode: TBiDiMode;
    function GetParentBiDiMode: Boolean;
{$ENDIF}
    function GetWidth: Integer;
    procedure SetAlignment(const Value: TAlignment);
    procedure SetBevel(const Value: TStatusPanelBevel);
{$IFDEF DFS_COMPILER_4_UP}
    procedure SetBiDiMode(const Value: TBiDiMode);
    procedure SetParentBiDiMode(const Value: Boolean);
{$ENDIF}
    procedure SetText(const Value: string);
    procedure SetWidth(const Value: Integer);
    procedure SetAutoFit(const Value: boolean);
    procedure SetDateFormat(const Value: string);
    procedure SetEnabled(const Value: boolean);
    procedure SetGlyph(const Value: TPicture);
    procedure SetTimeFormat(const Value: string);
    function GetStatusBar: TdfsStatusBar;
    function GetEnabled: boolean;
    function GetHint: string;
    procedure SetGaugeAttrs(const Value: TdfsGaugeAttrs);
    function GetLinkedPanel: TStatusPanel;
    function GetGaugeBitmap: TBitmap;
    procedure SetBorderWidth(const Value: TBorderWidth);
    function IsTextStored: Boolean;
  protected
    procedure SetIndex(Value: integer); override;
    function GetDisplayName: string; override;
    procedure TimerNotification;
    procedure UpdateAutoFitWidth; dynamic;
    procedure UpdateDateTime; dynamic;
    procedure GlyphChanged(Sender: TObject); dynamic;
    procedure DrawPanel(Rect: TRect); dynamic;
    procedure EnabledChanged; dynamic;
    procedure DoHintText(var HintText: string); dynamic;
    procedure Redraw(Canvas: TCanvas; Dest: TRect); dynamic;
    procedure DrawKeyLock(Canvas: TCanvas; R: TRect); dynamic;
    procedure DrawTextBased(Canvas: TCanvas; R: TRect); dynamic;
    procedure DrawGlyph(Canvas: TCanvas; R: TRect); dynamic;
    procedure DrawGauge(Canvas: TCanvas; R: TRect); dynamic;
    procedure DrawIndeterminateGauge(Canvas: TCanvas; R: TRect); dynamic;
    function InitGaugeBitmap: TBitmap; dynamic;
    procedure Click; dynamic;
    procedure UpdateKeyboardHook;
    property LinkedPanel: TStatusPanel
       read GetLinkedPanel;
    property GaugeBitmap: TBitmap
       read GetGaugeBitmap;
  public
    constructor Create(AOwner: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Invalidate;

    property StatusBar: TdfsStatusBar
       read GetStatusBar;
  published
    property GaugeAttrs: TdfsGaugeAttrs
       read FGaugeAttrs
       write SetGaugeAttrs;
    property Alignment: TAlignment
       read GetAlignment
       write SetAlignment
       default taLeftJustify;
    property Bevel: TStatusPanelBevel
       read GetBevel
       write SetBevel
       default pbLowered;
    property BorderWidth: TBorderWidth
      read FBorderWidth
      write SetBorderWidth
      default 0;
{$IFDEF DFS_COMPILER_4_UP}
    property BiDiMode: TBiDiMode
       read GetBiDiMode
       write SetBiDiMode
       stored IsBiDiModeStored;
    property ParentBiDiMode: Boolean
       read GetParentBiDiMode
       write SetParentBiDiMode
       default True;
{$ENDIF}
    // PanelType must come before most of the other properties because it would
    //   stomp on some of their values as they are streamed.  Some of the other
    //   properties have to be ordered a certain way, too, so don't mess with
    //   the declaration order.
    property PanelType: TdfsStatusPanelType
       read FPanelType
       write SetPanelType
       default sptNormal;
    property Glyph: TPicture
       read FGlyph
       write SetGlyph;
    property Text: string
       read FText
       write SetText
       stored IsTextStored;
    property DateFormat: string
       read FDateFormat
       write SetDateFormat;
    property TimeFormat: string
       read FTimeFormat
       write SetTimeFormat;
    property Enabled: boolean
       read GetEnabled
       write SetEnabled;
    property Width: Integer
       read GetWidth
       write SetWidth;
    property AutoFit: boolean
       read FAutoFit
       write SetAutoFit;
    property Hint: string
       read GetHint
       write FHint;

    property OnDrawPanel: TdfsDrawPanelEvent
       read FOnDrawPanel
       write FOnDrawPanel;
    property OnHintText: TdfsPanelHintTextEvent
       read FOnHintText
       write FOnHintText;
    property OnClick: TNotifyEvent
       read FOnClick
       write FOnClick;
  end;

  TdfsStatusPanels = class(TCollection)
  private
    FTimer: TTimer;
    FTimerClients: TList;
    FLastDate: TDateTime;
    FStatusBar: TdfsStatusBar;
    FLinkedPanels: TStatusPanels;
    function GetItem(Index: Integer): TdfsStatusPanel;
    procedure SetItem(Index: Integer; Value: TdfsStatusPanel);
  protected
    procedure Update(Item: TCollectionItem); override;
    function GetOwner: TPersistent; override;
    procedure RegisterTimer(Client: TdfsStatusPanel);
    procedure DeregisterTimer(Client: TdfsStatusPanel);
    procedure TimerEvent(Sender: TObject);
  public
    constructor Create(StatusBar: TdfsStatusBar; LinkedPanels: TStatusPanels);
    destructor Destroy; override;
    function Add: TdfsStatusPanel;
    property Items[Index: Integer]: TdfsStatusPanel
       read GetItem
       write SetItem;
       default;
  end;

  TdfsStatusBar = class(TStatusBar)
  private
    FPanels: TdfsStatusPanels;
    FMainWinHookClients: TList;
    FExtentCanvas: HDC;
    FExtentFont: HFONT;
    FExtentFontOld: HFONT;
    FUseMonitorDLL: boolean;
    FDLLClientCount: integer;
    FKeyHookMsg: UINT;
    procedure SetPanels(const Value: TdfsStatusPanels);
    function AppWinHook(var Message: TMessage): boolean;
    procedure WMRefreshLockIndicators(var Msg: TMessage);
       message WM_REFRESHLOCKINDICATORS;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
    procedure SetOnDrawPanel(const Value: TdfsDrawPanelEvent);
    function GetOnDrawPanel: TdfsDrawPanelEvent;
    function GetVersion: string;
    procedure SetVersion(const Val: string);
    procedure UpdateExtentFont;
    procedure SetUseMonitorDLL(const Value: boolean);
    procedure UpdateKeyboardHooks;
    procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  protected
    procedure DrawPanel(Panel: TStatusPanel; const Rect: TRect); override;
    procedure Loaded; override;
    procedure CreateWnd; override;
    procedure WndProc(var Msg: TMessage); override;
    function GetPanelRect(Index: integer): TRect;
    function FindLinkedPanel(Panel: TStatusPanel): TdfsStatusPanel;
    procedure RegisterMainWinHook(Client: TdfsStatusPanel);
    procedure DeregisterMainWinHook(Client: TdfsStatusPanel);
    procedure RegisterSystemHook;
    procedure DeregisterSystemHook;
    function TextExtent(const Text: string): TSize;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InvalidatePanel(Index: integer);
    {$IFDEF DFS_COMPILER_4_UP}
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    {$ENDIF}
  published
    property UseMonitorDLL: boolean
       read FUseMonitorDLL
       write SetUseMonitorDLL
       default FALSE;
    property Panels: TdfsStatusPanels
       read FPanels
       write SetPanels;
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;

    property OnDrawPanel: TdfsDrawPanelEvent
       read GetOnDrawPanel
       write SetOnDrawPanel;
  end;


// You may want to change this value if you don't like the speed of the
// indeterminate gauge
const
  INDETERMINATE_GAUGE_UPDATE_INTERVAL: integer = 50; // in milliseconds

{$IFDEF DFS_COMPILER_3_UP}
resourcestring
{$ELSE}
const
{$ENDIF}
  SCapsLock   = ' CAPS ';
  SNumLock    = ' NUM ';
  SScrollLock = ' SCROLL ';

const
  IndeterminateGuages: TdfsGaugeStyles = [gsIndeterminate, gsIndeterminate2];

implementation

uses
  {$IFDEF DFS_COMPILER_6_UP}
  RTLConsts,
  {$ELSE}
  Consts,
  {$ENDIF}
  CommCtrl, TypInfo, SysUtils, DFSKb;


const
  KEY_CODE: array[sptCapsLock..sptScrollLock] of integer = (
     VK_CAPITAL, VK_NUMLOCK, VK_SCROLL
    );