dfsstatusbar.pas

透明按钮 透明按钮 透明按钮

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

{-----------------------------------------------------------------------------}
{ TDFSStatusBar v1.01                                                         }
{-----------------------------------------------------------------------------}
{ A status bar that provides many common specialized panels and owning of     }
{ other components by the status bar.                                         }
{ Copyright 1999, Brad Stowers.  All Rights Reserved.                         }
{ This component can be freely used and distributed in commercial and private }
{ environments, provied this notice is not modified in any way and there is   }
{ no charge for it other than nomial handling fees.  Contact me directly for  }
{ modifications to this agreement.                                            }
{-----------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions  }
{ at [e-mail].                                                      }
{ The lateset version will always be available on the web at:                 }
{   http://www.pobox.com/~bstowers/delphi/                                    }
{ See DFSStatusBar.txt for notes, known issues, and revision history.         }
{-----------------------------------------------------------------------------}
{ Date last modified:  January 18, 1999                                       }
{-----------------------------------------------------------------------------}


unit DFSStatusBar;

interface

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

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.01';

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
     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.
                     //   Looks like the Netscape status bar when you are
                     //   connecting to a site.
    );
    

  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;
    procedure SetPosition(const Value: TPercent);
    procedure SetStyle(const Value: TDFSGaugeStyle);
  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;
  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;
    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;
  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;
    procedure Click; dynamic;
    procedure UpdateKeyboardHook;
    property LinkedPanel: TStatusPanel
       read GetLinkedPanel;
  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;
{$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;
    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
       default FALSE;
    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: TDFSVersion;
    procedure SetVersion(const Val: TDFSVersion);
    procedure UpdateExtentFont;
    procedure SetUseMonitorDLL(const Value: boolean);
    procedure UpdateKeyboardHooks;
    procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  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);
  published
    property UseMonitorDLL: boolean
       read FUseMonitorDLL
       write SetUseMonitorDLL
       default FALSE;
    property Panels: TDFSStatusPanels
       read FPanels
       write SetPanels;
    property Version: TDFSVersion
       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 ';


implementation

uses
  Consts, CommCtrl, TypInfo, SysUtils, DFSKb;


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

var
  KeyboardHookHandle: HHOOK;
  KeyHookClients: TList;
  RegisteredTimers: integer;
  MayNeedRefresh: boolean;

// Keyboard hook callback
function KeyboardHookCallBack(Code: integer; KeyCode: WPARAM;
   KeyInfo: LPARAM): LRESULT; stdcall;
var
  x: integer;
begin
  if Code >= 0 then
  begin
    if MayNeedRefresh then
    begin
      for x := 0 to KeyHookClients.Count-1 do
        TDFSStatusPanel(KeyHookClients[x]).Invalidate;
      MayNeedRefresh := FALSE;
    end else
    // Is it one of the indicator keys, and is it not a repeat
    if ((KeyCode = VK_CAPITAL) or (KeyCode = VK_NUMLOCK) or
       (KeyCode = VK_SCROLL)) and
       // This checks to see if the key is being pressed (bit 31) and if it was
       // up before (bit 30).  We don't care about key releases or keys that
       // were already down.  That just makes us flicker...
       (((KeyInfo SHR 31) and 1) = 0) and (((KeyInfo SHR 30) and 1) = 0) then
    begin
      for x := 0 to KeyHookClients.Count-1 do
      begin
        case TDFSStatusPanel(KeyHookClients[x]).PanelType of
          sptCapsLock:
            begin
              if KeyCode = VK_CAPITAL then
                TDFSStatusPanel(KeyHookClients[x]).Invalidate;
            end;
          sptNumLock:
            begin
              if KeyCode = VK_NUMLOCK then
                TDFSStatusPanel(KeyHookClients[x]).Invalidate;
            end;
          sptScrollLock:
            begin
              if KeyCode = VK_SCROLL then
                TDFSStatusPanel(KeyHookClients[x]).Invalidate;
            end;
        end;
      end;
    end;
  end;
  Result := CallNextHookEx(KeyboardHookHandle, Code, KeyCode, KeyInfo);
end;

// Utility routins for installing the windows hook for keypresses
procedure RegisterTaskKeyboardHook(Client: TDFSStatusPanel);
begin
  if KeyboardHookHandle = 0 then
    KeyboardHookHandle := SetWindowsHookEx(WH_KEYBOARD, KeyboardHookCallBack,
       0, GetCurrentThreadID);

  KeyHookClients.Add(Client);
end;

procedure DeregisterTaskKeyboardHook(Client: TDFSStatusPanel);
begin
  KeyHookClients.Remove(Client);
  if KeyHookClients.Count < 1 then
  begin
    UnhookWindowsHookEx(KeyboardHookHandle);
    KeyboardHookHandle := 0;
  end;
end;

// Utility function for making a copy of a font handle
function CopyHFont(Font: HFONT): HFONT;
var
  LF: TLogFont;
begin
  if Font <> 0 then
  begin
    GetObject(Font, SizeOf(LF), @LF);
    Result := CreateFontIndirect(LF);
  end else
    Result := 0;
end;


{ TDFSGaugeAttrs }

procedure TDFSGaugeAttrs.Assign(Source: TPersistent);
var
  SrcAttrs: TDFSGaugeAttrs absolute Source;
begin
  if Source is TDFSGaugeAttrs then
  begin
    FOwner := SrcAttrs.Owner;
    Position := SrcAttrs.Position;
    Style := SrcAttrs.Style;
  end else
    inherited Assign(Source);
end;

constructor TDFSGaugeAttrs.Create(AOwner: TDFSStatusPanel);
begin
  inherited Create;
  FOwner := AOwner;
  FStyle := gsPercent;
  FPosition := 0;
end;

procedure TDFSGaugeAttrs.SetPosition(const Value: TPercent);
begin