sciencedraw.pas

常用数学计算工具

   BeginDoc;
   Canvas.Draw(0, 0, fBitmap);
   EndDoc;
 end else begin
  if CanException
   then raise exception.Create('无法设置打印机!')
   else MessageBox(handle,'无法设置打印机!','错误',mb_OK);
 end;
end;

procedure TScienceDraw.Refresh;
begin
 Paint;
end;
procedure TScienceDraw.RefreshSDOK;
begin
 Canvas.Draw(0,0,fBitmap);
end;

function TScienceDraw.GetPixelFormat:TPixelFormat;
begin
 result:=fBitMap.PixelFormat;
end;
///////
function TScienceDraw.GetPositionValue;
begin
 result:=False;
 if MX*MY=0 then exit;
 ValueX:=(x-L)/MX+MinX;
 ValueY:=(y-B)/MY+MinY;
 Result:=True;
end;
procedure TScienceDraw.GetValuePosition;
begin
 X:=Round((ValueX-MinX)*MX+L);
 Y:=Round((ValueY-MinY)*MY+B);
end;
function TScienceDraw.GetNearPoint;
var
 i,Index:Integer;
 temp,Minv:Double;
begin
 Result:=-1;
 if High(fPointX)<0 then exit;
 if High(fPointX)<>High(fPointY) then exit;
 Index:=0;
 MinV:=Sqr(fPointX[0]-ValueX)+Sqr(fPointY[0]-ValueY);
 for i:=1 to High(fPointX) do
  begin
   Temp:=Sqr(fPointX[i]-ValueX)+Sqr(fPointY[i]-ValueY);
   if Temp<MinV then begin
    MinV:=Temp;
    Index:=i;
   end;
  end;
 Result:=Index;
end;
function TScienceDraw.GetPointSlope;
begin
 Result:=0;
 if (Index<0)or(Index>=high(fPointX)) or(High(fPointX)<1)
     or(High(fPointX)<>High(fPointY)) then begin
  Error:=1;
  exit;
 end;
 if fPointX[index]=fPointX[index+1] then begin
  Error:=2;
  exit;
 end;
 Result:=(fPointY[Index+1]-fPointY[Index])/(fPointX[Index+1]-fPointX[Index]);
end;
function TScienceDraw.GetIntegral;
var
 i:Integer;
 X:Double;
begin
 Result:=0;
 if (StartPoint>=EndPoint)or(High(fPointX)<>High(fPointY))or
    (StartPoint<0)or(EndPoint>High(fPointX)) then exit;
 X:=0;
 for i:=StartPoint to EndPoint-1 do
   X:=(fPointX[i+1]-fPointX[i])*((fPointY[i+1]+fPointY[i])/2-Bottom);
 Result:=X;
end;
function TSCienceDraw.GetXChangePP;
var
 xL,xR,tempY:Double;
begin
 GetPositionValue(1,0,xL,tempY);
 GetPositionValue(2,0,xR,tempY);
 Result:=(XR-XL);
end;
function TSCienceDraw.GetYChangePP;
var
 yT,yB,TempX:Double;
begin
 GetPositionValue(0,1,tempX,yB);
 GetPositionValue(0,2,tempX,yT);
 Result:=(yT-yB);
end;
procedure TScienceDraw.GetVisualXY;
begin
 GetPositionValue(L,B,MinX,MinY);
 GetPositionValue(R,T,MaxX,MaxY);
end;
/////
procedure TSciencedraw.SetValueCenter;
var
 X,Y:Integer;
begin
 if High(fPointX)<2 then exit;
 ViewStart:=Point(0,0);
 Draw2D;
 GetValuePosition(X,Y,ValueX,ValueY);
 ViewStart:=Point(X-DL-(DR-DL)div 2,
                  -(DB-DT) div 2+(Y-DT));
end;
procedure TSciencedraw.SetValueOrg;
var
 X,Y:Integer;
begin
 if High(fPointX)<2 then exit;
 ViewStart:=Point(0,0);
 Draw2D;
 GetValuePosition(X,Y,ValueX,ValueY);
 ViewStart:=Point(X-DL,-(DB-DT)+(Y-DT));
end;
procedure TScienceDraw.SetSCPosition;
var
 DL,DT,DR,DB,
 OrgX,OrgY:Integer;
 VX,VY:Double;
begin
 if not fCan2DOutLine then exit;
 DL:=2; DT:=2; DR:=Width-2; DB:=Height-2;
 if (x<DL)or(x>DR)or(y<DT)or(y>DB)then exit;
 if (fSC<>nil) and(fSC.pointsNum>2) then begin
  OrgX:=Round((X-DL)/(DR-DL)*(fSC.R-fSC.L)+fSC.L);
  OrgY:=Round((Y-DB)/(DT-DB)*(fSC.T-fSC.B)+fSC.B);
  fSC.GetPositionValue(OrgX,OrgY,VX,VY);
  fSC.SetValueCenter(VX,VY);
  fSC.paint;
  end;
end;
procedure TScienceDraw.SetSCOLPosition;
begin
 SetSCPosition(X,Y);
end;
/////
procedure TScienceDraw.SetPointValue;
begin
 if Num<0 then exit;
 if Num>High(fPointX) then exit;
 if Num>High(fPointY) then exit;
 if (Num>High(fPointC))and(CanColorPoint) then exit;  //防止出错

 fPointX[Num]:=Value.ValueX;
 fPointY[Num]:=Value.ValueY;
 if CanColorPoint then fPointC[Num]:=Value.C;
end;

function TScienceDraw.GetPointValue;
begin
 FillChar(Result,SizeOf(Result),0);
 if Num<0 then exit;
 if Num>High(fPointX) then exit;
 if Num>High(fPointY) then exit;
 if (Num>High(fPointC))and(CanColorPoint) then exit;  //防止出错

 Result.ValueX:=fPointX[Num];
 Result.ValueY:=fPointY[Num];
 if CanColorPoint then Result.C:=fPointC[Num];
end;
//////////////////////////////////////////////
procedure TScienceDraw.SetPointsXY;
var
 i:Integer;
begin
 fPointX:=PX;
 fPointY:=PY;
 if not CanColorPoint then exit;
 if PC=nil then
  begin
   SetLength(fPointC,Length(fPointX));
   for i:=0 to High(fPointC) do
    fPointC[i]:=fPointColor;
  end else fPointC:=PC;
end; //加2D点

procedure TScienceDraw.SetPointsXYZ;
begin
 fPointX:=PX;
 fPointY:=PY;
 fPointZ:=PZ;
end; //加3D点
/////////////////////////////////////////
procedure TScienceDraw.ClearXParallel;
begin
 SetLength(fXParallel,0);
end;
procedure TScienceDraw.ClearYParallel;
begin
 SetLength(fYParallel,0);
end;
procedure TScienceDraw.ClearSCLine;
begin
 SetLength(fSCLines,0);
end;
procedure TScienceDraw.ClearText;
var
 i:Integer;
begin
 for i:=0 to High(fTexts) do fTexts[i].Text:='';
 SetLength(fTexts,0);
end;
procedure TScienceDraw.DeleteFromBP;
begin
 if Index>High(fBreakPoints) then exit;
 if Index<0 then exit;
 SetLength(fPointX, fBreakPoints[Index].Index);
 SetLength(fPointY, fBreakPoints[Index].Index);
 if CanColorPoint then SetLength(fPointC, fBreakPoints[Index].Index);
 SetLength(fBreakPoints,High(fBreakPoints));
end;
/////
procedure TScienceDraw.AddXParallel;
var
 Len:Integer;
begin
 Len:=Length(fXParallel);
 Inc(Len);
 SetLength(fXParallel,Len);
 Dec(Len);
 fXParallel[Len].Value:=Y;
 fXParallel[Len].AddText:=B;
 fXParallel[Len].Style:=Style;
end;
procedure TScienceDraw.AddYParallel;
var
 Len:Integer;
begin
 Len:=Length(fYParallel);
 Inc(Len);
 SetLength(fYParallel,Len);
 Dec(Len);
 fYParallel[Len].Value:=X;
 fYParallel[Len].AddText:=B;
 fYParallel[Len].Style:=Style;
end;
procedure TScienceDraw.AddSCLine(X1,Y1,X2,Y2:Double; Const Style:Byte=0; Const Hint:String=''; Const CanHint:Boolean=True; Const Color:TColor=$FFFF00);
var
 Len:Integer;
begin
 Len:=Length(fSCLines); Inc(Len);
 SetLength(fSCLines,Len);
 Dec(Len);
 fSCLines[Len].ValueX1:=X1; fSCLines[Len].ValueY1:=Y1;
 fSCLines[Len].ValueX2:=X2; fSCLines[Len].ValueY2:=Y2;
 fSCLines[Len].Hint:=Hint; fSCLines[Len].CanHint:=CanHint;
 fScLines[Len].Style:=Style; fSCLines[Len].Color:=Color;
end;
procedure TScienceDraw.AddSCLineK;
var
 K2,
 X2,Y2:Double;
begin
 K2:=k*k;
 X2:=X+Len/(k2+1); Y2:=Y+Len*k/(k2+1);
 AddSCLine(X,Y,X2,Y2,Style,Hint,CanHint,Color);
end;

procedure TSCienceDraw.AddText(X,Y:Integer; Text:String; CanCenter:Boolean=False; Color:TColor=$FFFF00; Size:Integer=10);
var
 Len:Integer;
begin
 Len:=Length(fTexts);
 SetLength(fTexts,Len+1);
 fTexts[Len].x:=x;
 fTexts[Len].y:=y;
 fTexts[Len].CanCenter:=CanCenter;
 fTexts[Len].Text:=Text;
 fTexts[Len].Color:=Color;
 fTexts[Len].Size:=Size;
end;

procedure TScienceDraw.AddPointComment(Index:Integer; Text:String; Color:TColor=$FFFF00; Size:Integer=10);
var
 X,Y:Integer;
begin
 GetValuePosition(X,Y,fPointX[Index],fPointY[Index]);
 AddText(X,Y,Text,False,Color,Size);
end;

procedure TScienceDraw.DrawSCLine;
var
 CC,CCF:TColor;
 S: TPenStyle;
 ix1,ix2,iy1,iy2,temp:Integer;
begin
 CC:=Canvas.Pen.Color;
 CCF:=Canvas.Font.Color;
 S:=Canvas.Pen.Style;

 Canvas.Pen.Color:=Color;

 ix1:=Round(L+(X1-MinX)*MX);
 iy1:=round(B+(Y1-MinY)*MY);
 ix2:=Round(L+(X2-MinX)*MX);
 iy2:=round(B+(Y2-MinY)*MY);

 Canvas.MoveTo(ix1,iY1);
 case Style of
  0: Canvas.Pen.style:=psSolid;
  1: Canvas.Pen.Style:=psDash;
  2: Canvas.Pen.Style:=psDashDot;
 end;
 Canvas.LineTo(ix2,iy2);

 if CanHint then
  begin
    Canvas.Font.Color:=Color;
    if (iy2<>iy1)
      then Temp:=ix1+Round((DT-iy1)/(iy2-iy1)*(ix2-ix1))
      else Temp:=DL;
    if Temp>=DL
      then Canvas.TextOut(Temp+2,Dt,Hint)
      else Canvas.TextOut(DL+2,Dt+2,Hint);
  end;

 Canvas.Pen.Color:=CC;
 Canvas.Font.Color:=CCF;
 Canvas.Pen.Style:=s;
end;
procedure TScienceDraw.DrawSCLineK;
var
 K2,
 X2,Y2:Double;
begin
 K2:=k*k;
 X2:=X+Len/(k2+1); Y2:=Y+Len*k/(k2+1);
 DrawSCLine(X,Y,X2,Y2,Style,Hint,CanHint,Color);
end;
procedure TScienceDraw.AddGrids(X1,X2,Y1,Y2:Double;XParts,YParts:Integer; const RatioPLTP:Byte=5; const RatioSTPL:Byte=2);
var
 iP,iPL:Integer;
 Style:Byte;
 XSec,YSec:Double;
begin
 if (XParts=0)or(YParts=0)then exit;
 XSec:=(x2-x1)/XParts; YSec:=(y2-y1)/YParts;
 iP:=0; iPL:=0;
 repeat  //加X=?的直线
  if iP mod RatioPLTP<>0 then Style:=1 //虚线
   else begin
    if iPL mod RatioSTPL<>0
       then Style:=2
       else Style:=0;
    inc(iPL);
   end;
  AddYParallel(X1+iP*XSec,True,Style);
  inc(iP);
 until iP>XParts;

 iP:=0; iPL:=0;
 repeat  //加的Y=?的直线
  if iP mod RatioPLTP<>0 then Style:=1 //虚线
   else begin
    if iPL mod RatioSTPL<>0
       then Style:=2
       else Style:=0;
    inc(iPL);
   end;
  AddXParallel(Y1+iP*YSec,True,Style);
  inc(iP);
 until iP>XParts;
end;
procedure TScienceDraw.AddBreakPoints;
var
 Len:Integer;
begin
 if Index<=0 then exit;
 Len:=Length(fBreakPoints);
 SetLength(fBreakPoints,Len+1);
 fBreakPoints[Len].Index:=Index;
 if (Index>0)and (Length(fPointC)>=Index)
    then fBreakPoints[Len].C:=fPointC[Index-1]
    else fBreakPoints[Len].C:=fColor;
end;
/////////////////////////////////////////
procedure TScienceDraw.fReset;
begin
 fClear;
 ClearXParallel;
 ClearYParallel;
 ClearSCLine;
 ClearText;
 fViewXRatio:=1.0; fViewYRatio:=1.0;
 fViewStart:=Point(0,0);
// MX:=0; MY:=0;  
end;

procedure TScienceDraw.Reset;
begin
 fReset;
end;

procedure TScienceDraw.SetCanInv;
begin
 if fCanInv=B then exit;
 fCanInv:=B;
 if fCanInv
    then  ControlStyle:=ControlStyle+[csAcceptsControls]
    else  ControlStyle:=ControlStyle-[csAcceptsControls];
end;




///全部结束
end.