sstatusbar.pas

AlphaControls是一个Delphi标准控件的集合

unit sStatusBar;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, sPanel,
  commctrl, ComStrs, StdActns, sStyleUtil, sConst, sUtils, sGraphUtils,
  sDefaults, sVclUtils;

type
  TsStatusBar = class;

  TsStatusPanelStyle = (psText, psOwnerDraw);
  TsStatusPanelBevel = (pbNone, pbLowered, pbRaised);

  TsStatusPanel = class(TCollectionItem)
  private
    FText: string;
    FWidth: Integer;
    FAlignment: TAlignment;
    FBevel: TsStatusPanelBevel;
    FBiDiMode: TBiDiMode;
    FParentBiDiMode: Boolean;
    FStyle: TsStatusPanelStyle;
    FUpdateNeeded: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetBevel(Value: TsStatusPanelBevel);
    procedure SetBiDiMode(Value: TBiDiMode);
    procedure SetParentBiDiMode(Value: Boolean);
    procedure SetStyle(Value: TsStatusPanelStyle);
    procedure SetText(const Value: string);
    procedure SetWidth(Value: Integer);
    function IsBiDiModeStored: Boolean;
  protected
    function GetDisplayName: string; override;
    procedure ParentRedraw;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    procedure ParentBiDiModeChanged;
    function UseRightToLeftAlignment: Boolean;
    function UseRightToLeftReading: Boolean;
    property Style: TsStatusPanelStyle read FStyle write SetStyle default psText;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Bevel: TsStatusPanelBevel read FBevel write SetBevel default pbLowered;
    property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;
    property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
    property Text: string read FText write SetText;
    property Width: Integer read FWidth write SetWidth;
  end;

  TsStatusPanels = class(TCollection)
  private
    FStatusBar: TsStatusBar;
    function GetItem(Index: Integer): TsStatusPanel;
    procedure SetItem(Index: Integer; Value: TsStatusPanel);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    procedure ParentRedraw;
    constructor Create(StatusBar: TsStatusBar);
    function Add: TsStatusPanel;
    property Items[Index: Integer]: TsStatusPanel read GetItem write SetItem; default;
  end;

  TDrawPanelEvent = procedure(Canvas: TCanvas; StatusBar: TsStatusBar; Panel: TsStatusPanel;
    const Rect: TRect) of object;

  TsStatusBar = class(TsCustomPanel)
  private
    FPanels: TsStatusPanels;
    FSimpleText: string;
    FSimplePanel: Boolean;
    FSizeGrip: Boolean;
    FUseSystemFont: Boolean;
    FAutoHint: Boolean;
    FOnDrawPanel: TDrawPanelEvent;
    FOnHint: TNotifyEvent;
    procedure DoRightToLeftAlignment(var Str: string; AAlignment: TAlignment; ARTLAlignment: Boolean);
    function IsFontStored: Boolean;
    procedure SetPanels(Value: TsStatusPanels);
    procedure SetSimplePanel(Value: Boolean);
    procedure UpdateSimpleText;
    procedure SetSimpleText(const Value: string);
    procedure SetSizeGrip(Value: Boolean);
    procedure SyncToSystemFont;
    procedure UpdatePanel(Index: Integer; Repaint: Boolean);
    procedure UpdatePanels(UpdateRects, UpdateText: Boolean);
    procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
    procedure CMWinIniChange(var Message: TMessage); message CM_WININICHANGE;
    procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure SetUseSystemFont(const Value: Boolean);
  protected
    procedure ChangeScale(M, D: Integer); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    function DoHint: Boolean; virtual;
    procedure DrawPanel(Panel: TsStatusPanel; const Rect: TRect); dynamic;
    procedure InternalDrawPanel(Panel: TsStatusPanel; Text: string; Rect: TRect);
    procedure WriteText(R : TRect; sStyle: TsPaintStyle); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Paint; override;
    procedure PaintBody;
    procedure PaintGrip(p: TPoint);
    procedure PaintPanels;

    function PanelOffset(k: integer) : integer;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    procedure FlipChildren(AllLevels: Boolean); override;
    procedure WndProc (var Message: TMessage); override;
  published
    property AutoHint: Boolean read FAutoHint write FAutoHint default False;
    property Align default alBottom;
    property Constraints;
    property Font stored IsFontStored;
    property Height default 21;
    property Panels: TsStatusPanels read FPanels write SetPanels;
    property ParentFont default False;
    property SimplePanel: Boolean read FSimplePanel write SetSimplePanel;
    property SimpleText: string read FSimpleText write SetSimpleText;
    property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
    property UseSystemFont: Boolean read FUseSystemFont write SetUseSystemFont default True;
    property OnContextPopup;
    property OnHint: TNotifyEvent read FOnHint write FOnHint;
    property OnDrawPanel: TDrawPanelEvent read FOnDrawPanel write FOnDrawPanel;
  end;

function InitCommonControl(CC: Integer): Boolean;
procedure CheckCommonControl(CC: Integer);

implementation

uses sStyleSimply, sBorders, sMaskData, sSkinProps;

function InitCommonControl(CC: Integer): Boolean;
var
  ICC: TInitCommonControlsEx;
begin
  ICC.dwSize := SizeOf(TInitCommonControlsEx);
  ICC.dwICC := CC;
  Result := InitCommonControlsEx(ICC);
  if not Result then InitCommonControls;
end;

procedure CheckCommonControl(CC: Integer);
begin
  if not InitCommonControl(CC) then raise EComponentError.CreateRes(@SInvalidComCtl32);
end;

{ TsStatusPanel }

constructor TsStatusPanel.Create(Collection: TCollection);
begin
  FWidth := 84;
  FBevel := pbLowered;
  FParentBiDiMode := True;
  inherited Create(Collection);
  ParentBiDiModeChanged;
end;

procedure TsStatusPanel.Assign(Source: TPersistent);
begin
  if Source is TsStatusPanel then begin
    Text := TsStatusPanel(Source).Text;
    Width := TsStatusPanel(Source).Width;
    Alignment := TsStatusPanel(Source).Alignment;
    Bevel := TsStatusPanel(Source).Bevel;
    Style := TsStatusPanel(Source).Style;
    ParentRedraw;
  end
  else inherited Assign(Source);
end;

procedure TsStatusPanel.SetBiDiMode(Value: TBiDiMode);
begin
  if Value <> FBiDiMode then begin
    FBiDiMode := Value;
    FParentBiDiMode := False;
    Changed(False);
    ParentRedraw;
  end;
end;

function TsStatusPanel.IsBiDiModeStored: Boolean;
begin
  Result := not FParentBiDiMode;
end;

procedure TsStatusPanel.SetParentBiDiMode(Value: Boolean);
begin
  if FParentBiDiMode <> Value then begin
    FParentBiDiMode := Value;
    ParentBiDiModeChanged;
    ParentRedraw;
  end;
end;

procedure TsStatusPanel.ParentBiDiModeChanged;
begin
  if FParentBiDiMode then begin
    if GetOwner <> nil then begin
      BiDiMode := TsStatusPanels(GetOwner).FStatusBar.BiDiMode;
      FParentBiDiMode := True;
    end;
  end;
end;

function TsStatusPanel.UseRightToLeftReading: Boolean;
begin
  Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
end;

function TsStatusPanel.UseRightToLeftAlignment: Boolean;
begin
  Result := SysLocale.MiddleEast and (BiDiMode = bdRightToLeft);
end;

function TsStatusPanel.GetDisplayName: string;
begin
  Result := Text;
  if Result = '' then Result := inherited GetDisplayName;
end;

procedure TsStatusPanel.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    Changed(False);
    ParentRedraw;
  end;
end;

procedure TsStatusPanel.SetBevel(Value: TsStatusPanelBevel);
begin
  if FBevel <> Value then begin
    FBevel := Value;
    Changed(False);
    ParentRedraw;
  end;
end;

procedure TsStatusPanel.SetStyle(Value: TsStatusPanelStyle);
begin
  if FStyle <> Value then begin
    FStyle := Value;
    Changed(False);
    ParentRedraw;
  end;
end;

procedure TsStatusPanel.SetText(const Value: string);
begin
  if FText <> Value then begin
    FText := Value;
    Changed(False);
    ParentRedraw;
  end;
end;

procedure TsStatusPanel.SetWidth(Value: Integer);
begin
  if FWidth <> Value then begin
    FWidth := Value;
    Changed(True);
    ParentRedraw;
  end;
end;

procedure TsStatusPanel.ParentRedraw;
begin
  TsStatusPanels(Collection).ParentRedraw;
end;

{ TsStatusPanels }

constructor TsStatusPanels.Create(StatusBar: TsStatusBar);
begin
  inherited Create(TsStatusPanel);
  FStatusBar := StatusBar;
end;

function TsStatusPanels.Add: TsStatusPanel;
begin
  Result := TsStatusPanel(inherited Add);
end;

function TsStatusPanels.GetItem(Index: Integer): TsStatusPanel;
begin
  Result := TsStatusPanel(inherited GetItem(Index));
end;

function TsStatusPanels.GetOwner: TPersistent;
begin
  Result := FStatusBar;
end;

procedure TsStatusPanels.SetItem(Index: Integer; Value: TsStatusPanel);
begin
  inherited SetItem(Index, Value);
end;

procedure TsStatusPanels.Update(Item: TCollectionItem);
begin
  if Item <> nil
    then FStatusBar.UpdatePanel(Item.Index, False)
    else FStatusBar.UpdatePanels(True, False);
end;

procedure TsStatusPanels.ParentRedraw;
begin
  if not RestrictDrawing then FStatusBar.sStyle.BGChanged := True;
end;

{ TsStatusBar }

constructor TsStatusBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque, csAcceptsControls];
  FsStyle.COC := COC_TsStatusBar;

  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsStatusBar;
  end;

  Height := 21;
  Align := alBottom;
  FPanels := TsStatusPanels.Create(Self);
  FSizeGrip := True;
  FUseSystemFont := True;
  SyncToSystemFont;
end;

destructor TsStatusBar.Destroy;
begin
  FreeAndNil(FPanels);
  FreeAndNil(FsStyle);
  inherited Destroy;
end;

procedure TsStatusBar.CreateParams(var Params: TCreateParams);
const
  GripStyles: array[Boolean] of DWORD = (CCS_TOP, SBARS_SIZEGRIP);
begin
  InitCommonControl(ICC_BAR_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, STATUSCLASSNAME);

  Params.Style := Params.Style or GripStyles[FSizeGrip
  and (TCustomForm(GetParentForm(Self)).BorderStyle in [bsSizeable, bsSizeToolWin])];
  Params.WindowClass.style := Params.WindowClass.style and not CS_HREDRAW;
end;

procedure TsStatusBar.CreateWnd;
begin
  inherited CreateWnd;
  UpdatePanels(True, False);
end;

function TsStatusBar.DoHint: Boolean;
begin
  if Assigned(FOnHint) then begin
    FOnHint(Self);
    Result := True;
  end
  else Result := False;
end;

procedure TsStatusBar.DrawPanel(Panel: TsStatusPanel; const Rect: TRect);
var
  aRect: TRect;
begin
  aRect := Rect;
  InflateRect(aRect, -1, -1);

  if Assigned(FOnDrawPanel) then begin
    if Assigned(sStyle) then begin
      FOnDrawPanel(sStyle.FCacheBmp.Canvas, Self, Panel, Rect)
    end;
  end
  else begin
    InternalDrawPanel(Panel, '', aRect); 
  end;
end;

procedure TsStatusBar.SetPanels(Value: TsStatusPanels);
begin
  FPanels.Assign(Value);
  sStyle.Invalidate;
end;

procedure TsStatusBar.SetSimplePanel(Value: Boolean);
begin
  if FSimplePanel <> Value then begin
    FSimplePanel := Value;
    if HandleAllocated then SendMessage(Handle, SB_SIMPLE, Ord(FSimplePanel), 0);
    sStyle.Invalidate;
  end;
end;

procedure TsStatusBar.DoRightToLeftAlignment(var Str: string; AAlignment: TAlignment; ARTLAlignment: Boolean);