sciencedraw.pas

常用数学计算工具

//////////
procedure TScienceDraw.SetColor(c:TColor);
begin
 if fColor=c then exit;
 fColor:=c;
 Paint;
end;

procedure TScienceDraw.SetBKColor(c:TColor);
begin
 if fBKColor=C then exit;
 fBKColor:=C;
 fCaptionLabel.Color:=c;
 Paint;
end;

procedure TScienceDraw.SetPointColor(c:TColor);
begin
 if fPointColor=c then exit;
 fPointColor:=c;
 Paint;
end;
function TScienceDraw.NotColor:TColor;
var
 cs:Array [0..3] of byte;
begin
if fPointColor>0
  then
   Integer(Cs):=fPointColor
  else Integer(Cs):=GetSysColor(fPointColor and $FF);
 Result:=RGB(not cs[2],not cs[1],not cs[0]);  
end;

procedure TScienceDraw.Draw2d;
begin
// T:=20; B:=Height-20; L:=5; R:=Width-20;
 with fBitmap do begin
  DT:=20; DB:=Height-20; DL:=5; DR:=Width-12; //画坐标和自定义ParallelX[Y]用
 end;
 if fEqualPixels then
  begin
   if (DB-DT)>(DR-DL)
    then DT:=DB-DR+DL
    else DR:=DB-DT+DL;
  end;
// t:=Dt; b:=DB; L:=DL; R:=DR;
 L:=DL-fViewStart.x; R:=L+Round((DR-DL)*fViewXRatio);
 B:=DB-fViewStart.y; T:=B+Round((DT-DB)*fViewYRatio);

  if Assigned(fDrawFront)then fDrawFront(Canvas); // 自定义前景

//.....

end;

procedure TScienceDraw.DrawOutLine;
begin
 if not fCan2DOutLine then exit;
 if fSC=nil then exit;

   Draw2D;
//.....
end;

procedure TScienceDraw.Draw3d;
begin
 fBitMap.Canvas.Brush.Color:=fBkColor;
 fBitMap.Canvas.FillRect(fBitMap.MaxRect);
 SimpleDraw3d; //仅仅是简单的画点
end;
procedure TScienceDraw.SimpleDraw3d;
begin
//.....
end; // Simple3D End

procedure TScienceDraw.DrawPoints;
begin
 if fCan2DOutLine then begin
  if fSC<>nil then DrawOutLine;
 end else begin
  fBitMap.Width:=width; fBitMap.Height:=Height;
  if f3Demension
    then Draw3d
    else Draw2d;
  Canvas.Draw(0,0,fBitMap);
  if (not f3Demension) and (@fDrawOutLine<>nil)
   then fDrawOutLine;
 end;
 
end;

procedure TScienceDraw.Show;
begin
 if Assigned(fOnShow) then fOnShow(self);
end;

procedure TScienceDraw.MyMouseMoveprocedure(var Message: TWMMouseMove);
begin
 if not f3Demension then Hint2d(Message.XPos,Message.YPos);
 inherited;
end;
procedure TScienceDraw.MyMouseDownprocedure(var Message: TWMLButtonDown); 
begin
 SetSCPosition(Message.XPos,Message.YPos);
 inherited;
 if fCanGetKey then Windows.SetFocus(Handle);
end;
procedure TScienceDraw.MyMouseLeave(Var Message:TMessage);
begin
 inherited;
 if Assigned(fOnMouseLeave) then fOnMouseLeave(self);
end;

procedure TScienceDraw.Hint2d(x,y:integer);
begin
 if fCanStickHint then exit;
 if (MX=0) or (MY=0) then
  begin
   exit;
  end;
 fNowX:=(x-L)/MX+MinX;
 fNowY:=(y-B)/MY+MinY;
 if Assigned(fEditHintCacu) then fEditHintCacu(fNowX,fNowY);
 //Hint Edit
 if fEditX<>nil then fEditX.Text:=MyFormatFloat(NowX,fValidNum);
 if fEditY<>nil then fEditY.Text:=MyFormatFloat(NowY,fValidNum);
end;

procedure TScienceDraw.SetValidNum;
begin
 if fValidNum=B then exit;
 fValidNum:=B;
 Paint;
end;

procedure TScienceDraw.SetCaption(s:String);
begin
 if fCaption=s then exit;
 fCaption:=s;
 fCaptionLabel.Caption:=fCaption;
 fCaptionLabel.Top:=1;
 paint;
end;

procedure TScienceDraw.fHintLableOnMouseMove;
begin
 fHintLabel.Visible:=False;
end;

procedure TScienceDraw.SetLink;
begin
 if fCanLink=b then exit;
 fCanLink:=b;
 Paint;
end;

procedure TScienceDraw.SetPointStyle;
begin
 if fPointStyle=LS then exit;
 fPointStyle:=LS;
 Paint;
end;
procedure TScienceDraw.SetEqualRatio;
begin
 if  fEqualRatio=b then exit;
 fEqualRatio:=b;
 Paint;
end;

procedure TScienceDraw.SetTransparent;
begin
 if  fTransparent=b then exit;
 fTransparent:=b;
 Paint;
end;
procedure TScienceDraw.SetCoordinates;
begin
 if fSelfCoordinates=b then exit;
 fSelfCoordinates:=b;
 Paint;
end;
procedure TScienceDraw.SetCanStandard;
begin
 if fCanStandard=B then exit;
 fCanStandard:=B;
 Paint;
end;
procedure TScienceDraw.SetStandardStyle;
begin
 if fStandardStyle=StaStyle then exit;
 fStandardStyle:=StaStyle;
 if fCanStandard then Paint;
end;
procedure TScienceDraw.SetCanCP;
var
 i,OrgLen:Integer;
begin
 if fCanColorPoint=B then exit;
 fCanColorPoint:=B;
 if High(fPointX)<>High(fPointC) then
  begin
   OrgLen:=High(fPointC);
   SetLength(fPointC,Length(fPointX)); //向fPointX对齐
   for i:=OrgLen+1 to High(fPointC) do
          fPointC[i]:=fPointColor;
  end;
 Paint;
end;
procedure TScienceDraw.SetEqualPixels;
begin
 if  fEqualPixels=B then exit;
 fEqualPixels:=B;
 Paint;
end;

procedure TScienceDraw.Set2DOutLine;
begin
 if fCan2DOutLine=B then exit;
 fCan2DOutLine:=B;
 Paint;
end;
procedure TScienceDraw.SetOutLineSC;
begin
 if fSC<>nil then fSC.fDrawOutLine:=nil;
 fSC:=SC;
 if fSC<>nil then fSC.fDrawOutLine:=DrawOutLine;
end;
procedure TScienceDraw.SetBOLStyle;
begin
 if fBOLStyle=BS then exit;
 fBOLStyle:=BS;
 Paint;
end;
procedure TScienceDraw.SetEditX;
begin
 fEditX:=Edit;
 fEditX.Text:='';
end;
procedure TScienceDraw.SetEditY;
begin
 fEditY:=Edit;
 fEditY.Text:='';
end;

procedure TScienceDraw.SetFillArea;
begin
 if FA.StartPoint<0 then exit;
 if FA.StartPoint>FA.EndPoint then exit;
 fFillArea:=FA;
 Paint;
end;

procedure TScienceDraw.SetDataLines;   //为设计时期而建的属性，方法
var
 i,Amount,RealPointNum,
 PosX,PosY,PosS:Integer;
 s,StrX,StrY:String;
 TS:TStrings;
begin
 if (Lines<>nil)and(Lines<>fLines) then begin
    fLines.Clear;
    fLines.AddStrings(Lines);
   end;

 Clear;
 TS:=fLines;
 Amount:=TS.Count;  RealPointNum:=0;
 if Amount>0 then begin
  for i:=0 to Amount-1 do
   begin
    S:=UpperCase(TS.Strings[i]);
    PosX:=Pos('X:',s); if PosX=0 then Continue;
    PosY:=Pos('Y:',s); if PosY=0 then Continue;
    PosS:=Pos(';',s);  if PosS=0 then Continue;
    PosX:=PosX+2; PosY:=PosY+2;
    StrX:=Copy(S,PosX,PosS-PosX);
    if S[Length(s)]<>'*'
       then StrY:=Copy(S,PosY,Length(s)-PosY+1)
       else StrY:=Copy(S,PosY,Length(s)-PosY);
    if (StrX='')or(StrY='') then Continue;
    try
     AddXY(StrToFloat(StrX),StrToFloat(StrY));
     if S[Length(s)]='*' then AddBreakPoints(RealPointNum);
    except
     SetLength(fPointX,0); SetLength(fPointY,0);
     Continue;
    end; //End Try
    Inc(RealPointNum);
  end; //End For
 end else begin SetLength(fPointX,0); SetLength(fPointY,0); end;
 //End if
 Paint;
end;
procedure TScienceDraw.SetDataContainer;
begin
 fDataContainer:=Memo;
 if fDataContainer<>nil then begin
  DataLines:=fDataContainer.Lines;
 end else begin
  DataLines:=fLines;
 end;
end;
//////////////////////////////////////
procedure TScienceDraw.ClearLink;
begin
 SetLength(fLinkPoints,0);
end;
procedure TScienceDraw.Link(Point1,Point2:Integer);
var
 Len:Integer;
begin
 Len:=High(fLinkPoints);
 SetLength(fLinkPoints,Len+2);
 fLinkPoints[Len+1].Point1:=Point1;
 fLinkPoints[Len+1].Point2:=Point2;
 fLinkPoints[Len+1].C:=fColor;
end;
procedure TScienceDraw.Link(Point1,Point2:Integer;c:TColor);
var
 Len:Integer;
begin
 Len:=High(fLinkPoints);
 SetLength(fLinkPoints,Len+2);
 fLinkPoints[Len+1].Point1:=Point1;
 fLinkPoints[Len+1].Point2:=Point2;
 fLinkPoints[Len+1].C:=C;
end;
////
procedure TScienceDraw.SetRoll;
var
 Rs,Rc:Extended;
begin
 SinCos(Alpha*PI/180,Rs,Rc);
 RollSin:=Rs; RollCos:=Rc;
 RollX:=X; RollY:=Y;
end;
procedure TScienceDraw.RollPoint;
var
 OldX,OldY:Double;
begin
 OldX:=PointX-RollX; OldY:=PointY-RollY;
 PointX:=RollX+OldX*RollCos-OldY*RollSin;
 PointY:=RollY+OldX*RollSin+OldY*RollCos;
end;
procedure TScienceDraw.Roll2D;
var
 i:Integer;
begin
 if f3Demension then exit;
 if High(fPointX)<>High(fPointY) then exit;
 SetRoll(X,Y,Alpha);
 for i:=0 to High(fPointX) do
  RollPoint(fPointX[i],fPointY[i]);
end;
procedure TScienceDraw.Roll3D;
var
 i:Integer;
begin
 if not f3Demension then begin
    Roll2D(X,Y,AlphaZ);
    exit;
  end;
 if High(fPointX)<>High(fPointY) then exit;
 if High(fPointY)<>High(fPointZ) then exit;
 SetRoll(y,z,AlphaX);
 if Abs(AlphaX)>1e-10 then
  for i:=0 to High(fPointX) do
   RollPoint(fPointY[i],fPointZ[i]);
 SetRoll(z,x,AlphaY);
 if Abs(AlphaY)>1e-10 then
  for i:=0 to High(fPointX) do
   RollPoint(fPointZ[i],fPointX[i]);
 SetRoll(x,y,AlphaZ);
 if Abs(AlphaZ)>1e-10 then
  for i:=0 to High(fPointX) do
   RollPoint(fPointX[i],fPointY[i]);
end;
////
procedure TScienceDraw.AnimateDraw;
var
 i,
 x,y,
 b:Integer;
 C:TColor;
begin
 if High(fPointX)<>High(fPointY) then exit;
 C:=$0; B:=1; fStopAnimate:=False;
 for i:=0 to High(fPointX) do
 begin
  X:=fDrawX[i]; Y:=fDrawY[i];
  if (i>0)and(X=fDrawX[i-1])and(Y=fDrawY[i-1]) then continue;
  with Canvas do begin
   inc(c,b);
   if C=$FF then b:=-1;
   if C=$0  then b:=1;
   Brush.Color:=C;  Pen.Color:=255-C;
   Rectangle(x-2,y-2,x+2,y+2);
  end;
  SleepEx(Time,False);
  Application.ProcessMessages;
  if fStopAnimate then break;
  if Can3D then Break;
 end;
 Paint;
end;
procedure TScienceDraw.StopAnimate;
begin
 fStopAnimate:=True;
end;
procedure TScienceDraw.SavePictureToFile(FileName:String);
begin
 if (AnsiUpperCase(ExtractFileExt(FileName))='.JPG')or
   (AnsiUpperCase(ExtractFileExt(FileName))='.JPEG') then
  begin
   fJpg.assign(fBitmap);
   fJpg.SaveToFile(FileName);
  end else fBitmap.SaveToFile(FileName);
end;
procedure TScienceDraw.Print(CanException:Boolean=False);
begin
 if Printer.Printers.Count<>0
  then with Printer do begin