home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d3456 / SBPRO.ZIP / SBPro.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-12-27  |  29.7 KB  |  1,026 lines
  1. {------------------------------------------------------------------------------}
  2. {                                                                              }
  3. {  TStatusBarPro v1.11                                                         }
  4. {  by Kambiz R. Khojasteh                                                      }
  5. {                                                                              }
  6. {  kambiz@delphiarea.com                                                       }
  7. {  http://www.delphiarea.com                                                   }
  8. {                                                                              }
  9. {  Special thanks to:                                                          }
  10. {    Rudi Loos <loos@intekom.co.za> for adding Color property to the panels.   }
  11. {                                                                              }
  12. {------------------------------------------------------------------------------}
  13.  
  14. {$I DELPHIAREA.INC}
  15.  
  16. unit SBPro;
  17.  
  18. interface
  19.  
  20. uses
  21.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  22.   Menus, ComCtrls {$IFNDEF DELPHI3}, ImgList {$ENDIF};
  23.  
  24. type
  25.  
  26.   TStatusBarPro = class;
  27.  
  28.   TStatusPanelPro = class(TCollectionItem)
  29.   private
  30.     FText: string;
  31.     FHint: String;
  32.     FImageIndex: Integer;
  33.     FPopupMenu: TPopupMenu;
  34.     FWidth: Integer;
  35.     FPanelColor : TColor;                    {RAL}
  36.     FAlignment: TAlignment;
  37.     FBevel: TStatusPanelBevel;
  38.     {$IFDEF DELPHI4_UP}
  39.     FBiDiMode: TBiDiMode;
  40.     FParentBiDiMode: Boolean;
  41.     {$ENDIF}
  42.     FStyle: TStatusPanelStyle;
  43.     FUpdateNeeded: Boolean;
  44.     FOnCLick: TNotifyEvent;
  45.     FOnDblClick: TNotifyEvent;
  46.     procedure SetHint(Value: String);
  47.     procedure SetImageIndex(Value: Integer);
  48.     procedure SetPopupMenu(Value: TPopupMenu);
  49.     procedure SetAlignment(Value: TAlignment);
  50.     procedure SetBevel(Value: TStatusPanelBevel);
  51.     procedure SetStyle(Value: TStatusPanelStyle);
  52.     procedure SetText(const Value: string);
  53.     procedure SetWidth(Value: Integer);
  54.     procedure SetPanelColor(Value : TColor);                {RAL}
  55.     {$IFDEF DELPHI4_UP}
  56.     procedure SetBiDiMode(Value: TBiDiMode);
  57.     procedure SetParentBiDiMode(Value: Boolean);
  58.     function IsBiDiModeStored: Boolean;
  59.     {$ENDIF}
  60.   protected
  61.     function GetDisplayName: string; override;
  62.   public
  63.     constructor Create(Collection: TCollection); override;
  64.     procedure Assign(Source: TPersistent); override;
  65.     {$IFDEF DELPHI4_UP}
  66.     procedure ParentBiDiModeChanged;
  67.     function UseRightToLeftAlignment: Boolean;
  68.     function UseRightToLeftReading: Boolean;
  69.     {$ENDIF}
  70.   published
  71.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  72.     property Bevel: TStatusPanelBevel read FBevel write SetBevel default pbLowered;
  73.     {$IFDEF DELPHI4_UP}
  74.     property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;
  75.     {$ENDIF}
  76.     property Hint: String read FHint write SetHint;
  77.     property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
  78.     {$IFDEF DELPHI4_UP}
  79.     property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
  80.     {$ENDIF}
  81.     property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  82.     property Style: TStatusPanelStyle read FStyle write SetStyle default psText;
  83.     property Text: string read FText write SetText;
  84.     property Width: Integer read FWidth write SetWidth;
  85.     property Color: TColor read FPanelColor write SetPanelColor;         {RAL}
  86.     property OnClick: TNotifyEvent read FOnClick write FOnClick;
  87.     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  88.   end;
  89.  
  90.   TStatusPanelsPro = class(TCollection)
  91.   private
  92.     FStatusBar: TStatusBarPro;
  93.     function GetItem(Index: Integer): TStatusPanelPro;
  94.     procedure SetItem(Index: Integer; Value: TStatusPanelPro);
  95.   protected
  96.     function GetOwner: TPersistent; override;
  97.     procedure Update(Item: TCollectionItem); override;
  98.   public
  99.     constructor Create(StatusBar: TStatusBarPro);
  100.     function Add: TStatusPanelPro;
  101.     property Items[Index: Integer]: TStatusPanelPro read GetItem write SetItem; default;
  102.   end;
  103.  
  104.   TDrawPanelProEvent = procedure(StatusBar: TStatusBarPro; Panel: TStatusPanelPro;
  105.     const Rect: TRect) of object;
  106.  
  107.   TStatusBarPro = class(TWinControl)
  108.   private
  109.     FPanels: TStatusPanelsPro;
  110.     FCanvas: TCanvas;
  111.     FSimpleText: string;
  112.     FSimplePanel: Boolean;
  113.     FSizeGrip: Boolean;
  114.     FUseSystemFont: Boolean;
  115.     FAutoHint: Boolean;
  116.     FOnDrawPanel: TDrawPanelProEvent;
  117.     FOnHint: TNotifyEvent;
  118.     FImages: {$IFNDEF DELPHI3} TCustomImageList {$ELSE} TImageList {$ENDIF};
  119.     FImageChangeLink: TChangeLink;
  120.     FMousePanel: TStatusPanelPro;
  121.     {$IFDEF DELPHI4_UP}
  122.     procedure DoRightToLeftAlignment(var Str: string; AAlignment: TAlignment;
  123.       ARTLAlignment: Boolean);
  124.     {$ENDIF}
  125.     function IsFontStored: Boolean;
  126.     procedure ImageListChange(Sender: TObject);
  127.     procedure SetImages(Value: {$IFNDEF DELPHI3} TCustomImageList {$ELSE} TImageList {$ENDIF});
  128.     procedure SetPanels(Value: TStatusPanelsPro);
  129.     procedure SetSimplePanel(Value: Boolean);
  130.     procedure UpdateSimpleText;
  131.     procedure SetSimpleText(const Value: string);
  132.     procedure SetSizeGrip(Value: Boolean);
  133.     procedure SyncToSystemFont;
  134.     procedure UpdatePanel(Index: Integer; Repaint: Boolean);
  135.     procedure UpdatePanels(UpdateRects, UpdateText: Boolean);
  136.     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  137.     {$IFDEF DELPHI4_UP}
  138.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  139.     {$ENDIF}
  140.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  141.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
  142.     procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  143.     procedure CMWinIniChange(var Message: TMessage); message CM_WININICHANGE;
  144.     procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
  145.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  146.     procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
  147.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  148.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  149.     procedure SetUseSystemFont(const Value: Boolean);
  150.     function FindPanelAtPos(Point: TPoint): TStatusPanelPro;
  151.   protected
  152.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  153.     procedure ChangeScale(M, D: Integer); override;
  154.     procedure CreateParams(var Params: TCreateParams); override;
  155.     procedure CreateWnd; override;
  156.     function DoHint: Boolean; virtual;
  157.     procedure DrawPanel(Panel: TStatusPanelPro; const Rect: TRect); dynamic;
  158.     procedure WndProc(var Message: TMessage); override;
  159.     procedure Click; override;
  160.     procedure DblClick; override;
  161.     function GetPopupMenu: TPopupMenu; override;
  162.   public
  163.     constructor Create(AOwner: TComponent); override;
  164.     destructor Destroy; override;
  165.     {$IFDEF DELPHI4_UP}
  166.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  167.     procedure FlipChildren(AllLevels: Boolean); override;
  168.     {$ENDIF}
  169.     property Canvas: TCanvas read FCanvas;
  170.   published
  171.     {$IFDEF DELPHI4_UP}
  172.     property Action;
  173.     property AutoHint: Boolean read FAutoHint write FAutoHint default False;
  174.     {$ENDIF}
  175.     property Align default alBottom;
  176.     {$IFDEF DELPHI4_UP}
  177.     property Anchors;
  178.     property BiDiMode;
  179.     property BorderWidth;
  180.     {$ENDIF}
  181.     property Color default clBtnFace;
  182.     property DragCursor;
  183.     {$IFDEF DELPHI4_UP}
  184.     property DragKind;
  185.     {$ENDIF}
  186.     property DragMode;
  187.     property Enabled;
  188.     property Font stored IsFontStored;
  189.     property Images: {$IFNDEF DELPHI3} TCustomImageList {$ELSE} TImageList {$ENDIF}
  190.       read FImages write SetImages;
  191.     property Panels: TStatusPanelsPro read FPanels write SetPanels;
  192.     {$IFDEF DELPHI4_UP}
  193.     property Constraints;
  194.     property ParentBiDiMode;
  195.     {$ENDIF}
  196.     property ParentColor default False;
  197.     property ParentFont default False;
  198.     property ParentShowHint;
  199.     property PopupMenu;
  200.     property ShowHint;
  201.     property SimplePanel: Boolean read FSimplePanel write SetSimplePanel;
  202.     property SimpleText: string read FSimpleText write SetSimpleText;
  203.     property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
  204.     property UseSystemFont: Boolean read FUseSystemFont write SetUseSystemFont default True;
  205.     property Visible;
  206.     property OnClick;
  207.     {$IFDEF DELPHI5_UP}
  208.     property OnContextPopup;
  209.     {$ENDIF}
  210.     property OnDblClick;
  211.     property OnDragDrop;
  212.     property OnDragOver;
  213.     {$IFDEF DELPHI4_UP}
  214.     property OnEndDock;
  215.     {$ENDIF}
  216.     property OnEndDrag;
  217.     property OnHint: TNotifyEvent read FOnHint write FOnHint;
  218.     property OnMouseDown;
  219.     property OnMouseMove;
  220.     property OnMouseUp;
  221.     property OnDrawPanel: TDrawPanelProEvent read FOnDrawPanel write FOnDrawPanel;
  222.     {$IFDEF DELPHI4_UP}
  223.     property OnResize;
  224.     property OnStartDock;
  225.     {$ENDIF}
  226.     property OnStartDrag;
  227.   end;
  228.  
  229. implementation
  230.  
  231. uses
  232.   CommCtrl {$IFDEF DELPHI4_UP}, StdActns {$ENDIF};
  233.  
  234. {$IFDEF DELPHI3}
  235. const
  236.   SB_SETBKCOLOR = $2001;  // lParam = bkColor
  237. {$ENDIF}
  238.  
  239. { TStatusPanelPro }
  240.  
  241. constructor TStatusPanelPro.Create(Collection: TCollection);
  242. begin
  243.   FWidth := 50;
  244.   FPanelColor := clBtnFace;                              {RAL}
  245.   FBevel := pbLowered;
  246.   FImageIndex := -1;
  247.   {$IFDEF DELPHI4_UP}
  248.   FParentBiDiMode := True;
  249.   {$ENDIF}
  250.   inherited Create(Collection);
  251.   {$IFDEF DELPHI4_UP}
  252.   ParentBiDiModeChanged;
  253.   {$ENDIF}
  254. end;
  255.  
  256. procedure TStatusPanelPro.Assign(Source: TPersistent);
  257. begin
  258.   if Source is TStatusPanel then
  259.   begin
  260.     Text := TStatusPanel(Source).Text;
  261.     Width := TStatusPanel(Source).Width;
  262.     Alignment := TStatusPanel(Source).Alignment;
  263.     Bevel := TStatusPanel(Source).Bevel;
  264.     Style := TStatusPanel(Source).Style;
  265.   end
  266.   else if Source is TStatusPanelPro then
  267.   begin
  268.     Text := TStatusPanelPro(Source).Text;
  269.     Width := TStatusPanelPro(Source).Width;
  270.     Color := TStatusPanelPro(Source).Color;                  {RAL}
  271.     Alignment := TStatusPanelPro(Source).Alignment;
  272.     Bevel := TStatusPanelPro(Source).Bevel;
  273.     Style := TStatusPanelPro(Source).Style;
  274.     Hint := TStatusPanelPro(Source).Hint;
  275.     ImageIndex := TStatusPanelPro(Source).ImageIndex;
  276.     PopupMenu := TStatusPanelPro(Source).PopupMenu;
  277.     OnClick := TStatusPanelPro(Source).OnClick;
  278.     OnDblClick := TStatusPanelPro(Source).OnDblClick;
  279.   end
  280.   else
  281.     inherited Assign(Source);
  282. end;
  283.  
  284. {$IFDEF DELPHI4_UP}
  285. procedure TStatusPanelPro.SetBiDiMode(Value: TBiDiMode);
  286. begin
  287.   if Value <> FBiDiMode then
  288.   begin
  289.     FBiDiMode := Value;
  290.     FParentBiDiMode := False;
  291.     Changed(False);
  292.   end;
  293. end;
  294. {$ENDIF}
  295.  
  296. {$IFDEF DELPHI4_UP}
  297. function TStatusPanelPro.IsBiDiModeStored: Boolean;
  298. begin
  299.   Result := not FParentBiDiMode;
  300. end;
  301. {$ENDIF}
  302.  
  303. {$IFDEF DELPHI4_UP}
  304. procedure TStatusPanelPro.SetParentBiDiMode(Value: Boolean);
  305. begin
  306.   if FParentBiDiMode <> Value then
  307.   begin
  308.     FParentBiDiMode := Value;
  309.     ParentBiDiModeChanged;
  310.   end;
  311. end;
  312. {$ENDIF}
  313.  
  314. {$IFDEF DELPHI4_UP}
  315. procedure TStatusPanelPro.ParentBiDiModeChanged;
  316. begin
  317.   if FParentBiDiMode then
  318.   begin
  319.     if GetOwner <> nil then
  320.     begin
  321.       BiDiMode := TStatusPanelsPro(GetOwner).FStatusBar.BiDiMode;
  322.       FParentBiDiMode := True;
  323.     end;
  324.   end;
  325. end;
  326. {$ENDIF}
  327.  
  328. {$IFDEF DELPHI4_UP}
  329. function TStatusPanelPro.UseRightToLeftReading: Boolean;
  330. begin
  331.   Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
  332. end;
  333. {$ENDIF}
  334.  
  335. {$IFDEF DELPHI4_UP}
  336. function TStatusPanelPro.UseRightToLeftAlignment: Boolean;
  337. begin
  338.   Result := SysLocale.MiddleEast and (BiDiMode = bdRightToLeft);
  339. end;
  340. {$ENDIF}
  341.  
  342. function TStatusPanelPro.GetDisplayName: string;
  343. begin
  344.   Result := Text;
  345.   if Result = '' then Result := inherited GetDisplayName;
  346. end;
  347.  
  348. procedure TStatusPanelPro.SetAlignment(Value: TAlignment);
  349. begin
  350.   if FAlignment <> Value then
  351.   begin
  352.     FAlignment := Value;
  353.     Changed(False);
  354.   end;
  355. end;
  356.  
  357. procedure TStatusPanelPro.SetBevel(Value: TStatusPanelBevel);
  358. begin
  359.   if FBevel <> Value then
  360.   begin
  361.     FBevel := Value;
  362.     Changed(False);
  363.   end;
  364. end;
  365.  
  366. procedure TStatusPanelPro.SetStyle(Value: TStatusPanelStyle);
  367. begin
  368.   if FStyle <> Value then
  369.   begin
  370.     FStyle := Value;
  371.     Changed(False);
  372.   end;
  373. end;
  374.  
  375. procedure TStatusPanelPro.SetText(const Value: string);
  376. begin
  377.   if FText <> Value then
  378.   begin
  379.     FText := Value;
  380.     Changed(False);
  381.   end;
  382. end;
  383.  
  384. procedure TStatusPanelPro.SetWidth(Value: Integer);
  385. begin
  386.   if FWidth <> Value then
  387.   begin
  388.     FWidth := Value;
  389.     Changed(True);
  390.   end;
  391. end;
  392.  
  393. procedure TStatusPanelPro.SetPanelColor(Value : TColor);               {RAL}
  394. begin                                                                  {RAL}
  395.  if FPanelColor <> Value then                                          {RAL}
  396.   begin                                                                {RAL}
  397.    FPanelColor := Value;                                               {RAL}
  398.    Changed(False);                                                     {RAL}
  399.   end;                                                                 {RAL}
  400. end;                                                                   {RAL}
  401.  
  402. procedure TStatusPanelPro.SetHint(Value: String);
  403. begin
  404.   if FHint <> Value then
  405.   begin
  406.     FHint := Value;
  407.     Changed(False);
  408.   end;
  409. end;
  410.  
  411. procedure TStatusPanelPro.SetImageIndex(Value: Integer);
  412. begin
  413.   if FImageIndex <> Value then
  414.   begin
  415.     FImageIndex := Value;
  416.     Changed(False);
  417.   end;
  418. end;
  419.  
  420. procedure TStatusPanelPro.SetPopupMenu(Value: TPopupMenu);
  421. begin
  422.   if FPopupMenu <> Value then
  423.   begin
  424.     FPopupMenu := Value;
  425.     if (GetOwner <> nil) and (FPopupMenu <> nil) then
  426.       FPopupMenu.FreeNotification(TStatusPanelsPro(GetOwner).FStatusBar);
  427.     Changed(False);
  428.   end;
  429. end;
  430.  
  431. { TStatusPanelsPro }
  432.  
  433. constructor TStatusPanelsPro.Create(StatusBar: TStatusBarPro);
  434. begin
  435.   inherited Create(TStatusPanelPro);
  436.   FStatusBar := StatusBar;
  437. end;
  438.  
  439. function TStatusPanelsPro.Add: TStatusPanelPro;
  440. begin
  441.   Result := TStatusPanelPro(inherited Add);
  442. end;
  443.  
  444. function TStatusPanelsPro.GetItem(Index: Integer): TStatusPanelPro;
  445. begin
  446.   Result := TStatusPanelPro(inherited GetItem(Index));
  447. end;
  448.  
  449. function TStatusPanelsPro.GetOwner: TPersistent;
  450. begin
  451.   Result := FStatusBar;
  452. end;
  453.  
  454. procedure TStatusPanelsPro.SetItem(Index: Integer; Value: TStatusPanelPro);
  455. begin
  456.   inherited SetItem(Index, Value);
  457. end;
  458.  
  459. procedure TStatusPanelsPro.Update(Item: TCollectionItem);
  460. begin
  461.   if Item <> nil then
  462.     FStatusBar.UpdatePanel(Item.Index, False)
  463.   else
  464.     FStatusBar.UpdatePanels(True, False);
  465. end;
  466.  
  467. { TStatusBarPro }
  468.  
  469. constructor TStatusBarPro.Create(AOwner: TComponent);
  470. begin
  471.   inherited Create(AOwner);
  472.   ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque, csAcceptsControls];
  473.   FImageChangeLink := TChangeLink.Create;
  474.   FImageChangeLink.OnChange := ImageListChange;
  475.   Color := clBtnFace;
  476.   Height := 19;
  477.   Align := alBottom;
  478.   FPanels := TStatusPanelsPro.Create(Self);
  479.   FCanvas := TControlCanvas.Create;
  480.   TControlCanvas(FCanvas).Control := Self;
  481.   FSizeGrip := True;
  482.   ParentFont := False;
  483.   FUseSystemFont := True;
  484.   SyncToSystemFont;
  485. end;
  486.  
  487. destructor TStatusBarPro.Destroy;
  488. begin
  489.   FImageChangeLink.Free;
  490.   FCanvas.Free;
  491.   FPanels.Free;
  492.   inherited Destroy;
  493. end;
  494.  
  495. procedure TStatusBarPro.CreateParams(var Params: TCreateParams);
  496. const
  497.   GripStyles: array[Boolean] of DWORD = (CCS_TOP, SBARS_SIZEGRIP);
  498. begin
  499.   InitCommonControl(ICC_BAR_CLASSES);
  500.   inherited CreateParams(Params);
  501.   CreateSubClass(Params, STATUSCLASSNAME);
  502.   with Params do
  503.   begin
  504.     Style := Style or GripStyles[FSizeGrip and
  505.       (Parent is {$IFNDEF DELPHI3} TCustomForm {$ELSE} TForm {$ENDIF}) and
  506.       ({$IFNDEF DELPHI3} TCustomForm {$ELSE} TForm {$ENDIF} (Parent).BorderStyle
  507.        in [bsSizeable, bsSizeToolWin])];
  508.     WindowClass.style := WindowClass.style and not CS_HREDRAW;
  509.   end;
  510. end;
  511.  
  512. procedure TStatusBarPro.CreateWnd;
  513. begin
  514.   inherited CreateWnd;
  515.   SendMessage(Handle, SB_SETBKCOLOR, 0, ColorToRGB(Color));
  516.   UpdatePanels(True, False);
  517.   if FSimpleText <> '' then
  518.     SendMessage(Handle, SB_SETTEXT, 255, Integer(PChar(FSimpleText)));
  519.   if FSimplePanel then
  520.     SendMessage(Handle, SB_SIMPLE, 1, 0);
  521. end;
  522.  
  523. function TStatusBarPro.DoHint: Boolean;
  524. begin
  525.   if Assigned(FOnHint) then
  526.   begin
  527.     FOnHint(Self);
  528.     Result := True;
  529.   end
  530.   else Result := False;
  531. end;
  532.  
  533. procedure TStatusBarPro.DrawPanel(Panel: TStatusPanelPro; const Rect: TRect);
  534. var
  535.   X, Y: Integer;
  536.   ImageWidth: Integer;
  537.   Alignment: TAlignment;
  538.   RightSideImage: Boolean;
  539. begin
  540.   if (Panel.Style = psOwnerDraw) and Assigned(FOnDrawPanel) then
  541.     FOnDrawPanel(Self, Panel, Rect)
  542.   else
  543.   begin
  544.     // Changes alignment according to BiDiMode
  545.     Alignment := Panel.Alignment;
  546.     {$IFDEF DELPHI4_UP}
  547.     if Panel.UseRightToLeftAlignment then
  548.       ChangeBiDiModeAlignment(Alignment);
  549.     {$ENDIF}
  550.     RightSideImage := (Alignment = taRightJustify) {$IFDEF DELPHI4_UP} or
  551.       ((Alignment = taCenter) and Panel.UseRightToLeftAlignment) {$ENDIF};
  552.     // Determines image's width
  553.     if (FImages <> nil) and (Panel.ImageIndex >= 0) and
  554.        (Panel.ImageIndex < FImages.Count) then
  555.       ImageWidth := FImages.Width
  556.     else
  557.       ImageWidth := 0;
  558.     // Determines X position
  559.     case Alignment of
  560.       taLeftJustify: X := Rect.Left + 1;
  561.       taRightJustify: X := Rect.Right - 1 - ImageWidth;
  562.     else
  563.       {$IFDEF DELPHI4_UP}
  564.       if Panel.UseRightToLeftAlignment then
  565.         X := Rect.Left + ((Rect.Right - Rect.Left) +
  566.             (ImageWidth + FCanvas.TextWidth(Panel.Text))) div 2 - ImageWidth
  567.       else
  568.       {$ENDIF}
  569.         X := Rect.Left + ((Rect.Right - Rect.Left) -
  570.             (ImageWidth + FCanvas.TextWidth(Panel.Text))) div 2;
  571.     end;
  572.     // Clears the panel's client area
  573.     FCanvas.Brush.Color := Panel.Color; {RAL Put here so colors can be seen in design mode}
  574.     FCanvas.FillRect(Rect);
  575.     // Draws image
  576.     if ImageWidth > 0 then
  577.     begin
  578.       Y := Rect.Top + ((Rect.Bottom - Rect.Top) - FImages.Height) div 2;
  579.       FImages.Draw(FCanvas, X, Y, Panel.ImageIndex);
  580.       if RightSideImage then
  581.         Dec(X, 2)
  582.       else
  583.         Inc(X, FImages.Width + 2);
  584.     end;
  585.     // Draws text
  586.     if RightSideImage then
  587.       Dec(X, FCanvas.TextWidth(Panel.Text));
  588.     Y := Rect.Top + ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight('H')) div 2;
  589.     {$IFDEF DELPHI4_UP}
  590.     if Panel.UseRightToLeftReading then
  591.       FCanvas.TextFlags := FCanvas.TextFlags or ETO_RTLREADING
  592.     else
  593.       FCanvas.TextFlags := FCanvas.TextFlags and not ETO_RTLREADING;
  594.     {$ENDIF}
  595.     FCanvas.TextOut(X, Y, Panel.Text);
  596.   end;
  597. end;
  598.  
  599. procedure TStatusBarPro.SetImages(Value:
  600.   {$IFNDEF DELPHI3} TCustomImageList {$ELSE} TImageList {$ENDIF});
  601. begin
  602.   if FImages <> nil then
  603.     FImages.UnRegisterChanges(FImageChangeLink);
  604.   FImages := Value;
  605.   if FImages <> nil then
  606.   begin
  607.     FImages.RegisterChanges(FImageChangeLink);
  608.     FImages.FreeNotification(Self);
  609.   end;
  610.   Invalidate;
  611. end;
  612.  
  613. procedure TStatusBarPro.ImageListChange(Sender: TObject);
  614. begin
  615.   Invalidate;
  616. end;
  617.  
  618. procedure TStatusBarPro.Notification(AComponent: TComponent;
  619.   Operation: TOperation);
  620. var
  621.   I: Integer;
  622. begin
  623.   inherited Notification(AComponent, Operation);
  624.   if Operation = opRemove then
  625.     if AComponent = FImages then
  626.       Images := nil
  627.     else if AComponent is TPopupMenu then
  628.     begin
  629.       for I := 0 to Panels.Count-1 do
  630.         if Panels[I].PopupMenu = AComponent then
  631.           Panels[I].PopupMenu := nil;
  632.     end;
  633. end;
  634.  
  635. procedure TStatusBarPro.SetPanels(Value: TStatusPanelsPro);
  636. begin
  637.   FPanels.Assign(Value);
  638. end;
  639.  
  640. procedure TStatusBarPro.SetSimplePanel(Value: Boolean);
  641. begin
  642.   if FSimplePanel <> Value then
  643.   begin
  644.     FSimplePanel := Value;
  645.     if HandleAllocated then
  646.       SendMessage(Handle, SB_SIMPLE, Ord(FSimplePanel), 0);
  647.   end;
  648. end;
  649.  
  650. {$IFDEF DELPHI4_UP}
  651. procedure TStatusBarPro.DoRightToLeftAlignment(var Str: string;
  652.   AAlignment: TAlignment; ARTLAlignment: Boolean);
  653. begin
  654.   if ARTLAlignment then ChangeBiDiModeAlignment(AAlignment);
  655.  
  656.   case AAlignment of
  657.     taCenter: Insert(#9, Str, 1);
  658.     taRightJustify: Insert(#9#9, Str, 1);
  659.   end;
  660. end;
  661. {$ENDIF}
  662.  
  663. procedure TStatusBarPro.UpdateSimpleText;
  664. const
  665.   RTLReading: array[Boolean] of Longint = (0, SBT_RTLREADING);
  666. begin
  667.   {$IFDEF DELPHI4_UP}
  668.   DoRightToLeftAlignment(FSimpleText, taLeftJustify, UseRightToLeftAlignment);
  669.   {$ENDIF}
  670.   if HandleAllocated then
  671.     SendMessage(Handle, SB_SETTEXT, 255
  672.       {$IFDEF DELPHI4_UP} or RTLREADING[UseRightToLeftReading] {$ENDIF},
  673.       Integer(PChar(FSimpleText)));
  674. end;
  675.  
  676. procedure TStatusBarPro.SetSimpleText(const Value: string);
  677. begin
  678.   if FSimpleText <> Value then
  679.   begin
  680.     FSimpleText := Value;
  681.     UpdateSimpleText;
  682.   end;
  683. end;
  684.  
  685. {$IFDEF DELPHI4_UP}
  686. procedure TStatusBarPro.CMBiDiModeChanged(var Message: TMessage);
  687. var
  688.   Loop: Integer;
  689. begin
  690.   inherited;
  691.   if HandleAllocated then
  692.     if not SimplePanel then
  693.     begin
  694.       for Loop := 0 to Panels.Count - 1 do
  695.         if Panels[Loop].ParentBiDiMode then
  696.           Panels[Loop].ParentBiDiModeChanged;
  697.       UpdatePanels(True, True);
  698.     end
  699.     else
  700.       UpdateSimpleText;
  701. end;
  702. {$ENDIF}
  703.  
  704. {$IFDEF DELPHI4_UP}
  705. procedure TStatusBarPro.FlipChildren(AllLevels: Boolean);
  706. var
  707.   Loop, FirstWidth, LastWidth: Integer;
  708.   APanels: TStatusPanelsPro;
  709. begin
  710.   if HandleAllocated and
  711.      (not SimplePanel) and (Panels.Count > 0) then
  712.   begin
  713.     { Get the true width of the last panel }
  714.     LastWidth := ClientWidth;
  715.     FirstWidth := Panels[0].Width;
  716.     for Loop := 0 to Panels.Count - 2 do Dec(LastWidth, Panels[Loop].Width);
  717.     { Flip 'em }
  718.     APanels := TStatusPanelsPro.Create(Self);
  719.     try
  720.       for Loop := 0 to Panels.Count - 1 do with APanels.Add do
  721.         Assign(Self.Panels[Loop]);
  722.       for Loop := 0 to Panels.Count - 1 do
  723.         Panels[Loop].Assign(APanels[Panels.Count - Loop - 1]);
  724.     finally
  725.       APanels.Free;
  726.     end;
  727.     { Set the width of the last panel }
  728.     if Panels.Count > 1 then
  729.     begin
  730.       Panels[Panels.Count-1].Width := FirstWidth;
  731.       Panels[0].Width := LastWidth;
  732.     end;
  733.     UpdatePanels(True, True);
  734.   end;
  735. end;
  736. {$ENDIF}
  737.  
  738. procedure TStatusBarPro.SetSizeGrip(Value: Boolean);
  739. begin
  740.   if FSizeGrip <> Value then
  741.   begin
  742.     FSizeGrip := Value;
  743.     RecreateWnd;
  744.   end;
  745. end;
  746.  
  747. procedure TStatusBarPro.SyncToSystemFont;
  748. {$IFNDEF DELPHI5_UP}
  749. var
  750.   NonClientMetrics: TNonClientMetrics;
  751. {$ENDIF}
  752. begin
  753.   {$IFNDEF DELPHI5_UP}
  754.   if FUseSystemFont then
  755.   begin
  756.     NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  757.     if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  758.       Font.Handle := CreateFontIndirect(NonClientMetrics.lfStatusFont)
  759.   end;
  760.   {$ELSE}
  761.   if FUseSystemFont then
  762.     Font := Screen.HintFont;
  763.   {$ENDIF}
  764. end;
  765.  
  766. procedure TStatusBarPro.UpdatePanel(Index: Integer; Repaint: Boolean);
  767. var
  768.   Flags: Integer;
  769.   S: string;
  770.   PanelRect: TRect;
  771. begin
  772.   if HandleAllocated then
  773.     with Panels[Index] do
  774.     begin
  775.       if not Repaint then
  776.       begin
  777.         FUpdateNeeded := True;
  778.         SendMessage(Handle, SB_GETRECT, Index, Integer(@PanelRect));
  779.         InvalidateRect(Handle, @PanelRect, True);
  780.         Exit;
  781.       end
  782.       else if not FUpdateNeeded then Exit;
  783.       FUpdateNeeded := False;
  784.       Flags := 0;
  785.       case Bevel of
  786.         pbNone: Flags := SBT_NOBORDERS;
  787.         pbRaised: Flags := SBT_POPOUT;
  788.       end;
  789.       {$IFDEF DELPHI4_UP}
  790.       if UseRightToLeftReading then Flags := Flags or SBT_RTLREADING;
  791.       {$ENDIF}
  792.       {if Style = psOwnerDraw then} Flags := Flags or SBT_OWNERDRAW;
  793.       S := Text;
  794.       {$IFDEF DELPHI4_UP}
  795.       if UseRightToLeftAlignment then
  796.         DoRightToLeftAlignment(S, Alignment, UseRightToLeftAlignment)
  797.       else
  798.       {$ENDIF}
  799.         case Alignment of
  800.           taCenter: Insert(#9, S, 1);
  801.           taRightJustify: Insert(#9#9, S, 1);
  802.         end;
  803.       SendMessage(Handle, SB_SETTEXT, Index or Flags, Integer(PChar(S)));
  804.     end;
  805. end;
  806.  
  807. procedure TStatusBarPro.UpdatePanels(UpdateRects, UpdateText: Boolean);
  808. const
  809.   MaxPanelCount = 128;
  810. var
  811.   I, Count, PanelPos: Integer;
  812.   PanelEdges: array[0..MaxPanelCount - 1] of Integer;
  813. begin
  814.   if HandleAllocated then
  815.   begin
  816.     Count := Panels.Count;
  817.     if UpdateRects then
  818.     begin
  819.       if Count > MaxPanelCount then Count := MaxPanelCount;
  820.       if Count = 0 then
  821.       begin
  822.         PanelEdges[0] := -1;
  823.         SendMessage(Handle, SB_SETPARTS, 1, Integer(@PanelEdges));
  824.         SendMessage(Handle, SB_SETTEXT, 0, Integer(PChar('')));
  825.       end else
  826.       begin
  827.         PanelPos := 0;
  828.         for I := 0 to Count - 2 do
  829.         begin
  830.           Inc(PanelPos, Panels[I].Width);
  831.           PanelEdges[I] := PanelPos;
  832.         end;
  833.         PanelEdges[Count - 1] := -1;
  834.         SendMessage(Handle, SB_SETPARTS, Count, Integer(@PanelEdges));
  835.       end;
  836.     end;
  837.     for I := 0 to Count - 1 do
  838.       UpdatePanel(I, UpdateText);
  839.   end;
  840. end;
  841.  
  842. procedure TStatusBarPro.CMWinIniChange(var Message: TMessage);
  843. begin
  844.   inherited;
  845.   if (Message.WParam = 0) or (Message.WParam = SPI_SETNONCLIENTMETRICS) then
  846.     SyncToSystemFont;
  847. end;
  848.  
  849. procedure TStatusBarPro.CNDrawItem(var Message: TWMDrawItem);
  850. var
  851.   SaveIndex: Integer;
  852. begin
  853.   with Message.DrawItemStruct^ do
  854.   begin
  855.     SaveIndex := SaveDC(hDC);
  856.     FCanvas.Lock;
  857.     try
  858.       FCanvas.Handle := hDC;
  859.       FCanvas.Font := Font;
  860.       FCanvas.Brush.Color := Color;
  861.       FCanvas.Brush.Style := bsSolid;
  862.       DrawPanel(Panels[itemID], rcItem);
  863.     finally
  864.       FCanvas.Handle := 0;
  865.       FCanvas.Unlock;
  866.       RestoreDC(hDC, SaveIndex);
  867.     end;
  868.   end;
  869.   Message.Result := 1;
  870. end;
  871.  
  872. procedure TStatusBarPro.WMGetTextLength(var Message: TWMGetTextLength);
  873. begin
  874.   Message.Result := Length(FSimpleText);
  875. end;
  876.  
  877. procedure TStatusBarPro.WMPaint(var Message: TWMPaint);
  878. begin
  879.   UpdatePanels(False, True);
  880.   inherited;
  881. end;
  882.  
  883. procedure TStatusBarPro.WMSize(var Message: TWMSize);
  884. begin
  885.   { Eat WM_SIZE message to prevent control from doing alignment }
  886.   {$IFDEF DELPHI4_UP}
  887.   if not (csLoading in ComponentState) then Resize;
  888.   {$ENDIF}
  889.   Repaint;
  890. end;
  891.  
  892. procedure TStatusBarPro.CMHintShow(var Message: TCMHintShow);
  893. begin
  894.   inherited;
  895.   if Assigned(FMousePanel) and (FMousePanel.Hint <> '') then
  896.     Message.HintInfo^.HintStr := FMousePanel.Hint
  897.   else
  898.     Message.HintInfo^.HintStr := Hint;
  899. end;
  900.  
  901. function TStatusBarPro.FindPanelAtPos(Point: TPoint): TStatusPanelPro;
  902. var
  903.   Index: Integer;
  904.   PanelRect: TRect;
  905. begin
  906.   Result := nil;
  907.   for Index := 0 to FPanels.Count-1 do
  908.   begin
  909.     SendMessage(Handle, SB_GETRECT, Index, Integer(@PanelRect));
  910.     if PtInRect(PanelRect, Point) then
  911.     begin
  912.       Result := FPanels[Index];
  913.       Break;
  914.     end;
  915.   end;
  916. end;
  917.  
  918. procedure TStatusBarPro.WndProc(var Message: TMessage);
  919. var
  920.   OldPanel: TStatusPanelPro;
  921. begin
  922.   if (Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_RBUTTONDOWN) then
  923.     FMousePanel := FindPanelAtPos(Point(Message.LParamLo, Message.LParamHi))
  924.   else if ShowHint and (Message.Msg = WM_MOUSEMOVE) then
  925.   begin
  926.     OldPanel := FMousePanel;
  927.     FMousePanel := FindPanelAtPos(Point(Message.LParamLo, Message.LParamHi));
  928.     if OldPanel <> FMousePanel then Application.CancelHint;
  929.   end;
  930.   inherited WndProc(Message);
  931. end;
  932.  
  933. procedure TStatusBarPro.Click;
  934. begin
  935.   if Assigned(FMousePanel) and Assigned(FMousePanel.OnClick) then
  936.     FMousePanel.OnClick(FMousePanel)
  937.   else if Assigned(OnClick) then
  938.     FMousePanel.OnClick(Self);
  939. end;
  940.  
  941. procedure TStatusBarPro.DblClick;
  942. begin
  943.   if Assigned(FMousePanel) and Assigned(FMousePanel.OnDblClick) then
  944.     FMousePanel.OnDblClick(FMousePanel)
  945.   else if Assigned(OnDblClick) then
  946.     FMousePanel.OnDblClick(Self);
  947. end;
  948.  
  949. function TStatusBarPro.GetPopupMenu: TPopupMenu;
  950. begin
  951.   if Assigned(FMousePanel) and Assigned(FMousePanel.PopupMenu) then
  952.   begin
  953.     Result := FMousePanel.PopupMenu;
  954.     {$IFDEF DELPHI4_UP}
  955.     if Result <> nil then Result.BiDiMode := FMousePanel.BiDiMode;
  956.     {$ENDIF}
  957.   end
  958.   else
  959.     Result := PopupMenu;
  960. end;
  961.  
  962. function TStatusBarPro.IsFontStored: Boolean;
  963. begin
  964.   Result := not FUseSystemFont and not ParentFont and not DesktopFont;
  965. end;
  966.  
  967. procedure TStatusBarPro.SetUseSystemFont(const Value: Boolean);
  968. begin
  969.   if FUseSystemFont <> Value then
  970.   begin
  971.     FUseSystemFont := Value;
  972.     if Value then
  973.     begin
  974.       if ParentFont then ParentFont := False;
  975.       SyncToSystemFont;
  976.     end;
  977.   end;
  978. end;
  979.  
  980. procedure TStatusBarPro.CMColorChanged(var Message: TMessage);
  981. begin
  982.   inherited;
  983.   RecreateWnd;
  984. end;
  985.  
  986. procedure TStatusBarPro.CMParentFontChanged(var Message: TMessage);
  987. begin
  988.   inherited;
  989.   if FUseSystemFont and ParentFont then FUseSystemFont := False;
  990. end;
  991.  
  992. {$IFDEF DELPHI4_UP}
  993. function TStatusBarPro.ExecuteAction(Action: TBasicAction): Boolean;
  994. begin
  995.   if AutoHint and (Action is THintAction) and not DoHint then
  996.   begin
  997.     if SimplePanel or (Panels.Count = 0) then
  998.       SimpleText := THintAction(Action).Hint else
  999.       Panels[0].Text := THintAction(Action).Hint;
  1000.     Result := True;
  1001.   end
  1002.   else Result := inherited ExecuteAction(Action);
  1003. end;
  1004. {$ENDIF}
  1005.  
  1006. procedure TStatusBarPro.CMSysColorChange(var Message: TMessage);
  1007. begin
  1008.   inherited;
  1009.   RecreateWnd;
  1010. end;
  1011.  
  1012. procedure TStatusBarPro.CMSysFontChanged(var Message: TMessage);
  1013. begin
  1014.   inherited;
  1015.   SyncToSystemFont;
  1016. end;
  1017.  
  1018. procedure TStatusBarPro.ChangeScale(M, D: Integer);
  1019. begin
  1020.   if FUseSystemFont then  // status bar size based on system font size
  1021.     ScalingFlags := [sfTop];
  1022.   inherited;
  1023. end;
  1024.  
  1025. end.
  1026.