teeprocs.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 2,156 行 · 第 1/5 页

    property MouseButton:TMouseButton read FMouseButton write FMouseButton default mbLeft;
    property Pen:TTeeZoomPen read GetPen write SetPen;
  end;

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

    { for compatibility with Tee4 }
    Function GetAllowZoom:Boolean;
    Function GetAnimatedZoom:Boolean;
    Function GetAnimatedZoomSteps:Integer;
    Function GetBackImage:TPicture;
    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:TPicture);
    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   : TPicture;

    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 CLX}
    function GetPalette: HPALETTE; override;    { override the method }
    {$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:TPicture read GetBackImage write SetBackImage;
    property BackImageInside:Boolean read FBackImageInside
				     write SetBackImageInside default False;
    property BackImageMode:TTeeBackImageMode read FBackImageMode
					     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 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;
    FTransparency : TTeeTransparency;
    FTransparent  : Boolean;

    Function GetGradient:TChartGradient;

    Function GetShadowColor:TColor; // obsolete
    Function GetShadowSize:Integer; // obsolete
    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 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);
  protected
    FGradient : TChartGradient;
    Procedure DefineProperties(Filer:TFiler); override;
    Function GetGradientClass:TChartGradientClass; dynamic;
    property Transparency:TTeeTransparency read FTransparency
                                           write SetTransparency default 0;
  public
    ShapeBounds : TRect;

    Constructor Create(AOwner: TCustomTeePanel);
    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;

    { 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 FShadow write SetShadow;

    property ShapeStyle:TChartObjectShapeStyle read FShapeStyle
                                   write SetShapeStyle default fosRectangle;
    property Transparent:Boolean read FTransparent write SetTransparent default False;
  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);

{$IFNDEF LINUX}
{ Free Library, but do not free library in Windows 95 (lock, bug) }
Procedure TeeFreeLibrary(hLibModule: HMODULE);
{$ENDIF}

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

var
  ColorPalette:Array of TColor;

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);

{$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;

// Main procedure to translate a control (or Form)
Procedure TeeTranslateControl(AControl:TControl);

// Replaces "Search" char with "Replace" char
// in all occurrences in AString parameter.
// Returns "AString" with replace characters.
Function ReplaceChar(AString:String; Search:{$IFDEF NET}String{$ELSE}Char{$ENDIF}; Replace:Char=#0):String;

// Load a DLL, compatible with Delphi 4.
{$IFNDEF LINUX}
Function TeeLoadLibrary(Const FileName:String):HInst;
{$ENDIF}

// Returns "P" calculating 4 rotated corners using Angle parameter
// Note: Due to a C++ Builder v5 bug, this procedure is not a function.
Procedure RectToFourPoints(Const ARect:TRect; const Angle:Double; var P:TFourPoints);

Function TeeAntiAlias(Panel:TCustomTeePanel):TBitmap;

implementation

Uses {$IFNDEF D5}
     DsgnIntf,
     {$ENDIF}
     Math, TypInfo, TeeConst;

{.$DEFINE MONITOR_REDRAWS}

{$IFDEF MONITOR_REDRAWS}
var RedrawCount:Integer=0;
{$ENDIF}

{$R TeeResou.res}

{$IFDEF CLX}
Const
  LOGPIXELSX = 0;
  LOGPIXELSY = 1;
{$ENDIF}

var Tee19000101:TDateTime=0; { Optimization for TeeRoundDate function, 5.02 }

{ Same as IntToStr but faster }
Function TeeStr(Num:Integer):String;
begin
  Str(Num,Result);
end;

{ Returns one of the sample colors in ColorPalette constant array }
Function GetDefaultColor(Const Index:Integer):TColor;
Begin
  result:=ColorPalette[1+(Index mod High(ColorPalette))];
end;

{$IFDEF D5}
Function DaysInMonth(Year,Month:Word):Word;
begin
  result:=MonthDays[IsLeapYear(Year),Month]
end;
{$ELSE}
Function DaysInMonth(Year,Month:Word):Word;
Const DaysMonths:Array[1..12] of Byte=(31,28,31,30,31,30,31,31,30,31,30,31);
Begin
  result:=DaysMonths[Month];
  if (Month=2) and IsLeapYear(Year) then Inc(result);
End;
{$ENDIF}

Function DateTimeDefaultFormat(Const AStep:Double):String;
Begin
  if AStep<=1 then result:=ShortTimeFormat
              else result:=ShortDateFormat;
end;

Function NextDateTimeStep(Const AStep:Double):Double;
var t : TDateTimeStep;
Begin
  for t:=Pred(dtOneYear) downto Low(DateTimeStep) do
  if AStep>=DateTimeStep[t] then
  Begin
    result:=DateTimeStep[Succ(t)];
    exit;