sciencedraw.pas

常用数学计算工具

   property OnShow:TNotifyEvent read fOnShow write fOnShow;
  end;

procedure Register;
//建立斜字体
function CreateRotatedFont(F: TFont; Angle: Integer): hFont;
function XYTo2dValue(x,y:Double;C:TColor):T2dValue;
function MyFormatFloat(d:Double; ValidNum:Byte):String;  //自定义显示浮点数
function Factorial(N:Integer):Double;     //阶乘
function CMN(m,n:Integer):Double;         //C组合
function PMN(m,n:Integer):Double;         //P排列
function Garma(X:Integer;HasHalf:Bool):Double; //咖吗函数

implementation
uses Math,DataMaker;

function CreateRotatedFont(F: TFont; Angle: Integer): hFont;
var LF : TLogFont;
begin
  FillChar(LF, SizeOf(LF), #0);
  with LF do
  begin
    lfHeight := F.Height;
    lfWidth := 0;
    lfEscapement := Angle*10;
    lfOrientation := 0;
    if fsBold in F.Style then lfWeight := FW_BOLD
    else lfWeight := FW_NORMAL;
    lfItalic := Byte(fsItalic in F.Style);
    lfUnderline := Byte(fsUnderline in F.Style);
    lfStrikeOut := Byte(fsStrikeOut in F.Style);
    lfCharSet := DEFAULT_CHARSET;
    StrPCopy(lfFaceName, F.Name);
    lfQuality := DEFAULT_QUALITY;
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    case F.Pitch of
      fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
      fpFixed: lfPitchAndFamily := FIXED_PITCH;
    else
      lfPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  Result := CreateFontIndirect(LF);
end;

function XYTo2dValue(x,y:Double;C:TColor):T2dValue;
begin
 Result.ValueX:=X;
 Result.ValueY:=Y;
 Result.C:=C;
end;

function MyFormatFloat(d:Double;ValidNum:Byte):String;
begin
 if Abs(d)<1e-200 then Result:='0'
  else Result:=ExtendedToStr(D,3+ValidNum,#0);
end;

function Factorial(N:Integer):Double;
var
 i:Integer;
begin
 Result:=1;
 for i:=2 to N do
     Result:=Result*Int64(i);
end;
function CMN(m,n:Integer):Double;
begin
 Result:=Factorial(n)/Factorial(n-m)/Factorial(m);
end;

function PMN(m,n:Integer):Double;
begin
 Result:=Factorial(n)/Factorial(n-m);
end;

function Garma(X:Integer; HasHalf:Bool):Double;
var
 i:Integer;
begin
 if X<0 then begin Result:=0; exit; end;
 if not HasHalf then Result:=Factorial(x-1)
 else begin
  i:=0; Result:=Sqrt(PI);
  While i<X do begin
   Result:=(i+0.5)*Result;
   i:=i+1;
  end;
 end;
end;



procedure Register;
begin
  RegisterComponents('Additional', [TScienceDraw]);
end;


{ ///////////////////////
  以下是TSciencedraw
  ///////////////////////}
///////
constructor TScienceDraw.Create(AOwner:TComponent);
begin
 inherited;
 ControlStyle:=ControlStyle+[csReflector];   fCanGetKey:=False;
 fBitMap:=THSBitMap.Create;  fOLBMP:=THsBitmap.create; fLines:=TStringList.Create;//fBitMap.PixelFormat:=pf8Bit;
 fJpg:=TJpegImage.Create;    //fEditSCP:=TEditScienceDrawProperty.Create(nil);  fEditSCP.fSC:=TComponent(self);
 fCaptionLabel:=TLabel.Create(self);  fCaptionLabel.Caption:=''; fCaptionLabel.Width:=0; fCaptionLabel.Visible:=False;
 fHintLabel:=TLabel.Create(self); fHintLabel.Caption:=''; fHintLabel.width:=0;
 fHintLabel.OnMouseMove:=fHintLableOnMouseMove;
 fHintLabel.Visible:=False;
 fCaptionLabel.parent:=Self;
 fHintLabel.Parent:=Self;
 width:=300; Height:=300;
 fColor:=clRed; fBKColor:=clBtnFace; fPointColor:=clGreen; fStandardStyle:=SsLB;
 fCanStandard:=True; fCanLink:=True;  fCanPaintMake:=True; fCanStickHint:=False;
 fSelfCoordinates:=False; fSelfCoorStyle:=[scsX,scsY,scsZ];
 fSelf2dPN:=-1; fSelf2dSP:=-1;
 fViewStart:=Point(0,0); fViewXRatio:=1.0; fViewYRatio:=1.0; fValidNum:=2;

 cursor:=crCross;   fCan2DOutLine:=False;  fBOLStyle:=bsDiagCross;

 XStr:='t'; YStr:='t'; bStr:='0'; EStr:='10'; PartsStr:='100';
end;

destructor TScienceDraw.Destroy;
begin
 if fBitMap<>nil then fBitMap.Free; if fOLBMP<>nil then fOLBMP.Free;
 if fJpg<>nil then fJpg.Free; if fHintLabel<>nil then fHintLabel.Free;
 if fCaptionLabel<>nil then fCaptionLabel.Free;
 if fLines<>nil then fLines.Free;   //if fEditSCP<>nil then fEditSCP.Free;
 SetLength(fDrawX,0); SetLength(fDrawY,0);
 fReset; //释放内存
 inherited; 
// if fSC<>nil then fSC.OutLineSC:=nil; //释放句柄
end;

procedure TScienceDraw.WndProc(var Message:TMessage);
begin
 try
 case Message.Msg of
        WM_KEYDOWN, WM_SYSKEYDOWN, CN_KeyDown:
                 DoKeyDown(TWMKey(Message));
        WM_CHAR,CN_Char: DoKeyPress(TWMKey(Message));
        WM_KEYUP, WM_SYSKEYUP, CN_KeyUp:
                 DoKeyUp(TWMKey(Message));
  else inherited;
 end;
 except
  Application.HandleException(self);
 end;
end;
////以下是自定义程序  /////////////////-----------///////////////////
procedure TScienceDraw.paint;
begin
  if fHintLabel.Visible then
   begin
    fHintLabel.Color:=not(fHintLabel.Font.Color); //提示标题
   end;
  fCaptionLabel.Left:=(width-fCaptionLabel.Width) div 2; //标题位置
  try
  DrawPoints; //画点
  except
  end;
end;

procedure TScienceDraw.PaintWindow;
begin
 inherited;
 if fCanPaintMake then  //DataLine的初始化
 begin
  if fCan2DOutline then
  begin
    fCanPaintMake:=False;
    if (fSC<>nil)and fSC.fCanPaintMake
       then fSC.DataLines:=fSC.fLines;
  end else begin
   fCanPaintMake:=False;
   DataLines:=fLines;
  end;
 end;
 Show;  //Onshow事件
end;

procedure TScienceDraw.fClear;
begin
 SetLength(fPointX,0);
 SetLength(fPointY,0);
 SetLength(fPointZ,0);
 SetLength(fPointC,0);
 SetLength(fLinkPoints,0);
 SetLength(fBreakPoints,0);
 SetLength(D3DGroup,0);
end;

procedure TScienceDraw.Clear;
begin
 fClear;
end;

procedure TScienceDraw.AddXY(x,y:Double);
var
 Len:Integer;
begin
 if CanColorPoint
    then  AddXY(X,Y,fPointColor)
    else begin
     Len:=High(fPointX)+2;
     SetLength(fPointX,Len);
     fPointX[Len-1]:=X;
     SetLength(fPointY,Len);
     fPointY[Len-1]:=Y;
    end;
end;


procedure TScienceDraw.AddXY(x,y:Double; c:TColor);
var
 Len:Integer;
begin
 Len:=High(fPointX)+2;
 SetLength(fPointX,Len);
 fPointX[Len-1]:=X;
 SetLength(fPointY,Len);
 fPointY[Len-1]:=Y;
 SetLength(fPointC,Len);
 fPointC[Len-1]:=C;
end;
procedure TScienceDraw.DeleteXY(Index:Integer;Count:Integer=1);
var
 Len,i:Integer;
begin
 Len:=High(fPointX);
 if (Index<0)or(Index>Len)or(count=0)then exit;
 for i:=Index to Len-Count do
  begin
   fPointX[i]:=fPointX[i+Count];
   fPointY[i]:=fPointY[i+Count];
   if CanColorPoint then fPointC[i]:=fPointC[i+Count];
  end;
 SetLength(fPointX,Max(Len+1-Count,0));
 SetLength(fPointY,Max(Len+1-Count,0));
 if CanColorPoint then SetLength(fPointC,Max(Len+1-Count,0));
end;
procedure TScienceDraw.InsertXY(Index:Integer;ValueX,ValueY:Double);
var
 Len,i:Integer;
begin
 Len:=High(fPointX);
 if (Index<0)or(Index>Len)then exit;

 SetLength(fPointX,Len+2);
 SetLength(fPointY,Len+2);
 if CanColorPoint then SetLength(fPointC,Len+2);

 for i:=Len downto Index do
  begin
   fPointX[i+1]:=fPointX[i];
   fPointY[i+1]:=fPointY[i];
   if CanColorPoint then fPointC[i+1]:=fPointC[i];
  end;

 fPointX[Index]:=ValueX;
 fPointY[Index]:=ValueY;
 if CanColorPoint then fPointC[Index]:=fPointColor;
end;

procedure TScienceDraw.AddXYZ(x,y,z:Double);
var
 Len:Integer;
begin
 Len:=High(fPointX)+2;
 SetLength(fPointX,Len);
 fPointX[Len-1]:=X;
 SetLength(fPointY,Len);
 fPointY[Len-1]:=Y;
 SetLength(fPointZ,Len);
 fPointZ[Len-1]:=Z;
end;

procedure TScienceDraw.CopySDXY(SD:TScienceDraw; InsertPos:Integer=0; StartPos:Integer=0; Length:Integer=-1);
var
 InsPos,Len,LenSD,
 i:Integer;
begin
 InsPos:=InsertPos;
 if InsPos<0 then InsPos:=0 ;
 Len:=High(fPointX)+1; // 不要用Length(fPointX),因为有 Length:Integer=-1 参数
 if InsPos>Len then InsPos:=Len;  //分析自己的数据

 if Length=-1 then begin
  LenSD:=High(SD.fPointX)+1;
 end else begin
  LenSD:=Length;
 end;                            //对方数据完成
 SetLength(fPointX,Len+LenSD);
 SetLength(fPointY,Len+LenSD);

 for i:=InsPos to Len-1 do       //移动数据
  begin
   fPointX[i+LenSD]:=fPointX[i];
   fPointY[i+LenSD]:=fPointY[i];
  end;
 for i:=0 to LenSD-1 do
  begin
   fPointX[InsPos+i]:=SD.fPointX[StartPos+i];
   fPointY[InsPos+i]:=SD.fPointY[StartPos+i];
  end;
end;

type
 TSaveHead=Record
  Can3D:Boolean;
  PointX,PointY,PointZ,PointC,            //4
  LinkPoints,BreakPoints,D3DGroupL,       //3
  XParallel,YParallel,SCLines:Integer;    //3; 4+3+3=10
 end;
function TScienceDraw.LoadFromStream(Stream:TStream):Boolean;
var
 SH:TSaveHead;
begin
 Stream.Read(SH,SizeOf(SH));
 with SH,Stream do begin
  Result:=Can3D;

  SetLength(fPointX,PointX);
  if PointX>0 then Read(fPointX[0],PointX*SizeOf(double));

  SetLength(fPointY,PointY);
  if PointY>0 then Read(fPointY[0],PointY*SizeOf(double));

  SetLength(fPointZ,PointZ);
  if PointZ>0 then Read(fPointZ[0],PointZ*SizeOf(double));

  SetLength(fPointC,PointC);
  if PointC>0 then Read(fPointC[0],PointC*SizeOf(TColor));

  SetLength(fLinkPoints,LinkPoints);
  if LinkPoints>0 then Read(fLinkPoints[0],LinkPoints*SizeOf(TLinkPoints));

  SetLength(fBreakPoints,BreakPoints);
  if BreakPoints>0 then Read(fBreakPoints[0],BreakPoints*SizeOf(TBreakPoints));

  SetLength(D3DGroup,D3DGroupL);
  if D3DGroupL>0 then Read(D3DGroup[0],D3DGroupL*SizeOf(Integer));

  SetLength(fXParallel,XParallel);
  if XParallel>0 then Read(fXParallel[0],XParallel*SizeOf(TParallel));

  SetLength(fYParallel,YParallel);
  if YParallel>0 then Read(fYParallel[0],YParallel*SizeOf(TParallel));

  SetLength(fSClines,SCLines);
  if SCLines>0 then Read(fSCLines[0],SCLines*SizeOf(TSCLines));
 end;
end;
procedure TScienceDraw.SaveToStream(Stream:TStream);
var
 Pos:Int64;
 SH:TSaveHead;
begin
 with SH do begin
  Can3D:=f3Demension;
  PointX:=Length(fPointX);
  PointY:=Length(fPointY);
  PointZ:=Length(fPointZ);
  PointC:=Length(fPointC);
  LinkPoints:=Length(fLinkPoints);
  BreakPoints:=Length(fBreakPoints);
  D3DGroupL:=Length(D3DGroup);
  XParallel:=Length(fXParallel);
  YParallel:=Length(fYParallel);
  SCLines:=Length(fSClines);
 end;
 Pos:=Stream.Position;
 with  SH do Stream.Size:=Stream.Position+SizeOf(SH)+ //获得足够的空间
             PointX*SizeOf(double)+PointY*SizeOf(double)+PointZ*SizeOf(double)+PointC*SizeOf(TColor)+
             LinkPoints*SizeOf(TLinkPoints)+BreakPoints*SizeOf(TBreakPoints)+D3DGroupL*SizeOf(Integer)+
             XParallel*SizeOf(TParallel)+YParallel*SizeOf(TParallel)+SCLines*SizeOf(TSCLines);
 Stream.Position:=Pos;
 Stream.Write(SH,SizeOf(SH));
 with SH,Stream do begin
  if PointX>0 then Write(fPointX[0],PointX*SizeOf(double));
  if PointY>0 then Write(fPointY[0],PointY*SizeOf(double));
  if PointZ>0 then Write(fPointZ[0],PointZ*SizeOf(double));
  if PointC>0 then Write(fPointC[0],PointC*SizeOf(TColor));
  if LinkPoints>0 then Write(fLinkPoints[0],LinkPoints*SizeOf(TLinkPoints));
  if BreakPoints>0 then Write(fBreakPoints[0],BreakPoints*SizeOf(TBreakPoints));
  if D3DGroupL>0 then Write(D3DGroup[0],D3DGroupL*SizeOf(Integer));
  if XParallel>0 then Write(fXParallel[0],XParallel*SizeOf(TParallel));
  if YParallel>0 then Write(fYParallel[0],YParallel*SizeOf(TParallel));
  if SCLines>0 then Write(fSCLines[0],SCLines*SizeOf(TSCLines));
 end;
end;
//////////
function TScienceDraw.GetPointsNum:Integer;
begin
 Result:=High(fPointX)+1;
end;
function TScienceDraw.GetLinkPointsNum;
begin
 Result:=Length(fLinkPoints);
end;
function TScienceDraw.GetBreakPointsNum;
begin
 Result:=Length(fBreakPoints);
end;
function TSciencedraw.GetXParallelNum;
begin
 Result:=Length(fXParallel);
end;
function TSciencedraw.GetYParallelNum;
begin
 Result:=Length(fYParallel);
end;
function TScienceDraw.GetSCLinesNum;
begin
 Result:=Length(fSCLines);
end;