sciencedraw.pas

常用数学计算工具

{ 该控件的主要属性如下:
  Public
   AddXY:  画二维图形,加入一个点,如果加入C参数，则画出自己定义的颜色
   AddXYZ: 画三维图形,加入一个点
   AddXParallel,  画指定的平行与X,Y轴的直线以供参考, B=True则:加上X=XXX 或Y=XXX字样
   AddYParallel:  加入后不会被Clear,ClearLink清除,必须用ClearXParallel,ClearYParallel
   AddSCLine:     画指定的任意直线以供参考,
   AddSCLineK:    同AddSCLine,仅参数不同
   AddGrid:       加入自定义的网格，使用AddXParallel,AddYParallel
   AddBreakPoints:加入不能连接的点的坐标；AddBreakPoints(3) 则第2点和第3点的连线在CanLink=True时不连
   Animate:       动画显示进程方法
   StopAnimate:   终止动画方法
   Clear:  清除点和自定义点的连线,BreakPoints
   ClearLink:清除自定义点的连线
   ClearXParallel,
   ClearYParallel: 清除指定的平行与X,Y轴的直线
   ClearSCLine:    清除指定的任意直线
   CopySdXY:       从另外的ScienceDraw控件中拷贝数据插入到InsertPos处
   Create: 建立
   DeleteFromBP:   将BreakPoints[i]的数据删除
   DeleteXY:       将2D数据中的一个或数个数据删除
   Destroy:销毁
   DrawSCLine,DrawSCLineK:在Canvas上画斜线,用于快速的临时画图
   FillArea:填充区域
   GetPositionValue:某一点的坐标数值
   GetValuePosition:某一坐标数值的点
   GetNearPoint:    获得离某个数值最近的点
   GetPointSlope:        获得某点的斜率
   GetIntegral:     获得两点的积分
   GetXChangePP,
   GetYChangePP:    获得每象素的X,Y改变值
   InsertXY:       在2D数据中插入一个数据
   Link:   自定义连线 ,如果加入C参数，则以画出自己定义的颜色
   LoadFromStream: 将从数据流获得数据,返回值为是否3D[(fPointX,fPointY)或(fPointX,fPointY,fPointZ)或(fPointX,fPointY,fPointC)]
   Points: 访问现有的2d图象中的点;//读写操作
   Reset:  将各种设置归位:点清除,视角恢复
   Refresh:重画
   RefreshDSOK:在数据,控件大小不变时刷新
   Roll2D: 使2D图形旋转
   Roll3D: 使3D图形旋转
   SavePictureToFile:如果FileName的后缀是.Jpg则存为JPEG文件,否则存为BMP文件
   SaveToStream: 将数据存入数据流[(fPointX,fPointY)或(fPointX,fPointY,fPointZ)或(fPointX,fPointY,fPointC)]
   SetPointsXY: 一次输入2D点
   SetPointsXYZ:一次输入3D点
  Published
   BKColor:          背景颜色
   BreakPointsNum:   BreakPoints 的数目
   BrushStyleOutLine:Can2DOutLine时的区域填充风格
   Can2DOutLine:     以2D略图显示,(Can3D作废)可以显示另外的TScienceDraw的2D图形，不适合用于动画
   Can3D:            True是三维图形 ,一般为False画二维图形，在3D模式下,以Z方向描绘光亮
   CanGetKey:        允许输入焦点
   CanInvolve:       允许拥有控
   CanLink:          允许连线
   CanStandard:      允许画坐标
   Caption           标题
   Color:            连线颜色
   CMinX:            当前坐标原点X,与SelfMinX区别
   CMinY:            当前坐标原点Y,与SelfMaxY区别
   CMaxX:            当前坐标最大X,与SelfMaxX区别
   CMinY:            当前坐标最大Y,与SelfMinY区别
   DataContainer,
   DataLines:        数据容器
   DrawPoint:        画点时触发,改变其中的CanDraw属性为False则该点不允许画
   DrawLine:         画线时触发,改变其中的CanDraw属性为False则该线段不允许画
   DrawBKPicture,                                        (2D模式下才有效)
   DrawFrontPicture: 用于画背景,前景图象,提供Canvas属性  (2D模式下才有效)
   EditHintX,
   EditHintY:        为显示鼠标位置的数值的TEdit    (2D模式下才有效)
   EqualPixels:      使X,Y,Z坐标的象素相同          (2D模式下才有效)
   EqualRatio:       等坐标,不允许自动将坐标比例调整 (2D模式下才有效)
   EqualXYRatio:     X,Y 等坐标 //3d
   EqualYZRatio:     Y,Z 等坐标 //3d
   EqualZXRatio:     Z,X 等坐标 //3d
   HintValidNums:    各种数据有效的数字   (2D模式下才有效)
   NowX:             鼠标所在位置的X数值  (2D模式下才有效)
   NowY:             鼠标所在位置的Y数值  (2D模式下才有效)
   PointColor:       点的颜色
   PointsNum:        点的数目       (2D模式下才有效)
   LinkPoinsNum:     自定义连线数目 (2D模式下才有效)
   XParallelNum,
   YParallelNum,
   SCLinesNum:       自定义直，斜线数目(2D模式下才有效)
   OutLineSC:        当Can2DOutLine为True是的另外的OutLineSC图形
   PointStyle:       点的形式
   Self2dPointNum:   自定义的画点数目>=0时生效(2D模式下才有效)
   SelfCoordinate:   SelfMaxX,SelfMaxY,SelfMaxZ,SelfMinX,SelfMinY,SelfMinZ 生效.
                     但如果规定的值不够,将自动根据SelfCoorStyle进行调整
   SelfCoorStyle:    对自定义坐标的性质描述;(scsCheck2D模式下才有效)
   SelfMaxX,
   SelfMaxY，
   SelfMaxZ,           (SelfMaxZ,SelfMinZ:3D模式下才有效)
   SelfMinX,
   SelfMinY,
   SelfMinZ     :     自定义坐标的X,Y,Z最大,最小值
   StandardStyle:     坐标风格
   Transparent:      允许保留以前的图象
   ViewXRatio,       默认：1.0                   (2D模式下才有效)
   ViewYRatio:       对X,Y轴进行缩放 默认：1.0   (2D模式下才有效)
   ViewStart:        坐标的起点位置  默认：(0,0) (2D模式下才有效)

   OnHintCaculate:
}
unit ScienceDraw;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,ComCtrls,
  Forms, Dialogs, Jpeg, Stdctrls,extctrls,HSBitMapSD,Printers;

const
 SolidLine=0;
 DotLine=1;
 DashDotLine=2;

 SlopeOK=0;
 SlopeOutRange=1;
 SlopeVertical=2;

type
  TPointStyle=(psPoint,psACrossLine,psRectangle,psCircle);
  TStandardStyle=(SsLB,SsCenter,SsZero);//坐标风格
  TSelfCoorStyle=set of (scsX,scsY,scsZ,scsUp,scsDown,scsNoCheck);//scsNoCheck可能导致错误出现, 所以应该谨慎使用

  T2DValue=Record
          ValueX,
          ValueY:Double;
          C:TColor;
         end;
  TMyDrawLP=procedure(x,y:Double;ord:Integer;var CanDraw:Bool) of object;
  TMyDrawPic=procedure(Canvas:TCanvas)of Object;
  TMyDrawOutLine=procedure of Object;
  THintCaculate=procedure (Var HintValueX,HintValueY:Double)of Object;
  TFillArea=Record
             CanFill:Boolean;     //允许填充
             StartPoint:Integer; //开始点
             EndPoint:Integer;   //结束点
             ToValue:Double;  //下界直线
            end;
  TLinkPoints=Record
                Point1,Point2:Integer;
                C:TColor;
               end;
  TBreakPoints=record
                Index:Integer;     //2D组分界点
                C:TColor;
               end;
 TParallel=record
              Value:Double;
              AddText:Boolean;
              Style:Byte;
             end;
 TSCLines=Record
             ValueX1,ValueY1,
             ValueX2,ValueY2:Double;
             Style:Byte;
             Hint:String[32];
             CanHint:Boolean;
             Color:TColor;
          end;


  TScienceDraw = class(TCustomControl)
  private
    { Private declarations }
   fTemp:Double; 
   fJpg:TJpegImage;
   fHintLabel,fCaptionLabel:TLabel;
   fEditHintCacu:THintCaculate;
   fEditX,fEditY:TCustomEdit;
   fLines:TStrings;
   fDataContainer:TCustomMemo;
   fSC:TScienceDraw;
  // fEditSCP:TEditScienceDrawProperty;
   fFillArea:TFillArea;
   fValidNum:Byte;
   fCanStickHint,
   f3Demension:Boolean;
   fCanStandard:Bool;
   fCan2DOutLine:Bool;
   fCanLink:Bool;
   fCanColorPoint,
   fCanInv,
   fCanPaintMake,
   fEqualPixels,
   fEqualRatio,
   fEqualXYRatio,
   fEqualYZRatio,
   fEqualZXRatio:Bool;
   fTransparent:Bool;
   fSelfCoordinates:Bool;
   fStandardStyle:TStandardStyle;
   fSelfCoorStyle:TSelfCoorStyle;
   fCanGetKey,
   fStopAnimate:Boolean;
   fT,fB,fL,fR,fF,fH:Double;  //自定义的大小
   fBreakPoints:Array of TBreakPoints;
   D3DGroup:Array of Integer;         //3D组分界点
   fDrawX,fDrawY:Array of Integer;
   fPointX:Array of Double;
   fPointY:Array of Double;
   fSelf2dPN,fSelf2dSP:Integer;
   fPointZ:Array of Double;
   fPointC:Array of TColor;
   fLinkPoints:Array of TLinkPoints;
   fXParallel,fYParallel:Array of TParallel;
   fSCLines:Array of TSCLines;
   fTexts:Array of Record
           x,y,Size:Integer;
           CanCenter:Boolean;
           Text:String;
           Color:TColor;
          end;
   fNowX,fNowY,
   MaxX,MaxY,MaxZ,MinX,MinY,MinZ:Double;
   DT,DB,DL,DR:integer; //图形的大小
   T,B,L,R:Integer;     //虚拟图形大小
   MX,MY:Double;
   fViewXRatio,
   fViewYRatio:Double;
   RollX,RollY,
   RollSin,RollCos:Double;
   fViewStart:TPoint;
   fColor,fBKColor,fPointColor:TColor;
   fCaption:String;
   fPointStyle:TPointStyle;
   fBOLStyle:TBrushStyle;
   fDrawPoint:TMyDrawLP;
   fDrawLine:TMyDrawLP;
   fDrawBK,fDrawFront:TMyDrawPic;
   fDrawOutLine:TMyDrawOutLine;
   fOnShow: TNotifyEvent;
   fOnMouseLeave:TNotifyEvent;
   procedure SetColor(c:TColor);
   procedure SetBKColor(c:TColor);
   procedure SetPointColor(c:TColor);
   procedure Draw2d;    //画2D图形
   procedure Draw3d;
   procedure SimpleDraw3d; //画3D图形
   procedure DrawOutLine;  //画OutLine 轮郭图形
   procedure SetRoll(X,Y,Alpha:Double);
   procedure RollPoint(Var PointX,PointY:Double);
   procedure MyMouseMoveprocedure(var Message: TWMMouseMove); message WM_MOUSEMOVE;
   procedure MyMouseDownprocedure(var Message: TWMLButtonDown); message WM_LButtonDown;
   procedure MyMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;   
   procedure Hint2d(x,y:Integer);  // 提示2D图形
   procedure SetLink(b:Bool);
   procedure SetCaption(s:String);
   procedure SetPointStyle(LS:TPointStyle); //点风格:点,十字线,方块,圆,
   procedure fHintLableOnMouseMove(sender:TObject;keyState:TShiftState;x,y:Integer);
   procedure SetEqualRatio(b:Bool);
   procedure SetTransparent(b:Bool);
   procedure SetCoordinates(b:Bool);
   function GetPixelFormat:TPixelFormat;
   procedure SetPointValue(Num:Integer; Value:T2DValue);
   function GetPointValue(Num:Integer):T2DValue;
   procedure SetCanStandard(B:Bool);
   procedure SetStandardStyle(StaStyle:TStandardStyle);
   procedure SetCanInv(B:Bool);
   procedure SetEqualPixels(B:Bool);
   procedure Set2DOutLine(B:Bool);
   procedure SetCanCP(B:Bool);   
   procedure SetOutLineSC(SC:TScienceDraw);
   procedure SetDataContainer(Memo:TCustomMemo);
   procedure SetDataLines(Lines:TStrings);
   procedure SetEditX(Edit:TCustomEdit);
   procedure SetEditY(Edit:TCustomEdit);
   procedure SetFillArea(FA:TFillArea);
   procedure SetSCPosition(X,Y:Integer);
   procedure SetBOLStyle(BS:TBrushStyle);
   procedure SetValidNum(B:Byte);
   procedure fReset;
   procedure fClear;
  protected
    { Protected declarations }
   fBitMap,
   fOLBMP:THSBitMap;
   XStr,YStr,BStr,EStr,PartsStr:String;
   procedure paint; override;
   procedure PaintWindow(DC: HDC); override;
   procedure DrawPoints;   dynamic; //判断画2d/3d图形
   function GetPointsNum:Integer;
   function GetLinkPointsNum:Integer;
   function GetBreakPointsNum:Integer;
   function GetXParallelNum:Integer;
   function GetYParallelNum:Integer;
   function GetSCLinesNum:Integer;
   procedure Show;  dynamic;
  public
    { Public declarations }
   constructor Create(AOwner:TComponent); override;
   destructor Destroy; override;
   procedure WndProc(var Message:TMessage); override;

   procedure Clear;
   procedure ClearLink;
   procedure ClearXParallel;
   procedure ClearYParallel;
   procedure ClearSCLine;
   procedure ClearText;
   procedure DeleteFromBP(Index:Integer);
   procedure Reset;
   procedure AddXY(x,y:Double);  overload;
   procedure AddXY(x,y:Double; c:TColor); overload;
   procedure AddXParallel(Y:Double;Const B:Boolean=False;Const Style:Byte=0);
   procedure AddYParallel(X:Double;Const B:Boolean=False;Const Style:Byte=0);
   procedure AddSCLine(X1,Y1,X2,Y2:Double; Const Style:Byte=0; Const Hint:String=''; Const CanHint:Boolean=True;Const Color:TColor=$FFFF00);
   procedure AddSCLineK(X,Y,K,Len:Double; Const Style:Byte=0; Const Hint:String=''; Const CanHint:Boolean=True;Const Color:TColor=$FFFF00);
   procedure AddText(X,Y:Integer; Text:String; CanCenter:Boolean=False; Color:TColor=$FFFF00; Size:Integer=10);
   procedure AddPointComment(Index:Integer; Text:String; Color:TColor=$FFFF00; Size:Integer=10);
   procedure AddGrids(X1,X2,Y1,Y2:Double;XParts,YParts:Integer; const RatioPLTP:Byte=5; const RatioSTPL:Byte=2);
   procedure AddBreakPoints(Index:Integer);
   Procedure AddXYZ(x,y,z:Double);
   procedure DeleteXY(Index:Integer;Count:Integer=1);
   procedure InsertXY(Index:Integer;ValueX,ValueY:Double);
   procedure CopySDXY(SD:TScienceDraw; InsertPos:Integer=0; StartPos:Integer=0; Length:Integer=-1);
   function  LoadFromStream(Stream:TStream):Boolean;
   procedure SaveToStream(Stream:TStream);
   procedure DrawSCLine(X1,Y1,X2,Y2:Double; Const Style:Byte=0; Const Hint:PChar=nil; Const CanHint:Boolean=True;Const Color:TColor=$FFFF00);
   procedure DrawSCLineK(X,Y,K,Len:Double; Const Style:Byte=0; Const Hint:PChar=nil; Const CanHint:Boolean=True;Const Color:TColor=$FFFF00);
   procedure Link(Point1,Point2:Integer); overload;
   procedure Link(Point1,Point2:Integer;c:TColor); overload;
   procedure Roll2D(x,y:Double;Alpha:Double);
   procedure Roll3D(x,y,Z:Double;AlphaX,AlphaY,AlphaZ:Double);
   procedure AnimateDraw(Time:DWord=5);
   procedure StopAnimate;
   procedure SavePictureToFile(FileName:String);
   procedure Print(CanException:Boolean=False);
   procedure Refresh;
   procedure RefreshSDOK;
   property Points[Num:Integer]:T2DValue read GetPointValue write SetPointValue;
   property FillArea:TFillArea read fFillArea write SetFillArea;
   function NotColor:TColor;
   function GetPositionValue(x,y:Single; var ValueX,ValueY:Double):Bool;
   procedure GetValuePosition(Var x,y:Integer; ValueX,ValueY:Double);
   function  GetNearPoint(ValueX,ValueY:Double):Integer;
   function  GetPointSlope(Index:Integer;Var Error:Byte):Double;
   function  GetIntegral(StartPoint,EndPoint:Integer;Const Bottom:Double=0):Double;
   function  GetXChangePP:Double;
   function  GetYChangePP:Double;
   procedure GetVisualXY(Var MinX,MinY,MaxX,MaxY:Double);
   procedure SetValueCenter(ValueX,ValueY:Double);
   procedure SetValueOrg(ValueX,ValueY:Double);
   procedure SetPointsXY(pX,pY:Pointer;const PC:Pointer=nil);
   procedure SetPointsXYZ(pX,pY,pZ:Pointer;size:Integer);
   procedure SetSCOLPosition(X,Y:Integer);
  published
    { Published declarations }
   property NowX:Double read fNowX write ftemp;
   property NowY:Double read fNowY write ftemp;
   property Font;
   property Transparent:Bool read fTransparent write SetTransparent default false;
   property PointsNum:Integer read GetPointsNum;
   property LinkPointsNum:Integer read GetLinkPointsNum;
   property BreakPointsNum:Integer read GetBreakPointsNum;
   property XParallelNum:Integer read GetXParallelNum;
   property YParallelNum:Integer read GetYParallelNum;
   property SCLinesNum:Integer read GetSCLinesNum;
   property Can3D:Boolean read f3Demension write f3Demension default False;
   property Color:TColor read fColor write SetColor default ClRed;
   property BKColor:TColor read fBKColor write SetBKColor default clBtnFace;
   property PointColor:TColor read fPointColor write SetPointColor default clGreen;
   property Can2DOutLine:Bool read fCan2dOutLine write Set2dOutLine;
   property CanStandard:Bool read fCanStandard write SetCanStandard;
   property StandardStyle:TStandardStyle read fStandardStyle write SetStandardStyle default SSLB;
   property CanLink:Bool read fCanLink write SetLink default True;
   property CanInvolve:Bool read fCanInv write SetCanInv default False;
   property CanColorPoint:Bool read fCanColorPoint write SetCanCP default False;
   property HintValidNums:Byte read fValidNum write SetValidNum;
   property Caption:String read fCaption write SetCaption;
   property PointStyle:TPointStyle read fPointStyle write SetPointStyle default psPoint;
   property EqualPixels:Bool read fEqualPixels write SetEqualPixels;
   property EqualRatio:Bool read fEqualRatio write SetEqualRatio default false;
   property EqualXYRatio:Bool read fEqualXYRatio write fEqualXYRatio default false;
   property EqualYZRatio:Bool read fEqualYZRatio write fEqualYZRatio default false;
   property EqualZXRatio:Bool read fEqualZXRatio write fEqualZXRatio default false;
   property SelfCoordinate:Bool read fSelfCoordinates write SetCoordinates default false;
   property SelfCoorStyle:TSelfCoorStyle read fSelfCoorStyle write fSelfCoorStyle default [scsX,scsY,scsZ];
   property Self2dStartPos:Integer read fSelf2dSP write fSelf2dSP default -1;
   property Self2dPointsNum:Integer read fSelf2dPN write fSelf2dPN default -1;
   property ViewXRatio:Double read fViewXRatio write fViewXRatio;
   property ViewYRatio:Double read fViewYRatio write fViewYRatio;
   property ViewStart:TPoint read fViewStart write fViewStart;
   property OutLineSC:TScienceDraw read fSC write SetOutLineSC;
   property EditHintX:TCustomEdit read fEditX write SetEditX;
   property EditHintY:TCustomEdit read fEditY write SetEditY;
   property EditHintCaculate:THintCaculate read fEditHintCacu write fEditHintCacu;
   property CanStickHint:Boolean read fCanStickHint write fCanStickHint default False;
   property CMinX:Double read MinX;
   property CMaxX:Double read MaxX;
   property CMinY:Double read MinY;
   property CMaxY:Double read MaxY;
   property CMinZ:Double read MinZ;
   property CMaxZ:Double read MaxZ;
   property SelfMinX:Double read fL write fL;
   property SelfMaxX:Double read fR write fR;
   property SelfMinY:Double read fB write fB;
   property SelfMaxY:Double read fT write fT;
   property SelfMinZ:Double read fH write fH;   
   property SelfMaxZ:Double read fF write fF;
   property PixelFormat:TPixelFormat read GetPixelFormat;
   property BrushStyleOutLine:TBrushStyle read fBOLStyle write SetBOLStyle;
   property OnMouseMove;
   property OnMouseDown;
   property OnMouseUp;
   property OnMouseLeave:TNotifyEvent read fOnMouseLeave write fOnMouseLeave;
   property OnDblClick;
   property OnClick;
   property OnResize;
   property Align;
   property CanGetKey:Boolean read fCanGetKey write fCanGetKey default False;
   property OnKeyDown;
   Property OnKeyUp;
   Property OnKeyPress;
   property PopupMenu;
   property Visible;
   property DrawPoint:TMyDrawLP read fDrawPoint write fDrawPoint;
   property DrawLine:TMyDrawLP read fDrawLine write fDrawLine;
   property DrawBKPicture:TMyDrawPic read fDrawBK write fDrawBK;
   property DrawFrontPicture:TMyDrawPic read fDrawFront write fDrawFront;
   property DataContainer:TCustomMemo read fDataContainer write SetDataContainer;
   property DataLines:TStrings read fLines write SetDataLines;