home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d123456 / DFS.ZIP / DFSStatusBar.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  66KB  |  2,235 lines
  1. {$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }
  2.  
  3. {------------------------------------------------------------------------------}
  4. { TdfsStatusBar v1.24                                                          }
  5. {------------------------------------------------------------------------------}
  6. { A status bar that provides many common specialized panels and owning of      }
  7. { other components by the status bar.                                          }
  8. {                                                                              }
  9. { Copyright 2000, Brad Stowers.  All Rights Reserved.                          }
  10. {                                                                              }
  11. { Copyright:                                                                   }
  12. { All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
  13. { Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
  14. { property of the author.                                                      }
  15. {                                                                              }
  16. { Distribution Rights:                                                         }
  17. { You are granted a non-exlusive, royalty-free right to produce and distribute }
  18. { compiled binary files (executables, DLLs, etc.) that are built with any of   }
  19. { the DFS source code unless specifically stated otherwise.                    }
  20. { You are further granted permission to redistribute any of the DFS source     }
  21. { code in source code form, provided that the original archive as found on the }
  22. { DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
  23. { example, if you create a descendant of TdfsColorButton, you must include in  }
  24. { the distribution package the colorbtn.zip file in the exact form that you    }
  25. { downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
  26. {                                                                              }
  27. { Restrictions:                                                                }
  28. { Without the express written consent of the author, you may not:              }
  29. {   * Distribute modified versions of any DFS source code by itself. You must  }
  30. {     include the original archive as you found it at the DFS site.            }
  31. {   * Sell or lease any portion of DFS source code. You are, of course, free   }
  32. {     to sell any of your own original code that works with, enhances, etc.    }
  33. {     DFS source code.                                                         }
  34. {   * Distribute DFS source code for profit.                                   }
  35. {                                                                              }
  36. { Warranty:                                                                    }
  37. { There is absolutely no warranty of any kind whatsoever with any of the DFS   }
  38. { source code (hereafter "software"). The software is provided to you "AS-IS", }
  39. { and all risks and losses associated with it's use are assumed by you. In no  }
  40. { event shall the author of the softare, Bradley D. Stowers, be held           }
  41. { accountable for any damages or losses that may occur from use or misuse of   }
  42. { the software.                                                                }
  43. {                                                                              }
  44. { Support:                                                                     }
  45. { Support is provided via the DFS Support Forum, which is a web-based message  }
  46. { system.  You can find it at http://www.delphifreestuff.com/discus/           }
  47. { All DFS source code is provided free of charge. As such, I can not guarantee }
  48. { any support whatsoever. While I do try to answer all questions that I        }
  49. { receive, and address all problems that are reported to me, you must          }
  50. { understand that I simply can not guarantee that this will always be so.      }
  51. {                                                                              }
  52. { Clarifications:                                                              }
  53. { If you need any further information, please feel free to contact me directly.}
  54. { This agreement can be found online at my site in the "Miscellaneous" section.}
  55. {------------------------------------------------------------------------------}
  56. { The lateset version of my components are always available on the web at:     }
  57. {   http://www.delphifreestuff.com/                                            }
  58. { See DFSStatusBar.txt for notes, known issues, and revision history.          }
  59. {------------------------------------------------------------------------------}
  60. { Date last modified:  June 27, 2001                                           }
  61. {------------------------------------------------------------------------------}
  62.  
  63.  
  64. unit dfsStatusBar;
  65.  
  66. interface
  67.  
  68. uses
  69.   {$IFDEF DFS_DEBUG}
  70.   DFSDebug,
  71.   {$ENDIF}
  72.   Windows, Classes, Messages, Controls, ComCtrls, Graphics, Forms,
  73.   ExtCtrls;
  74.  
  75. const
  76.   WM_REFRESHLOCKINDICATORS = WM_APP + 230;
  77.   { This shuts up C++Builder 3 about the redefiniton being different. There
  78.     seems to be no equivalent in C1.  Sorry. }
  79.   {$IFDEF DFS_CPPB_3_UP}
  80.   {$EXTERNALSYM DFS_COMPONENT_VERSION}
  81.   {$ENDIF}
  82.   DFS_COMPONENT_VERSION = 'TdfsStatusBar v1.24';
  83.  
  84. type
  85.   TdfsStatusPanelType = (
  86.      sptNormal,            // Nothing special, same as a regular TStatusPanel
  87.      sptCapsLock,          // Caps lock indicator.  Normal color if on, gray if
  88.                            //   off
  89.      sptNumLock,           // Num lock indicator.  Normal color if on, gray if
  90.                            //   off
  91.      sptScrollLock,        // Scroll lock indicator.  Normal color if on, gray
  92.                            //   if off
  93.      sptDate,              // Current date.  Uses DateFormat property for format
  94.      sptTime,              // Current time.  Uses TimeFormat property for format
  95.      sptDateTime,          // Current date and time.  Uses DateFormat and
  96.                            //   TimeFormat properties for format
  97.      sptTimeDate,          // Current time and date.  Uses DateFormat and
  98.                            //   TimeFormat properties for format
  99.      sptEllipsisText,      // Shorten text at the end with '...' when won't fit.
  100.      sptEllipsisPath,      // Shorten by removing path info with '...' when
  101.                            //   won't fit.
  102.      sptGlyph,             // Displays a TPicture object in the panel.
  103.      sptGauge,             // A progress meter.  Use GaugeAttrs to customize it.
  104.      sptOwnerDraw          // Same as the old TStatusPanel.Style = psOwnerDraw.
  105.     );
  106.  
  107.   TPercent = 0..100;
  108.  
  109.   TdfsGaugeStyle = (
  110.      gsPercent,        // Your basic progress meeter.
  111.      gsIndeterminate,  // A progress indicator where the min/max are not
  112.                        //   known.  That is, you want to show something
  113.                        //   going on, but don't know how long it will take.
  114.                        //   It's a little ball that "bounces" back and forth.
  115.      gsIndeterminate2  // Same as above, but looks more Netscape-ish.
  116.     );
  117.   TdfsGaugeStyles = set of TdfsGaugeStyle;
  118.  
  119.   TdfsStatusBar = class; // forward declaration
  120.   TdfsStatusPanel = class; // forward declaration
  121.  
  122.  
  123.   TdfsDrawPanelEvent = procedure(StatusBar: TdfsStatusBar;
  124.      Panel: TdfsStatusPanel; const Rect: TRect) of object;
  125.   TdfsPanelHintTextEvent = procedure (StatusBar: TdfsStatusBar;
  126.      Panel: TdfsStatusPanel; var Hint: string) of object;
  127.  
  128.  
  129.   TdfsGaugeAttrs = class(TPersistent)
  130.   private
  131.     FStyle: TdfsGaugeStyle;
  132.     FOwner: TdfsStatusPanel;
  133.     FPosition: TPercent;
  134.     FSpeed: integer;
  135.     FColor: TColor;
  136.     FTextColor: TColor;
  137.     procedure SetPosition(const Value: TPercent);
  138.     procedure SetStyle(const Value: TdfsGaugeStyle);
  139.     procedure SetSpeed(const Value: integer);
  140.     procedure SetColor(const Value: TColor);
  141.     procedure SetTextColor(const Value: TColor);
  142.   public
  143.     constructor Create(AOwner: TdfsStatusPanel);
  144.     procedure Assign(Source: TPersistent); override;
  145.  
  146.     property Owner: TdfsStatusPanel
  147.        read FOwner;
  148.   published
  149.     property Style: TdfsGaugeStyle
  150.        read FStyle
  151.        write SetStyle
  152.        default gsPercent;
  153.     property Position: TPercent
  154.        read FPosition
  155.        write SetPosition
  156.        default 0;
  157.     property Speed: integer
  158.        read FSpeed
  159.        write SetSpeed
  160.        default 4;
  161.     property Color: TColor
  162.        read FColor
  163.        write SetColor
  164.        default clHighlight;
  165.     property TextColor: TColor
  166.        read FTextColor
  167.        write SetTextColor
  168.        default clHighlightText;
  169.   end;
  170.  
  171.   TdfsStatusPanel = class(TCollectionItem)
  172.   private
  173.     FKeyOn: boolean;
  174.     FPanelType: TdfsStatusPanelType;
  175.     FAutoFit: boolean;
  176.     FEnabled: boolean;
  177.     FTimeFormat: string;
  178.     FDateFormat: string;
  179.     FText: string;
  180.     FGlyph: TPicture;
  181.     FGaugeLastPos: integer;
  182.     FGaugeDirection: integer;
  183.     FOnDrawPanel: TdfsDrawPanelEvent;
  184.     FHint: string;
  185.     FOnHintText: TdfsPanelHintTextEvent;
  186.     FOnClick: TNotifyEvent;
  187.     FGaugeAttrs: TdfsGaugeAttrs;
  188.     FGaugeBitmap: TBitmap;
  189.     FBorderWidth: TBorderWidth;
  190.  
  191.     procedure SetPanelType(const Val: TdfsStatusPanelType);
  192.     function GetAlignment: TAlignment;
  193.     function GetBevel: TStatusPanelBevel;
  194. {$IFDEF DFS_COMPILER_4_UP}
  195.     function IsBiDiModeStored: Boolean;
  196.     function GetBiDiMode: TBiDiMode;
  197.     function GetParentBiDiMode: Boolean;
  198. {$ENDIF}
  199.     function GetWidth: Integer;
  200.     procedure SetAlignment(const Value: TAlignment);
  201.     procedure SetBevel(const Value: TStatusPanelBevel);
  202. {$IFDEF DFS_COMPILER_4_UP}
  203.     procedure SetBiDiMode(const Value: TBiDiMode);
  204.     procedure SetParentBiDiMode(const Value: Boolean);
  205. {$ENDIF}
  206.     procedure SetText(const Value: string);
  207.     procedure SetWidth(const Value: Integer);
  208.     procedure SetAutoFit(const Value: boolean);
  209.     procedure SetDateFormat(const Value: string);
  210.     procedure SetEnabled(const Value: boolean);
  211.     procedure SetGlyph(const Value: TPicture);
  212.     procedure SetTimeFormat(const Value: string);
  213.     function GetStatusBar: TdfsStatusBar;
  214.     function GetEnabled: boolean;
  215.     function GetHint: string;
  216.     procedure SetGaugeAttrs(const Value: TdfsGaugeAttrs);
  217.     function GetLinkedPanel: TStatusPanel;
  218.     function GetGaugeBitmap: TBitmap;
  219.     procedure SetBorderWidth(const Value: TBorderWidth);
  220.     function IsTextStored: Boolean;
  221.   protected
  222.     procedure SetIndex(Value: integer); override;
  223.     function GetDisplayName: string; override;
  224.     procedure TimerNotification;
  225.     procedure UpdateAutoFitWidth; dynamic;
  226.     procedure UpdateDateTime; dynamic;
  227.     procedure GlyphChanged(Sender: TObject); dynamic;
  228.     procedure DrawPanel(Rect: TRect); dynamic;
  229.     procedure EnabledChanged; dynamic;
  230.     procedure DoHintText(var HintText: string); dynamic;
  231.     procedure Redraw(Canvas: TCanvas; Dest: TRect); dynamic;
  232.     procedure DrawKeyLock(Canvas: TCanvas; R: TRect); dynamic;
  233.     procedure DrawTextBased(Canvas: TCanvas; R: TRect); dynamic;
  234.     procedure DrawGlyph(Canvas: TCanvas; R: TRect); dynamic;
  235.     procedure DrawGauge(Canvas: TCanvas; R: TRect); dynamic;
  236.     procedure DrawIndeterminateGauge(Canvas: TCanvas; R: TRect); dynamic;
  237.     function InitGaugeBitmap: TBitmap; dynamic;
  238.     procedure Click; dynamic;
  239.     procedure UpdateKeyboardHook;
  240.     property LinkedPanel: TStatusPanel
  241.        read GetLinkedPanel;
  242.     property GaugeBitmap: TBitmap
  243.        read GetGaugeBitmap;
  244.   public
  245.     constructor Create(AOwner: TCollection); override;
  246.     destructor Destroy; override;
  247.     procedure Assign(Source: TPersistent); override;
  248.     procedure Invalidate;
  249.  
  250.     property StatusBar: TdfsStatusBar
  251.        read GetStatusBar;
  252.   published
  253.     property GaugeAttrs: TdfsGaugeAttrs
  254.        read FGaugeAttrs
  255.        write SetGaugeAttrs;
  256.     property Alignment: TAlignment
  257.        read GetAlignment
  258.        write SetAlignment
  259.        default taLeftJustify;
  260.     property Bevel: TStatusPanelBevel
  261.        read GetBevel
  262.        write SetBevel
  263.        default pbLowered;
  264.     property BorderWidth: TBorderWidth
  265.       read FBorderWidth
  266.       write SetBorderWidth
  267.       default 0;
  268. {$IFDEF DFS_COMPILER_4_UP}
  269.     property BiDiMode: TBiDiMode
  270.        read GetBiDiMode
  271.        write SetBiDiMode
  272.        stored IsBiDiModeStored;
  273.     property ParentBiDiMode: Boolean
  274.        read GetParentBiDiMode
  275.        write SetParentBiDiMode
  276.        default True;
  277. {$ENDIF}
  278.     // PanelType must come before most of the other properties because it would
  279.     //   stomp on some of their values as they are streamed.  Some of the other
  280.     //   properties have to be ordered a certain way, too, so don't mess with
  281.     //   the declaration order.
  282.     property PanelType: TdfsStatusPanelType
  283.        read FPanelType
  284.        write SetPanelType
  285.        default sptNormal;
  286.     property Glyph: TPicture
  287.        read FGlyph
  288.        write SetGlyph;
  289.     property Text: string
  290.        read FText
  291.        write SetText
  292.        stored IsTextStored;
  293.     property DateFormat: string
  294.        read FDateFormat
  295.        write SetDateFormat;
  296.     property TimeFormat: string
  297.        read FTimeFormat
  298.        write SetTimeFormat;
  299.     property Enabled: boolean
  300.        read GetEnabled
  301.        write SetEnabled;
  302.     property Width: Integer
  303.        read GetWidth
  304.        write SetWidth;
  305.     property AutoFit: boolean
  306.        read FAutoFit
  307.        write SetAutoFit;
  308.     property Hint: string
  309.        read GetHint
  310.        write FHint;
  311.  
  312.     property OnDrawPanel: TdfsDrawPanelEvent
  313.        read FOnDrawPanel
  314.        write FOnDrawPanel;
  315.     property OnHintText: TdfsPanelHintTextEvent
  316.        read FOnHintText
  317.        write FOnHintText;
  318.     property OnClick: TNotifyEvent
  319.        read FOnClick
  320.        write FOnClick;
  321.   end;
  322.  
  323.   TdfsStatusPanels = class(TCollection)
  324.   private
  325.     FTimer: TTimer;
  326.     FTimerClients: TList;
  327.     FLastDate: TDateTime;
  328.     FStatusBar: TdfsStatusBar;
  329.     FLinkedPanels: TStatusPanels;
  330.     function GetItem(Index: Integer): TdfsStatusPanel;
  331.     procedure SetItem(Index: Integer; Value: TdfsStatusPanel);
  332.   protected
  333.     procedure Update(Item: TCollectionItem); override;
  334.     function GetOwner: TPersistent; override;
  335.     procedure RegisterTimer(Client: TdfsStatusPanel);
  336.     procedure DeregisterTimer(Client: TdfsStatusPanel);
  337.     procedure TimerEvent(Sender: TObject);
  338.   public
  339.     constructor Create(StatusBar: TdfsStatusBar; LinkedPanels: TStatusPanels);
  340.     destructor Destroy; override;
  341.     function Add: TdfsStatusPanel;
  342.     property Items[Index: Integer]: TdfsStatusPanel
  343.        read GetItem
  344.        write SetItem;
  345.        default;
  346.   end;
  347.  
  348.   TdfsStatusBar = class(TStatusBar)
  349.   private
  350.     FPanels: TdfsStatusPanels;
  351.     FMainWinHookClients: TList;
  352.     FExtentCanvas: HDC;
  353.     FExtentFont: HFONT;
  354.     FExtentFontOld: HFONT;
  355.     FUseMonitorDLL: boolean;
  356.     FDLLClientCount: integer;
  357.     FKeyHookMsg: UINT;
  358.     procedure SetPanels(const Value: TdfsStatusPanels);
  359.     function AppWinHook(var Message: TMessage): boolean;
  360.     procedure WMRefreshLockIndicators(var Msg: TMessage);
  361.        message WM_REFRESHLOCKINDICATORS;
  362.     procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
  363.     procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  364.     procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
  365.     procedure SetOnDrawPanel(const Value: TdfsDrawPanelEvent);
  366.     function GetOnDrawPanel: TdfsDrawPanelEvent;
  367.     function GetVersion: string;
  368.     procedure SetVersion(const Val: string);
  369.     procedure UpdateExtentFont;
  370.     procedure SetUseMonitorDLL(const Value: boolean);
  371.     procedure UpdateKeyboardHooks;
  372.     procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  373.     procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  374.   protected
  375.     procedure DrawPanel(Panel: TStatusPanel; const Rect: TRect); override;
  376.     procedure Loaded; override;
  377.     procedure CreateWnd; override;
  378.     procedure WndProc(var Msg: TMessage); override;
  379.     function GetPanelRect(Index: integer): TRect;
  380.     function FindLinkedPanel(Panel: TStatusPanel): TdfsStatusPanel;
  381.     procedure RegisterMainWinHook(Client: TdfsStatusPanel);
  382.     procedure DeregisterMainWinHook(Client: TdfsStatusPanel);
  383.     procedure RegisterSystemHook;
  384.     procedure DeregisterSystemHook;
  385.     function TextExtent(const Text: string): TSize;
  386.     procedure Click; override;
  387.   public
  388.     constructor Create(AOwner: TComponent); override;
  389.     destructor Destroy; override;
  390.     procedure InvalidatePanel(Index: integer);
  391.     {$IFDEF DFS_COMPILER_4_UP}
  392.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  393.     {$ENDIF}
  394.   published
  395.     property UseMonitorDLL: boolean
  396.        read FUseMonitorDLL
  397.        write SetUseMonitorDLL
  398.        default FALSE;
  399.     property Panels: TdfsStatusPanels
  400.        read FPanels
  401.        write SetPanels;
  402.     property Version: string
  403.        read GetVersion
  404.        write SetVersion
  405.        stored FALSE;
  406.  
  407.     property OnDrawPanel: TdfsDrawPanelEvent
  408.        read GetOnDrawPanel
  409.        write SetOnDrawPanel;
  410.   end;
  411.  
  412.  
  413. // You may want to change this value if you don't like the speed of the
  414. // indeterminate gauge
  415. const
  416.   INDETERMINATE_GAUGE_UPDATE_INTERVAL: integer = 50; // in milliseconds
  417.  
  418. {$IFDEF DFS_COMPILER_3_UP}
  419. resourcestring
  420. {$ELSE}
  421. const
  422. {$ENDIF}
  423.   SCapsLock   = ' CAPS ';
  424.   SNumLock    = ' NUM ';
  425.   SScrollLock = ' SCROLL ';
  426.  
  427. const
  428.   IndeterminateGuages: TdfsGaugeStyles = [gsIndeterminate, gsIndeterminate2];
  429.  
  430. implementation
  431.  
  432. uses
  433.   {$IFDEF DFS_COMPILER_6_UP}
  434.   RTLConsts,
  435.   {$ELSE}
  436.   Consts,
  437.   {$ENDIF}
  438.   CommCtrl, TypInfo, SysUtils, DFSKb;
  439.  
  440.  
  441. const
  442.   KEY_CODE: array[sptCapsLock..sptScrollLock] of integer = (
  443.      VK_CAPITAL, VK_NUMLOCK, VK_SCROLL
  444.     );
  445.  
  446. var
  447.   KeyboardHookHandle: HHOOK;
  448.   KeyHookClients: TList;
  449.   RegisteredTimers: integer;
  450.   MayNeedRefresh: boolean;
  451.  
  452. // Keyboard hook callback
  453. function KeyboardHookCallBack(Code: integer; KeyCode: WPARAM;
  454.    KeyInfo: LPARAM): LRESULT; stdcall;
  455. var
  456.   x: integer;
  457. begin
  458.   if Code >= 0 then
  459.   begin
  460.     if MayNeedRefresh then
  461.     begin
  462.       for x := 0 to KeyHookClients.Count-1 do
  463.         TdfsStatusPanel(KeyHookClients[x]).Invalidate;
  464.       MayNeedRefresh := FALSE;
  465.     end else
  466.     // Is it one of the indicator keys, and is it not a repeat
  467.     if ((KeyCode = VK_CAPITAL) or (KeyCode = VK_NUMLOCK) or
  468.        (KeyCode = VK_SCROLL)) and
  469.        // This checks to see if the key is being pressed (bit 31) and if it was
  470.        // up before (bit 30).  We don't care about key releases or keys that
  471.        // were already down.  That just makes us flicker...
  472.        (((KeyInfo SHR 31) and 1) = 0) and (((KeyInfo SHR 30) and 1) = 0) then
  473.     begin
  474.       for x := 0 to KeyHookClients.Count-1 do
  475.       begin
  476.         case TdfsStatusPanel(KeyHookClients[x]).PanelType of
  477.           sptCapsLock:
  478.             begin
  479.               if KeyCode = VK_CAPITAL then
  480.                 TdfsStatusPanel(KeyHookClients[x]).Invalidate;
  481.             end;
  482.           sptNumLock:
  483.             begin
  484.               if KeyCode = VK_NUMLOCK then
  485.                 TdfsStatusPanel(KeyHookClients[x]).Invalidate;
  486.             end;
  487.           sptScrollLock:
  488.             begin
  489.               if KeyCode = VK_SCROLL then
  490.                 TdfsStatusPanel(KeyHookClients[x]).Invalidate;
  491.             end;
  492.         end;
  493.       end;
  494.     end;
  495.   end;
  496.   Result := CallNextHookEx(KeyboardHookHandle, Code, KeyCode, KeyInfo);
  497. end;
  498.  
  499. // Utility routins for installing the windows hook for keypresses
  500. procedure RegisterTaskKeyboardHook(Client: TdfsStatusPanel);
  501. begin
  502.   if KeyboardHookHandle = 0 then
  503.     KeyboardHookHandle := SetWindowsHookEx(WH_KEYBOARD, KeyboardHookCallBack,
  504.        0, GetCurrentThreadID);
  505.  
  506.   KeyHookClients.Add(Client);
  507. end;
  508.  
  509. procedure DeregisterTaskKeyboardHook(Client: TdfsStatusPanel);
  510. begin
  511.   KeyHookClients.Remove(Client);
  512.   if KeyHookClients.Count < 1 then
  513.   begin
  514.     UnhookWindowsHookEx(KeyboardHookHandle);
  515.     KeyboardHookHandle := 0;
  516.   end;
  517. end;
  518.  
  519. // Utility function for making a copy of a font handle
  520. function CopyHFont(Font: HFONT): HFONT;
  521. var
  522.   LF: TLogFont;
  523. begin
  524.   if Font <> 0 then
  525.   begin
  526.     GetObject(Font, SizeOf(LF), @LF);
  527.     Result := CreateFontIndirect(LF);
  528.   end else
  529.     Result := 0;
  530. end;
  531.  
  532.  
  533. { TdfsGaugeAttrs }
  534.  
  535. procedure TdfsGaugeAttrs.Assign(Source: TPersistent);
  536. var
  537.   SrcAttrs: TdfsGaugeAttrs absolute Source;
  538. begin
  539.   if Source is TdfsGaugeAttrs then
  540.   begin
  541.     FOwner := SrcAttrs.Owner;
  542.     Position := SrcAttrs.Position;
  543.     Style := SrcAttrs.Style;
  544.   end else
  545.     inherited Assign(Source);
  546. end;
  547.  
  548. constructor TdfsGaugeAttrs.Create(AOwner: TdfsStatusPanel);
  549. begin
  550.   inherited Create;
  551.   FOwner := AOwner;
  552.   FStyle := gsPercent;
  553.   FPosition := 0;
  554.   FSpeed := 4;
  555.   FColor := clHighlight;
  556.   FTextColor := clHighlightText;
  557. end;
  558.  
  559. procedure TdfsGaugeAttrs.SetColor(const Value: TColor);
  560. begin
  561.   if FColor <> Value then
  562.   begin
  563.     FColor := Value;
  564.     FOwner.FGaugeBitmap.Free;
  565.     FOwner.FGaugeBitmap := NIL;
  566.     FOwner.Invalidate;
  567.   end;
  568. end;
  569.  
  570. procedure TdfsGaugeAttrs.SetPosition(const Value: TPercent);
  571. begin
  572.   if FPosition <> Value then
  573.   begin
  574.     FPosition := Value;
  575.     FOwner.Invalidate;
  576.   end;
  577. end;
  578.  
  579. procedure TdfsGaugeAttrs.SetSpeed(const Value: integer);
  580. begin
  581.   if (FSpeed <> Value) and (FSpeed > 0) then
  582.     FSpeed := Value;
  583.  
  584.   if Owner.FGaugeDirection < 0 then
  585.     Owner.FGaugeDirection := -FSpeed
  586.   else
  587.     Owner.FGaugeDirection := FSpeed;
  588. end;
  589.  
  590. procedure TdfsGaugeAttrs.SetStyle(const Value: TdfsGaugeStyle);
  591. begin
  592.   if FStyle <> Value then
  593.   begin
  594.     if (Owner.PanelType = sptGauge) and (FStyle in IndeterminateGuages) and
  595.        Owner.Enabled then
  596.       TdfsStatusPanels(Owner.Collection).DeregisterTimer(Owner);
  597.     FStyle := Value;
  598.     FOwner.Invalidate;
  599.     if (Owner.PanelType = sptGauge) and (FStyle in IndeterminateGuages) and
  600.        Owner.Enabled then
  601.       TdfsStatusPanels(Owner.Collection).RegisterTimer(Owner);
  602.   end;
  603. end;
  604.  
  605.  
  606. procedure TdfsGaugeAttrs.SetTextColor(const Value: TColor);
  607. begin
  608.   if Value <> FTextColor then
  609.   begin
  610.     FTextColor := Value;
  611.     Owner.Invalidate;
  612.   end;
  613. end;
  614.  
  615. { TdfsStatusPanel }
  616.  
  617. procedure TdfsStatusPanel.Assign(Source: TPersistent);
  618. var
  619.   SrcPanel: TdfsStatusPanel absolute Source;
  620. begin
  621.   if Source is TdfsStatusPanel then
  622.   begin
  623. {    if LinkedPanel <> NIL then
  624.       LinkedPanel.Free;
  625.     LinkedPanel := SrcPanel.FLinkedPanel;}
  626.  
  627.     GaugeAttrs.Assign(SrcPanel.GaugeAttrs);
  628.     Alignment := SrcPanel.Alignment;
  629.     Bevel := SrcPanel.Bevel;
  630. {$IFDEF DFS_COMPILER_4_UP}
  631.     BiDiMode := SrcPanel.BiDiMode;
  632.     ParentBiDiMode := SrcPanel.ParentBiDiMode;
  633. {$ENDIF}
  634.     Glyph.Assign(SrcPanel.Glyph);
  635.     Text := SrcPanel.Text;
  636.     DateFormat := SrcPanel.DateFormat;
  637.     TimeFormat := SrcPanel.TimeFormat;
  638.     Enabled := SrcPanel.Enabled;
  639.     Width := SrcPanel.Width;
  640.     AutoFit := SrcPanel.AutoFit;
  641.     Hint := SrcPanel.Hint;
  642.  
  643.     OnDrawPanel := SrcPanel.OnDrawPanel;
  644.     OnHintText := SrcPanel.OnHintText;
  645.  
  646.     // Do last!
  647.     PanelType := SrcPanel.PanelType;
  648.   end else
  649.     inherited Assign(Source);
  650. end;
  651.  
  652. constructor TdfsStatusPanel.Create(AOwner: TCollection);
  653. begin
  654.   inherited Create(AOwner);
  655.  
  656.   if AOwner is TdfsStatusPanels then
  657.   begin
  658.     TdfsStatusPanels(AOwner).FLinkedPanels.Add;
  659.     LinkedPanel.Style := psOwnerDraw;
  660.   end else
  661.     raise Exception.Create('TdfsStatusPanel owner must be TdfsStatusPanesls');
  662.   FKeyOn := FALSE;
  663.   FGaugeLastPos := 0;
  664.   FGaugeDirection := 1;
  665.   FPanelType := sptNormal;
  666.   FAutoFit := FALSE;
  667.   FEnabled := TRUE;
  668.   FTimeFormat := '';
  669.   FDateFormat := '';
  670.   FGaugeAttrs := TdfsGaugeAttrs.Create(Self);
  671.   FGlyph := TPicture.Create;
  672.   FGlyph.OnChange := GlyphChanged;
  673. end;
  674.  
  675.  
  676. destructor TdfsStatusPanel.Destroy;
  677. begin
  678.   if Enabled then
  679.     case FPanelType of
  680.       sptCapsLock, sptNumLock, sptScrollLock:
  681.         begin
  682.           if StatusBar.UseMonitorDLL then
  683.             StatusBar.DeregisterSystemHook
  684.           else begin
  685.             DeregisterTaskKeyboardHook(Self);
  686.             StatusBar.DeregisterMainWinHook(Self);
  687.           end;
  688.         end;
  689.       sptDate, sptTime, sptDateTime, sptTimeDate:
  690.         TdfsStatusPanels(Collection).DeregisterTimer(Self);
  691.       sptGauge:
  692.         if GaugeAttrs.Style in IndeterminateGuages then
  693.           TdfsStatusPanels(Collection).DeregisterTimer(Self);
  694.     end;
  695.  
  696.   FGlyph.Free;
  697.   FGaugeAttrs.Free;
  698.   FGaugeBitmap.Free;
  699.   TdfsStatusPanels(Collection).FLinkedPanels[Index].Free;
  700.  
  701.   inherited Destroy;
  702. end;
  703.  
  704.  
  705. function TdfsStatusPanel.GetAlignment: TAlignment;
  706. begin
  707.   Result := LinkedPanel.Alignment
  708. end;
  709.  
  710. function TdfsStatusPanel.GetBevel: TStatusPanelBevel;
  711. begin
  712.   Result := LinkedPanel.Bevel
  713. end;
  714.  
  715. {$IFDEF DFS_COMPILER_4_UP}
  716. function TdfsStatusPanel.GetBiDiMode: TBiDiMode;
  717. begin
  718.   Result := LinkedPanel.BiDiMode
  719. end;
  720.  
  721. function TdfsStatusPanel.GetParentBiDiMode: Boolean;
  722. begin
  723.   Result := LinkedPanel.ParentBiDiMode
  724. end;
  725. {$ENDIF}
  726.  
  727. function TdfsStatusPanel.GetStatusBar: TdfsStatusBar;
  728. begin
  729.   Result := TdfsStatusPanels(Collection).FStatusBar;
  730. end;
  731.  
  732. function TdfsStatusPanel.GetWidth: Integer;
  733. begin
  734.   Result := LinkedPanel.Width
  735. end;
  736.  
  737. procedure TdfsStatusPanel.Invalidate;
  738. begin
  739.   if StatusBar <> NIL then
  740.     StatusBar.InvalidatePanel(Index);
  741. end;
  742.  
  743. {$IFDEF DFS_COMPILER_4_UP}
  744. function TdfsStatusPanel.IsBiDiModeStored: Boolean;
  745. begin
  746.   Result := not ParentBiDiMode;
  747. end;
  748. {$ENDIF}
  749.  
  750. procedure TdfsStatusPanel.Redraw(Canvas: TCanvas; Dest: TRect);
  751. var
  752.   Buffer: TBitmap;
  753.   R: TRect;
  754. begin
  755.   if (not StatusBar.HandleAllocated) or (IsRectEmpty(Dest))then
  756.     exit;
  757.  
  758.   InflateRect(Dest, -1, -1); // Don't paint over the shadows.
  759.  
  760.   R := Dest;
  761.   OffsetRect(R, -Dest.Left, -Dest.Top);
  762.   Buffer := TBitmap.Create;
  763.   try
  764.     Buffer.Width := R.Right;
  765.     Buffer.Height := R.Bottom;
  766.  
  767.     Buffer.Canvas.Font.Handle := CopyHFont(Canvas.Font.Handle);
  768.     Buffer.Canvas.Brush.Color := StatusBar.Color;
  769.     Buffer.Canvas.FillRect(R);
  770.  
  771.     if BorderWidth > 0 then
  772.       InflateRect(R, -BorderWidth, -BorderWidth);
  773.  
  774.     if Enabled then
  775.     begin
  776.       case PanelType of
  777.         sptCapsLock, sptNumLock, sptScrollLock:
  778.           DrawKeyLock(Buffer.Canvas, R);
  779.  
  780.         sptNormal, sptDate, sptTime, sptDateTime, sptTimeDate, sptEllipsisText,
  781.         sptEllipsisPath, sptOwnerDraw:
  782.           begin
  783.             if (PanelType = sptOwnerDraw) and
  784.                not (csDesigning in StatusBar.ComponentState) then
  785.               exit;
  786.             DrawTextBased(Buffer.Canvas, R);
  787.           end;
  788.  
  789.           sptGlyph:
  790.             DrawGlyph(Buffer.Canvas, R);
  791.  
  792.           sptGauge:
  793.             if GaugeAttrs.Style in IndeterminateGuages then
  794.               DrawIndeterminateGauge(Buffer.Canvas, R)
  795.             else
  796.               DrawGauge(Buffer.Canvas, R);
  797.       end;
  798.     end;
  799.  
  800.     Canvas.Draw(Dest.Left, Dest.Top, Buffer);
  801.   finally
  802.     Buffer.Free;
  803.   end;
  804. end;
  805.  
  806. procedure TdfsStatusPanel.DrawGauge(Canvas: TCanvas; R: TRect);
  807. var
  808.   R1, R2: TRect;
  809.   R1Rgn, R2Rgn, OldRgn: HRGN;
  810.   Pct: string;
  811.   OldColor: TColorRef;
  812.   DTFlags: UINT;
  813. begin
  814.   R1 := R;
  815.   R2 := R;
  816.   R1.Right := R1.Left + MulDiv(R.Right-R.Left, FGaugeAttrs.Position, 100);
  817.   with Canvas do
  818.   begin
  819.     Brush.Color := GaugeAttrs.Color;
  820.     FillRect(R1);
  821.     R2.Left := R1.Right;
  822.     Brush.Color := StatusBar.Color;
  823.     FillRect(R2);
  824.  
  825.     { This could probably be simplified with ExtTextOut and SetTextAlign now
  826.       things are being properly buffered off-screen.  But, this is working and
  827.       doesn't seem slow, so....  "If it ain't broke, don't fix it."  :)        }
  828.     if Text = '' then
  829.       Pct := IntToStr(FGaugeAttrs.Position) + '%'
  830.     else
  831.       Pct := Text; // Use what's in the panel's text property.
  832.     // don't change background color behind text!
  833.     Brush.Style := bsClear;
  834.     OldColor := GetTextColor(Handle);
  835.  
  836.     R1Rgn := CreateRectRgnIndirect(R1);
  837.     R2Rgn := CreateRectRgnIndirect(R2);
  838.     OldRgn := CreateRectRgn(0, 0, 1, 1);
  839.     try
  840.       GetClipRgn(Handle, OldRgn);
  841.  
  842.       DTFlags := DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE;
  843.       case Alignment of
  844.         taCenter:       DTFlags := DTFlags or DT_CENTER;
  845.         taRightJustify: DTFlags := DTFlags or DT_RIGHT;
  846.       end;
  847.       // Draw the text in the "filled" area with text color
  848.       if (R1Rgn<>0) and (SelectClipRgn(Handle, R1Rgn) <> ERROR) then
  849.         try
  850.           SetTextColor(Handle, ColorToRGB(GaugeAttrs.TextColor));
  851.           DrawText(Handle, PChar(Pct), -1, R, DTFlags);
  852.         finally
  853.           SelectClipRgn(Handle, OldRgn);
  854.         end;
  855.  
  856.       // Draw the text in the "empty" area with normal color
  857.       if (R2Rgn<>0) and (SelectClipRgn(Handle, R2Rgn) <> ERROR) then
  858.         try
  859. //          SetTextColor(Handle, OldColor);
  860.           SetTextColor(Handle, ColorToRGB(StatusBar.Font.Color));
  861.           DrawText(Handle, PChar(Pct), -1, R, DTFlags);
  862.         finally
  863.           SelectClipRgn(Handle, OldRgn);
  864.         end;
  865.     finally
  866.       SetTextColor(Handle, OldColor);
  867.       DeleteObject(R1Rgn);
  868.       DeleteObject(R2Rgn);
  869.       DeleteObject(OldRgn);
  870.     end;
  871.   end;
  872. end;
  873.  
  874. procedure TdfsStatusPanel.DrawGlyph(Canvas: TCanvas; R: TRect);
  875. const
  876.   TEXT_SPACE = 2;
  877. var
  878.   TW: integer;
  879.   GR: TRect;
  880. begin
  881.   GR := R;
  882.   if Text <> '' then
  883.     TW := Canvas.TextWidth(Text) + TEXT_SPACE
  884.   else
  885.     TW := 0;
  886.   if (Alignment = taCenter) or AutoFit then
  887.      with GR do
  888.        Left := Left + ((Right - Left - Glyph.Width - TW) div 2)
  889.   else if Alignment = taRightJustify then
  890.     GR.Left := GR.Right - Glyph.Width;
  891.  
  892.   GR.Top := GR.Top + (GR.Bottom - GR.Top - Glyph.Height) div 2;
  893.  
  894.   if Glyph.Graphic is TBitmap then
  895.   begin
  896.     // Draw it transparently
  897.     Canvas.BrushCopy(Bounds(GR.Left, GR.Top, Glyph.Width,
  898.        Glyph.Height), Glyph.Bitmap, Rect(0, 0, Glyph.Width,
  899.        Glyph.Height), Glyph.Bitmap.Canvas.Pixels[0, Glyph.Height-1]);
  900.   end else
  901.     Canvas.Draw(GR.Left, GR.Top, Glyph.Graphic);
  902.   if Text <> '' then
  903.   begin
  904.     SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  905.     case Alignment of
  906.       taLeftJustify,
  907.       taCenter:
  908.         begin
  909.           GR.Left := GR.Left + Glyph.Width + TEXT_SPACE;
  910.           GR.Top := R.Top;
  911.           GR.Bottom := R.Bottom;
  912.           DrawText(Canvas.Handle, PChar(Text), -1, GR, DT_SINGLELINE or
  913.             DT_NOPREFIX or DT_VCENTER);
  914.         end;
  915.       taRightJustify:
  916.         begin
  917.           GR.Left := GR.Left - TW - TEXT_SPACE;
  918.           GR.Top := R.Top;
  919.           GR.Bottom := R.Bottom;
  920.           DrawText(Canvas.Handle, PChar(Text), -1, GR, DT_SINGLELINE or
  921.             DT_NOPREFIX or DT_VCENTER);
  922.         end;
  923.     end;
  924.   end;
  925. end;
  926.  
  927. function TdfsStatusPanel.InitGaugeBitmap: TBitmap;
  928. var
  929.     r1, b1, g1, r2, b2, g2: byte;
  930.     c1, c2: Longint;
  931.   i: integer;
  932.     divi: integer;
  933.     mul: extended;
  934. begin
  935.     c1 := ColorToRGB(StatusBar.Color);
  936.     c2 := ColorToRGB(GaugeAttrs.Color);
  937.     r1 := GetRValue(c1);
  938.   b1 := GetBValue(c1);
  939.   g1 := GetGValue(c1);
  940.     r2 := GetRValue(c2);
  941.   b2 := GetBValue(c2);
  942.   g2 := GetGValue(c2);
  943.     Result := TBitmap.Create;
  944.     with Result do
  945.     begin
  946.         Height := StatusBar.Height;
  947.         Width := 100;
  948.         divi := Width-1;
  949.         Canvas.Brush.Color := clRed;
  950.         Canvas.FillRect(Rect(0, 0, Width, Height));
  951.         for i := 0 to divi do
  952.         begin
  953.             mul := (i/divi);
  954.             Canvas.Pen.Color := RGB(trunc(r1 + (r2 - r1) * mul),
  955.          trunc(g1 + (g2 - g1) *mul), trunc(b1 + (b2 - b1) * mul));
  956.             Canvas.MoveTo(i, 0);
  957.             Canvas.LineTo(i, Height);
  958.         end;
  959.     end;
  960. end;
  961.  
  962. procedure TdfsStatusPanel.DrawIndeterminateGauge(Canvas: TCanvas; R: TRect);
  963. var
  964.     gb:TBitmap;
  965.     gbr:TRect;
  966.   x: integer;
  967. begin
  968.   inc(FGaugeLastPos, FGaugeDirection);
  969.   case GaugeAttrs.Style of
  970.     gsIndeterminate:
  971.       begin
  972.         with Canvas do
  973.         begin
  974.           Brush.Color := GaugeAttrs.Color;
  975.           Pen.Color := GaugeAttrs.Color;
  976.           gbr := R;
  977.           InflateRect(R, 0, -((R.Bottom - R.Top) div 3));
  978.           x := R.Bottom - R.Top;
  979.           if (FGaugeDirection > 0) and ((FGaugeLastPos + X + 1) >=
  980.              (R.Right - R.Left)) then
  981.           begin
  982.             FGaugeDirection := -GaugeAttrs.Speed;
  983.           end else if (FGaugeDirection < 0) and (FGaugeLastPos <= 1) then
  984.           begin
  985.             FGaugeDirection := GaugeAttrs.Speed;
  986.           end;
  987.           Inc(R.Left, FGaugeLastPos);
  988.           R.Right := R.Left + X;
  989.           // Make it a wee bit bigger
  990.           InflateRect(R, 1, 1);
  991.  
  992.           with R do
  993.             Ellipse(Left, Top, Right, Bottom);
  994.         end;
  995.       end;
  996.  
  997.     gsIndeterminate2:
  998.       begin
  999.         with Canvas do
  1000.         begin
  1001.           gb := GaugeBitmap;
  1002.           if (FGaugeDirection > 0) and
  1003.              ((FGaugeLastPos+ 1) >= (R.Right - R.Left)) then
  1004.             FGaugeDirection := -FGaugeAttrs.Speed
  1005.           else if (FGaugeDirection < 0) and (FGaugeLastPos <= -gb.Width) then
  1006.             FGaugeDirection := FGaugeAttrs.Speed;
  1007.           Inc(R.Left, FGaugeLastPos);
  1008.           gbr := Rect(0, 0, gb.Width, gb.Height);
  1009.           if (r.right - r.left) > gb.width then
  1010.             r.right := r.left + gb.Width
  1011.           else
  1012.             if (r.right - r.left) < gb.width then
  1013.             begin
  1014.               if FGaugeDirection > 0 then
  1015.                 gbr.Right := r.right - r.Left
  1016.               else
  1017.                 gbr.Left := gbr.right - (r.right - r.left);
  1018.             end;
  1019.  
  1020.           if FGaugeDirection > 0 then
  1021.             CopyRect(r, gb.Canvas, gbr)
  1022.           else
  1023.             CopyRect(r, gb.Canvas,
  1024.                Rect(gbr.right-1, gbr.Bottom-1, gbr.left-1, gbr.top-1))
  1025.         end;
  1026.       end;
  1027.   end;
  1028. end;
  1029.  
  1030. procedure TdfsStatusPanel.DrawKeyLock(Canvas: TCanvas; R: TRect);
  1031. var
  1032.   DTFlags: UINT;
  1033.   OldColor: TColorRef;
  1034. begin
  1035.   OldColor := GetTextColor(Canvas.Handle);
  1036.   if StatusBar.UseMonitorDLL then
  1037.   begin
  1038.     if not FKeyOn then
  1039.       SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)) // might need to be a property
  1040.     else
  1041.       SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  1042.   end else begin
  1043.     if not Odd(GetKeyState(KEY_CODE[FPanelType])) then
  1044.       SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)) // might need to be a property
  1045.     else
  1046.       SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  1047.   end;
  1048.   DTFlags := DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER;
  1049.   if AutoFit then
  1050.     DTFLags := DTFlags or DT_CENTER
  1051.   else
  1052.     case Alignment of
  1053.       taCenter:       DTFlags := DTFlags or DT_CENTER;
  1054.       taRightJustify: DTFlags := DTFlags or DT_RIGHT;
  1055.     end;
  1056.   DrawText(Canvas.Handle, PChar(Text), -1, R, DTFlags);
  1057.   SetTextColor(Canvas.Handle, OldColor);
  1058. end;
  1059.  
  1060. procedure TdfsStatusPanel.DrawTextBased(Canvas: TCanvas; R: TRect);
  1061. var
  1062.   DTFlags: UINT;
  1063. begin
  1064.   DTFlags := DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER;
  1065.   if AutoFit then
  1066.     DTFLags := DTFlags or DT_CENTER
  1067.   else
  1068.     case Alignment of
  1069.       taCenter:       DTFlags := DTFlags or DT_CENTER;
  1070.       taRightJustify:
  1071.         begin
  1072.           dec(R.Right);
  1073.           DTFlags := DTFlags or DT_RIGHT;
  1074.         end;
  1075.     end;
  1076.   case PanelType of
  1077.     sptEllipsisPath: DTFlags := DTFlags or DT_PATH_ELLIPSIS;
  1078.     sptEllipsisText: DTFlags := DTFlags or DT_END_ELLIPSIS;
  1079.   end;
  1080.   SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  1081.   if PanelType = sptOwnerDraw then
  1082.     // This only happens when in design mode, see Redraw method.
  1083.     DrawText(Canvas.Handle, ' *OD* ', -1, R, DTFlags)
  1084.   else
  1085.     DrawText(Canvas.Handle, PChar(Text), -1, R, DTFlags);
  1086. end;
  1087.  
  1088. procedure TdfsStatusPanel.SetAlignment(const Value: TAlignment);
  1089. begin
  1090.   if LinkedPanel.Alignment <> Value then
  1091.   begin
  1092.     LinkedPanel.Alignment := Value;
  1093.     Invalidate;
  1094.   end;
  1095. end;
  1096.  
  1097. procedure TdfsStatusPanel.SetAutoFit(const Value: boolean);
  1098. begin
  1099.   if FAutoFit <> Value then
  1100.   begin
  1101.     FAutoFit := Value;
  1102.     UpdateAutoFitWidth;
  1103.   end;
  1104. end;
  1105.  
  1106. procedure TdfsStatusPanel.SetBevel(const Value: TStatusPanelBevel);
  1107. begin
  1108.   if LinkedPanel.Bevel <> Value then
  1109.     LinkedPanel.Bevel := Value;
  1110. end;
  1111.  
  1112. {$IFDEF DFS_COMPILER_4_UP}
  1113. procedure TdfsStatusPanel.SetBiDiMode(const Value: TBiDiMode);
  1114. begin
  1115.   if LinkedPanel.BiDiMode <> Value then
  1116.     LinkedPanel.BiDiMode := Value;
  1117. end;
  1118.  
  1119. procedure TdfsStatusPanel.SetParentBiDiMode(const Value: Boolean);
  1120. begin
  1121.   if LinkedPanel.ParentBiDiMode <> Value then
  1122.     LinkedPanel.ParentBiDiMode := Value;
  1123. end;
  1124.  
  1125. {$ENDIF}
  1126.  
  1127. procedure TdfsStatusPanel.SetDateFormat(const Value: string);
  1128. begin
  1129.   if FDateFormat <> Value then
  1130.   begin
  1131.     FDateFormat := Value;
  1132.     UpdateDateTime;
  1133.   end;
  1134. end;
  1135.  
  1136. procedure TdfsStatusPanel.SetEnabled(const Value: boolean);
  1137. begin
  1138.   if FEnabled <> Value then
  1139.   begin
  1140.     FEnabled := Value;
  1141.     EnabledChanged;
  1142.   end;
  1143. end;
  1144.  
  1145. procedure TdfsStatusPanel.SetGlyph(const Value: TPicture);
  1146. begin
  1147.   FGlyph.Assign(Value);
  1148.   // GlyphChanged method will take care of updating display.
  1149. end;
  1150.  
  1151. procedure TdfsStatusPanel.SetPanelType(const Val: TdfsStatusPanelType);
  1152. const
  1153.   LOCK_TEXT: array[sptCapsLock..sptScrollLock] of string = (
  1154.      SCapsLock, SNumLock, SScrollLock
  1155.     );
  1156. begin
  1157.   if Val <> FPanelType then
  1158.   begin
  1159.     if Enabled then
  1160.       case FPanelType of
  1161.         sptCapsLock, sptNumLock, sptScrollLock:
  1162.           begin
  1163.             if StatusBar.UseMonitorDLL then
  1164.               StatusBar.DeregisterSystemHook
  1165.             else begin
  1166.               DeregisterTaskKeyboardHook(Self);
  1167.               StatusBar.DeregisterMainWinHook(Self);
  1168.             end;
  1169.           end;
  1170.         sptDate, sptTime, sptDateTime, sptTimeDate:
  1171.           TdfsStatusPanels(Collection).DeregisterTimer(Self);
  1172.         sptGauge:
  1173.           if GaugeAttrs.Style in IndeterminateGuages then
  1174.             TdfsStatusPanels(Collection).DeregisterTimer(Self);
  1175.       end;
  1176.  
  1177.     FPanelType := Val;
  1178.     case FPanelType of
  1179.       sptCapsLock, sptNumLock, sptScrollLock:
  1180.         begin
  1181.           Text := LOCK_TEXT[FPanelType];
  1182.           AutoFit := TRUE;
  1183.           if Enabled then
  1184.           begin
  1185.             if StatusBar.UseMonitorDLL then
  1186.             begin
  1187.               StatusBar.RegisterSystemHook;
  1188.               FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType]));
  1189.             end else begin
  1190.               RegisterTaskKeyboardHook(Self);
  1191.               StatusBar.RegisterMainWinHook(Self);
  1192.             end;
  1193.           end;
  1194.         end;
  1195.       sptDate, sptTime, sptDateTime, sptTimeDate:
  1196.         begin
  1197.           AutoFit := FALSE;
  1198.           if Enabled then
  1199.             TdfsStatusPanels(Collection).RegisterTimer(Self);
  1200.           UpdateDateTime;
  1201.         end;
  1202.       sptEllipsisText, sptEllipsisPath:
  1203.         begin
  1204.           AutoFit := FALSE;
  1205.           if Hint = '' then
  1206.             Hint := '...'; 
  1207.         end;
  1208.       sptGlyph:
  1209.         begin
  1210.           AutoFit := TRUE;
  1211.         end;
  1212.       sptGauge:
  1213.         begin
  1214.           AutoFit := FALSE;
  1215.           Alignment := taCenter;
  1216.           if GaugeAttrs.Style in IndeterminateGuages then
  1217.           begin
  1218.             Enabled := FALSE; // Enabled is false, so don't need to register
  1219.             FGaugeLastPos := 0;
  1220.             FGaugeDirection := GaugeAttrs.Speed;
  1221.           end;
  1222.         end;
  1223.     else
  1224.       AutoFit := FALSE;
  1225.     end;
  1226.     
  1227.     Invalidate;
  1228.   end;
  1229. end;
  1230.  
  1231.  
  1232. procedure TdfsStatusPanel.SetText(const Value: string);
  1233. begin
  1234. //outputdebugstring(Pchar(value));
  1235.   if FText <> Value then
  1236.   begin
  1237. //outputdebugstring(Pchar(ftext));
  1238.     FText := Value;
  1239. //outputdebugstring(Pchar(ftext));
  1240.     Invalidate;
  1241.     UpdateAutoFitWidth;
  1242.   end;
  1243. end;
  1244.  
  1245. procedure TdfsStatusPanel.SetTimeFormat(const Value: string);
  1246. begin
  1247.   if FTimeFormat <> Value then
  1248.   begin
  1249.     FTimeFormat := Value;
  1250.     UpdateDateTime;
  1251.   end;
  1252. end;
  1253.  
  1254. procedure TdfsStatusPanel.SetWidth(const Value: Integer);
  1255. begin
  1256.   if ((not FAutoFit) or (csLoading in StatusBar.ComponentState)) and
  1257.      (LinkedPanel.Width <> Value) then
  1258.     LinkedPanel.Width := Value;
  1259.   if (PanelType = sptGauge) and (GaugeAttrs.Style in IndeterminateGuages) then
  1260.   begin
  1261.     FGaugeLastPos := 0;
  1262.     FGaugeDirection := GaugeAttrs.Speed;
  1263.     Invalidate;
  1264.   end;
  1265. end;
  1266.  
  1267. procedure TdfsStatusPanel.TimerNotification;
  1268. begin
  1269.   if PanelType in [sptDate, sptTime, sptDateTime, sptTimeDate] then
  1270.     UpdateDateTime
  1271.   else if (PanelType = sptGauge) and (GaugeAttrs.Style in IndeterminateGuages) then
  1272.     // Call Redraw directly. It will take care of erasing the old part.  If we
  1273.     // used Invalidate, the background would get erased, too, and it would
  1274.     // flicker a lot.
  1275.     Redraw(StatusBar.Canvas, StatusBar.GetPanelRect(Index));
  1276. end;
  1277.  
  1278. procedure TdfsStatusPanel.UpdateAutoFitWidth;
  1279. begin
  1280.   if FAutoFit and (StatusBar <> NIL) and (StatusBar.HandleAllocated) then
  1281.   begin
  1282.     if PanelType = sptGlyph then
  1283.     begin
  1284.       if Text = '' then
  1285.         LinkedPanel.Width := BorderWidth + Glyph.Width + 4
  1286.       else
  1287.         LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 2 +
  1288.           (BorderWidth * 2) + Glyph.Width + 4;
  1289.     end
  1290.     else
  1291.       LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 6 + BorderWidth;
  1292.   end;
  1293.   Invalidate;
  1294. end;
  1295.  
  1296. procedure TdfsStatusPanel.UpdateDateTime;
  1297. var
  1298.   Fmt: string;
  1299.   Txt: string;
  1300. begin
  1301.   case PanelType of
  1302.     sptDate:
  1303.       if DateFormat = '' then
  1304.         Fmt := ShortDateFormat
  1305.       else
  1306.         Fmt := DateFormat;
  1307.     sptTime:
  1308.       if TimeFormat = '' then
  1309.         Fmt := LongTimeFormat
  1310.       else
  1311.         Fmt := TimeFormat;
  1312.     sptDateTime:
  1313.       begin
  1314.         if DateFormat = '' then
  1315.           Fmt := ShortDateFormat
  1316.         else
  1317.           Fmt := DateFormat;
  1318.         if TimeFormat = '' then
  1319.           Fmt := Fmt + ' ' + LongTimeFormat
  1320.         else
  1321.           Fmt := Fmt + ' ' + TimeFormat;
  1322.       end;
  1323.     sptTimeDate:
  1324.       begin
  1325.         if TimeFormat = '' then
  1326.           Fmt := LongTimeFormat
  1327.         else
  1328.           Fmt := TimeFormat;
  1329.         if DateFormat = '' then
  1330.           Fmt := Fmt + ' ' + ShortDateFormat
  1331.         else
  1332.           Fmt := Fmt + ' ' + DateFormat;
  1333.       end;
  1334.   end;
  1335.   Txt := FormatDateTime(Fmt, Now);
  1336.   if Txt <> Text then
  1337.   begin
  1338.     Text := Txt;
  1339.     //    Invalidate(TRUE);
  1340.     Redraw(Statusbar.Canvas, StatusBar.GetPanelRect(Index));
  1341.   end;
  1342. end;
  1343.  
  1344. procedure TdfsStatusPanel.GlyphChanged(Sender: TObject);
  1345. begin
  1346.   if PanelType = sptGlyph then
  1347.   begin
  1348.     Invalidate;
  1349.     UpdateAutoFitWidth;
  1350.   end;
  1351. end;
  1352.  
  1353.  
  1354. procedure TdfsStatusPanel.DrawPanel(Rect: TRect);
  1355. begin
  1356.   if (csDesigning in StatusBar.ComponentState) or (Addr(OnDrawPanel) = NIL) or
  1357.      (PanelType <> sptOwnerDraw) then
  1358.     Redraw(StatusBar.Canvas, StatusBar.GetPanelRect(Index))
  1359.   else if assigned(FOnDrawPanel) then
  1360.     FOnDrawPanel(StatusBar, Self, Rect);
  1361. end;
  1362.  
  1363.  
  1364. function TdfsStatusPanel.GetEnabled: boolean;
  1365. begin
  1366.   if csWriting in StatusBar.ComponentState then
  1367.     Result := FEnabled
  1368.   else
  1369.     Result := FEnabled and StatusBar.Enabled;
  1370. end;
  1371.  
  1372. procedure TdfsStatusPanel.EnabledChanged;
  1373. begin
  1374.   // Enabled property (self or parent) changed, update register/deregister calls
  1375.   if Enabled then
  1376.   begin
  1377.     case FPanelType of
  1378.       sptCapsLock, sptNumLock, sptScrollLock:
  1379.         begin
  1380.           if StatusBar.UseMonitorDLL then
  1381.           begin
  1382.             StatusBar.RegisterSystemHook;
  1383.             FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType]));
  1384.           end else begin
  1385.             RegisterTaskKeyboardHook(Self);
  1386.             StatusBar.RegisterMainWinHook(Self);
  1387.           end;
  1388.         end;
  1389.       sptDate, sptTime, sptDateTime, sptTimeDate:
  1390.         TdfsStatusPanels(Collection).RegisterTimer(Self);
  1391.       sptGauge:
  1392.         if GaugeAttrs.Style in IndeterminateGuages then
  1393.           TdfsStatusPanels(Collection).RegisterTimer(Self);
  1394.     end;
  1395.   end else begin
  1396.     case FPanelType of
  1397.       sptCapsLock, sptNumLock, sptScrollLock:
  1398.         begin
  1399.           if StatusBar.UseMonitorDLL then
  1400.             StatusBar.DeregisterSystemHook
  1401.           else begin
  1402.             DeregisterTaskKeyboardHook(Self);
  1403.             StatusBar.DeregisterMainWinHook(Self);
  1404.           end;
  1405.         end;
  1406.       sptDate, sptTime, sptDateTime, sptTimeDate:
  1407.         TdfsStatusPanels(Collection).DeregisterTimer(Self);
  1408.       sptGauge:
  1409.         if GaugeAttrs.Style in IndeterminateGuages then
  1410.           TdfsStatusPanels(Collection).DeregisterTimer(Self);
  1411.     end;
  1412.   end;
  1413.  
  1414.   Invalidate;
  1415.   if not Enabled then
  1416.   begin
  1417.     FGaugeLastPos := 0;
  1418.     FGaugeDirection := GaugeAttrs.Speed;
  1419.   end;
  1420. end;
  1421.  
  1422.  
  1423. function TdfsStatusPanel.GetHint: string;
  1424. begin
  1425.   if (not (csDesigning in StatusBar.ComponentState)) and
  1426.      (PanelType in [sptEllipsisText, sptEllipsisPath]) and (FHint = '...') then
  1427.     Result := Text
  1428.   else
  1429.     Result := FHint;
  1430.   DoHintText(Result);
  1431. end;
  1432.  
  1433. procedure TdfsStatusPanel.DoHintText(var HintText: string);
  1434. begin
  1435.   if assigned(FOnHintText) then
  1436.     FOnHintText(StatusBar, Self, HintText);
  1437. end;
  1438.  
  1439. procedure TdfsStatusPanel.SetGaugeAttrs(const Value: TdfsGaugeAttrs);
  1440. begin
  1441.   FGaugeAttrs := Value;
  1442. end;
  1443.  
  1444. function TdfsStatusPanel.GetDisplayName: string;
  1445. begin
  1446.   case PanelType of
  1447.     sptNormal, sptEllipsisText, sptEllipsisPath:
  1448.       Result := Text;
  1449.   else
  1450.     Result := GetEnumName(TypeInfo(TdfsStatusPanelType), ord(PanelType));
  1451.   end;
  1452.  
  1453.   if Result = '' then
  1454.     Result := inherited GetDisplayName;
  1455. end;
  1456.  
  1457. procedure TdfsStatusPanel.SetIndex(Value: integer);
  1458. var
  1459.   CurIndex: Integer;
  1460. begin
  1461.   CurIndex := Index;
  1462.   if (CurIndex >= 0) and (CurIndex <> Value) then
  1463.   begin
  1464.     TdfsStatusPanels(Collection).FLinkedPanels[CurIndex].Index := Value;
  1465.     inherited SetIndex(Value);
  1466.   end;
  1467. end;
  1468.  
  1469. function TdfsStatusPanel.GetLinkedPanel: TStatusPanel;
  1470. begin
  1471.   Result := TdfsStatusPanels(Collection).FLinkedPanels[Index];
  1472. end;
  1473.  
  1474.  
  1475. procedure TdfsStatusPanel.UpdateKeyboardHook;
  1476. begin
  1477.   if PanelType in [sptCapsLock, sptNumLock, sptScrollLock] then
  1478.   begin
  1479.     if StatusBar.UseMonitorDLL and Enabled then
  1480.     begin
  1481.       DeregisterTaskKeyboardHook(Self);
  1482.       StatusBar.DeregisterMainWinHook(Self);
  1483.       StatusBar.RegisterSystemHook;
  1484.       FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType]));
  1485.     end else if (not StatusBar.UseMonitorDLL) and Enabled then
  1486.     begin
  1487.       StatusBar.DeregisterSystemHook;
  1488.       RegisterTaskKeyboardHook(Self);
  1489.       StatusBar.RegisterMainWinHook(Self);
  1490.     end;
  1491.   end;
  1492. end;
  1493.  
  1494. procedure TdfsStatusPanel.Click;
  1495. begin
  1496.   if assigned(FOnClick) then
  1497.     FOnClick(Self);
  1498. end;
  1499.  
  1500. function TdfsStatusPanel.GetGaugeBitmap: TBitmap;
  1501. begin
  1502.   if FGaugeBitmap = NIL then
  1503.     FGaugeBitmap := InitGaugeBitmap;
  1504.   Result := FGaugeBitmap;
  1505. end;
  1506.  
  1507. procedure TdfsStatusPanel.SetBorderWidth(const Value: TBorderWidth);
  1508. begin
  1509.   if FBorderWidth <> Value then
  1510.   begin
  1511.     FBorderWidth := Value;
  1512.     UpdateAutoFitWidth;
  1513.     Invalidate;
  1514.   end;
  1515. end;
  1516.  
  1517. function TdfsStatusPanel.IsTextStored: Boolean;
  1518. begin
  1519.   Result := not (PanelType in [sptDate, sptTime, sptDateTime, sptTimeDate]);
  1520. end;
  1521.  
  1522. { TdfsStatusPanels }
  1523.  
  1524. function TdfsStatusPanels.Add: TdfsStatusPanel;
  1525. begin
  1526.   Result := TdfsStatusPanel(inherited Add);
  1527. end;
  1528.  
  1529. constructor TdfsStatusPanels.Create(StatusBar: TdfsStatusBar;
  1530.    LinkedPanels: TStatusPanels);
  1531. begin
  1532.   FStatusBar := StatusBar;
  1533.   FLinkedPanels := LinkedPanels;
  1534.   FTimer := NIL;
  1535.   FTimerClients := TList.Create;
  1536.  
  1537.   inherited Create(TdfsStatusPanel);
  1538. end;
  1539.  
  1540. procedure TdfsStatusPanels.DeregisterTimer(Client: TdfsStatusPanel);
  1541. var
  1542.   x: integer;
  1543.   NewTimerRes: integer;
  1544. begin
  1545.   if FTimerClients.Remove(Client) <> -1 then
  1546.     dec(RegisteredTimers);
  1547.   if FTimerClients.Count < 1 then
  1548.   begin
  1549.     FTimer.Free;
  1550.     FTimer := NIL;
  1551.   end else begin
  1552.     NewTimerRes := 60000; // Least impact we can manage easily
  1553.     for x := 0 to FTimerClients.Count-1 do
  1554.       case TdfsStatusPanel(FTimerClients[x]).PanelType of
  1555.         sptTime, sptDateTime, sptTimeDate:
  1556.           NewTimerRes := 1000;
  1557.         sptGauge:
  1558.           if TdfsStatusPanel(FTimerClients[x]).GaugeAttrs.Style in
  1559.              IndeterminateGuages then begin
  1560.             NewTimerRes := INDETERMINATE_GAUGE_UPDATE_INTERVAL;
  1561.             break;
  1562.           end;
  1563.       end;
  1564.  
  1565.     FTimer.Interval := NewTimerRes;
  1566.   end;
  1567. end;
  1568.  
  1569. destructor TdfsStatusPanels.Destroy;
  1570. begin
  1571.   // Call inherited first because it causes children to be destroyed, and that
  1572.   // might cause FTimerClients to be needed.
  1573.   inherited Destroy;
  1574.  
  1575.   FTimer.Free;
  1576.   FTimer := NIL;
  1577.   FTimerClients.Free;
  1578.   FTimerClients := NIL; // Yes, there is a reason for this!
  1579. end;
  1580.  
  1581. function TdfsStatusPanels.GetItem(Index: Integer): TdfsStatusPanel;
  1582. begin
  1583.   Result := TdfsStatusPanel(inherited GetItem(Index));
  1584. end;
  1585.  
  1586. function TdfsStatusPanels.GetOwner: TPersistent;
  1587. begin
  1588.   Result := FStatusBar;
  1589. end;
  1590.  
  1591. procedure TdfsStatusPanels.RegisterTimer(Client: TdfsStatusPanel);
  1592. var
  1593.   FirstClient: boolean;
  1594. begin
  1595.   if FTimer = NIL then
  1596.   begin
  1597.     FTimer := TTimer.Create(FStatusBar);
  1598.     FLastDate := Date;
  1599.     FTimer.OnTimer := TimerEvent;
  1600.   end;
  1601.   if FTimerClients.IndexOf(Client) >= 0 then
  1602.     exit;  // We're already in the list!
  1603.     
  1604.   FTimerClients.Add(Client);
  1605.   inc(RegisteredTimers);
  1606.   FirstClient := FTimerClients.Count = 1;
  1607.   case Client.PanelType of
  1608.     sptDate:
  1609.       if FirstClient then
  1610.         FTimer.Interval := 60000; // Least impact we can manage easily
  1611.     sptTime, sptDateTime, sptTimeDate:
  1612.       if FirstClient or (FTimer.Interval > 1000) then
  1613.         FTimer.Interval := 1000;
  1614.     sptGauge:
  1615.       if Client.GaugeAttrs.Style in IndeterminateGuages then
  1616.         FTimer.Interval := INDETERMINATE_GAUGE_UPDATE_INTERVAL;
  1617.   end;
  1618.   FTimer.Enabled := TRUE;
  1619. end;
  1620.  
  1621. procedure TdfsStatusPanels.SetItem(Index: Integer; Value: TdfsStatusPanel);
  1622. begin
  1623.   // I have no idea if this will work or not....
  1624.   inherited SetItem(Index, Value);
  1625.   FLinkedPanels[Index] := Value.LinkedPanel;
  1626. end;
  1627.  
  1628. procedure TdfsStatusPanels.TimerEvent(Sender: TObject);
  1629. var
  1630.   x: integer;
  1631.   DateUpdate: boolean;
  1632.   Panel: TdfsStatusPanel;
  1633. begin
  1634.   if FLastDate <> Date then
  1635.   begin
  1636.     DateUpdate := TRUE;
  1637.     FLastDate := Date;
  1638.   end else
  1639.     DateUpdate := FALSE;
  1640.  
  1641.   for x := 0 to FTimerClients.Count-1 do
  1642.   begin
  1643.     Panel := TdfsStatusPanel(FTimerClients[x]); // shorthand
  1644.     if (Panel.PanelType in [sptTime, sptDateTime, sptTimeDate]) or
  1645.        (DateUpdate and (Panel.PanelType = sptDate)) or
  1646.        ((Panel.PanelType = sptGauge) and
  1647.        (Panel.GaugeAttrs.Style in IndeterminateGuages)) then
  1648.       TdfsStatusPanel(FTimerClients[x]).TimerNotification;
  1649.   end;
  1650. end;
  1651.  
  1652. procedure TdfsStatusPanels.Update(Item: TCollectionItem);
  1653. begin
  1654.   if Item is TdfsStatusPanel then
  1655.     TdfsStatusPanel(Item).Invalidate
  1656.   else
  1657.     FStatusBar.Invalidate;
  1658. end;
  1659.  
  1660. { TdfsStatusBar }
  1661.  
  1662. constructor TdfsStatusBar.Create(AOwner: TComponent);
  1663. begin
  1664.   FExtentCanvas := CreateCompatibleDC(0);
  1665.   FExtentFont := 0;
  1666.   FExtentFontOld := 0;
  1667.   FUseMonitorDLL := FALSE;
  1668.   FDLLClientCount := 0;
  1669.   FMainWinHookClients := TList.Create;
  1670.  
  1671.   inherited Create(AOwner);
  1672.  
  1673.   // Allow it to accept controls dropped onto it.
  1674.   ControlStyle:= ControlStyle + [csAcceptsControls];
  1675.  
  1676.   FPanels := TdfsStatusPanels.Create(Self, inherited Panels);
  1677. end;
  1678.  
  1679. procedure TdfsStatusBar.InvalidatePanel(Index: integer);
  1680. var
  1681.   PanelRect: TRect;
  1682. begin
  1683.   if (Index >= 0) and (Index < Panels.Count) then
  1684.   begin
  1685.     PanelRect := GetPanelRect(Index);
  1686.     if not IsRectEmpty(PanelRect) then
  1687.       Panels[Index].Redraw(Canvas, PanelRect)
  1688.   end else begin
  1689.     {$IFDEF DFS_COMPILER_6_UP}
  1690.     TList.Error(@SListIndexError, Index);
  1691.     {$ELSE}
  1692.     {$IFDEF DFS_COMPILER_3_UP}
  1693.     raise EListError.Create(SListIndexError);
  1694.     {$ELSE}
  1695.     raise EListError.CreateRes(SListIndexError);
  1696.     {$ENDIF}
  1697.     {$ENDIF}
  1698.   end;
  1699. end;
  1700.  
  1701. function TdfsStatusBar.GetPanelRect(Index: integer): TRect;
  1702. begin
  1703.   SetRectEmpty(Result);
  1704.   if HandleAllocated then
  1705.     if Perform(SB_GETRECT, Index, LPARAM(@Result)) = 0 then
  1706.       SetRectEmpty(Result); // SB_GETRECT failed, probably not visible
  1707. end;
  1708.  
  1709. procedure TdfsStatusBar.SetPanels(const Value: TdfsStatusPanels);
  1710. begin
  1711.   FPanels.Assign(Value);
  1712. // what about linked panels????
  1713. end;
  1714.  
  1715. destructor TdfsStatusBar.Destroy;
  1716. begin
  1717.   FPanels.Free;
  1718.   SelectObject(FExtentCanvas, FExtentFontOld);
  1719.   if FExtentFont <> 0 then
  1720.   begin
  1721.     DeleteObject(FExtentFont);
  1722.     FExtentFont := 0;
  1723.   end;
  1724.   if FExtentCanvas <> 0 then
  1725.   begin
  1726.     DeleteDC(FExtentCanvas);
  1727.     FExtentCanvas := 0;
  1728.   end;
  1729.  
  1730.   Assert(FMainWinHookClients.Count = 0, 'Unbalanced MainWinHook registrations');
  1731.  
  1732.   inherited Destroy;
  1733.   FMainWinHookClients.Free;
  1734. end;
  1735.  
  1736.  
  1737. procedure TdfsStatusBar.DrawPanel(Panel: TStatusPanel; const Rect: TRect);
  1738. var
  1739.   DFSPanel: TdfsStatusPanel;
  1740.   OldFont: HFONT;
  1741. begin
  1742.   // Panel is the REAL TStatusPanel, we need to find our special one.
  1743.   DFSPanel := FindLinkedPanel(Panel);
  1744.   Assert(DFSPanel <> NIL, 'Panel links corrupted');
  1745.  
  1746.   // Stupid VCL status bar doesn't always have the right font in Canvas.
  1747.   OldFont := SelectObject(Canvas.Handle, FExtentFont);
  1748.   try
  1749.     if Addr(OnDrawPanel) <> NIL then
  1750.       inherited DrawPanel(TStatusPanel(DFSPanel), Rect);
  1751.     DFSPanel.DrawPanel(Rect);
  1752.   finally
  1753.     SelectObject(Canvas.Handle, OldFont);
  1754.   end;
  1755. end;
  1756.  
  1757. function TdfsStatusBar.FindLinkedPanel(Panel: TStatusPanel): TdfsStatusPanel;
  1758. var
  1759.   x: integer;
  1760. begin
  1761.   Result := NIL;
  1762.   for x := 0 to Panels.Count-1 do
  1763.     if Panels[x].LinkedPanel = Panel then
  1764.     begin
  1765.       Result := Panels[x];
  1766.       break;
  1767.     end;
  1768. end;
  1769.  
  1770. function TdfsStatusBar.AppWinHook(var Message: TMessage): boolean;
  1771. begin
  1772.   if Message.Msg = WM_ACTIVATEAPP then
  1773.   begin
  1774.     if UseMonitorDLL then
  1775.     begin
  1776. {      if Message.wParam = 1 then
  1777.         PostMessage(Handle, WM_REFRESHLOCKINDICATORS, 0, 0);}
  1778.     end else begin
  1779.       // We're being deactivated, someone may change an indicator and that will
  1780.       // screw up the GetKeyState API call.
  1781.       if Message.wParam = 0 then
  1782.         MayNeedRefresh := TRUE;
  1783.       // Won't work in some situations if we call it directly.
  1784.       PostMessage(Handle, WM_REFRESHLOCKINDICATORS, 0, 0);
  1785.     end;
  1786.   end;
  1787.   Result := FALSE;
  1788. end;
  1789.  
  1790. procedure TdfsStatusBar.WMRefreshLockIndicators(var Msg: TMessage);
  1791. var
  1792.   x: integer;
  1793. begin
  1794.   Panels.BeginUpdate;
  1795.   try
  1796.     for x := 0 to Panels.Count-1 do
  1797.       if Panels[x].PanelType in [sptCapsLock, sptNumLock, sptScrollLock] then
  1798.         InvalidatePanel(Panels[x].Index);
  1799.   finally
  1800.     Panels.EndUpdate;
  1801.   end;
  1802. end;
  1803.  
  1804. procedure TdfsStatusBar.CMFontChanged(var Msg: TMessage);
  1805. var
  1806.   x: integer;
  1807. begin
  1808.   inherited;
  1809.  
  1810.   UpdateExtentFont;
  1811.  
  1812.   if Panels = NIL then exit;
  1813.  
  1814.   Panels.BeginUpdate;
  1815.   try
  1816.     for x := 0 to Panels.Count-1 do
  1817.       if Panels[x].AutoFit then
  1818.         Panels[x].UpdateAutoFitWidth;
  1819.   finally
  1820.     Panels.EndUpdate;
  1821.   end;
  1822. end;
  1823.  
  1824.  
  1825. procedure TdfsStatusBar.SetOnDrawPanel(const Value: TdfsDrawPanelEvent);
  1826. begin
  1827.   inherited OnDrawPanel := TDrawPanelEvent(Value);
  1828. end;
  1829.  
  1830. function TdfsStatusBar.GetOnDrawPanel: TdfsDrawPanelEvent;
  1831. begin
  1832.   TDrawPanelEvent(Result) := inherited OnDrawPanel;
  1833. end;
  1834.  
  1835. function TdfsStatusBar.GetVersion: string;
  1836. begin
  1837.   Result := DFS_COMPONENT_VERSION;
  1838. end;
  1839.  
  1840. procedure TdfsStatusBar.SetVersion(const Val: string);
  1841. begin
  1842.   { empty write method, just needed to get it to show up in Object Inspector }
  1843. end;
  1844.  
  1845.  
  1846. procedure TdfsStatusBar.CMEnabledChanged(var Msg: TMessage);
  1847. var
  1848.   x: integer;
  1849. begin
  1850.   inherited;
  1851.   Invalidate;
  1852.   for x := 0 to Panels.Count-1 do
  1853.     Panels[x].EnabledChanged;
  1854. end;
  1855.  
  1856. procedure TdfsStatusBar.CMHintShow(var Msg: TMessage);
  1857.   function FindClosestBefore(x: integer): TdfsStatusPanel;
  1858.   var
  1859.     y: integer;
  1860.   begin
  1861.     Result := NIL;
  1862.     for y := 0 to Panels.Count-1 do
  1863.     begin
  1864.       if GetPanelRect(y).Left < x then
  1865.         Result := Panels[y]
  1866.       else
  1867.         break;
  1868.     end;
  1869. (*  If I do it this way, it screws up.  Optimizaer bug, maybe?
  1870.     for y := Panels.Count-1 downto 0 do
  1871.     begin
  1872.       if GetPanelRect(y).Left < x then
  1873.       begin
  1874.         Result := Panels[y];
  1875.         break;
  1876.       end;
  1877.     end;*)
  1878.   end;
  1879.  
  1880.   function FindClosestAfter(x: integer): TdfsStatusPanel;
  1881.   var
  1882.     y: integer;
  1883.   begin
  1884.     Result := NIL;
  1885.     for y := 0 to Panels.Count-1 do
  1886.     begin
  1887.       if GetPanelRect(y).Right > x then
  1888.       begin
  1889.         Result := Panels[y];
  1890.         break;
  1891.       end;
  1892.     end;
  1893.   end;
  1894. var
  1895.   x: integer;
  1896.   Panel: TdfsStatusPanel;
  1897.   R: TRect;
  1898. begin
  1899.   inherited;
  1900.  
  1901.   with TCMHintShow(Msg) do
  1902.   begin
  1903.     begin
  1904.       Panel := NIL;
  1905.       for x := 0 to Panels.Count-1 do
  1906.       begin
  1907.         if PtInRect(GetPanelRect(x), HintInfo.CursorPos) then
  1908.         begin
  1909.           Panel := Panels[x];
  1910.           break;
  1911.         end;
  1912.       end;
  1913.  
  1914.       if (Panel = NIL) or (Panel.Hint = '') then
  1915.       begin
  1916.         // Hit a border, or a panel without a hint.  What we have to do here is
  1917.         // tell the hint info how big of a rectangle the hint applies to.  So,
  1918.         // we must find the first panel before this point with a hint, and the
  1919.         // first panel after this point with a hint and set CursorRect equal to
  1920.         // the area between those two panels.  CursorRect already has the area
  1921.         // of the status bar, so if we don't find a panel, it's ok.
  1922.  
  1923.         // Find first valid panel before hint position and set CursorRect.Left
  1924.         Panel := FindClosestBefore(HintInfo.CursorPos.x);
  1925.         while (Panel <> NIL) do
  1926.         begin
  1927.           R := GetPanelRect(Panel.Index);
  1928.           if Panel.Hint <> '' then
  1929.           begin
  1930.             HintInfo.CursorRect.Left := R.Right;
  1931.             Panel := NIL;
  1932.           end else
  1933.             Panel := FindClosestBefore(R.Left);
  1934.         end;
  1935.  
  1936.         // Find first valid panel after hint position and set CursorRect.Right
  1937.         Panel := FindClosestAfter(HintInfo.CursorPos.x);
  1938.         while (Panel <> NIL) do
  1939.         begin
  1940.           R := GetPanelRect(Panel.Index);
  1941.           if Panel.Hint <> '' then
  1942.           begin
  1943.             HintInfo.CursorRect.Right := R.Left;
  1944.             Panel := NIL;
  1945.           end else
  1946.             Panel := FindClosestAfter(R.Right);
  1947.         end;
  1948.       end else begin
  1949.         // Give it the hint of the panel
  1950.         HintInfo.HintStr := Panel.Hint;
  1951.         // Tell the hint mechanism that it needs to check the hint when the
  1952.         // cursor leaves the panel rectangle.
  1953.         HintInfo.CursorRect := GetPanelRect(Panel.Index);
  1954.       end;
  1955.     end;
  1956.   end;
  1957. end;
  1958.  
  1959. procedure TdfsStatusBar.DeregisterMainWinHook(Client: TdfsStatusPanel);
  1960. begin
  1961.   FMainWinHookClients.Remove(Client);
  1962.   Assert(FMainWinHookClients.Count >= 0, 'Unbalanced MainWinHook registrations');
  1963.   if FMainWinHookClients.Count < 1 then
  1964.     Application.UnhookMainWindow(AppWinHook);
  1965. end;
  1966.  
  1967. procedure TdfsStatusBar.RegisterMainWinHook(Client: TdfsStatusPanel);
  1968. begin
  1969.   FMainWinHookClients.Add(Client);
  1970.   if FMainWinHookClients.Count = 1 then
  1971.     Application.HookMainWindow(AppWinHook);
  1972. end;
  1973.  
  1974.  
  1975.  
  1976. procedure TdfsStatusBar.Loaded;
  1977. var
  1978.   x: integer;
  1979. begin
  1980.   inherited Loaded;
  1981.  
  1982.   UpdateExtentFont;
  1983.  
  1984.   for x := 0 to Panels.Count-1 do
  1985.     if Panels[x].AutoFit then
  1986.       Panels[x].UpdateAutoFitWidth;
  1987. end;
  1988.  
  1989. procedure TdfsStatusBar.CreateWnd;
  1990. var
  1991.   x: integer;
  1992. begin
  1993.   inherited CreateWnd;
  1994.  
  1995.   if not (csLoading in ComponentState) then
  1996.   begin
  1997.     UpdateExtentFont;
  1998.  
  1999.     for x := 0 to Panels.Count-1 do
  2000.       if Panels[x].AutoFit then
  2001.         Panels[x].UpdateAutoFitWidth;
  2002.   end;
  2003.  
  2004.   if FDLLClientCount > 0 then
  2005.     FKeyHookMsg := DLLRegisterKeyboardHook(Handle);
  2006. end;
  2007.  
  2008. procedure TdfsStatusBar.WMDestroy(var Msg: TWMDestroy);
  2009. begin
  2010.   if FUseMonitorDLL and (FDLLClientCount > 0) then
  2011.     DLLDeregisterKeyboardHook(Handle);
  2012.  
  2013.   inherited;
  2014. end;
  2015.  
  2016.  
  2017. function TdfsStatusBar.TextExtent(const Text: string): TSize;
  2018. begin
  2019.   if not GetTextExtentPoint32(FExtentCanvas, PChar(Text), Length(Text),
  2020.      Result) then
  2021.   begin
  2022.     Result.cx := -1;
  2023.     Result.cy := -1;
  2024.   end;
  2025. end;
  2026.  
  2027. procedure TdfsStatusBar.UpdateExtentFont;
  2028. begin
  2029.   if FExtentFont <> 0 then
  2030.   begin
  2031.     SelectObject(FExtentCanvas, FExtentFontOld);
  2032.     DeleteObject(FExtentFont);
  2033.   end;
  2034.  
  2035.   // In D4, the font handle might be different than what TFont describes!
  2036.   FExtentFont := CopyHFont(Font.Handle);
  2037.   FExtentFontOld := SelectObject(FExtentCanvas, FExtentFont);
  2038. end;
  2039.  
  2040. procedure TdfsStatusBar.SetUseMonitorDLL(const Value: boolean);
  2041. begin
  2042.   if FUseMonitorDLL <> Value then
  2043.   begin
  2044.     FUseMonitorDLL := Value;
  2045.     UpdateKeyboardHooks;
  2046.     if FUseMonitorDLL and (not DFSKbDLL_Loaded) {and
  2047.        not (csDesigning in ComponentState)} then
  2048.     begin
  2049.       UseMonitorDLL := FALSE;
  2050.       if csDesigning in ComponentState then
  2051.         raise Exception.Create('Could not load ' + DFSKbDLLName);
  2052.     end;    
  2053.   end;
  2054. end;
  2055.  
  2056. procedure TdfsStatusBar.UpdateKeyboardHooks;
  2057. var
  2058.   x: integer;
  2059. begin
  2060.   for x := 0 to Panels.Count-1 do
  2061.     Panels[x].UpdateKeyboardHook;
  2062. end;
  2063.  
  2064.  
  2065. procedure TdfsStatusBar.DeregisterSystemHook;
  2066. begin
  2067.   dec(FDLLClientCount);
  2068.   if FDLLClientCount < 1 then
  2069.   begin
  2070.     if DFSKbDLL_Loaded and HandleAllocated then
  2071.       DLLDeregisterKeyboardHook(Handle);
  2072.     FDLLClientCount := 0;
  2073.     if DFSKbDLL_Loaded then
  2074.       UnloadDFSKbDLL;
  2075.   end;
  2076. end;
  2077.  
  2078. procedure TdfsStatusBar.RegisterSystemHook;
  2079. begin
  2080.   inc(FDLLClientCount);
  2081.   if (FDLLClientCount = 1) {and not (csDesigning in ComponentState)} then
  2082.   begin
  2083.     if not DFSKbDLL_Loaded then
  2084.       IniTdfsKbDLL;
  2085.     if HandleAllocated and DFSKbDLL_Loaded then
  2086.       FKeyHookMsg := DLLRegisterKeyboardHook(Handle);
  2087.   end;
  2088. end;
  2089.  
  2090. procedure TdfsStatusBar.WndProc(var Msg: TMessage);
  2091.   function VKToPanelType(VKCode: byte): TdfsStatusPanelType;
  2092.   begin
  2093.     case VKCode of
  2094.       VK_NUMLOCK: Result := sptNumLock;
  2095.       VK_SCROLL:  Result := sptScrollLock;
  2096.     else
  2097.       Result := sptCapsLock;
  2098.     end;
  2099.   end;
  2100. var
  2101.   x: integer;
  2102. begin
  2103.   if Msg.Msg = FKeyHookMsg then
  2104.   begin
  2105.     for x := 0 to Panels.Count-1 do
  2106.       if VKToPanelType(Msg.wParam) = Panels[x].PanelType then
  2107.       begin
  2108.         Panels[x].FKeyOn := Odd(Msg.lParam);
  2109.         Panels[x].Invalidate;
  2110.       end;
  2111.   end else
  2112.     inherited WndProc(Msg);
  2113. end;
  2114.  
  2115. procedure TdfsStatusBar.Click;
  2116. var
  2117.   x: integer;
  2118.   CursorPos: TPoint;
  2119. begin
  2120.   GetCursorPos(CursorPos);
  2121.   CursorPos := ScreenToClient(CursorPos);
  2122.   for x := 0 to Panels.Count-1 do
  2123.   begin
  2124.     if PtInRect(GetPanelRect(x), CursorPos) then
  2125.     begin
  2126.       Panels[x].Click;
  2127.       break;
  2128.     end;
  2129.   end;
  2130.  
  2131.   inherited Click;
  2132. end;
  2133.  
  2134. procedure TdfsStatusBar.WMPaint(var Msg: TWMPaint);
  2135.   procedure DrawSizeGrip(R: TRect);
  2136.   begin
  2137.     OffsetRect(R, -1, -1);
  2138.     with Canvas do
  2139.     begin
  2140.       Brush.Color := Color;
  2141.       Pen.Width := 1;
  2142.       FillRect(R);
  2143.       Pen.Color := clBtnHighlight;
  2144.       MoveTo(R.Right - 2, R.Bottom);
  2145.       LineTo(R.Right, R.Bottom - 2);
  2146.       MoveTo(R.Right - 13, R.Bottom);
  2147.       LineTo(R.Right, R.Bottom - 13);
  2148.       MoveTo(R.Right - 9, R.Bottom);
  2149.       LineTo(R.Right, R.Bottom - 9);
  2150.       MoveTo(R.Right - 5, R.Bottom);
  2151.       LineTo(R.Right, R.Bottom - 5);
  2152.       MoveTo(R.Right - 1, R.Bottom);
  2153.       LineTo(R.Right, R.Bottom);
  2154.  
  2155.       Pen.Color := clBtnShadow;
  2156.       MoveTo(R.Right - 11, R.Bottom);
  2157.       LineTo(R.Right, R.Bottom - 11);
  2158.       MoveTo(R.Right - 7, R.Bottom);
  2159.       LineTo(R.Right, R.Bottom - 7);
  2160.       MoveTo(R.Right - 3, R.Bottom);
  2161.       LineTo(R.Right, R.Bottom - 3);
  2162.  
  2163.       Brush.Color := clBtnFace;
  2164.       Pen.Color := clBtnShadow;
  2165.       MoveTo(R.Left, R.Top);
  2166.       LineTo(R.Right, R.Top);
  2167.     end;
  2168.   end;
  2169. var
  2170.   R: TRect;
  2171. begin
  2172.   inherited;
  2173.   if Color <> clBtnFace then
  2174.   begin
  2175.     R := ClientRect;
  2176.     R.Left := R.Right - 15;
  2177.     Inc(R.Top, 3);
  2178.     dec(R.Bottom);
  2179.     DrawSizeGrip(R);
  2180.   end;
  2181. end;
  2182.  
  2183. {$IFDEF DFS_COMPILER_4_UP}
  2184. function TdfsStatusBar.ExecuteAction(Action: TBasicAction): Boolean;
  2185. begin
  2186. //  outputdebugstring(Pchar(panels[0].ftext));
  2187.   Result := inherited ExecuteAction(Action);
  2188. //  outputdebugstring(Pchar(panels[0].ftext));
  2189.   Invalidate;
  2190. //  outputdebugstring(Pchar(panels[0].ftext));
  2191. end;
  2192. {$ENDIF}
  2193.  
  2194.  
  2195. initialization
  2196.   {$IFDEF DFS_DEBUG}
  2197.   DFSDebug.Log('dfsStatusBar: init begin', TRUE);
  2198.   {$ENDIF}
  2199.   MayNeedRefresh := FALSE;
  2200.   KeyboardHookHandle := 0;
  2201.   KeyHookClients := TList.Create;
  2202.   RegisteredTimers := 0;
  2203.   {$IFDEF DFS_DEBUG}
  2204.   DFSDebug.Log('dfsStatusBar: init end.', TRUE);
  2205.   {$ENDIF}
  2206.  
  2207. finalization
  2208.  
  2209.   {$IFDEF DFS_DEBUG}
  2210.   DFSDebug.Log('dfsStatusBar: finalization begin.', TRUE);
  2211.   {$ENDIF}
  2212.   // remove hook just in case it somehow got left installed
  2213.   if KeyboardHookHandle <> 0 then
  2214.   begin
  2215.     UnhookWindowsHookEx(KeyboardHookHandle);
  2216.     KeyboardHookHandle := 0;
  2217.     Assert(FALSE, 'TdfsStatusBar: Keyboard hook still installed');
  2218.   end;
  2219.  
  2220.   Assert(RegisteredTimers = 0, 'TdfsStatusBar: Unbalanced timer registrations');
  2221.  
  2222.   KeyHookClients.Free;
  2223.   KeyHookClients := NIL;
  2224.  
  2225.   if DFSKb.DFSKbDLL_Loaded then
  2226.     UnloadDFSKbDLL;
  2227.  
  2228.   {$IFDEF DFS_DEBUG}
  2229.   DFSDebug.Log('dfsStatusBar: finalization end.', TRUE);
  2230.   {$ENDIF}
  2231. end.
  2232.  
  2233.  
  2234.  
  2235.