psstatusbar.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

(*  GREATIS PRINT SUITE                              *)
(*  unit version 1.85.006.001                        *)
(*  Copyright (C) 2001-2007 Greatis Software         *)
(*  http://www.greatis.com/delphicb/printsuite/      *)
(*  http://www.greatis.com/delphicb/printsuite/faq/  *)
(*  http://www.greatis.com/bteam.html                *)
(*  Improved by Thomas "Bulldog" Jackson             *)
(*  http://www.greatis.com/delphicb/bulldog/         *)


unit PSStatusBar;

interface

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

type

  TPanelKind = (pnPage,pnScale);
  TPanels = set of TPanelKind;

  TCustomPreviewStatusBar = class(TWinControl)
  private
    FPreview: TCustomPreview;
    FPanels: TPanels;
    FPagePanelWidth: Integer;
    FScalePanelWidth: Integer;
    FUserText: string;
    FSizeGrip: Boolean;
    FOnUpdate: TNotifyEvent;
    procedure SetPreview(const Value: TCustomPreview);
    procedure SetPanels(const Value: TPanels);
    procedure SetPagePanelWidth(const Value: Integer);
    procedure SetScalePanelWidth(const Value: Integer);
    procedure SetUserText(const Value: string);
    procedure SetSizeGrip(const Value: Boolean);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property Preview: TCustomPreview read FPreview write SetPreview;
    property Panels: TPanels read FPanels write SetPanels default [pnPage,pnScale];
    property PagePanelWidth: Integer read FPagePanelWidth write SetPagePanelWidth default 100;
    property ScalePanelWidth: Integer read FScalePanelWidth write SetScalePanelWidth default 100;
    property UserText: string read FUserText write SetUserText;
    property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
  end;

  TPreviewStatusBar = class(TCustomPreviewStatusBar)
  published
    property Preview;
    property Panels;
    property PagePanelWidth;
    property ScalePanelWidth;
    property UserText;
    property SizeGrip;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnUpdate;
  end;

procedure Register;

implementation

procedure TCustomPreviewStatusBar.SetPreview(const Value: TCustomPreview);
begin
  if Value<>FPreview then
  begin
    if Assigned(FPreview) then FPreview.DeleteControlNotification(Self);
    FPreview:=Value;
    if Assigned(FPreview) then FPreview.AddControlNotification(Self);
    Update;
  end;
end;

procedure TCustomPreviewStatusBar.SetPanels(const Value: TPanels);
begin
  if Value<>FPanels then
  begin
    FPanels:=Value;
    Update;
  end;
end;

procedure TCustomPreviewStatusBar.SetPagePanelWidth(const Value: Integer);
begin
  if Value<>FPagePanelWidth then
  begin
    FPagePanelWidth:=Value;
    Update;
  end;
end;

procedure TCustomPreviewStatusBar.SetScalePanelWidth(const Value: Integer);
begin
  if Value<>FScalePanelWidth then
  begin
    FScalePanelWidth:=Value;
    Update;
  end;
end;

procedure TCustomPreviewStatusBar.SetUserText(const Value: string);
begin
  if Value<>FUserText then
  begin
    FUserText:=Value;
    Update;
  end;
end;

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

constructor TCustomPreviewStatusBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle:=[csCaptureMouse,csClickEvents,csDoubleClicks,csOpaque];
  Color:=clBtnFace;
  Height:=19;
  Align:=alBottom;
  FPanels:=[pnPage,pnScale];
  FPagePanelWidth:=100;
  FScalePanelWidth:=100;
  FSizeGrip:=True;
end;

destructor TCustomPreviewStatusBar.Destroy;
begin
  if Assigned(FPreview) then FPreview.DeleteControlNotification(Self);
  inherited Destroy;
end;

procedure TCustomPreviewStatusBar.Update;
  { local function begin }
  { to be used if you do not have a canvas -
    code from Peter Below with a few modifications by me }
  function CalcMaxWidthOfStrings(const S: string; AFont: TFont): Integer;
  var
    Canvas: TCanvas;
  begin
    Assert(Assigned(AFont));
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := CreateDC('DISPLAY', nil, nil, nil);
      try
        Canvas.Font := AFont;
        Result := Canvas.TextWidth(S);
      finally
        DeleteDC(Canvas.Handle);
        Canvas.Handle := 0;
      end;
    finally
      if Assigned(Canvas) then
        Canvas.Free;
    end;
  end;
  { local function end }
var
  S: string;
  Count: Integer;
  Parts: array[0..2] of Integer;
begin
  inherited;
  if Assigned(Parent) and Assigned(FPreview) then
    with FPreview do
    begin
      Count:=0;
      if pnPage in Panels then
      begin
        Parts[Count] := (CalcMaxWidthOfStrings(PageText, Self.Font) + 10);
//        Parts[Count]:=FPagePanelWidth;
        Inc(Count);
      end;
      if pnScale in Panels then
      begin
        Parts[Count] := (CalcMaxWidthOfStrings(ScaleText, Self.Font) + 10);
//        Parts[Count]:=FScalePanelWidth;
        if Count>0 then Inc(Parts[Count],Parts[0]);
        Inc(Count);
      end;
      Parts[Count]:=ClientWidth;
      SendMessage(Self.Handle,SB_SETPARTS,Count+1,Integer(@Parts));
      Count:=0;
      S := PageText;
      Insert(#9#9, S, 1);  { to make right alignment change #9 to #9#9 }
      if pnPage in Panels then
      begin
        SendMessage(Self.Handle, SB_SETTEXT, Count, Integer(PChar(S)));
//        SendMessage(Self.Handle,SB_SETTEXT,Count,Integer(PChar(PageText)));
        Inc(Count);
      end;
      S := ScaleText;
      Insert(#9, S, 1);  { to make right alignment change #9 to #9#9 }
      if pnScale in Panels then
      begin
        SendMessage(Self.Handle, SB_SETTEXT, Count, Integer(PChar(S)));
//        SendMessage(Self.Handle,SB_SETTEXT,Count,Integer(PChar(ScaleText)));
        Inc(Count);
      end;
      if (Trim(FUserText) <> '') then SendMessage(Self.Handle,SB_SETTEXT,Count,Integer(PChar(' ' + FUserText))); { space character gets the text off of the panel edge }
    end;
  if Assigned(FOnUpdate) then FOnUpdate(Self);
end;

procedure TCustomPreviewStatusBar.CreateParams(var Params: TCreateParams);
const
  GripStyles: array[Boolean] of DWORD = (CCS_BOTTOM, SBARS_SIZEGRIP);
begin
  InitCommonControl(ICC_BAR_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params,STATUSCLASSNAME);
  with Params do
  begin
    Style := Style or GripStyles[FSizeGrip];
//    if FSizeGrip then Style:=Style or SBARS_SIZEGRIP;
    WindowClass.style:=WindowClass.style and not CS_HREDRAW;
  end;
end;

procedure TCustomPreviewStatusBar.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and Assigned(FPreview) and (AComponent=FPreview) then
    Preview:=nil;
end;

procedure Register;
begin
  RegisterComponents('Print Suite', [TPreviewStatusBar]);
end;

end.