fthsbar.pas

Gestione Cellulari Nokia

{*******************************************************}
{                                                       }
{       4th GUI Library for Delphi                      }
{       FourthShortcutBar Unit                          }
{                                                       }
{       Copyright (C) 1996,2001 Sergey S. Tkachenko     }
{       e-mail: [e-mail]                    }
{          Web: http://www.4thfebruary.f2s.com          }
{                                                       }
{       Based on the TjanOutPanel by Jan Verhoeven      }
{                                                       }
{*******************************************************}

unit FthSBar;

{$I FTHVER.INC}

interface

uses
  Messages, Windows, SysUtils, Classes, Controls, Forms,
{$IFDEF DELPHI4_UP}
  ActnList, ImgList,
{$ENDIF}
  StdCtrls, ExtCtrls, Graphics;

type

{ TFourthShortcutBar }

  TFourthShortcutBarButtonState = (sbbsRaised, sbbsFlat, sbbsSunken);

  TFourthShortcutBar = class;
  TFourthShortcutBarPanel = class;
  TFourthShortcutBarButtons = class;

{ TFourthShortcutBarButton }

  TFourthShortcutBarButton = class(TCollectionItem)
  private
//    FAction: TCustomAction;
    FDisplayRect: TRect;
    FButtonRect: TRect;
    FText: string;
    FImageIndex: Integer;
    FOnClick: TNotifyEvent;
//    FVisible: Integer;
    procedure SetText(const Value: string);
    procedure SetImageIndex(const Value: Integer);
//    procedure SetVisible(Value: Boolean);
    procedure SetOnClick(const Value: TNotifyEvent);
  protected
{$IFDEF DELPHI3_UP}
    function GetDisplayName: string; override;
{$ENDIF}
    procedure Click;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
//    property Action: TCustomAction read FAction write FAction;
    property Text: string read FText write SetText;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
//    property Visible: Boolean read FVisible write SetVisible;
    property OnClick: TNotifyEvent read FOnClick write SetOnClick;
  end;

{ TFourthShortcutBarButtons }

  TFourthShortcutBarButtons = class(TCollection)
  private
    FFourthShortcutBarPanel: TFourthShortcutBarPanel;
    function GetItem(Index: Integer): TFourthShortcutBarButton;
    procedure SetItem(Index: Integer; Value: TFourthShortcutBarButton);
//    function GetVisibleCount: Integer;
  protected
{$IFDEF DELPHI3_UP}
    function GetOwner: TPersistent; override;
{$ENDIF}
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(FourthShortcutBarPanel: TFourthShortcutBarPanel);
    function Add: TFourthShortcutBarButton;
    property Items[Index: Integer]: TFourthShortcutBarButton read GetItem write SetItem; default;
//    property VisibleCount: Integer read GetVisibleCount;
  end;

{ TFourthShortcutBarPanel }

  TFourthShortcutBarPanel = class(TCollectionItem)
  private
    FDisplayRect: TRect;
    FText: string;
    FButtons: TFourthShortcutBarButtons;
    FOnClick: TNotifyEvent;
    FSmallImages: Boolean;
    procedure SetText(const Value: string);
    procedure SetButtons(const Value: TFourthShortcutBarButtons);
    procedure SetOnClick(const Value: TNotifyEvent);
    procedure SetSmallImages(const Value: boolean);
  protected
{$IFDEF DELPHI3_UP}
    function GetDisplayName: string; override;
{$ENDIF}
    procedure Click;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Text: string read FText write SetText;
    property Buttons: TFourthShortcutBarButtons read FButtons write SetButtons;
    property OnClick: TNotifyEvent read FOnClick write SetOnClick;
    property SmallImages: Boolean read FSmallImages write SetSmallImages;
  end;

{ TFourthShortcutBarPanels }

  TFourthShortcutBarPanels = class(TCollection)
  private
    FFourthShortcutBar: TFourthShortcutBar;
    function GetItem(Index: Integer): TFourthShortcutBarPanel;
    procedure SetItem(Index: Integer; Value: TFourthShortcutBarPanel);
  protected
{$IFDEF DELPHI3_UP}
    function GetOwner: TPersistent; override;
{$ENDIF}
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(FourthShortcutBar: TFourthShortcutBar);
    function Add: TFourthShortcutBarPanel;
    property Items[Index: Integer]: TFourthShortcutBarPanel read GetItem write SetItem; default;
  end;

{ TFourthShortcutBar }

  TDrawPanelEvent = procedure(FourthShortcutBar: TFourthShortcutBar;
    Panel: TFourthShortcutBarPanel; const Rect: TRect) of object;

  TFourthShortcutBar = class(TCustomControl)
  private
    FPanels: TFourthShortcutBarPanels;
    FPanelRect: TRect;        { rectangle for active panel buttons }
    FScrollTimer: TTimer;     { timer for scroll repeat }
    FScrollTop: Integer;      { first visible button }
    FScrollBottom: Integer;   { last visible button }
    FUpR: TRect;              { rect for up scroll button }
    FUpActive: Boolean;       { upscroller visible }
    FUpIsDown: Boolean;       { upscroller depressed }
    FDownR: TRect;            { rect for down scroll button }
    FDownActive: Boolean;     { downscroller visible }
    FDownIsDown: Boolean;     { downscroller depressed }
    FPanelIndex: Integer;     { current panel }
    FTabHeight: Integer;      { height of the clickable tabs }
    FPanelHeight: Integer;    { current height of the buttons area }
    FDownTab: Integer;        { current mousedown Tab }
    FDownButton: Integer;     { current mousedown Button }
    FMoveButton: Integer;     { current mousemove Button }
    FMoveTab: Integer;        { current mousemove Tab }
    FImages: TImagelist;      { large images, caption displayed below image }
    FSmallImages: TImageList; { small images, caption displayed right of image }
    procedure SetPanels(Value: TFourthShortcutBarPanels);
    procedure Update_Panel(Index: Integer; State: TFourthShortcutBarButtonState);
    procedure UpdatePanels(UpdateRects: Boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function GetPanelAtPos(APoint: TPoint): Integer;
    procedure SetPanelIndex(const Value: Integer);
    procedure SetTabHeight(const Value: Integer);
    procedure SetImages(const Value: TImagelist);
    procedure UpdatePanel(First: Boolean; Index: Integer);
    procedure UpdateButton(aPanel, aButton: Integer;
      State: TFourthShortcutBarButtonstate);
    function GetButtonAtPos(Pt: TPoint): Integer;
    procedure SetSmallImages(const Value: TImageList);
    function GetButtonArea(pt: TPoint): Integer;
    procedure DrawDownRaised;
    procedure DrawDownSunken;
    procedure DrawUpRaised;
    procedure DrawUpSunken;
    procedure DrawRaised(R: TRect);
    procedure DrawUpArrow(R: TRect);
    procedure DrawDownArrow(R: TRect);
    procedure DrawSunken(R: TRect);
    procedure TimedScroll(Sender: TObject);
  protected
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure ClickAtPos(APoint: TPoint);
    procedure CreateWnd; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
//    property Canvas: TCanvas read FCanvas;
  published
    property Align default alLeft;
    property Enabled;
    property Font stored True;
    property Images: TImageList read FImages write SetImages;
    property SmallImages: TImageList read FSmallImages write SetSmallImages;
    property Panels: TFourthShortcutBarPanels read FPanels write SetPanels;
    property PanelIndex: Integer read FPanelIndex write SetPanelIndex;
    property TabHeight: Integer read FTabHeight write SetTabHeight;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Hint;
    property Visible;
    property OnClick;
  {$IFDEF DELPHI5_UP}
    property OnContextPopup;
  {$ENDIF}
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  {$IFDEF DELPHI4_UP}
    property OnResize;
  {$ENDIF}
  end;

implementation

uses Consts;

{ TFourthShortcutBarPanel }

constructor TFourthShortcutBarPanel.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FButtons := TFourthShortcutBarButtons.Create(Self);
end;

procedure TFourthShortcutBarPanel.Assign(Source: TPersistent);
begin
  if Source is TFourthShortcutBarPanel then
  begin
    Text := TFourthShortcutBarPanel(Source).Text;
  end else
    inherited Assign(Source);
end;

{$IFDEF DELPHI3_UP}
function TFourthShortcutBarPanel.GetDisplayName: string;
begin
  Result := Text;
  if Result = '' then Result := inherited GetDisplayName;
end;
{$ENDIF}

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

procedure TFourthShortcutBarPanel.SetButtons(const Value: TFourthShortcutBarButtons);
begin
  FButtons.Assign(Value);
end;

destructor TFourthShortcutBarPanel.Destroy;
begin
  FButtons.Free;
  inherited;
end;

procedure TFourthShortcutBarPanel.SetOnClick(const Value: TNotifyEvent);
begin
  FOnClick := Value;
end;

procedure TFourthShortcutBarPanel.Click;
begin
  if Assigned(OnClick) then OnClick(Self);
end;

procedure TFourthShortcutBarPanel.SetSmallImages(const Value: boolean);
begin
  if (FSmallImages <> Value) then
  begin
    FSmallImages := Value;
    Changed(True);
  end;
end;

{ TFourthShortcutBarPanels }

constructor TFourthShortcutBarPanels.Create(FourthShortcutBar: TFourthShortcutBar);
begin
  inherited Create(TFourthShortcutBarPanel);
  FFourthShortcutBar := FourthShortcutBar;
end;

function TFourthShortcutBarPanels.Add: TFourthShortcutBarPanel;
begin
  Result := TFourthShortcutBarPanel(inherited Add);
end;

function TFourthShortcutBarPanels.GetItem(Index: Integer): TFourthShortcutBarPanel;
begin
  Result := TFourthShortcutBarPanel(inherited GetItem(Index));
end;

{$IFDEF DELPHI3_UP}
function TFourthShortcutBarPanels.GetOwner: TPersistent;
begin
  Result := FFourthShortcutBar;
end;
{$ENDIF}

procedure TFourthShortcutBarPanels.SetItem(Index: Integer; Value: TFourthShortcutBarPanel);
begin
  inherited SetItem(Index, Value);
end;

procedure TFourthShortcutBarPanels.Update(Item: TCollectionItem);
begin
  if Item <> nil then
    FFourthShortcutBar.Update_Panel(Item.Index, sbbsFlat) else
    FFourthShortcutBar.UpdatePanels(True);
end;

{ TFourthShortcutBar }

constructor TFourthShortcutBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
//  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  Canvas.Font := Font;
  Color := clBtnFace;
  Width := 100;
  Align := alLeft;
  FTabHeight := 22;
  FPanels := TFourthShortcutBarPanels.Create(Self);
  ParentFont := True;
  FMoveButton := -1;
  FMoveTab := -1;
end;

destructor TFourthShortcutBar.Destroy;
begin
  FPanels.Free;
  inherited Destroy;
end;

procedure TFourthShortcutBar.CreateWnd;
begin
  inherited CreateWnd;
  UpdatePanels(True);
end;

procedure TFourthShortcutBar.SetPanels(Value: TFourthShortcutBarPanels);
begin
  FPanels.Assign(Value);
end;

{ 悟痂耦怅