qiplottoolbar.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiPlotToolBar                                   }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iPlotToolBar;{$endif}
{$ifdef iCLX}unit QiPlotToolBar;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} Menus,  iTypes,  iGPFunctions,  iPlotObjects,  ImgList;{$ENDIF}
  {$IFDEF iCLX}QMenus, QiTypes, QiGPFunctions, QiPlotObjects, QImgList;{$ENDIF}

const
  ButtonTopOffset  = 3;
  ButtonLeftOffset = 3;
  SpacerWidth      = 10;
type
  TiPlotToolBarButtonStyle = (iptbbsButton, iptbbsSpacer);
  TiPlotToolBarButtonType  = (iptbbtResume, iptbbtPause, iptbbtScrollAxesMode, iptbbtZoomAxesMode, iptbbtSelect, iptbbtZoomBox, iptbbtZoomOut,
                              iptbbtZoomIn, iptbbtCursor, iptbbtEdit, iptbbtCopy, iptbbtSave, iptbbtPrint, iptbbtPreview);

  TiPlotToolBar = class;

  TiPlotToolBarButton = class(TiPlotButton)
  private
    FHint       : String;
    FStyle      : TiPlotToolBarButtonStyle;
    FImageList  : TImageList;
    FImageIndex : Integer;
    FImageName  : String;
    FFlat       : Boolean;
    FMouseOver  : Boolean;
    FToolBar    : TiPlotToolBar;
  protected

  public
    procedure DoMouseHint(MouseData: TiPlotMouseData; var HintData: TiHintData); override;
    procedure DoMouseNotOver;                                                    override;

    procedure iMouseMove (var HintData: TiHintData; Shift: TShiftState; X, Y, ScreenX, ScreenY: Integer; DblClickActive: Boolean); override;

    procedure Draw           (const Canvas: TCanvas; const BackGroundColor: TColor);        override;
    procedure DrawLoweredEdge(const Canvas: TCanvas);
    procedure DrawRaisedEdge (const Canvas: TCanvas);

    property ImageList    : TImageList               read FImageList    write FImageList;
    property ImageIndex   : Integer                  read FImageIndex   write FImageIndex;
    property Hint         : String                   read FHint         write FHint;
    property Style        : TiPlotToolBarButtonStyle read FStyle        write FStyle;

    property ImageName    : String                   read FImageName    write FImageName;
    property ToolBar      : TiPlotToolBar            read FToolBar      write FToolBar;

    property Flat         : Boolean                  read FFlat         write FFlat;
  end;

  TiPlotToolBar = class(TiPlotLayoutObject)
  private
    FButtonList           : TStringList;
    FImageList            : TImageList;

    FResumeButton         : TiPlotToolBarButton;
    FPauseButton          : TiPlotToolBarButton;
    FResumePauseSpacer    : TiPlotToolBarButton;

    FAxesModeScrollButton : TiPlotToolBarButton;
    FAxesModeZoomButton   : TiPlotToolBarButton;
    FAxesModeSpacer       : TiPlotToolBarButton;

    FZoomInButton         : TiPlotToolBarButton;
    FZoomOutButton        : TiPlotToolBarButton;
    FZoomInOutSpacer      : TiPlotToolBarButton;

    FSelectButton         : TiPlotToolBarButton;
    FZoomBoxButton        : TiPlotToolBarButton;
    FCursorButton         : TiPlotToolBarButton;
    FZoomBoxCursorSpacer  : TiPlotToolBarButton;

    FEditButton           : TiPlotToolBarButton;
    FEditSpacer           : TiPlotToolBarButton;

    FCopyButton           : TiPlotToolBarButton;
    FSaveButton           : TiPlotToolBarButton;
    FPrintButton          : TiPlotToolBarButton;
    FPreviewButton        : TiPlotToolBarButton;

    FZoomInOutFactor      : Double;
    FFlatButtons          : Boolean;
    FSmallButtons         : Boolean;
    FFlatBorder           : Boolean;
  protected
    procedure SetShowResumeButton     (const Value: Boolean);
    procedure SetShowPauseButton      (const Value: Boolean);
    procedure SetShowAxesModeButtons  (const Value: Boolean);
    procedure SetShowZoomInOutButtons (const Value: Boolean);
    procedure SetShowSelectButton     (const Value: Boolean);
    procedure SetShowZoomBoxButton    (const Value: Boolean);
    procedure SetShowCursorButton     (const Value: Boolean);
    procedure SetShowEditButton       (const Value: Boolean);
    procedure SetShowCopyButton       (const Value: Boolean);
    procedure SetShowPrintButton      (const Value: Boolean);
    procedure SetShowPreviewButton    (const Value: Boolean);
    procedure SetShowSaveButton       (const Value: Boolean);
    procedure SetFlatButtons          (const Value: Boolean);
    procedure SetSmallButtons         (const Value: Boolean);
    procedure SetFlatBorder           (const Value: Boolean);

    function GetShowResumeButton     : Boolean;
    function GetShowPauseButton      : Boolean;
    function GetShowAxesModeButtons  : Boolean;
    function GetShowZoomInOutButtons : Boolean;
    function GetShowSelectButton     : Boolean;
    function GetShowZoomBoxButton    : Boolean;
    function GetShowCursorButton     : Boolean;
    function GetShowEditButton       : Boolean;
    function GetShowCopyButton       : Boolean;
    function GetShowPrintButton      : Boolean;
    function GetShowPreviewButton    : Boolean;
    function GetShowSaveButton       : Boolean;

    procedure SetZoomInOutFactor(const Value: Double);

    function GetCursorActive  : Boolean;
    function GetZoomBoxActive : Boolean;
    function GetSelectActive  : Boolean;

    procedure ResumeClick        (Sender : TObject);
    procedure PauseClick         (Sender : TObject);
    procedure AxesModeScrollClick(Sender : TObject);
    procedure AxesModeZoomClick  (Sender : TObject);
    procedure ZoomOutClick       (Sender : TObject);
    procedure ZoomInClick        (Sender : TObject);
    procedure SelectClick        (Sender : TObject);
    procedure ZoomBoxClick       (Sender : TObject);
    procedure CursorClick        (Sender : TObject);
    procedure EditClick          (Sender : TObject);
    procedure CopyClick          (Sender : TObject);
    procedure SaveClick          (Sender : TObject);
    procedure PrintClick         (Sender : TObject);
    procedure PreviewClick       (Sender : TObject);

    procedure ZoomBoxDownChange  (Sender : TObject);
    procedure CursorDownChange   (Sender : TObject);
    procedure SelectDownChange   (Sender: TObject);

    procedure GroupClick         (Sender : TObject);

    function CreateButton(OnClick : TNotifyEvent; ImageIndex, GroupIndex : Integer; GlphyName, Hint: String) : TiPlotToolBarButton;
    function CreateSpacer : TiPlotToolBarButton;

    procedure UpdateSpacers;
    procedure UpdateResumePauseButtons;

    procedure ButtonInvalidate(Sender : TObject);

    function GetMouseObject(X, Y: Integer): TiPlotObject;                                              override;

    procedure AddMenuItems(PopupMenu: TPopUpMenu);                                                     override;

    function  GetRequiredWidth(const Canvas : TCanvas) : Integer;                                      override;

    procedure NotificationSetFocus(Sender: TObject);                                                   override;

    procedure Draw(const Canvas: TCanvas; const BackGroundColor: TColor);                              override;

    procedure SetupLargeImages;
    procedure SetupSmallImages;
  public
    constructor Create(AOwner: TObject; AOnChange, AOnInsert, AOnRemove, AOnRename: TNotifyEvent); override;
    destructor  Destroy;                                                                               override;

    procedure TurnOffCursor;
         
    property  ZoomBoxActive       : Boolean read GetZoomBoxActive;
    property  CursorActive        : Boolean read GetCursorActive;
    property  SelectActive        : Boolean read GetSelectActive;

    procedure DoButtonClickResume;
    procedure DoButtonClickPause;
    procedure DoButtonClickScrollAxesMode;
    procedure DoButtonClickZoomAxesMode;
    procedure DoButtonClickSelect;
    procedure DoButtonClickZoomBox;
    procedure DoButtonClickZoomOut;
    procedure DoButtonClickZoomIn;
    procedure DoButtonClickCursor;
    procedure DoButtonClickEdit;
    procedure DoButtonClickCopy;
    procedure DoButtonClickSave;
    procedure DoButtonClickPrint;
    procedure DoButtonClickPreview;
  published
    property ShowResumeButton      : Boolean read GetShowResumeButton     write SetShowResumeButton     default True;
    property ShowPauseButton       : Boolean read GetShowPauseButton      write SetShowPauseButton      default True;
    property ShowAxesModeButtons   : Boolean read GetShowAxesModeButtons  write SetShowAxesModeButtons  default True;
    property ShowZoomInOutButtons  : Boolean read GetShowZoomInOutButtons write SetShowZoomInOutButtons default True;
    property ShowSelectButton      : Boolean read GetShowSelectButton     write SetShowSelectButton     default False;
    property ShowZoomBoxButton     : Boolean read GetShowZoomBoxButton    write SetShowZoomBoxButton    default True;
    property ShowCursorButton      : Boolean read GetShowCursorButton     write SetShowCursorButton     default True;
    property ShowEditButton        : Boolean read GetShowEditButton       write SetShowEditButton       default True;
    property ShowCopyButton        : Boolean read GetShowCopyButton       write SetShowCopyButton       default True;
    property ShowSaveButton        : Boolean read GetShowSaveButton       write SetShowSaveButton       default True;
    property ShowPrintButton       : Boolean read GetShowPrintButton      write SetShowPrintButton      default True;
    property ShowPreviewButton     : Boolean read GetShowPreviewButton    write SetShowPreviewButton    default False;

    property ZoomInOutFactor       : Double  read FZoomInOutFactor        write SetZoomInOutFactor;
    property FlatBorder            : Boolean read FFlatBorder             write SetFlatBorder           default False;
    property FlatButtons           : Boolean read FFlatButtons            write SetFlatButtons          default False;
    property SmallButtons          : Boolean read FSmallButtons           write SetSmallButtons         default False;
  end;
                           
{$ifdef iVCL}{$R iPlotPackGlyphs.res} {$endif}
{$ifdef iCLX}{$R QiPlotPackGlyphs.res}{$endif}

implementation

uses
{$ifdef iVCL} iPlotChannelCustom,  iPlotDataView, iPlotAxis,   iPlotComponent;{$endif}
{$ifdef iCLX}QiPlotChannelCustom, QiPlotDataView, QiPlotAxis, QiPlotComponent;{$endif}

type
  TiPlotComponentAccess     = class(TiPlotComponent    )end;
  TiPlotDataViewAccess      = class(TiPlotDataView     )end;
  TiPlotChannelCustomAccess = class(TiPlotChannelCustom)end;
//****************************************************************************************************************************************************
constructor TiPlotToolBar.Create(AOwner: TObject; AOnChange, AOnInsert, AOnRemove, AOnRename: TNotifyEvent);
begin
  inherited;

  FImageList := TImageList.CreateSize(24, 24);

  Horizontal := True;

  FZoomInOutFactor  := 2;

  FButtonList := TStringList.Create;
  FButtonList.Sorted := False;                    

  FResumeButton          := CreateButton(ResumeClick,          0,  0, 'AUTO',       'Resume All (Tracking)');
  FPauseButton           := CreateButton(PauseClick,           1,  0, 'PAUSE',      'Pause All (Tracking)');
  FResumePauseSpacer     := CreateSpacer;

  FAxesModeScrollButton  := CreateButton(AxesModeScrollClick,  2,  2, 'SCROLL',     'Scroll (Axes)'); FAxesModeScrollButton.Down := True;
  FAxesModeZoomButton    := CreateButton(AxesModeZoomClick,    3,  2, 'ZOOM',       'Zoom (Axes)');
  FAxesModeSpacer        := CreateSpacer;

  FZoomOutButton         := CreateButton(ZoomOutClick,         4,  0, 'ZOOMOUT',    'Zoom Out All Axes');
  FZoomInButton          := CreateButton(ZoomInClick,          5,  0, 'ZOOMIN',     'Zoom In All Axes');
  FZoomInOutSpacer       := CreateSpacer;

  FSelectButton          := CreateButton(SelectClick,          6, -1, 'SELECT',     'Select');
  FZoomBoxButton         := CreateButton(ZoomBoxClick,         7, -1, 'SCROLLBOX',  'Zoom Box');
  FCursorButton          := CreateButton(CursorClick,          8, -2, 'CURSOR',     'Cursor');

  FZoomBoxCursorSpacer   := CreateSpacer;

  FEditButton            := CreateButton(EditClick,            9,  0, 'PROPERTIES', 'Properties');
  FEditSpacer            := CreateSpacer;

  FCopyButton            := CreateButton(CopyClick,           10,  0, 'COPY',       'Copy to Clipboard');
  FSaveButton            := CreateButton(SaveClick,           11,  0, 'SAVE',       'Save to File');
  FPrintButton           := CreateButton(PrintClick,          12,  0, 'PRINTER',    'Print');
  FPreviewButton         := CreateButton(PreviewClick,        13,  0, 'PREVIEW',    'Preview');

  FCursorButton.OnDownChange  := CursorDownChange;
  FZoomBoxButton.OnDownChange := ZoomBoxDownChange;
  FSelectButton.OnDownChange  := SelectDownChange;

  FSelectButton.Visible  := False;
  FPreviewButton.Visible := False;

  SetupLargeImages;
end;
//****************************************************************************************************************************************************
destructor TiPlotToolBar.Destroy;
begin
  while FButtonList.Count <> 0 do
    begin
      FButtonList.Objects[0].Free;
      FButtonList.Delete(0);
    end;
  FButtonList.Free;                                     
  FImageList.Free;  
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiPlotToolBar.SetupLargeImages;
var
  x : Integer;
begin
  FResumeButton.ImageName          := 'AUTO';
  FPauseButton.ImageName           := 'PAUSE';
  FAxesModeScrollButton.ImageName  := 'SCROLL';
  FAxesModeZoomButton.ImageName    := 'ZOOM';
  FZoomOutButton.ImageName         := 'ZOOMOUT';
  FZoomInButton.ImageName          := 'ZOOMIN';
  FSelectButton.ImageName          := 'SELECT';
  FZoomBoxButton.ImageName         := 'SCROLLBOX';
  FCursorButton.ImageName          := 'CURSOR';
  FEditButton.ImageName            := 'PROPERTIES';
  FCopyButton.ImageName            := 'COPY';
  FSaveButton.ImageName            := 'SAVE';
  FPrintButton.ImageName           := 'PRINTER';
  FPreviewButton.ImageName         := 'PREVIEW';