ddhdbstatus.pas

Delphi高级开发指南是开发程序的好帮手

unit DdhDbStatus;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Db, CommCtrl, DbTables;

type
  TDdhStatusPanels = class;
  TDdhStatusPanel = class;

  TDdhDbStatus = class (TWinControl)
  private
    // data-aware support fields
    FDataLink: TDataLink;
    // status bar fields
    FPanels: TDdhStatusPanels;
    FCanvas: TCanvas;
    FSizeGrip: Boolean;
    // data-aware support methods
    function GetDataSource: TDataSource;
    procedure SetDataSource (Value: TDataSource);
    // status bar methods
    procedure SetSizeGrip(Value: Boolean);
    procedure UpdatePanel(Index: Integer);
    procedure UpdatePanels;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DrawPanel(Panel: TDdhStatusPanel; const Rect: TRect); dynamic;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read FCanvas;
  published
    property DataSource: TDataSource
      read GetDataSource write SetDataSource;
    property Align default alBottom;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  TDdhStatusPanel = class(TCollectionItem)
  private
    FText: string;
    FWidth: Integer;
    FAlignment: TAlignment;
    FBevel: TStatusPanelBevel;
    FStyle: TStatusPanelStyle;
    function GetDisplayName: string; override;
    procedure SetAlignment(Value: TAlignment);
    procedure SetBevel(Value: TStatusPanelBevel);
    procedure SetStyle(Value: TStatusPanelStyle);
    procedure SetText(const Value: string);
    procedure SetWidth(Value: Integer);
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Bevel: TStatusPanelBevel read FBevel write SetBevel default pbLowered;
    property Style: TStatusPanelStyle read FStyle write SetStyle default psText;
    property Text: string read FText write SetText;
    property Width: Integer read FWidth write SetWidth;
  end;

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

procedure Register;

implementation

////// data link //////

type
  TDdhStatusLink = class (TDataLink)
  private
    FBar: TDdhDbStatus;
  public
    constructor Create (Bar: TDdhDbStatus);
    procedure ActiveChanged; override;
    procedure EditingChanged; override;
    procedure RecordChanged (Field: TField); override;
    function RecordSummary: String;
  end;

constructor TDdhStatusLink.Create (Bar: TDdhDbStatus);
begin
  inherited Create;
  FBar := Bar;
end;

procedure TDdhStatusLink.ActiveChanged;
begin
  if Active then
  begin
    if DataSet is TTable then
      FBar.FPanels[0].Text := TTable(DataSet).TableName
    else if DataSet is TQuery then
      FBar.FPanels[0].Text := TQuery (DataSet).SQL.Text;
    FBar.FPanels[1].Text := '[Browsing]';
    FBar.FPanels [2].Text := RecordSummary;
  end
  else
  begin
    FBar.FPanels[0].Text := '[Inactive]';
    FBar.FPanels[1].Text := '[]';
  end;
end;

procedure TDdhStatusLink.EditingChanged;
begin
  if Editing then
    FBar.FPanels[1].Text := '[Editing]'
  else
    FBar.FPanels[1].Text := '[Browsing]';
end;

procedure TDdhStatusLink.RecordChanged (Field: TField);
begin
  FBar.FPanels [2].Text := RecordSummary;
end;

function TDdhStatusLink.RecordSummary;
var
  I: Integer;
begin
  for I := 0 to DataSet.FieldCount - 1 do
    Result := Result +
      DataSet.Fields[I].DisplayText + ' ';
end;

{ TDdhStatusPanel }

constructor TDdhStatusPanel.Create(Collection: TCollection);
begin
  FWidth := 50;
  FBevel := pbLowered;
  inherited Create(Collection);
end;

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

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

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

procedure TDdhStatusPanel.SetBevel(Value: TStatusPanelBevel);
begin
  if FBevel <> Value then
  begin
    FBevel := Value;
    Changed(True);
  end;
end;

procedure TDdhStatusPanel.SetStyle(Value: TStatusPanelStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Changed(False);
  end;
end;

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

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

{ TDdhStatusPanels }

constructor TDdhStatusPanels.Create(StatusBar: TDdhDbStatus);
begin
  inherited Create(TDdhStatusPanel);
  FStatusBar := StatusBar;
end;

function TDdhStatusPanels.Add: TDdhStatusPanel;
begin
  Result := TDdhStatusPanel(inherited Add);
end;

function TDdhStatusPanels.GetItem(Index: Integer): TDdhStatusPanel;
begin
  Result := TDdhStatusPanel(inherited GetItem(Index));
end;

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

procedure TDdhStatusPanels.SetItem(Index: Integer; Value: TDdhStatusPanel);
begin
  inherited SetItem(Index, Value);
end;

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

////// component //////

constructor TDdhDbStatus.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FDataLink := TDdhStatusLink.Create (self);
  // status bar
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  Color := clBtnFace;
  Height := 19;
  Align := alBottom;
  // create four panels and initialize them
  FPanels := TDdhStatusPanels.Create(Self);
  FPanels.Add.Text := '[Inactive]';
  FPanels.Add.Text := '[]';
  FPanels.Add.Text := 'Record';
  UpdatePanels;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FSizeGrip := True;
end;

destructor TDdhDbStatus.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  // status bar
  FCanvas.Free;
  FPanels.Free;
  inherited Destroy;
end;

procedure TDdhDbStatus.CreateParams(var Params: TCreateParams);
begin
  InitCommonControl(ICC_BAR_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, STATUSCLASSNAME);
  with Params do
  begin
    if FSizeGrip then
      Style := Style or SBARS_SIZEGRIP else
      Style := Style or CCS_TOP;
    WindowClass.style := WindowClass.style and not CS_HREDRAW;
  end;
end;

procedure TDdhDbStatus.CreateWnd;
begin
  inherited CreateWnd;
  UpdatePanels;
end;

procedure TDdhDbStatus.SetSizeGrip(Value: Boolean);
begin
  if FSizeGrip <> Value then
  begin
    FSizeGrip := Value;
    RecreateWnd;
  end;
end;

procedure TDdhDbStatus.UpdatePanel(Index: Integer);
var
  Flags: Integer;
  S: string;
begin
  if HandleAllocated then
    with FPanels[Index] do
    begin
      Flags := 0;
      case Bevel of
        pbNone: Flags := SBT_NOBORDERS;
        pbRaised: Flags := SBT_POPOUT;
      end;
      if Style = psOwnerDraw then Flags := Flags or SBT_OWNERDRAW;
      S := Text;
      case Alignment of
        taCenter: S := #9 + S;
        taRightJustify: S := #9#9 + S;
      end;
      SendMessage(Handle, SB_SETTEXT, Index or Flags, Integer(PChar(S)));
      InvalidateRect(Handle, Nil, True);
    end;
end;

procedure TDdhDbStatus.UpdatePanels;
const
  MaxPanelCount = 128;
var
  I, Count, PanelPos: Integer;
  PanelEdges: array[0..MaxPanelCount - 1] of Integer;
begin
  if HandleAllocated then
  begin
    Count := FPanels.Count;
    if Count > MaxPanelCount then Count := MaxPanelCount;
    if Count = 0 then
    begin
      PanelEdges[0] := -1;
      SendMessage(Handle, SB_SETPARTS, 1, Integer(@PanelEdges));
      SendMessage(Handle, SB_SETTEXT, 0, Integer(PChar('')));
    end else
    begin
      PanelPos := 0;
      for I := 0 to Count - 2 do
      begin
        Inc(PanelPos, FPanels[I].Width);
        PanelEdges[I] := PanelPos;
      end;
      PanelEdges[Count - 1] := -1;
      SendMessage(Handle, SB_SETPARTS, Count, Integer(@PanelEdges));
      for I := 0 to Count - 1 do UpdatePanel(I);
    end;
  end;
end;

procedure TDdhDbStatus.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Handle := hDC;
    FCanvas.Font := Font;
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.Brush.Style := bsSolid;
    DrawPanel(FPanels[itemID], rcItem);
    FCanvas.Handle := 0;
    RestoreDC(hDC, SaveIndex);
  end;
  Message.Result := 1;
end;

procedure TDdhDbStatus.DrawPanel(Panel: TDdhStatusPanel; const Rect: TRect);
begin
  FCanvas.FillRect(Rect);
end;

procedure TDdhDbStatus.WMSize(var Message: TWMSize);
begin
  { Eat WM_SIZE message to prevent control from doing alignment }
  FPanels [0].Width := Width div 4;
  FPanels [1].Width := Width div 4;
  Repaint;
end;

// data-aware support
function TDdhDbStatus.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TDdhDbStatus.SetDataSource (Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

procedure Register;
begin
  RegisterComponents('DDHB DB', [TDdhDbStatus]);
end;

end.