⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teeprocs.pas

📁 TeeChart7Source 控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
{******************************************}
{   Base types and Procedures              }
{ Copyright (c) 1995-2004 by David Berneda }
{        All Rights Reserved               }
{******************************************}
unit TeeProcs;
{$I TeeDefs.inc}

interface

Uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}

     {$IFDEF TEEVCL}

     {$IFDEF CLX}
     Qt, QClipbrd, QGraphics, QStdCtrls, QExtCtrls, QControls, QForms, QPrinters,
     {$ELSE}
     Printers, Clipbrd, ExtCtrls, Controls, Graphics, Forms,
     {$IFNDEF D6}
     {$IFNDEF D5}
     Buttons,
     {$ENDIF}
     {$ENDIF}
     {$ENDIF}

     {$ENDIF}

     {$IFDEF D6}
     Types,
     {$ENDIF}

     Classes, SysUtils, TeCanvas;

{$IFDEF CLX}
type
  TMetafile=class(TBitmap)
  private
    FEnhanced: Boolean;
  published
    property Enhanced:Boolean read FEnhanced write FEnhanced;
  end;
{$ENDIF}

Const
   TeeDefVerticalMargin = 4;
   TeeDefHorizMargin    = 3;

   crTeeHand              = TCursor(2020); { Hand cursor }
   TeeMsg_TeeHand         = 'crTeeHand'; { string cursor name (dont translate) }

   TeeNormalPrintDetail   =    0;
   TeeHighPrintDetail     = -100;

   TeeDefault_PrintMargin =   15;

   MaxDefaultColors=19;  // Length of DefaultPalette (+1)

   TeeTabDelimiter        = #9;  { separator used in TeExport.pas }

Var
  TeeCheckPenWidth      : Boolean=True;  { for HP Laserjet printers... }
  TeeClipWhenPrinting   : Boolean=True;  { Apply clipping when printing }
  TeeClipWhenMetafiling : Boolean=True;  { Apply clipping when creating metafiles }
  TeeEraseBack          : Boolean=False; { erase background before repainting panel }

  { Should Panel background to be printed ? Default: False }
  PrintTeePanel         : Boolean=False;

type
  TDateTimeStep=(  dtOneMicroSecond,
                   dtOneMillisecond,
                   dtOneSecond,
                   dtFiveSeconds,
                   dtTenSeconds,
                   dtFifteenSeconds,
                   dtThirtySeconds,
                   dtOneMinute,
                   dtFiveMinutes,
                   dtTenMinutes,
                   dtFifteenMinutes,
                   dtThirtyMinutes,
                   dtOneHour,
                   dtTwoHours,
                   dtSixHours,
                   dtTwelveHours,
                   dtOneDay,
                   dtTwoDays,
                   dtThreeDays,
                   dtOneWeek,
                   dtHalfMonth,
                   dtOneMonth,
                   dtTwoMonths,
                   dtThreeMonths,
                   dtFourMonths,
                   dtSixMonths,
                   dtOneYear,
                   dtNone );

Const
    DateTimeStep:Array[TDateTimeStep] of Double=
      ( 1.0/(1000000.0*86400.0), 1.0/(1000.0*86400.0), 1.0/86400.0,
        5.0/86400.0,  10.0/86400.0,
        0.25/1440.0,  0.5/1440.0,    1.0/1440.0,
        5.0/1440.0,  10.0/1440.0,    0.25/24.0,
        0.5/24.0 ,    1.0/24.0 ,  2.0/24.0 ,  6.0/24.0 ,
        12.0/24.0,    1, 2, 3, 7, 15, 30, 60, 90, 120, 182, 365, {none:} 1
      );

type
  TCustomPanelNoCaption=class(TCustomPanel)
  public
    Constructor Create(AOwner: TComponent); override;
  end;

  TCustomTeePanel=class;

  TZoomPanning={$IFNDEF BCB}packed{$ENDIF} class(TPersistent)
  private
    FActive     : Boolean;
  public
    X0,Y0,X1,Y1 : Integer;
    Procedure Check;
    Procedure Activate(x,y:Integer);

    property Active:Boolean read FActive write FActive;
  end;

  TTeeEvent=class
  public
    Sender : TCustomTeePanel;
    {$IFDEF CLR}
    Constructor Create; virtual;
    {$ENDIF}
  end;

  ITeeEventListener=interface
    procedure TeeEvent(Event:TTeeEvent);
  end;

  TTeeEventListeners=class {$IFDEF CLR}sealed{$ENDIF} (TList)
  private
    Function Get(Index:Integer):ITeeEventListener;
  public
    function Add(Const Item: ITeeEventListener): Integer;
    function Remove(Item: ITeeEventListener): Integer;
    property Items[Index:Integer]:ITeeEventListener read Get; default;
  end;

  TTeeMouseEventKind=(meDown,meUp,meMove);

  TTeeMouseEvent=class {$IFDEF CLR}sealed{$ENDIF} (TTeeEvent)
  public
    Event  : TTeeMouseEventKind;
    Button : TMouseButton;
    Shift  : TShiftState;
    X      : Integer;
    Y      : Integer;
  end;

  TTeeView3DEvent=class {$IFDEF CLR}sealed{$ENDIF}(TTeeEvent);

  TTeeUnits=(muPercent,muPixels);

  TCustomTeePanel=class(TCustomPanelNoCaption)
  private
    FApplyZOrder      : Boolean;
    FAutoRepaint      : Boolean;  { when False, it does not refresh }
    FBorder           : TChartHiddenPen;
    FBorderRound      : Integer;
    FCancelMouse      : Boolean;  { when True, it does not finish mouse events }
    FChartBounds      : TRect;
    FChartWidth       : Integer;
    FChartHeight      : Integer;
    FChartXCenter     : Integer;
    FChartYCenter     : Integer;
    FDelphiCanvas     : TCanvas;
    FHeight3D         : Integer;
    FMargins          : TRect;
    FMarginUnits      : TTeeUnits;
    FOriginalCursor   : TCursor;
    FPanning          : TZoomPanning;
    FPrinting         : Boolean;
    FPrintMargins     : TRect;
    FPrintProportional: Boolean;
    FPrintResolution  : Integer;
    FShadow           : TTeeShadow;
    FView3D           : Boolean;
    FView3DOptions    : TView3DOptions;
    FWidth3D          : Integer;

    FGLComponent      : TComponent; { internal }
    
    IEventListeners   : TTeeEventListeners;
    {$IFNDEF CLX}
    IRounding         : Boolean;
    {$ENDIF}
    Procedure BroadcastMouseEvent(Kind:TTeeMouseEventKind;
                                  Button: TMouseButton;
                                  Shift: TShiftState; X, Y: Integer);
    Function GetBorderStyle:TBorderStyle;
    Function GetBufferedDisplay:Boolean;
    Function GetMargin(Index:Integer):Integer;
    Function GetMonochrome:Boolean;
    Procedure NonBufferDraw(ACanvas:TCanvas; Const R:TRect);
    procedure ReadBorderStyle(Reader: TReader); // obsolete
    Procedure SetBorder(const Value:TChartHiddenPen);
    Procedure SetBorderRound(Value:Integer);
    Procedure SetBorderStyle(Value:TBorderStyle);
    Procedure SetBufferedDisplay(Value:Boolean);
    procedure SetControlRounded;
    Procedure SetMargin(Index,Value:Integer);
    Procedure SetMarginUnits(const Value:TTeeUnits);
    Procedure SetMonochrome(Value:Boolean);
    Procedure SetShadow(Value:TTeeShadow);
    procedure SetView3D(Value:Boolean);
    procedure SetView3DOptions(Value:TView3DOptions);
  protected
    InternalCanvas : TCanvas3D;

    procedure AssignTo(Dest: TPersistent); override;
    Function BroadcastTeeEvent(Event:TTeeEvent):TTeeEvent;
    {$IFNDEF CLX}
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CreateParams(var Params: TCreateParams); override;
    {$ELSE}
    procedure BoundsChanged; override;
    procedure MouseLeave(AControl: TControl); override;
    {$ENDIF}
    Procedure DefineProperties(Filer:TFiler); override; // obsolete
    procedure DblClick; override; // 7.0
    Function GetBackColor:TColor; virtual;
    Procedure InternalDraw(Const UserRectangle:TRect); virtual; // abstract;

    {$IFNDEF CLR}
    property Listeners:TTeeEventListeners read IEventListeners;
    {$ENDIF}

    Procedure Loaded; 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;
    procedure Paint; override;

    {$IFNDEF CLR}
    procedure RemoveListener(Sender:ITeeEventListener);
    {$ENDIF}

    procedure Resize; override;
    Procedure SetBooleanProperty(Var Variable:Boolean; Value:Boolean);
    Procedure SetColorProperty(Var Variable:TColor; Value:TColor);
    Procedure SetDoubleProperty(Var Variable:Double; Const Value:Double);
    Procedure SetIntegerProperty(Var Variable:Integer; Value:Integer);
    Procedure SetStringProperty(Var Variable:String; Const Value:String);
    {$IFDEF CLX}
    function WidgetFlags: Integer; override;
    {$ELSE}
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    {$ENDIF}

  {$IFDEF CLR}
  public
  {$ENDIF}
    property GLComponent:TComponent read FGLComponent write FGLComponent; { internal }
  public
    ChartRect : TRect;    { the rectangle bounded by axes in pixels }

    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Procedure CalcMetaBounds( Var R:TRect; Const AChartRect:TRect;
                              Var WinWidth,WinHeight,ViewWidth,ViewHeight:Integer);
    Function CalcProportionalMargins:TRect;
    Function CanClip:Boolean;
    Procedure CanvasChanged(Sender:TObject); virtual;
    Function ChartPrintRect:TRect;
    Procedure CheckPenWidth(APen:TPen);
    Procedure CopyToClipboardBitmap; overload;
    Procedure CopyToClipboardBitmap(Const R:TRect); overload;
    Procedure CopyToClipboardMetafile(Enhanced:Boolean); overload;
    Procedure CopyToClipboardMetafile(Enhanced:Boolean; Const R:TRect); overload;
    Function TeeCreateBitmap(ABackColor:TColor; Const Rect:TRect;
                             APixelFormat:TPixelFormat=
                               {$IFDEF CLX}TeePixelFormat{$ELSE}pfDevice{$ENDIF}
                            ):TBitmap;
    Procedure Draw(UserCanvas:TCanvas; Const UserRect:TRect); overload; virtual;
    Procedure Draw; overload;
    Procedure DrawPanelBevels(Rect:TRect); dynamic;
    Procedure DrawToMetaCanvas(ACanvas:TCanvas; Const Rect:TRect);

    Function GetCursorPos:TPoint;
    Function GetRectangle:TRect; virtual;
    procedure Invalidate; override;
    Function IsScreenHighColor:Boolean;

    Procedure Print;
    Procedure PrintLandscape;
    Procedure PrintOrientation(AOrientation:TPrinterOrientation);
    Procedure PrintPartial(Const PrinterRect:TRect);
    Procedure PrintPartialCanvas( PrintCanvas:TCanvas;
                                  Const PrinterRect:TRect);
    Procedure PrintPortrait;
    Procedure PrintRect(Const R:TRect);

    {$IFDEF CLR}
    procedure RemoveListener(Sender:ITeeEventListener);
    {$ENDIF}

    Procedure SaveToBitmapFile(Const FileName:String); overload;
    Procedure SaveToBitmapFile(Const FileName:String; Const R:TRect); overload;
    Procedure SaveToMetafile(Const FileName:String);
    Procedure SaveToMetafileEnh(Const FileName:String);
    Procedure SaveToMetafileRect( Enhanced:Boolean; Const FileName:String;
                                  Const Rect:TRect );
    Procedure SetBrushCanvas( AColor:TColor; ABrush:TChartBrush;
                              ABackColor:TColor);
    Procedure SetInternalCanvas(NewCanvas:TCanvas3D);
    Procedure ReCalcWidthHeight;
    Function  TeeCreateMetafile(Enhanced:Boolean; Const Rect:TRect):TMetafile;

    { public properties }
    property ApplyZOrder:Boolean read FApplyZOrder write FApplyZOrder;
    property AutoRepaint:Boolean read FAutoRepaint write FAutoRepaint;  { when False, it does not refresh }
    property Border:TChartHiddenPen read FBorder write SetBorder;
    property BorderRound:Integer read FBorderRound write SetBorderRound default 0;
    property BorderStyle:TBorderStyle read GetBorderStyle write SetBorderStyle; // obsolete
    property BufferedDisplay:Boolean read GetBufferedDisplay
                                     write SetBufferedDisplay;
    property CancelMouse:Boolean read FCancelMouse write FCancelMouse; { when True, it does not finish mouse events }
    property Canvas:TCanvas3D read InternalCanvas write SetInternalCanvas;
    property ChartBounds:TRect read FChartBounds;
    property ChartHeight:Integer read FChartHeight;
    property ChartWidth:Integer read FChartWidth;
    property ChartXCenter:Integer read FChartXCenter;
    property ChartYCenter:Integer read FChartYCenter;
    property DelphiCanvas:TCanvas read FDelphiCanvas;
    property Height3D:Integer read FHeight3D write FHeight3D;
    property IPanning:TZoomPanning read FPanning;

    {$IFDEF CLR}
    property Listeners:TTeeEventListeners read IEventListeners;
    {$ENDIF}

    property OriginalCursor:TCursor read FOriginalCursor write FOriginalCursor;
    property Printing:Boolean read FPrinting write FPrinting;
    property Width3D:Integer read FWidth3D write FWidth3D;

    property PrintResolution:Integer read FPrintResolution
                                     write FPrintResolution default TeeNormalPrintDetail;
    { to be published properties }
    property MarginLeft:Integer   index 0 read GetMargin write SetMargin default TeeDefHorizMargin;
    property MarginTop:Integer    index 1 read GetMargin write SetMargin default TeeDefVerticalMargin;
    property MarginRight:Integer  index 2 read GetMargin write SetMargin default TeeDefHorizMargin;
    property MarginBottom:Integer index 3 read GetMargin write SetMargin default TeeDefVerticalMargin;
    property MarginUnits:TTeeUnits read FMarginUnits write SetMarginUnits
                                   default muPercent;

    property Monochrome:Boolean read GetMonochrome write SetMonochrome default False;
    property PrintMargins:TRect read FPrintMargins write FPrintMargins;    { the percent of paper printer margins }
    property PrintProportional:Boolean read FPrintProportional
                                       write FPrintProportional default True;
    property Shadow:TTeeShadow read FShadow write SetShadow;
    property View3D:Boolean read FView3D write SetView3D default True;
    property View3DOptions:TView3DOptions read FView3DOptions write SetView3DOptions;

    { TPanel properties }
    property Align;
    property Anchors;

    property BevelInner;
    property BevelOuter;
    property BevelWidth;

    {$IFDEF CLX}
    property Bitmap;
    {$ENDIF}

    property BorderWidth;
    property Color {$IFDEF CLX}default clBackground{$ENDIF};

    {$IFNDEF CLX}
    property DragCursor;
    {$ENDIF}

    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;

    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

    {$IFDEF K3}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF}

  published
  end;

  TChartGradient=TTeeGradient;

  TChartGradientClass=class of TChartGradient;

  TPanningMode=(pmNone,pmHorizontal,pmVertical,pmBoth);

  TTeeZoomPen=class(TChartPen) // do not seal (TeeTree)
  private
    Function IsColorStored:Boolean;
  {$IFNDEF CLR}
  protected
  {$ELSE}
  public
  {$ENDIF}
    DefaultColor : TColor;
  published
    property Color stored IsColorStored nodefault;  // 5.03
  end;

  TTeeZoomBrush=class {$IFDEF CLR}sealed{$ENDIF}(TChartBrush)

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -