www.pudn.com > dfs.zip > DFSStatusBar.pas, change:2001-06-28,size:65726b


{$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 
    ); 
 
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; 
  FSpeed := 4; 
  FColor := clHighlight; 
  FTextColor := clHighlightText; 
end; 
 
procedure TdfsGaugeAttrs.SetColor(const Value: TColor); 
begin 
  if FColor <> Value then 
  begin 
    FColor := Value; 
    FOwner.FGaugeBitmap.Free; 
    FOwner.FGaugeBitmap := NIL; 
    FOwner.Invalidate; 
  end; 
end; 
 
procedure TdfsGaugeAttrs.SetPosition(const Value: TPercent); 
begin 
  if FPosition <> Value then 
  begin 
    FPosition := Value; 
    FOwner.Invalidate; 
  end; 
end; 
 
procedure TdfsGaugeAttrs.SetSpeed(const Value: integer); 
begin 
  if (FSpeed <> Value) and (FSpeed > 0) then 
    FSpeed := Value; 
 
  if Owner.FGaugeDirection < 0 then 
    Owner.FGaugeDirection := -FSpeed 
  else 
    Owner.FGaugeDirection := FSpeed; 
end; 
 
procedure TdfsGaugeAttrs.SetStyle(const Value: TdfsGaugeStyle); 
begin 
  if FStyle <> Value then 
  begin 
    if (Owner.PanelType = sptGauge) and (FStyle in IndeterminateGuages) and 
       Owner.Enabled then 
      TdfsStatusPanels(Owner.Collection).DeregisterTimer(Owner); 
    FStyle := Value; 
    FOwner.Invalidate; 
    if (Owner.PanelType = sptGauge) and (FStyle in IndeterminateGuages) and 
       Owner.Enabled then 
      TdfsStatusPanels(Owner.Collection).RegisterTimer(Owner); 
  end; 
end; 
 
 
procedure TdfsGaugeAttrs.SetTextColor(const Value: TColor); 
begin 
  if Value <> FTextColor then 
  begin 
    FTextColor := Value; 
    Owner.Invalidate; 
  end; 
end; 
 
{ TdfsStatusPanel } 
 
procedure TdfsStatusPanel.Assign(Source: TPersistent); 
var 
  SrcPanel: TdfsStatusPanel absolute Source; 
begin 
  if Source is TdfsStatusPanel then 
  begin 
{    if LinkedPanel <> NIL then 
      LinkedPanel.Free; 
    LinkedPanel := SrcPanel.FLinkedPanel;} 
 
    GaugeAttrs.Assign(SrcPanel.GaugeAttrs); 
    Alignment := SrcPanel.Alignment; 
    Bevel := SrcPanel.Bevel; 
{$IFDEF DFS_COMPILER_4_UP} 
    BiDiMode := SrcPanel.BiDiMode; 
    ParentBiDiMode := SrcPanel.ParentBiDiMode; 
{$ENDIF} 
    Glyph.Assign(SrcPanel.Glyph); 
    Text := SrcPanel.Text; 
    DateFormat := SrcPanel.DateFormat; 
    TimeFormat := SrcPanel.TimeFormat; 
    Enabled := SrcPanel.Enabled; 
    Width := SrcPanel.Width; 
    AutoFit := SrcPanel.AutoFit; 
    Hint := SrcPanel.Hint; 
 
    OnDrawPanel := SrcPanel.OnDrawPanel; 
    OnHintText := SrcPanel.OnHintText; 
 
    // Do last! 
    PanelType := SrcPanel.PanelType; 
  end else 
    inherited Assign(Source); 
end; 
 
constructor TdfsStatusPanel.Create(AOwner: TCollection); 
begin 
  inherited Create(AOwner); 
 
  if AOwner is TdfsStatusPanels then 
  begin 
    TdfsStatusPanels(AOwner).FLinkedPanels.Add; 
    LinkedPanel.Style := psOwnerDraw; 
  end else 
    raise Exception.Create('TdfsStatusPanel owner must be TdfsStatusPanesls'); 
  FKeyOn := FALSE; 
  FGaugeLastPos := 0; 
  FGaugeDirection := 1; 
  FPanelType := sptNormal; 
  FAutoFit := FALSE; 
  FEnabled := TRUE; 
  FTimeFormat := ''; 
  FDateFormat := ''; 
  FGaugeAttrs := TdfsGaugeAttrs.Create(Self); 
  FGlyph := TPicture.Create; 
  FGlyph.OnChange := GlyphChanged; 
end; 
 
 
destructor TdfsStatusPanel.Destroy; 
begin 
  if Enabled then 
    case FPanelType of 
      sptCapsLock, sptNumLock, sptScrollLock: 
        begin 
          if StatusBar.UseMonitorDLL then 
            StatusBar.DeregisterSystemHook 
          else begin 
            DeregisterTaskKeyboardHook(Self); 
            StatusBar.DeregisterMainWinHook(Self); 
          end; 
        end; 
      sptDate, sptTime, sptDateTime, sptTimeDate: 
        TdfsStatusPanels(Collection).DeregisterTimer(Self); 
      sptGauge: 
        if GaugeAttrs.Style in IndeterminateGuages then 
          TdfsStatusPanels(Collection).DeregisterTimer(Self); 
    end; 
 
  FGlyph.Free; 
  FGaugeAttrs.Free; 
  FGaugeBitmap.Free; 
  TdfsStatusPanels(Collection).FLinkedPanels[Index].Free; 
 
  inherited Destroy; 
end; 
 
 
function TdfsStatusPanel.GetAlignment: TAlignment; 
begin 
  Result := LinkedPanel.Alignment 
end; 
 
function TdfsStatusPanel.GetBevel: TStatusPanelBevel; 
begin 
  Result := LinkedPanel.Bevel 
end; 
 
{$IFDEF DFS_COMPILER_4_UP} 
function TdfsStatusPanel.GetBiDiMode: TBiDiMode; 
begin 
  Result := LinkedPanel.BiDiMode 
end; 
 
function TdfsStatusPanel.GetParentBiDiMode: Boolean; 
begin 
  Result := LinkedPanel.ParentBiDiMode 
end; 
{$ENDIF} 
 
function TdfsStatusPanel.GetStatusBar: TdfsStatusBar; 
begin 
  Result := TdfsStatusPanels(Collection).FStatusBar; 
end; 
 
function TdfsStatusPanel.GetWidth: Integer; 
begin 
  Result := LinkedPanel.Width 
end; 
 
procedure TdfsStatusPanel.Invalidate; 
begin 
  if StatusBar <> NIL then 
    StatusBar.InvalidatePanel(Index); 
end; 
 
{$IFDEF DFS_COMPILER_4_UP} 
function TdfsStatusPanel.IsBiDiModeStored: Boolean; 
begin 
  Result := not ParentBiDiMode; 
end; 
{$ENDIF} 
 
procedure TdfsStatusPanel.Redraw(Canvas: TCanvas; Dest: TRect); 
var 
  Buffer: TBitmap; 
  R: TRect; 
begin 
  if (not StatusBar.HandleAllocated) or (IsRectEmpty(Dest))then 
    exit; 
 
  InflateRect(Dest, -1, -1); // Don't paint over the shadows. 
 
  R := Dest; 
  OffsetRect(R, -Dest.Left, -Dest.Top); 
  Buffer := TBitmap.Create; 
  try 
    Buffer.Width := R.Right; 
    Buffer.Height := R.Bottom; 
 
    Buffer.Canvas.Font.Handle := CopyHFont(Canvas.Font.Handle); 
    Buffer.Canvas.Brush.Color := StatusBar.Color; 
    Buffer.Canvas.FillRect(R); 
 
    if BorderWidth > 0 then 
      InflateRect(R, -BorderWidth, -BorderWidth); 
 
    if Enabled then 
    begin 
      case PanelType of 
        sptCapsLock, sptNumLock, sptScrollLock: 
          DrawKeyLock(Buffer.Canvas, R); 
 
        sptNormal, sptDate, sptTime, sptDateTime, sptTimeDate, sptEllipsisText, 
        sptEllipsisPath, sptOwnerDraw: 
          begin 
            if (PanelType = sptOwnerDraw) and 
               not (csDesigning in StatusBar.ComponentState) then 
              exit; 
            DrawTextBased(Buffer.Canvas, R); 
          end; 
 
          sptGlyph: 
            DrawGlyph(Buffer.Canvas, R); 
 
          sptGauge: 
            if GaugeAttrs.Style in IndeterminateGuages then 
              DrawIndeterminateGauge(Buffer.Canvas, R) 
            else 
              DrawGauge(Buffer.Canvas, R); 
      end; 
    end; 
 
    Canvas.Draw(Dest.Left, Dest.Top, Buffer); 
  finally 
    Buffer.Free; 
  end; 
end; 
 
procedure TdfsStatusPanel.DrawGauge(Canvas: TCanvas; R: TRect); 
var 
  R1, R2: TRect; 
  R1Rgn, R2Rgn, OldRgn: HRGN; 
  Pct: string; 
  OldColor: TColorRef; 
  DTFlags: UINT; 
begin 
  R1 := R; 
  R2 := R; 
  R1.Right := R1.Left + MulDiv(R.Right-R.Left, FGaugeAttrs.Position, 100); 
  with Canvas do 
  begin 
    Brush.Color := GaugeAttrs.Color; 
    FillRect(R1); 
    R2.Left := R1.Right; 
    Brush.Color := StatusBar.Color; 
    FillRect(R2); 
 
    { This could probably be simplified with ExtTextOut and SetTextAlign now 
      things are being properly buffered off-screen.  But, this is working and 
      doesn't seem slow, so....  "If it ain't broke, don't fix it."  :)        } 
    if Text = '' then 
      Pct := IntToStr(FGaugeAttrs.Position) + '%' 
    else 
      Pct := Text; // Use what's in the panel's text property. 
    // don't change background color behind text! 
    Brush.Style := bsClear; 
    OldColor := GetTextColor(Handle); 
 
    R1Rgn := CreateRectRgnIndirect(R1); 
    R2Rgn := CreateRectRgnIndirect(R2); 
    OldRgn := CreateRectRgn(0, 0, 1, 1); 
    try 
      GetClipRgn(Handle, OldRgn); 
 
      DTFlags := DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE; 
      case Alignment of 
        taCenter:       DTFlags := DTFlags or DT_CENTER; 
        taRightJustify: DTFlags := DTFlags or DT_RIGHT; 
      end; 
      // Draw the text in the "filled" area with text color 
      if (R1Rgn<>0) and (SelectClipRgn(Handle, R1Rgn) <> ERROR) then 
        try 
          SetTextColor(Handle, ColorToRGB(GaugeAttrs.TextColor)); 
          DrawText(Handle, PChar(Pct), -1, R, DTFlags); 
        finally 
          SelectClipRgn(Handle, OldRgn); 
        end; 
 
      // Draw the text in the "empty" area with normal color 
      if (R2Rgn<>0) and (SelectClipRgn(Handle, R2Rgn) <> ERROR) then 
        try 
//          SetTextColor(Handle, OldColor); 
          SetTextColor(Handle, ColorToRGB(StatusBar.Font.Color)); 
          DrawText(Handle, PChar(Pct), -1, R, DTFlags); 
        finally 
          SelectClipRgn(Handle, OldRgn); 
        end; 
    finally 
      SetTextColor(Handle, OldColor); 
      DeleteObject(R1Rgn); 
      DeleteObject(R2Rgn); 
      DeleteObject(OldRgn); 
    end; 
  end; 
end; 
 
procedure TdfsStatusPanel.DrawGlyph(Canvas: TCanvas; R: TRect); 
const 
  TEXT_SPACE = 2; 
var 
  TW: integer; 
  GR: TRect; 
begin 
  GR := R; 
  if Text <> '' then 
    TW := Canvas.TextWidth(Text) + TEXT_SPACE 
  else 
    TW := 0; 
  if (Alignment = taCenter) or AutoFit then 
     with GR do 
       Left := Left + ((Right - Left - Glyph.Width - TW) div 2) 
  else if Alignment = taRightJustify then 
    GR.Left := GR.Right - Glyph.Width; 
 
  GR.Top := GR.Top + (GR.Bottom - GR.Top - Glyph.Height) div 2; 
 
  if Glyph.Graphic is TBitmap then 
  begin 
    // Draw it transparently 
    Canvas.BrushCopy(Bounds(GR.Left, GR.Top, Glyph.Width, 
       Glyph.Height), Glyph.Bitmap, Rect(0, 0, Glyph.Width, 
       Glyph.Height), Glyph.Bitmap.Canvas.Pixels[0, Glyph.Height-1]); 
  end else 
    Canvas.Draw(GR.Left, GR.Top, Glyph.Graphic); 
  if Text <> '' then 
  begin 
    SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color)); 
    case Alignment of 
      taLeftJustify, 
      taCenter: 
        begin 
          GR.Left := GR.Left + Glyph.Width + TEXT_SPACE; 
          GR.Top := R.Top; 
          GR.Bottom := R.Bottom; 
          DrawText(Canvas.Handle, PChar(Text), -1, GR, DT_SINGLELINE or 
            DT_NOPREFIX or DT_VCENTER); 
        end; 
      taRightJustify: 
        begin 
          GR.Left := GR.Left - TW - TEXT_SPACE; 
          GR.Top := R.Top; 
          GR.Bottom := R.Bottom; 
          DrawText(Canvas.Handle, PChar(Text), -1, GR, DT_SINGLELINE or 
            DT_NOPREFIX or DT_VCENTER); 
        end; 
    end; 
  end; 
end; 
 
function TdfsStatusPanel.InitGaugeBitmap: TBitmap; 
var 
	r1, b1, g1, r2, b2, g2: byte; 
	c1, c2: Longint; 
  i: integer; 
	divi: integer; 
	mul: extended; 
begin 
	c1 := ColorToRGB(StatusBar.Color); 
	c2 := ColorToRGB(GaugeAttrs.Color); 
	r1 := GetRValue(c1); 
  b1 := GetBValue(c1); 
  g1 := GetGValue(c1); 
	r2 := GetRValue(c2); 
  b2 := GetBValue(c2); 
  g2 := GetGValue(c2); 
	Result := TBitmap.Create; 
	with Result do 
	begin 
		Height := StatusBar.Height; 
		Width := 100; 
		divi := Width-1; 
		Canvas.Brush.Color := clRed; 
		Canvas.FillRect(Rect(0, 0, Width, Height)); 
		for i := 0 to divi do 
		begin 
			mul := (i/divi); 
			Canvas.Pen.Color := RGB(trunc(r1 + (r2 - r1) * mul), 
         trunc(g1 + (g2 - g1) *mul), trunc(b1 + (b2 - b1) * mul)); 
			Canvas.MoveTo(i, 0); 
			Canvas.LineTo(i, Height); 
		end; 
	end; 
end; 
 
procedure TdfsStatusPanel.DrawIndeterminateGauge(Canvas: TCanvas; R: TRect); 
var 
	gb:TBitmap; 
	gbr:TRect; 
  x: integer; 
begin 
  inc(FGaugeLastPos, FGaugeDirection); 
  case GaugeAttrs.Style of 
    gsIndeterminate: 
      begin 
        with Canvas do 
        begin 
          Brush.Color := GaugeAttrs.Color; 
          Pen.Color := GaugeAttrs.Color; 
          gbr := R; 
          InflateRect(R, 0, -((R.Bottom - R.Top) div 3)); 
          x := R.Bottom - R.Top; 
          if (FGaugeDirection > 0) and ((FGaugeLastPos + X + 1) >= 
             (R.Right - R.Left)) then 
          begin 
            FGaugeDirection := -GaugeAttrs.Speed; 
          end else if (FGaugeDirection < 0) and (FGaugeLastPos <= 1) then 
          begin 
            FGaugeDirection := GaugeAttrs.Speed; 
          end; 
          Inc(R.Left, FGaugeLastPos); 
          R.Right := R.Left + X; 
          // Make it a wee bit bigger 
          InflateRect(R, 1, 1); 
 
          with R do 
            Ellipse(Left, Top, Right, Bottom); 
        end; 
      end; 
 
    gsIndeterminate2: 
      begin 
        with Canvas do 
        begin 
          gb := GaugeBitmap; 
          if (FGaugeDirection > 0) and 
             ((FGaugeLastPos+ 1) >= (R.Right - R.Left)) then 
            FGaugeDirection := -FGaugeAttrs.Speed 
          else if (FGaugeDirection < 0) and (FGaugeLastPos <= -gb.Width) then 
            FGaugeDirection := FGaugeAttrs.Speed; 
          Inc(R.Left, FGaugeLastPos); 
          gbr := Rect(0, 0, gb.Width, gb.Height); 
          if (r.right - r.left) > gb.width then 
            r.right := r.left + gb.Width 
          else 
            if (r.right - r.left) < gb.width then 
            begin 
              if FGaugeDirection > 0 then 
                gbr.Right := r.right - r.Left 
              else 
                gbr.Left := gbr.right - (r.right - r.left); 
            end; 
 
          if FGaugeDirection > 0 then 
            CopyRect(r, gb.Canvas, gbr) 
          else 
            CopyRect(r, gb.Canvas, 
               Rect(gbr.right-1, gbr.Bottom-1, gbr.left-1, gbr.top-1)) 
        end; 
      end; 
  end; 
end; 
 
procedure TdfsStatusPanel.DrawKeyLock(Canvas: TCanvas; R: TRect); 
var 
  DTFlags: UINT; 
  OldColor: TColorRef; 
begin 
  OldColor := GetTextColor(Canvas.Handle); 
  if StatusBar.UseMonitorDLL then 
  begin 
    if not FKeyOn then 
      SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)) // might need to be a property 
    else 
      SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color)); 
  end else begin 
    if not Odd(GetKeyState(KEY_CODE[FPanelType])) then 
      SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)) // might need to be a property 
    else 
      SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color)); 
  end; 
  DTFlags := DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER; 
  if AutoFit then 
    DTFLags := DTFlags or DT_CENTER 
  else 
    case Alignment of 
      taCenter:       DTFlags := DTFlags or DT_CENTER; 
      taRightJustify: DTFlags := DTFlags or DT_RIGHT; 
    end; 
  DrawText(Canvas.Handle, PChar(Text), -1, R, DTFlags); 
  SetTextColor(Canvas.Handle, OldColor); 
end; 
 
procedure TdfsStatusPanel.DrawTextBased(Canvas: TCanvas; R: TRect); 
var 
  DTFlags: UINT; 
begin 
  DTFlags := DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER; 
  if AutoFit then 
    DTFLags := DTFlags or DT_CENTER 
  else 
    case Alignment of 
      taCenter:       DTFlags := DTFlags or DT_CENTER; 
      taRightJustify: 
        begin 
          dec(R.Right); 
          DTFlags := DTFlags or DT_RIGHT; 
        end; 
    end; 
  case PanelType of 
    sptEllipsisPath: DTFlags := DTFlags or DT_PATH_ELLIPSIS; 
    sptEllipsisText: DTFlags := DTFlags or DT_END_ELLIPSIS; 
  end; 
  SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color)); 
  if PanelType = sptOwnerDraw then 
    // This only happens when in design mode, see Redraw method. 
    DrawText(Canvas.Handle, ' *OD* ', -1, R, DTFlags) 
  else 
    DrawText(Canvas.Handle, PChar(Text), -1, R, DTFlags); 
end; 
 
procedure TdfsStatusPanel.SetAlignment(const Value: TAlignment); 
begin 
  if LinkedPanel.Alignment <> Value then 
  begin 
    LinkedPanel.Alignment := Value; 
    Invalidate; 
  end; 
end; 
 
procedure TdfsStatusPanel.SetAutoFit(const Value: boolean); 
begin 
  if FAutoFit <> Value then 
  begin 
    FAutoFit := Value; 
    UpdateAutoFitWidth; 
  end; 
end; 
 
procedure TdfsStatusPanel.SetBevel(const Value: TStatusPanelBevel); 
begin 
  if LinkedPanel.Bevel <> Value then 
    LinkedPanel.Bevel := Value; 
end; 
 
{$IFDEF DFS_COMPILER_4_UP} 
procedure TdfsStatusPanel.SetBiDiMode(const Value: TBiDiMode); 
begin 
  if LinkedPanel.BiDiMode <> Value then 
    LinkedPanel.BiDiMode := Value; 
end; 
 
procedure TdfsStatusPanel.SetParentBiDiMode(const Value: Boolean); 
begin 
  if LinkedPanel.ParentBiDiMode <> Value then 
    LinkedPanel.ParentBiDiMode := Value; 
end; 
 
{$ENDIF} 
 
procedure TdfsStatusPanel.SetDateFormat(const Value: string); 
begin 
  if FDateFormat <> Value then 
  begin 
    FDateFormat := Value; 
    UpdateDateTime; 
  end; 
end; 
 
procedure TdfsStatusPanel.SetEnabled(const Value: boolean); 
begin 
  if FEnabled <> Value then 
  begin 
    FEnabled := Value; 
    EnabledChanged; 
  end; 
end; 
 
procedure TdfsStatusPanel.SetGlyph(const Value: TPicture); 
begin 
  FGlyph.Assign(Value); 
  // GlyphChanged method will take care of updating display. 
end; 
 
procedure TdfsStatusPanel.SetPanelType(const Val: TdfsStatusPanelType); 
const 
  LOCK_TEXT: array[sptCapsLock..sptScrollLock] of string = ( 
     SCapsLock, SNumLock, SScrollLock 
    ); 
begin 
  if Val <> FPanelType then 
  begin 
    if Enabled then 
      case FPanelType of 
        sptCapsLock, sptNumLock, sptScrollLock: 
          begin 
            if StatusBar.UseMonitorDLL then 
              StatusBar.DeregisterSystemHook 
            else begin 
              DeregisterTaskKeyboardHook(Self); 
              StatusBar.DeregisterMainWinHook(Self); 
            end; 
          end; 
        sptDate, sptTime, sptDateTime, sptTimeDate: 
          TdfsStatusPanels(Collection).DeregisterTimer(Self); 
        sptGauge: 
          if GaugeAttrs.Style in IndeterminateGuages then 
            TdfsStatusPanels(Collection).DeregisterTimer(Self); 
      end; 
 
    FPanelType := Val; 
    case FPanelType of 
      sptCapsLock, sptNumLock, sptScrollLock: 
        begin 
          Text := LOCK_TEXT[FPanelType]; 
          AutoFit := TRUE; 
          if Enabled then 
          begin 
            if StatusBar.UseMonitorDLL then 
            begin 
              StatusBar.RegisterSystemHook; 
              FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType])); 
            end else begin 
              RegisterTaskKeyboardHook(Self); 
              StatusBar.RegisterMainWinHook(Self); 
            end; 
          end; 
        end; 
      sptDate, sptTime, sptDateTime, sptTimeDate: 
        begin 
          AutoFit := FALSE; 
          if Enabled then 
            TdfsStatusPanels(Collection).RegisterTimer(Self); 
          UpdateDateTime; 
        end; 
      sptEllipsisText, sptEllipsisPath: 
        begin 
          AutoFit := FALSE; 
          if Hint = '' then 
            Hint := '...';  
        end; 
      sptGlyph: 
        begin 
          AutoFit := TRUE; 
        end; 
      sptGauge: 
        begin 
          AutoFit := FALSE; 
          Alignment := taCenter; 
          if GaugeAttrs.Style in IndeterminateGuages then 
          begin 
            Enabled := FALSE; // Enabled is false, so don't need to register 
            FGaugeLastPos := 0; 
            FGaugeDirection := GaugeAttrs.Speed; 
          end; 
        end; 
    else 
      AutoFit := FALSE; 
    end; 
     
    Invalidate; 
  end; 
end; 
 
 
procedure TdfsStatusPanel.SetText(const Value: string); 
begin 
//outputdebugstring(Pchar(value)); 
  if FText <> Value then 
  begin 
//outputdebugstring(Pchar(ftext)); 
    FText := Value; 
//outputdebugstring(Pchar(ftext)); 
    Invalidate; 
    UpdateAutoFitWidth; 
  end; 
end; 
 
procedure TdfsStatusPanel.SetTimeFormat(const Value: string); 
begin 
  if FTimeFormat <> Value then 
  begin 
    FTimeFormat := Value; 
    UpdateDateTime; 
  end; 
end; 
 
procedure TdfsStatusPanel.SetWidth(const Value: Integer); 
begin 
  if ((not FAutoFit) or (csLoading in StatusBar.ComponentState)) and 
     (LinkedPanel.Width <> Value) then 
    LinkedPanel.Width := Value; 
  if (PanelType = sptGauge) and (GaugeAttrs.Style in IndeterminateGuages) then 
  begin 
    FGaugeLastPos := 0; 
    FGaugeDirection := GaugeAttrs.Speed; 
    Invalidate; 
  end; 
end; 
 
procedure TdfsStatusPanel.TimerNotification; 
begin 
  if PanelType in [sptDate, sptTime, sptDateTime, sptTimeDate] then 
    UpdateDateTime 
  else if (PanelType = sptGauge) and (GaugeAttrs.Style in IndeterminateGuages) then 
    // Call Redraw directly. It will take care of erasing the old part.  If we 
    // used Invalidate, the background would get erased, too, and it would 
    // flicker a lot. 
    Redraw(StatusBar.Canvas, StatusBar.GetPanelRect(Index)); 
end; 
 
procedure TdfsStatusPanel.UpdateAutoFitWidth; 
begin 
  if FAutoFit and (StatusBar <> NIL) and (StatusBar.HandleAllocated) then 
  begin 
    if PanelType = sptGlyph then 
    begin 
      if Text = '' then 
        LinkedPanel.Width := BorderWidth + Glyph.Width + 4 
      else 
        LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 2 + 
          (BorderWidth * 2) + Glyph.Width + 4; 
    end 
    else 
      LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 6 + BorderWidth; 
  end; 
  Invalidate; 
end; 
 
procedure TdfsStatusPanel.UpdateDateTime; 
var 
  Fmt: string; 
  Txt: string; 
begin 
  case PanelType of 
    sptDate: 
      if DateFormat = '' then 
        Fmt := ShortDateFormat 
      else 
        Fmt := DateFormat; 
    sptTime: 
      if TimeFormat = '' then 
        Fmt := LongTimeFormat 
      else 
        Fmt := TimeFormat; 
    sptDateTime: 
      begin 
        if DateFormat = '' then 
          Fmt := ShortDateFormat 
        else 
          Fmt := DateFormat; 
        if TimeFormat = '' then 
          Fmt := Fmt + ' ' + LongTimeFormat 
        else 
          Fmt := Fmt + ' ' + TimeFormat; 
      end; 
    sptTimeDate: 
      begin 
        if TimeFormat = '' then 
          Fmt := LongTimeFormat 
        else 
          Fmt := TimeFormat; 
        if DateFormat = '' then 
          Fmt := Fmt + ' ' + ShortDateFormat 
        else 
          Fmt := Fmt + ' ' + DateFormat; 
      end; 
  end; 
  Txt := FormatDateTime(Fmt, Now); 
  if Txt <> Text then 
  begin 
    Text := Txt; 
    //    Invalidate(TRUE); 
    Redraw(Statusbar.Canvas, StatusBar.GetPanelRect(Index)); 
  end; 
end; 
 
procedure TdfsStatusPanel.GlyphChanged(Sender: TObject); 
begin 
  if PanelType = sptGlyph then 
  begin 
    Invalidate; 
    UpdateAutoFitWidth; 
  end; 
end; 
 
 
procedure TdfsStatusPanel.DrawPanel(Rect: TRect); 
begin 
  if (csDesigning in StatusBar.ComponentState) or (Addr(OnDrawPanel) = NIL) or 
     (PanelType <> sptOwnerDraw) then 
    Redraw(StatusBar.Canvas, StatusBar.GetPanelRect(Index)) 
  else if assigned(FOnDrawPanel) then 
    FOnDrawPanel(StatusBar, Self, Rect); 
end; 
 
 
function TdfsStatusPanel.GetEnabled: boolean; 
begin 
  if csWriting in StatusBar.ComponentState then 
    Result := FEnabled 
  else 
    Result := FEnabled and StatusBar.Enabled; 
end; 
 
procedure TdfsStatusPanel.EnabledChanged; 
begin 
  // Enabled property (self or parent) changed, update register/deregister calls 
  if Enabled then 
  begin 
    case FPanelType of 
      sptCapsLock, sptNumLock, sptScrollLock: 
        begin 
          if StatusBar.UseMonitorDLL then 
          begin 
            StatusBar.RegisterSystemHook; 
            FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType])); 
          end else begin 
            RegisterTaskKeyboardHook(Self); 
            StatusBar.RegisterMainWinHook(Self); 
          end; 
        end; 
      sptDate, sptTime, sptDateTime, sptTimeDate: 
        TdfsStatusPanels(Collection).RegisterTimer(Self); 
      sptGauge: 
        if GaugeAttrs.Style in IndeterminateGuages then 
          TdfsStatusPanels(Collection).RegisterTimer(Self); 
    end; 
  end else begin 
    case FPanelType of 
      sptCapsLock, sptNumLock, sptScrollLock: 
        begin 
          if StatusBar.UseMonitorDLL then 
            StatusBar.DeregisterSystemHook 
          else begin 
            DeregisterTaskKeyboardHook(Self); 
            StatusBar.DeregisterMainWinHook(Self); 
          end; 
        end; 
      sptDate, sptTime, sptDateTime, sptTimeDate: 
        TdfsStatusPanels(Collection).DeregisterTimer(Self); 
      sptGauge: 
        if GaugeAttrs.Style in IndeterminateGuages then 
          TdfsStatusPanels(Collection).DeregisterTimer(Self); 
    end; 
  end; 
 
  Invalidate; 
  if not Enabled then 
  begin 
    FGaugeLastPos := 0; 
    FGaugeDirection := GaugeAttrs.Speed; 
  end; 
end; 
 
 
function TdfsStatusPanel.GetHint: string; 
begin 
  if (not (csDesigning in StatusBar.ComponentState)) and 
     (PanelType in [sptEllipsisText, sptEllipsisPath]) and (FHint = '...') then 
    Result := Text 
  else 
    Result := FHint; 
  DoHintText(Result); 
end; 
 
procedure TdfsStatusPanel.DoHintText(var HintText: string); 
begin 
  if assigned(FOnHintText) then 
    FOnHintText(StatusBar, Self, HintText); 
end; 
 
procedure TdfsStatusPanel.SetGaugeAttrs(const Value: TdfsGaugeAttrs); 
begin 
  FGaugeAttrs := Value; 
end; 
 
function TdfsStatusPanel.GetDisplayName: string; 
begin 
  case PanelType of 
    sptNormal, sptEllipsisText, sptEllipsisPath: 
      Result := Text; 
  else 
    Result := GetEnumName(TypeInfo(TdfsStatusPanelType), ord(PanelType)); 
  end; 
 
  if Result = '' then 
    Result := inherited GetDisplayName; 
end; 
 
procedure TdfsStatusPanel.SetIndex(Value: integer); 
var 
  CurIndex: Integer; 
begin 
  CurIndex := Index; 
  if (CurIndex >= 0) and (CurIndex <> Value) then 
  begin 
    TdfsStatusPanels(Collection).FLinkedPanels[CurIndex].Index := Value; 
    inherited SetIndex(Value); 
  end; 
end; 
 
function TdfsStatusPanel.GetLinkedPanel: TStatusPanel; 
begin 
  Result := TdfsStatusPanels(Collection).FLinkedPanels[Index]; 
end; 
 
 
procedure TdfsStatusPanel.UpdateKeyboardHook; 
begin 
  if PanelType in [sptCapsLock, sptNumLock, sptScrollLock] then 
  begin 
    if StatusBar.UseMonitorDLL and Enabled then 
    begin 
      DeregisterTaskKeyboardHook(Self); 
      StatusBar.DeregisterMainWinHook(Self); 
      StatusBar.RegisterSystemHook; 
      FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType])); 
    end else if (not StatusBar.UseMonitorDLL) and Enabled then 
    begin 
      StatusBar.DeregisterSystemHook; 
      RegisterTaskKeyboardHook(Self); 
      StatusBar.RegisterMainWinHook(Self); 
    end; 
  end; 
end; 
 
procedure TdfsStatusPanel.Click; 
begin 
  if assigned(FOnClick) then 
    FOnClick(Self); 
end; 
 
function TdfsStatusPanel.GetGaugeBitmap: TBitmap; 
begin 
  if FGaugeBitmap = NIL then 
    FGaugeBitmap := InitGaugeBitmap; 
  Result := FGaugeBitmap; 
end; 
 
procedure TdfsStatusPanel.SetBorderWidth(const Value: TBorderWidth); 
begin 
  if FBorderWidth <> Value then 
  begin 
    FBorderWidth := Value; 
    UpdateAutoFitWidth; 
    Invalidate; 
  end; 
end; 
 
function TdfsStatusPanel.IsTextStored: Boolean; 
begin 
  Result := not (PanelType in [sptDate, sptTime, sptDateTime, sptTimeDate]); 
end; 
 
{ TdfsStatusPanels } 
 
function TdfsStatusPanels.Add: TdfsStatusPanel; 
begin 
  Result := TdfsStatusPanel(inherited Add); 
end; 
 
constructor TdfsStatusPanels.Create(StatusBar: TdfsStatusBar; 
   LinkedPanels: TStatusPanels); 
begin 
  FStatusBar := StatusBar; 
  FLinkedPanels := LinkedPanels; 
  FTimer := NIL; 
  FTimerClients := TList.Create; 
 
  inherited Create(TdfsStatusPanel); 
end; 
 
procedure TdfsStatusPanels.DeregisterTimer(Client: TdfsStatusPanel); 
var 
  x: integer; 
  NewTimerRes: integer; 
begin 
  if FTimerClients.Remove(Client) <> -1 then 
    dec(RegisteredTimers); 
  if FTimerClients.Count < 1 then 
  begin 
    FTimer.Free; 
    FTimer := NIL; 
  end else begin 
    NewTimerRes := 60000; // Least impact we can manage easily 
    for x := 0 to FTimerClients.Count-1 do 
      case TdfsStatusPanel(FTimerClients[x]).PanelType of 
        sptTime, sptDateTime, sptTimeDate: 
          NewTimerRes := 1000; 
        sptGauge: 
          if TdfsStatusPanel(FTimerClients[x]).GaugeAttrs.Style in 
             IndeterminateGuages then begin 
            NewTimerRes := INDETERMINATE_GAUGE_UPDATE_INTERVAL; 
            break; 
          end; 
      end; 
 
    FTimer.Interval := NewTimerRes; 
  end; 
end; 
 
destructor TdfsStatusPanels.Destroy; 
begin 
  // Call inherited first because it causes children to be destroyed, and that 
  // might cause FTimerClients to be needed. 
  inherited Destroy; 
 
  FTimer.Free; 
  FTimer := NIL; 
  FTimerClients.Free; 
  FTimerClients := NIL; // Yes, there is a reason for this! 
end; 
 
function TdfsStatusPanels.GetItem(Index: Integer): TdfsStatusPanel; 
begin 
  Result := TdfsStatusPanel(inherited GetItem(Index)); 
end; 
 
function TdfsStatusPanels.GetOwner: TPersistent; 
begin 
  Result := FStatusBar; 
end; 
 
procedure TdfsStatusPanels.RegisterTimer(Client: TdfsStatusPanel); 
var 
  FirstClient: boolean; 
begin 
  if FTimer = NIL then 
  begin 
    FTimer := TTimer.Create(FStatusBar); 
    FLastDate := Date; 
    FTimer.OnTimer := TimerEvent; 
  end; 
  if FTimerClients.IndexOf(Client) >= 0 then 
    exit;  // We're already in the list! 
     
  FTimerClients.Add(Client); 
  inc(RegisteredTimers); 
  FirstClient := FTimerClients.Count = 1; 
  case Client.PanelType of 
    sptDate: 
      if FirstClient then 
        FTimer.Interval := 60000; // Least impact we can manage easily 
    sptTime, sptDateTime, sptTimeDate: 
      if FirstClient or (FTimer.Interval > 1000) then 
        FTimer.Interval := 1000; 
    sptGauge: 
      if Client.GaugeAttrs.Style in IndeterminateGuages then 
        FTimer.Interval := INDETERMINATE_GAUGE_UPDATE_INTERVAL; 
  end; 
  FTimer.Enabled := TRUE; 
end; 
 
procedure TdfsStatusPanels.SetItem(Index: Integer; Value: TdfsStatusPanel); 
begin 
  // I have no idea if this will work or not.... 
  inherited SetItem(Index, Value); 
  FLinkedPanels[Index] := Value.LinkedPanel; 
end; 
 
procedure TdfsStatusPanels.TimerEvent(Sender: TObject); 
var 
  x: integer; 
  DateUpdate: boolean; 
  Panel: TdfsStatusPanel; 
begin 
  if FLastDate <> Date then 
  begin 
    DateUpdate := TRUE; 
    FLastDate := Date; 
  end else 
    DateUpdate := FALSE; 
 
  for x := 0 to FTimerClients.Count-1 do 
  begin 
    Panel := TdfsStatusPanel(FTimerClients[x]); // shorthand 
    if (Panel.PanelType in [sptTime, sptDateTime, sptTimeDate]) or 
       (DateUpdate and (Panel.PanelType = sptDate)) or 
       ((Panel.PanelType = sptGauge) and 
       (Panel.GaugeAttrs.Style in IndeterminateGuages)) then 
      TdfsStatusPanel(FTimerClients[x]).TimerNotification; 
  end; 
end; 
 
procedure TdfsStatusPanels.Update(Item: TCollectionItem); 
begin 
  if Item is TdfsStatusPanel then 
    TdfsStatusPanel(Item).Invalidate 
  else 
    FStatusBar.Invalidate; 
end; 
 
{ TdfsStatusBar } 
 
constructor TdfsStatusBar.Create(AOwner: TComponent); 
begin 
  FExtentCanvas := CreateCompatibleDC(0); 
  FExtentFont := 0; 
  FExtentFontOld := 0; 
  FUseMonitorDLL := FALSE; 
  FDLLClientCount := 0; 
  FMainWinHookClients := TList.Create; 
 
  inherited Create(AOwner); 
 
  // Allow it to accept controls dropped onto it. 
  ControlStyle:= ControlStyle + [csAcceptsControls]; 
 
  FPanels := TdfsStatusPanels.Create(Self, inherited Panels); 
end; 
 
procedure TdfsStatusBar.InvalidatePanel(Index: integer); 
var 
  PanelRect: TRect; 
begin 
  if (Index >= 0) and (Index < Panels.Count) then 
  begin 
    PanelRect := GetPanelRect(Index); 
    if not IsRectEmpty(PanelRect) then 
      Panels[Index].Redraw(Canvas, PanelRect) 
  end else begin 
    {$IFDEF DFS_COMPILER_6_UP} 
    TList.Error(@SListIndexError, Index); 
    {$ELSE} 
    {$IFDEF DFS_COMPILER_3_UP} 
    raise EListError.Create(SListIndexError); 
    {$ELSE} 
    raise EListError.CreateRes(SListIndexError); 
    {$ENDIF} 
    {$ENDIF} 
  end; 
end; 
 
function TdfsStatusBar.GetPanelRect(Index: integer): TRect; 
begin 
  SetRectEmpty(Result); 
  if HandleAllocated then 
    if Perform(SB_GETRECT, Index, LPARAM(@Result)) = 0 then 
      SetRectEmpty(Result); // SB_GETRECT failed, probably not visible 
end; 
 
procedure TdfsStatusBar.SetPanels(const Value: TdfsStatusPanels); 
begin 
  FPanels.Assign(Value); 
// what about linked panels???? 
end; 
 
destructor TdfsStatusBar.Destroy; 
begin 
  FPanels.Free; 
  SelectObject(FExtentCanvas, FExtentFontOld); 
  if FExtentFont <> 0 then 
  begin 
    DeleteObject(FExtentFont); 
    FExtentFont := 0; 
  end; 
  if FExtentCanvas <> 0 then 
  begin 
    DeleteDC(FExtentCanvas); 
    FExtentCanvas := 0; 
  end; 
 
  Assert(FMainWinHookClients.Count = 0, 'Unbalanced MainWinHook registrations'); 
 
  inherited Destroy; 
  FMainWinHookClients.Free; 
end; 
 
 
procedure TdfsStatusBar.DrawPanel(Panel: TStatusPanel; const Rect: TRect); 
var 
  DFSPanel: TdfsStatusPanel; 
  OldFont: HFONT; 
begin 
  // Panel is the REAL TStatusPanel, we need to find our special one. 
  DFSPanel := FindLinkedPanel(Panel); 
  Assert(DFSPanel <> NIL, 'Panel links corrupted'); 
 
  // Stupid VCL status bar doesn't always have the right font in Canvas. 
  OldFont := SelectObject(Canvas.Handle, FExtentFont); 
  try 
    if Addr(OnDrawPanel) <> NIL then 
      inherited DrawPanel(TStatusPanel(DFSPanel), Rect); 
    DFSPanel.DrawPanel(Rect); 
  finally 
    SelectObject(Canvas.Handle, OldFont); 
  end; 
end; 
 
function TdfsStatusBar.FindLinkedPanel(Panel: TStatusPanel): TdfsStatusPanel; 
var 
  x: integer; 
begin 
  Result := NIL; 
  for x := 0 to Panels.Count-1 do 
    if Panels[x].LinkedPanel = Panel then 
    begin 
      Result := Panels[x]; 
      break; 
    end; 
end; 
 
function TdfsStatusBar.AppWinHook(var Message: TMessage): boolean; 
begin 
  if Message.Msg = WM_ACTIVATEAPP then 
  begin 
    if UseMonitorDLL then 
    begin 
{      if Message.wParam = 1 then 
        PostMessage(Handle, WM_REFRESHLOCKINDICATORS, 0, 0);} 
    end else begin 
      // We're being deactivated, someone may change an indicator and that will 
      // screw up the GetKeyState API call. 
      if Message.wParam = 0 then 
        MayNeedRefresh := TRUE; 
      // Won't work in some situations if we call it directly. 
      PostMessage(Handle, WM_REFRESHLOCKINDICATORS, 0, 0); 
    end; 
  end; 
  Result := FALSE; 
end; 
 
procedure TdfsStatusBar.WMRefreshLockIndicators(var Msg: TMessage); 
var 
  x: integer; 
begin 
  Panels.BeginUpdate; 
  try 
    for x := 0 to Panels.Count-1 do 
      if Panels[x].PanelType in [sptCapsLock, sptNumLock, sptScrollLock] then 
        InvalidatePanel(Panels[x].Index); 
  finally 
    Panels.EndUpdate; 
  end; 
end; 
 
procedure TdfsStatusBar.CMFontChanged(var Msg: TMessage); 
var 
  x: integer; 
begin 
  inherited; 
 
  UpdateExtentFont; 
 
  if Panels = NIL then exit; 
 
  Panels.BeginUpdate; 
  try 
    for x := 0 to Panels.Count-1 do 
      if Panels[x].AutoFit then 
        Panels[x].UpdateAutoFitWidth; 
  finally 
    Panels.EndUpdate; 
  end; 
end; 
 
 
procedure TdfsStatusBar.SetOnDrawPanel(const Value: TdfsDrawPanelEvent); 
begin 
  inherited OnDrawPanel := TDrawPanelEvent(Value); 
end; 
 
function TdfsStatusBar.GetOnDrawPanel: TdfsDrawPanelEvent; 
begin 
  TDrawPanelEvent(Result) := inherited OnDrawPanel; 
end; 
 
function TdfsStatusBar.GetVersion: string; 
begin 
  Result := DFS_COMPONENT_VERSION; 
end; 
 
procedure TdfsStatusBar.SetVersion(const Val: string); 
begin 
  { empty write method, just needed to get it to show up in Object Inspector } 
end; 
 
 
procedure TdfsStatusBar.CMEnabledChanged(var Msg: TMessage); 
var 
  x: integer; 
begin 
  inherited; 
  Invalidate; 
  for x := 0 to Panels.Count-1 do 
    Panels[x].EnabledChanged; 
end; 
 
procedure TdfsStatusBar.CMHintShow(var Msg: TMessage); 
  function FindClosestBefore(x: integer): TdfsStatusPanel; 
  var 
    y: integer; 
  begin 
    Result := NIL; 
    for y := 0 to Panels.Count-1 do 
    begin 
      if GetPanelRect(y).Left < x then 
        Result := Panels[y] 
      else 
        break; 
    end; 
(*  If I do it this way, it screws up.  Optimizaer bug, maybe? 
    for y := Panels.Count-1 downto 0 do 
    begin 
      if GetPanelRect(y).Left < x then 
      begin 
        Result := Panels[y]; 
        break; 
      end; 
    end;*) 
  end; 
 
  function FindClosestAfter(x: integer): TdfsStatusPanel; 
  var 
    y: integer; 
  begin 
    Result := NIL; 
    for y := 0 to Panels.Count-1 do 
    begin 
      if GetPanelRect(y).Right > x then 
      begin 
        Result := Panels[y]; 
        break; 
      end; 
    end; 
  end; 
var 
  x: integer; 
  Panel: TdfsStatusPanel; 
  R: TRect; 
begin 
  inherited; 
 
  with TCMHintShow(Msg) do 
  begin 
    begin 
      Panel := NIL; 
      for x := 0 to Panels.Count-1 do 
      begin 
        if PtInRect(GetPanelRect(x), HintInfo.CursorPos) then 
        begin 
          Panel := Panels[x]; 
          break; 
        end; 
      end; 
 
      if (Panel = NIL) or (Panel.Hint = '') then 
      begin 
        // Hit a border, or a panel without a hint.  What we have to do here is 
        // tell the hint info how big of a rectangle the hint applies to.  So, 
        // we must find the first panel before this point with a hint, and the 
        // first panel after this point with a hint and set CursorRect equal to 
        // the area between those two panels.  CursorRect already has the area 
        // of the status bar, so if we don't find a panel, it's ok. 
 
        // Find first valid panel before hint position and set CursorRect.Left 
        Panel := FindClosestBefore(HintInfo.CursorPos.x); 
        while (Panel <> NIL) do 
        begin 
          R := GetPanelRect(Panel.Index); 
          if Panel.Hint <> '' then 
          begin 
            HintInfo.CursorRect.Left := R.Right; 
            Panel := NIL; 
          end else 
            Panel := FindClosestBefore(R.Left); 
        end; 
 
        // Find first valid panel after hint position and set CursorRect.Right 
        Panel := FindClosestAfter(HintInfo.CursorPos.x); 
        while (Panel <> NIL) do 
        begin 
          R := GetPanelRect(Panel.Index); 
          if Panel.Hint <> '' then 
          begin 
            HintInfo.CursorRect.Right := R.Left; 
            Panel := NIL; 
          end else 
            Panel := FindClosestAfter(R.Right); 
        end; 
      end else begin 
        // Give it the hint of the panel 
        HintInfo.HintStr := Panel.Hint; 
        // Tell the hint mechanism that it needs to check the hint when the 
        // cursor leaves the panel rectangle. 
        HintInfo.CursorRect := GetPanelRect(Panel.Index); 
      end; 
    end; 
  end; 
end; 
 
procedure TdfsStatusBar.DeregisterMainWinHook(Client: TdfsStatusPanel); 
begin 
  FMainWinHookClients.Remove(Client); 
  Assert(FMainWinHookClients.Count >= 0, 'Unbalanced MainWinHook registrations'); 
  if FMainWinHookClients.Count < 1 then 
    Application.UnhookMainWindow(AppWinHook); 
end; 
 
procedure TdfsStatusBar.RegisterMainWinHook(Client: TdfsStatusPanel); 
begin 
  FMainWinHookClients.Add(Client); 
  if FMainWinHookClients.Count = 1 then 
    Application.HookMainWindow(AppWinHook); 
end; 
 
 
 
procedure TdfsStatusBar.Loaded; 
var 
  x: integer; 
begin 
  inherited Loaded; 
 
  UpdateExtentFont; 
 
  for x := 0 to Panels.Count-1 do 
    if Panels[x].AutoFit then 
      Panels[x].UpdateAutoFitWidth; 
end; 
 
procedure TdfsStatusBar.CreateWnd; 
var 
  x: integer; 
begin 
  inherited CreateWnd; 
 
  if not (csLoading in ComponentState) then 
  begin 
    UpdateExtentFont; 
 
    for x := 0 to Panels.Count-1 do 
      if Panels[x].AutoFit then 
        Panels[x].UpdateAutoFitWidth; 
  end; 
 
  if FDLLClientCount > 0 then 
    FKeyHookMsg := DLLRegisterKeyboardHook(Handle); 
end; 
 
procedure TdfsStatusBar.WMDestroy(var Msg: TWMDestroy); 
begin 
  if FUseMonitorDLL and (FDLLClientCount > 0) then 
    DLLDeregisterKeyboardHook(Handle); 
 
  inherited; 
end; 
 
 
function TdfsStatusBar.TextExtent(const Text: string): TSize; 
begin 
  if not GetTextExtentPoint32(FExtentCanvas, PChar(Text), Length(Text), 
     Result) then 
  begin 
    Result.cx := -1; 
    Result.cy := -1; 
  end; 
end; 
 
procedure TdfsStatusBar.UpdateExtentFont; 
begin 
  if FExtentFont <> 0 then 
  begin 
    SelectObject(FExtentCanvas, FExtentFontOld); 
    DeleteObject(FExtentFont); 
  end; 
 
  // In D4, the font handle might be different than what TFont describes! 
  FExtentFont := CopyHFont(Font.Handle); 
  FExtentFontOld := SelectObject(FExtentCanvas, FExtentFont); 
end; 
 
procedure TdfsStatusBar.SetUseMonitorDLL(const Value: boolean); 
begin 
  if FUseMonitorDLL <> Value then 
  begin 
    FUseMonitorDLL := Value; 
    UpdateKeyboardHooks; 
    if FUseMonitorDLL and (not DFSKbDLL_Loaded) {and 
       not (csDesigning in ComponentState)} then 
    begin 
      UseMonitorDLL := FALSE; 
      if csDesigning in ComponentState then 
        raise Exception.Create('Could not load ' + DFSKbDLLName); 
    end;     
  end; 
end; 
 
procedure TdfsStatusBar.UpdateKeyboardHooks; 
var 
  x: integer; 
begin 
  for x := 0 to Panels.Count-1 do 
    Panels[x].UpdateKeyboardHook; 
end; 
 
 
procedure TdfsStatusBar.DeregisterSystemHook; 
begin 
  dec(FDLLClientCount); 
  if FDLLClientCount < 1 then 
  begin 
    if DFSKbDLL_Loaded and HandleAllocated then 
      DLLDeregisterKeyboardHook(Handle); 
    FDLLClientCount := 0; 
    if DFSKbDLL_Loaded then 
      UnloadDFSKbDLL; 
  end; 
end; 
 
procedure TdfsStatusBar.RegisterSystemHook; 
begin 
  inc(FDLLClientCount); 
  if (FDLLClientCount = 1) {and not (csDesigning in ComponentState)} then 
  begin 
    if not DFSKbDLL_Loaded then 
      IniTdfsKbDLL; 
    if HandleAllocated and DFSKbDLL_Loaded then 
      FKeyHookMsg := DLLRegisterKeyboardHook(Handle); 
  end; 
end; 
 
procedure TdfsStatusBar.WndProc(var Msg: TMessage); 
  function VKToPanelType(VKCode: byte): TdfsStatusPanelType; 
  begin 
    case VKCode of 
      VK_NUMLOCK: Result := sptNumLock; 
      VK_SCROLL:  Result := sptScrollLock; 
    else 
      Result := sptCapsLock; 
    end; 
  end; 
var 
  x: integer; 
begin 
  if Msg.Msg = FKeyHookMsg then 
  begin 
    for x := 0 to Panels.Count-1 do 
      if VKToPanelType(Msg.wParam) = Panels[x].PanelType then 
      begin 
        Panels[x].FKeyOn := Odd(Msg.lParam); 
        Panels[x].Invalidate; 
      end; 
  end else 
    inherited WndProc(Msg); 
end; 
 
procedure TdfsStatusBar.Click; 
var 
  x: integer; 
  CursorPos: TPoint; 
begin 
  GetCursorPos(CursorPos); 
  CursorPos := ScreenToClient(CursorPos); 
  for x := 0 to Panels.Count-1 do 
  begin 
    if PtInRect(GetPanelRect(x), CursorPos) then 
    begin 
      Panels[x].Click; 
      break; 
    end; 
  end; 
 
  inherited Click; 
end; 
 
procedure TdfsStatusBar.WMPaint(var Msg: TWMPaint); 
  procedure DrawSizeGrip(R: TRect); 
  begin 
    OffsetRect(R, -1, -1); 
    with Canvas do 
    begin 
      Brush.Color := Color; 
      Pen.Width := 1; 
      FillRect(R); 
      Pen.Color := clBtnHighlight; 
      MoveTo(R.Right - 2, R.Bottom); 
      LineTo(R.Right, R.Bottom - 2); 
      MoveTo(R.Right - 13, R.Bottom); 
      LineTo(R.Right, R.Bottom - 13); 
      MoveTo(R.Right - 9, R.Bottom); 
      LineTo(R.Right, R.Bottom - 9); 
      MoveTo(R.Right - 5, R.Bottom); 
      LineTo(R.Right, R.Bottom - 5); 
      MoveTo(R.Right - 1, R.Bottom); 
      LineTo(R.Right, R.Bottom); 
 
      Pen.Color := clBtnShadow; 
      MoveTo(R.Right - 11, R.Bottom); 
      LineTo(R.Right, R.Bottom - 11); 
      MoveTo(R.Right - 7, R.Bottom); 
      LineTo(R.Right, R.Bottom - 7); 
      MoveTo(R.Right - 3, R.Bottom); 
      LineTo(R.Right, R.Bottom - 3); 
 
      Brush.Color := clBtnFace; 
      Pen.Color := clBtnShadow; 
      MoveTo(R.Left, R.Top); 
      LineTo(R.Right, R.Top); 
    end; 
  end; 
var 
  R: TRect; 
begin 
  inherited; 
  if Color <> clBtnFace then 
  begin 
    R := ClientRect; 
    R.Left := R.Right - 15; 
    Inc(R.Top, 3); 
    dec(R.Bottom); 
    DrawSizeGrip(R); 
  end; 
end; 
 
{$IFDEF DFS_COMPILER_4_UP} 
function TdfsStatusBar.ExecuteAction(Action: TBasicAction): Boolean; 
begin 
//  outputdebugstring(Pchar(panels[0].ftext)); 
  Result := inherited ExecuteAction(Action); 
//  outputdebugstring(Pchar(panels[0].ftext)); 
  Invalidate; 
//  outputdebugstring(Pchar(panels[0].ftext)); 
end; 
{$ENDIF} 
 
 
initialization 
  {$IFDEF DFS_DEBUG} 
  DFSDebug.Log('dfsStatusBar: init begin', TRUE); 
  {$ENDIF} 
  MayNeedRefresh := FALSE; 
  KeyboardHookHandle := 0; 
  KeyHookClients := TList.Create; 
  RegisteredTimers := 0; 
  {$IFDEF DFS_DEBUG} 
  DFSDebug.Log('dfsStatusBar: init end.', TRUE); 
  {$ENDIF} 
 
finalization 
 
  {$IFDEF DFS_DEBUG} 
  DFSDebug.Log('dfsStatusBar: finalization begin.', TRUE); 
  {$ENDIF} 
  // remove hook just in case it somehow got left installed 
  if KeyboardHookHandle <> 0 then 
  begin 
    UnhookWindowsHookEx(KeyboardHookHandle); 
    KeyboardHookHandle := 0; 
    Assert(FALSE, 'TdfsStatusBar: Keyboard hook still installed'); 
  end; 
 
  Assert(RegisteredTimers = 0, 'TdfsStatusBar: Unbalanced timer registrations'); 
 
  KeyHookClients.Free; 
  KeyHookClients := NIL; 
 
  if DFSKb.DFSKbDLL_Loaded then 
    UnloadDFSKbDLL; 
 
  {$IFDEF DFS_DEBUG} 
  DFSDebug.Log('dfsStatusBar: finalization end.', TRUE); 
  {$ENDIF} 
end.