teeprocs.pas

TeeChart7Source 控件

  published
    property Color default clWhite;
    property Style default bsClear;
  end;

  TTeeZoomDirection=(tzdHorizontal, tzdVertical, tzdBoth);

  TTeeZoom=class {$IFDEF CLR}sealed{$ENDIF} (TZoomPanning)
  private
    FAllow         : Boolean;
    FAnimated      : Boolean;
    FAnimatedSteps : Integer;
    FBrush         : TTeeZoomBrush;
    FDirection     : TTeeZoomDirection;
    FKeyShift      : TShiftState;
    FMinimumPixels : Integer;
    FMouseButton   : TMouseButton;
    FPen           : TTeeZoomPen;
    FUpLeftZooms   : Boolean;

    Function GetBrush:TTeeZoomBrush;
    Function GetPen:TTeeZoomPen;
    Procedure SetBrush(Value:TTeeZoomBrush);
    Procedure SetPen(Value:TTeeZoomPen);
  public
    Constructor Create;
    Destructor Destroy; override;
    Procedure Assign(Source:TPersistent); override;
  published
    property Allow:Boolean read FAllow write FAllow default True;
    property Animated:Boolean read FAnimated write FAnimated default False;
    property AnimatedSteps:Integer read FAnimatedSteps write FAnimatedSteps default 8;
    property Brush:TTeeZoomBrush read GetBrush write SetBrush;
    property Direction:TTeeZoomDirection read FDirection write FDirection default tzdBoth;
    property KeyShift:TShiftState read FKeyShift write FKeyShift default [];
    property MinimumPixels:Integer read FMinimumPixels write FMinimumPixels default 16;
    property MouseButton:TMouseButton read FMouseButton write FMouseButton default mbLeft;
    property Pen:TTeeZoomPen read GetPen write SetPen;
    property UpLeftZooms:Boolean read FUpLeftZooms write FUpLeftZooms default False;
  end;

  TTeeBackImageMode=(pbmStretch,pbmTile,pbmCenter,pbmCustom); // 7.0

  TBackImage=class(TPicture)  // 7.0
  private
    FInside : Boolean;
    FLeft   : Integer;
    FMode   : TTeeBackImageMode;
    FTop    : Integer;

    procedure SetInside(Const Value:Boolean);
    procedure SetLeft(Value:Integer);
    procedure SetMode(Const Value:TTeeBackImageMode);
    procedure SetTop(Value:Integer);
  public
    constructor Create;
    procedure Assign(Source:TPersistent); override;
  published
    property Inside:Boolean read FInside write SetInside default False;
    property Left:Integer read FLeft write SetLeft default 0;
    property Mode:TTeeBackImageMode read FMode write SetMode default pbmStretch;
    property Top:Integer read FTop write SetTop default 0;
  end;

  TCustomTeePanelExtended=class(TCustomTeePanel)
  private
    FAllowPanning      : TPanningMode;
    FGradient          : TChartGradient;
    FZoom              : TTeeZoom;
    FZoomed            : Boolean;

    { for compatibility with Tee4 }
    Function GetAllowZoom:Boolean;
    Function GetAnimatedZoom:Boolean;
    Function GetAnimatedZoomSteps:Integer;
    Function GetBackImage:TBackImage;
    Function GetBackImageInside:Boolean;
    Function GetBackImageMode:TTeeBackImageMode;
    Function GetBackImageTransp:Boolean;
    Function GetGradient:TChartGradient;

    procedure ReadAnimatedZoomSteps(Reader: TReader);
    procedure ReadAnimatedZoom(Reader: TReader);
    procedure ReadAllowZoom(Reader: TReader);
    procedure ReadPrintMargins(Reader: TReader);
    procedure SavePrintMargins(Writer: TWriter);
    Procedure SetAllowZoom(Value:Boolean);
    Procedure SetAnimatedZoom(Value:Boolean);
    Procedure SetAnimatedZoomSteps(Value:Integer);

    procedure SetBackImage(const Value:TBackImage);
    procedure SetBackImageInside(Const Value:Boolean);
    procedure SetBackImageMode(Const Value:TTeeBackImageMode);
    procedure SetBackImageTransp(Const Value:Boolean);
    Procedure SetGradient(Value:TChartGradient);
    Procedure SetZoom(Value:TTeeZoom);
  protected
    FBackImage   : TBackImage;

    FOnAfterDraw : TNotifyEvent;
    FOnScroll    : TNotifyEvent;
    FOnUndoZoom  : TNotifyEvent;
    FOnZoom      : TNotifyEvent;
    Procedure DefineProperties(Filer:TFiler); override;
    procedure DrawBitmap(Rect:TRect; Z:Integer);
    procedure FillPanelRect(Const Rect:TRect); virtual;
    {$IFNDEF CLR}
    {$IFNDEF CLX}
    function GetPalette: HPALETTE; override;    { override the method }
    {$ENDIF}
    {$ENDIF}
    procedure PanelPaint(Const UserRect:TRect); virtual;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Procedure DrawZoomRectangle;
    function HasBackImage:Boolean; // Returns True when has BackImage.Graphic
    procedure UndoZoom; dynamic;

    property Zoomed:Boolean read FZoomed write FZoomed;

    property AllowPanning:TPanningMode read FAllowPanning
				       write FAllowPanning default pmBoth;

    { for compatibility with Tee4 }
    property AllowZoom:Boolean read GetAllowZoom write SetAllowZoom default True;
    property AnimatedZoom:Boolean read GetAnimatedZoom
				  write SetAnimatedZoom default False;
    property AnimatedZoomSteps:Integer read GetAnimatedZoomSteps
				       write SetAnimatedZoomSteps default 8;
    {}
    
    property BackImage:TBackImage read GetBackImage write SetBackImage;
    property BackImageInside:Boolean read GetBackImageInside
				     write SetBackImageInside default False;
    property BackImageMode:TTeeBackImageMode read GetBackImageMode
					     write SetBackImageMode
					     default pbmStretch;
    property BackImageTransp:Boolean read GetBackImageTransp
                                     write SetBackImageTransp default False;

    property Gradient:TChartGradient read GetGradient write SetGradient;
    property Zoom:TTeeZoom read FZoom write SetZoom;

    { events }
    property OnAfterDraw:TNotifyEvent read FOnAfterDraw write FOnAfterDraw;
    property OnScroll:TNotifyEvent read FOnScroll write FOnScroll;
    property OnUndoZoom:TNotifyEvent read FOnUndoZoom write FOnUndoZoom;
    property OnZoom:TNotifyEvent read FOnZoom write FOnZoom;
  end;

  TChartBrushClass=class of TChartBrush;

  TTeeCustomShapeBrushPen=class(TPersistent)
  private
    FBrush   : TChartBrush;
    FParent  : TCustomTeePanel;
    FPen     : TChartPen;
    FVisible : Boolean;

    Procedure SetBrush(Value:TChartBrush);
    Procedure SetPen(Value:TChartPen);
    Procedure SetVisible(Value:Boolean);
  protected
    Procedure CanvasChanged(Sender:TObject);
    Function GetBrushClass:TChartBrushClass; dynamic;
    Procedure SetParent(Value:TCustomTeePanel); virtual;
  public
    Constructor Create;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Procedure Show;
    Procedure Hide;
    Procedure Repaint;

    property Brush:TChartBrush read FBrush write SetBrush;
    property Frame:TChartPen read FPen write SetPen; // alias obsolete
    property ParentChart:TCustomTeePanel read FParent write SetParent;
    property Pen:TChartPen read FPen write SetPen;
    property Visible:Boolean read FVisible write SetVisible;
  end;

  TChartObjectShapeStyle=(fosRectangle,fosRoundRectangle);

  TTeeCustomShape=class(TTeeCustomShapeBrushPen)
  private
    FBevel        : TPanelBevel;
    FBevelWidth   : TBevelWidth;
    FColor        : TColor;
    FFont         : TTeeFont;
    FShadow       : TTeeShadow;
    FShapeStyle   : TChartObjectShapeStyle;
    FTransparent  : Boolean;

    Function GetGradient:TChartGradient;
    Function GetHeight:Integer;
    Function GetWidth:Integer;
    Function GetShadow:TTeeShadow;
    Function GetShadowColor:TColor; // obsolete
    Function GetShadowSize:Integer; // obsolete

    Function IsTranspStored:Boolean;

    procedure ReadShadowColor(Reader: TReader); // obsolete
    procedure ReadShadowSize(Reader: TReader); // obsolete

    Procedure SetBevel(Value:TPanelBevel);
    procedure SetBevelWidth(Value: TBevelWidth);
    Procedure SetColor(Value:TColor);
    Procedure SetFont(Value:TTeeFont);
    procedure SetGradient(Value:TChartGradient);
    procedure SetHeight(Value:Integer);
    Procedure SetShadow(Value:TTeeShadow);
    Procedure SetShadowColor(Value:TColor); // obsolete
    Procedure SetShadowSize(Value:Integer); // obsolete
    Procedure SetShapeStyle(Value:TChartObjectShapeStyle);
    procedure SetTransparency(Value:TTeeTransparency);
    procedure SetTransparent(Value:Boolean);
    procedure SetWidth(Value:Integer);
  protected
    FDefaultTransparent : Boolean;
    FGradient : TChartGradient;
    FTransparency : TTeeTransparency;

    Procedure DefineProperties(Filer:TFiler); override;
    Function GetGradientClass:TChartGradientClass; dynamic;
    Procedure InitShadow(AShadow:TTeeShadow); dynamic;
    property Transparency:TTeeTransparency read FTransparency
                                           write SetTransparency default 0;
  public
    ShapeBounds : TRect;

    Constructor Create(AOwner: TCustomTeePanel); overload; virtual;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;
    Procedure Draw;
    Procedure DrawRectRotated(Const Rect:TRect; Angle:Integer=0; AZ:Integer=0);

    // compatibility with v5  (obsolete)
    property ShadowColor:TColor read GetShadowColor write SetShadowColor default clBlack;
    property ShadowSize:Integer read GetShadowSize write SetShadowSize default 3;

    // public properties
    property Height: Integer read GetHeight write SetHeight;
    property Width: Integer read GetWidth write SetWidth;

    { to be published }
    property Bevel:TPanelBevel read FBevel write SetBevel default bvNone;
    property BevelWidth:TBevelWidth read FBevelWidth write SetBevelWidth default 2;
    property Color:TColor read FColor write SetColor default clWhite;
    property Font:TTeeFont read FFont write SetFont;
    property Gradient:TChartGradient read GetGradient write SetGradient;
    property Shadow:TTeeShadow read GetShadow write SetShadow;

    property ShapeStyle:TChartObjectShapeStyle read FShapeStyle
                                   write SetShapeStyle default fosRectangle;
    property Transparent:Boolean read FTransparent write SetTransparent stored IsTranspStored;
  end;

  TTeeShape=class(TTeeCustomShape)
  public
    property Transparency;
  published
    property Bevel;
    property BevelWidth;
    property Color;
    property Font;
    property Gradient;
    property Shadow;
    property ShapeStyle;
    property Transparent;
  end;

  TeeString256=Array[0..255] of Char;

  // Used at TeExport, TeeStore and TeeTree export dialog.
  TTeeExportData=class
  public
    Function AsString:String; virtual; // abstract;
    Procedure CopyToClipboard; dynamic;
    Procedure SaveToFile(Const FileName:String); dynamic;
    Procedure SaveToStream(AStream:TStream); dynamic;
  end;

Function TeeStr(Num:Integer):String; // same as IntToStr but a bit faster

{ returns the appropiate string date or time format according to "step" }
Function DateTimeDefaultFormat(Const AStep:Double):String;

{ returns the number of days of month-year }
Function DaysInMonth(Year,Month:Word):Word;

{ Given a "step", return the corresponding set element }
Function FindDateTimeStep(Const StepValue:Double):TDateTimeStep;

{ Returns the next "step" in ascending order. (eg: TwoDays follows OneDay }
Function NextDateTimeStep(Const AStep:Double):Double;

{ Returns True if point T is over line:  P --> Q }
Function PointInLine(Const P:TPoint; px,py,qx,qy:Integer):Boolean; overload;
Function PointInLine(Const P,FromPoint,ToPoint:TPoint):Boolean; overload;

{ Returns True if point T is over (more or less "Tolerance" pixels)
  line:  P --> Q }
Function PointInLine(Const P,FromPoint,ToPoint:TPoint; TolerancePixels:Integer):Boolean; overload; // obsolete;
Function PointInLine(Const P:TPoint; px,py,qx,qy,TolerancePixels:Integer):Boolean; overload;

Function PointInLineTolerance(Const P:TPoint; px,py,qx,qy,TolerancePixels:Integer):Boolean; // obsolete;

{ Returns True if point P is inside Poly polygon }
Function PointInPolygon(Const P:TPoint; Const Poly:Array of TPoint):Boolean;

{ Returns True if point P is inside the vert triangle of x0y0, midxY1, x1y0 }
Function PointInTriangle(Const P:TPoint; X0,X1,Y0,Y1:Integer):Boolean;

{ Returns True if point P is inside the horiz triangle of x0y0, x1midY, x0y0 }
Function PointInHorizTriangle(Const P:TPoint; Y0,Y1,X0,X1:Integer):Boolean;

{ Returns True if point P is inside the ellipse bounded by Rect }
Function PointInEllipse(Const P:TPoint; Const Rect:TRect):Boolean; overload;
Function PointInEllipse(Const P:TPoint; Left,Top,Right,Bottom:Integer):Boolean; overload;

{ This functions try to solve locale problems with formatting numbers }
Function DelphiToLocalFormat(Const Format:String):String;
Function LocalToDelphiFormat(Const Format:String):String;

{ For all controls in the array, set the Enabled property }
Procedure EnableControls(Enable:Boolean; Const ControlArray:Array of TControl);

{ Round "ADate" to the nearest "AStep" value }
Function TeeRoundDate(Const ADate:TDateTime; AStep:TDateTimeStep):TDateTime;

{ Increment or Decrement "Value", for DateTime and not-DateTime }
Procedure TeeDateTimeIncrement( IsDateTime:Boolean;
                                Increment:Boolean;
                                Var Value:Double;
                                Const AnIncrement:Double;
                                tmpWhichDateTime:TDateTimeStep);


{ Generic "QuickSort" sorting algorithm }
type TTeeSortCompare=Function(a,b:Integer):Integer of object;
     TTeeSortSwap=Procedure(a,b:Integer) of object;

Procedure TeeSort( StartIndex,EndIndex:Integer;
                   CompareFunc:TTeeSortCompare;
                   SwapFunc:TTeeSortSwap);

{ Returns a valid component name }
Function TeeGetUniqueName(AOwner:TComponent; Const AStartName:String):TComponentName;

{ Delimited field routines }
Var TeeFieldsSeparator:String=';';

{ Returns the "index" item in string, using "TeeFieldsSeparator" character }
Function TeeExtractField(St:String; Index:Integer):String; overload;

{ Returns the "index" item in string, using "Separator" parameter }
Function TeeExtractField(St:String; Index:Integer; const Separator:String):String; overload;

{ Returns the number of fields in string, using "TeeFieldsSeparator" character }
Function TeeNumFields(St:String):Integer; overload;
{ Returns the number of fields in string, using "Separator" parameter }
Function TeeNumFields(const St,Separator:String):Integer; overload;

{ Try to find a resource bitmap and load it }
Procedure TeeGetBitmapEditor(AObject:TObject; Var Bitmap:TBitmap);
Procedure TeeLoadBitmap(Bitmap:TBitmap; Const Name1,Name2:String);

type TColorArray=Array of TColor;

{ returns one of the sample colors in default ColorPalette constant array }
Function GetDefaultColor(Const Index:Integer):TColor;

// Resets ColorPalette to default one.
Procedure SetDefaultColorPalette; overload;
Procedure SetDefaultColorPalette(const Palette:Array of TColor); overload;

var
  ColorPalette:TColorArray;

const
  TeeBorderStyle={$IFDEF CLX}fbsDialog{$ELSE}bsDialog{$ENDIF};

  TeeCheckBoxSize=11; { for TChart Legend }

  { Keyboard codes }
  TeeKey_Escape = {$IFDEF CLX}Key_Escape {$ELSE}VK_ESCAPE{$ENDIF};
  TeeKey_Up     = {$IFDEF CLX}Key_Up     {$ELSE}VK_UP{$ENDIF};
  TeeKey_Down   = {$IFDEF CLX}Key_Down   {$ELSE}VK_DOWN{$ENDIF};
  TeeKey_Insert = {$IFDEF CLX}Key_Insert {$ELSE}VK_INSERT{$ENDIF};
  TeeKey_Delete = {$IFDEF CLX}Key_Delete {$ELSE}VK_DELETE{$ENDIF};
  TeeKey_Left   = {$IFDEF CLX}Key_Left   {$ELSE}VK_LEFT{$ENDIF};
  TeeKey_Right  = {$IFDEF CLX}Key_Right  {$ELSE}VK_RIGHT{$ENDIF};
  TeeKey_Return = {$IFDEF CLX}Key_Return {$ELSE}VK_RETURN{$ENDIF};
  TeeKey_Space  = {$IFDEF CLX}Key_Space  {$ELSE}VK_SPACE{$ENDIF};
  TeeKey_Back   = {$IFDEF CLX}Key_BackSpace {$ELSE}VK_BACK{$ENDIF};

  TeeKey_F1     = {$IFDEF CLX}Key_F1     {$ELSE}VK_F1{$ENDIF};
  TeeKey_F2     = {$IFDEF CLX}Key_F2     {$ELSE}VK_F2{$ENDIF};
  TeeKey_F3     = {$IFDEF CLX}Key_F3     {$ELSE}VK_F3{$ENDIF};
  TeeKey_F4     = {$IFDEF CLX}Key_F4     {$ELSE}VK_F4{$ENDIF};
  TeeKey_F5     = {$IFDEF CLX}Key_F5     {$ELSE}VK_F5{$ENDIF};
  TeeKey_F6     = {$IFDEF CLX}Key_F6     {$ELSE}VK_F6{$ENDIF};
  TeeKey_F7     = {$IFDEF CLX}Key_F7     {$ELSE}VK_F7{$ENDIF};
  TeeKey_F8     = {$IFDEF CLX}Key_F8     {$ELSE}VK_F8{$ENDIF};
  TeeKey_F9     = {$IFDEF CLX}Key_F9     {$ELSE}VK_F9{$ENDIF};
  TeeKey_F10    = {$IFDEF CLX}Key_F10    {$ELSE}VK_F10{$ENDIF};
  TeeKey_F11    = {$IFDEF CLX}Key_F11    {$ELSE}VK_F11{$ENDIF};
  TeeKey_F12    = {$IFDEF CLX}Key_F12    {$ELSE}VK_F12{$ENDIF};

Procedure TeeDrawCheckBox( x,y:Integer; Canvas:TCanvas; Checked:Boolean;
                           ABackColor:TColor; CheckBox:Boolean=True);

{$IFNDEF D6}
function StrToFloatDef(const S: string; const Default: Extended): Extended;
{$ENDIF}

{ Returns True if line1 and line2 cross each other.
  xy is returned with crossing point. }
function CrossingLines(const X1,Y1,X2,Y2,X3,Y3,X4,Y4:Double; var x,y:Double):Boolean;

// TRANSLATIONS
type TTeeTranslateHook=procedure(AControl:TControl);
var TeeTranslateHook:TTeeTranslateHook=nil;