unitmain.pas

常用数学计算工具

    procedure NELinkNClick(Sender: TObject);
    procedure N62Click(Sender: TObject);
    procedure NTransGClick(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure SavePicDialogTypeChange(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure NDFOClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure ControlBar1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditMaxXKeyPress(Sender: TObject; var Key: Char);
    procedure EditMinXKeyPress(Sender: TObject; var Key: Char);
    procedure EditMaxYKeyPress(Sender: TObject; var Key: Char);
    procedure EditMinYKeyPress(Sender: TObject; var Key: Char);
    procedure EditMaxZKeyPress(Sender: TObject; var Key: Char);
    procedure EditMinZKeyPress(Sender: TObject; var Key: Char);
    procedure Edit2VTXChange(Sender: TObject);
    procedure Edit2VTBChange(Sender: TObject);
    procedure Edit2VTXKeyPress(Sender: TObject; var Key: Char);
    procedure Edit2VTZKeyPress(Sender: TObject; var Key: Char);
    procedure Edit2VTYKeyPress(Sender: TObject; var Key: Char);
    procedure Edit2VTBKeyPress(Sender: TObject; var Key: Char);
    procedure Edit2VTEKeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn2VTEClick(Sender: TObject);
    procedure EditXCKeyPress(Sender: TObject; var Key: Char);
    procedure EditKCKeyPress(Sender: TObject; var Key: Char);
    procedure ToolButtonJ3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn3DTurnClick(Sender: TObject);
    procedure EditMatrixChange(Sender: TObject);
    procedure BitBtnMatrixClick(Sender: TObject);
    procedure MemoNormalKeyPress(Sender: TObject; var Key: Char);
    procedure NAlwTopClick(Sender: TObject);
    procedure PanelSDFNumClick(Sender: TObject);
    procedure EditRXCChange(Sender: TObject);
    procedure BitBtnMoreRMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MemoIntFunChange(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure PageControlGraphDrawTab(Control: TCustomTabControl;
      TabIndex: Integer; const Rect: TRect; Active: Boolean);
    procedure EditV1CExit(Sender: TObject);
    procedure EditNXYZChange(Sender: TObject);
    procedure BitBtnNXYZClick(Sender: TObject);
    procedure EditV1VKeyPress(Sender: TObject; var Key: Char);
    procedure EditWFFNChange(Sender: TObject);
    procedure BitBtnWFClick(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure ComboBoxMatrixSelect(Sender: TObject);
    procedure ComboBoxWFOSelect(Sender: TObject);
    procedure ComboBoxNXYZSelect(Sender: TObject);
    procedure NCorLBClick(Sender: TObject);
    procedure EditZDNDNChange(Sender: TObject);
    procedure EditZDNRNChange(Sender: TObject);
    procedure BitBtnZRNClick(Sender: TObject);
    procedure ComboBoxZDNSelect(Sender: TObject);
    procedure EditDXHVNChange(Sender: TObject);
    procedure EditDXHYNChange(Sender: TObject);
    procedure BtnDXHClick(Sender: TObject);
    procedure ComboBoxDXHSelect(Sender: TObject);
    procedure BitBtnChaoClick(Sender: TObject);
  private
    { Private declarations }
   SStrs:TStrings;      //函数库编译后的目标
   OrgPath:String;      //原始路径
   FirstTime:Boolean;   //第一次OnShow
   FileChanged:Boolean; //文件改变标志
   FindB:Boolean;       //查找标志
   PartNum:Integer;     //图形精度
   EnableWipe:Boolean;  //允许擦除旧图形标志
   SubPNum:Integer;     //求微分等份
   fCanResize:Boolean;  //图形移动标志
   OrgX,OrgY:Integer;
   V1,V2,V3,V4,V5:Extended;//普通计算中的值
   SidaX,SidaY,SidaZ:Integer; //3D动画中的X,Y,Z旋转角度
   function SaveToExcel(SG1,SG2:TStringGrid):Boolean;
   function LoadFromExcel(SG1,SG2:TStringGrid):Boolean;
  public
    { Public declarations }
  end;

var
  FormMath: TFormMath;
  
procedure Register;

implementation
uses DataMaker,Clipbrd,{HsBitmap32,}ZXDDialogs,Matrix,ComObj;
{$MINSTACKSIZE 1024*1024}
{$R *.dfm}
const
 LibFile='FunDefLib.FDL';  //函数库文件
 DefFile='FunDefFile.FDF'; //编译目标文件
 MaxVNum=50;
var
 DFormat:Integer;
 DValidNum:Integer;

procedure Register;
begin
//  RegisterComponents('Standard', [TFormMath]);
end;

function Point(X, Y: Integer): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

function JudgeInt(Sender:TObject; CanMsg:Boolean=False; CanC:Boolean=True):Boolean;
var
 v,C:Integer;
begin
 Result:=False;
 if not(Sender is TCustomEdit) then exit;
 Val(TEdit(sender).Text,V,C);
 if C=0 then Result:=True;
 if CanMsg and (not Result)
    then MessageBox(Application.Handle,PChar(TLabeledEdit(Sender).EditLabel.caption
     +'的表达式错误!'),'错误',mb_OK);

 if Result then TEdit(Sender).Font.Color:=clBlack
           else TEdit(Sender).Font.Color:=clRed;
 C:=V;
end;
function JudgeFloat(Sender:TObject; CanMsg:Boolean=False; CanC:Boolean=True):Boolean;
var
 Value:Extended;
begin
 Result:=False;
 if Sender is TCustomEdit then begin
  try
   if CanC
    then Result:=CStrToFloat(TEdit(Sender).Text,Value,FormMath.SStrs)
    else Result:=TextToFloat(PChar(TEdit(Sender).Text),Value,fvExtended);
  except
  end;
 if CanMsg and (not Result)
    then MessageBox(Application.Handle,PChar(TLabeledEdit(Sender).EditLabel.caption
     +'的表达式错误!'),'错误',mb_OK);

  if Result
    then TEdit(Sender).Font.Color:=clBlack
    else TEdit(Sender).Font.Color:=clRed;
 end;
end;
function JudgeCStr(Sender:TObject;VarC:Char; CanMsg:Boolean=False):Boolean;
var
 S:String;
 FunCom:TFunCommand;
begin
 Result:=False;
 if not (Sender is TCustomEdit)then exit;
 S:=CStrToSStr(TEdit(Sender).Text,FormMath.SStrs);
 Result:=StrToFunCom(S,FunCom,Varc);

 if CanMsg and (not Result)
    then MessageBox(Application.Handle,PChar(TLabeledEdit(Sender).EditLabel.caption
     +'的表达式错误!'),'错误',mb_OK);

 if Result
    then TEdit(Sender).Font.Color:=clBlack
    else TEdit(Sender).Font.Color:=clRed;
end;
procedure SelAll(Sender:TObject);
begin
 if not (Sender is TCustomEdit) then exit;
 with TCustomEdit(Sender) do
  begin
   SelStart:=0;
   SelLength:=Length(Text);
  end;
end;
function TextToFloat(S:String; var Value:Extended):Boolean;
begin
 Result:=CStrToFloat(S,Value,FormMath.SStrs);
end;
function FloatToStr(Value:Extended):String;
begin
 Case DFormat of
  0: Result:=ExtendedToStr(Value,DValidNum,#0);  //普通
  1: Result:=ExtendedToStr(Value,DValidNum,','); //数字英
  2: Result:=ExtendedToStr(Value,DValidNum,',',4); //数字中
  3: if Frac(Value)=0 then Result:=FloatToStrF(Value,ffExponent,DValidNum,0)
   else  Result:=FloatToStrF(Value,ffExponent,DValidNum,DValidNum);
 end;
end;

function SaveGridToFile(SG:TStringGrid; FileName:String; CanLoad:Boolean=True; SG2:TStringGrid=nil):Boolean;
var
 i,j,w,h:integer;
 s:String;
 SL:TStrings;
begin
 SL:=TStringList.Create;
 w:=SG.ColCount;
 h:=SG.RowCount;
 if CanLoad then begin
  SL.Add(IntToStr(W));
  SL.Add(IntToStr(h));
  for i:=1 to w-1 do
   for j:=1 to h-1 do
    SL.Add(SG.Cells[i,j]);
  if SG2<>nil then begin//第二个字符串
   for i:=1 to H-1 do
    SL.Add(SG2.Cells[1,i]);
  end;
 end else begin
  for i:=1 to w-1 do begin
   s:='';
   for j:=1 to h-1 do s:=s+SG.Cells[i,j]+#9;
   SL.Add(s);
  end;
 end;

 try
  if (not FileExists(FileName))or
     (MessageBox(FormMath.handle,'文件已经存在，覆盖它?','请确认',mb_YesNO)=idYes)
    then SL.SaveToFile(FileName);
 except
  SL.Free;
  Result:=False;
  exit;
 end;
 SL.Free;
 Result:=True;
end;
function LoadGridFromFile(SG:TStringGrid; FileName:String; SG2:TStringGrid=nil):Boolean;
var
 i,j,w,h:Integer;
 SL:TStrings;
begin
 sL:=TStringList.Create;
 try
  SL.LoadFromFile(FileName);
  w:=StrToInt(SL[0]);
  h:=StrToInt(SL[1]);
  SG.ColCount:=W; SG.RowCount:=H;
  for i:=1 to w-1 do
   for j:=1 to h-1 do
    SG.Cells[i,j]:=SL[(i-1)*(h-1)+(j-1)+2];
  if SG2<>nil then begin//第二个字符串
   SG2.RowCount:=H;
   for i:=1 to H-1 do
    SG2.Cells[1,i]:=SL[SL.Count-H+i];
  end;
 except
  Result:=False;
  SL.Free;
  exit;
 end;
 Result:=True;
 SL.Free;
end;


var
 xl,xlaSheet:variant;

procedure LinkToExcel;
begin
 try
  xl:=GetActiveOleObject('Excel.Application');
 except
  MessageBox(Application.handle,'无法找到Excel!','错误',mb_OK);
  exit;
 end;
 xl.Visible:=True;
 xlaSheet:=XL.ActiveSheet;
end;
procedure LoadSGFromExcel(SG:TStringGrid; SCol,SRow:Integer);
var
 i,j:Integer;
begin
 LinkToExcel;
 xlaSheet.cells.specialcells(xlcelltypelastcell).activate;
 //SG.ColCount:=xl.ActiveCell.Column+1;
 //SG.RowCount:=xl.ActiveCell.Row+1;
 for i:=1 to SG.ColCount-1 do
  for j:=1 to SG.RowCount-1 do
   SG.Cells[i,j]:=xlaSheet.Cells[j+SRow,i+SCol].value;
end;
procedure SaveSGToExcel(SG:TStringGrid; SCol,SRow:Integer);
var
 i,j:Integer;
begin
 LinkToExcel;
 for i:=1 to SG.ColCount-1 do
  for j:=1 to SG.RowCount-1 do
   xlaSheet.Cells[j+SRow,i+SCol].value:=SG.Cells[i,j];
end;

function TFormMath.SaveToExcel(SG1,SG2:TStringGrid):Boolean;
begin
 Result:=False;
 try
  SaveSGToExcel(SG1,0,0);
  SaveSGToExcel(SG2,SG1.ColCount,SG1.RowCount-1);
 except
 exit;
 end;
 Result:=True;
end;
function TFormMath.LoadFromExcel(SG1,SG2:TStringGrid):Boolean;
begin
 Result:=False;
 try
  LoadSGFromExcel(SG1,0,0);
  LoadSGFromExcel(SG2,SG1.ColCount-1,SG1.RowCount-1);
 except
 exit;
 end;
 Result:=True;
end;


procedure TFormMath.FormCreate(Sender: TObject);
begin
 SStrs:=TStringList.Create;
 OrgPath:=ExtractFileDir(Application.ExeName);
 if OrgPath[Length(OrgPath)]<>'\' then OrgPath:=OrgPath+'\';

 Application.Title:=Caption;
 if FileExists(OrgPath+LibFile)
    then FunDef.Lines.LoadFromFile(OrgPath+LibFile)
    else try FunDef.Lines.SaveToFile(OrgPath+LibFile);
         except MessageBox(handle,PChar('无法建立库文件,'+#$d+'可能是在光盘上'
           +'或者在权限'+#$D+'不够的网络上运行的结果。'),'错误',mb_OK); end;

 FileChanged:=False;   FindB:=False;   EnableWipe:=True;
 PartNum:=1000;        SubPNum:=10;
 V1:=0; V2:=0; V3:=0; V4:=0; V5:=0;
 DFormat:=1; DValidNum:=10;

 if FileExists(OrgPath+DefFile)
    then begin
      SStrs.LoadFromFile(OrgPath+DefFile);
      GetDFS(SStrs,ListBoxFunDef.Items,True);
      PanelSDFNum.Caption:='函数个数:'+IntToStr(ListBoxFunDef.Items.Count)
    end else BitBtnCompileClick(nil);
 FunDef.HighLightedLine:=-1;

 FirstTime:=True;
 Application.HelpFile:='数学小帮手.HLP';
end;

procedure TFormMath.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
 Answer:Integer;
begin
 BitBtn2DRC.Tag:=1;
 SDFun.StopAnimate;
 TimerXYZ.Enabled:=False;
 if FileChanged then
 begin
  Answer:=MessageBox(Handle,'文件已经变动，您要保存吗?','注意',mb_YesNoCancel);
  Case Answer of
   id_Cancel: CanClose:=False;
   id_Yes:    BitBtnSaveClick(Sender);
  end;
 end;
end;

procedure TFormMath.FormShow(Sender: TObject);
begin
  if FirstTime then begin
   ComboBox1V.ItemIndex:=0;
   ComboBox2V.ItemIndex:=0;
   ComboBox2VT.ItemIndex:=3;
   ComboBoxVNum.ItemIndex:=5;
   ComboBoxSta.ItemIndex:=0;
   ComboBox3DTS.ItemIndex:=1;
   EditMatrixChange(EditMatrix);
   EditNXYZChange(EditNXYZ);
   EditWFFNChange(EditWFFN);
   EditZDNDNChange(EditZDNDN);
   EditDXHVNChange(EditDXHVN);
   AutoSaveDesk.DefaultDir:=OrgPath;
   try AutoSaveDesk.Load; except end; //桌面情况
   Edit1VB.EditLabel.Caption:='';
   ComboBox1VChange(ComboBox1V);
   Edit1VB.LabelPosition:=lpLeft;     //AutoSaveDesk的Bug
   if (PageControlGraph.ActivePage=TabSheet2V)or
      (PageControlGraph.ActivePage=TabSheetSigG)
      then begin SDFun.Can3D:=True; SDFun.Refresh; end;   
  end;
end;

procedure TFormMath.FormClose(Sender: TObject; var Action: TCloseAction);
var
 H:THandle;
 Code:DWord;
begin
 if SStrs<>nil then SStrs.Free;
 H:=OpenProcess(PROCESS_ALL_ACCESS,True,GetCurrentProcess);
 GetExitCodeProcess(H,code);
 TerminateProcess(H,Code);
 try AutoSaveDesk.Save; except end;
end;

procedure TFormMath.BitBtnCompileClick(Sender: TObject);
var
 EStr:String;
 BP,EP:TPoint;
 Pos:Integer;
 bt,et:DWord;
begin
 bt:=GetTickCount;

 SStrs.Clear;      FunDef.HighLightedLine:=-1;
 ListBoxResult.Clear;  ListBoxResult.Items.Add('正在编译......');
 ListBoxResult.Refresh;

 if (Sender=BitBtnCompile)or(Sender=nil)
  then EStr:=OrgStrsToSStrs(FunDef.Lines,SStrs)
  else EStr:=OrgStrsToSStrs(FunDef.Lines,SStrs,FunDef.caretPos.Y);
 ListBoxFunDef.Clear;  ListBoxResult.Clear;
 if EStr<>''
    then begin
     ListBoxResult.Items.Add('编译结果:'+ErrorMsg+'!');
     if FindWordInStrs(FunDef.Lines,EStr,Pos,BP,EP,False,False,True) then
       begin
        FunDef.VScrollPos:=EP.y;
        FunDef.HighLightColor:=ClRed;
        FunDef.HighLightedLine:=BP.y;
        FunDef.HighLightedLineNum:=EP.y-BP.y+1;
        FunDef.SetFocus; FunDef.Refresh;
        ListBoxResult.Items.Add('    是："'+GetStrFromStrs(FunDef.Lines,BP,EP,True)+'"字符串中出现的问题!');
        ListBoxResult.Items.Add('    错误发生处： X:'+IntToStr(BP.X)+';Y:'+IntToStr(BP.Y+1));
       end else ListBoxResult.Items.Add('未知错误! 原始错误信息:'+EStr+' 无效');
    end else begin
     ListBoxResult.Items.Add('编译结果:成功!');
     try SStrs.SaveToFile(OrgPath+DefFile); except ListBoxResult.Items.Add('但无法保存库函数!'); end;
     GetDFS(SStrs,ListBoxFunDef.Items,True);
     PanelSDFNum.Caption:='函数个数:'+IntToStr(ListBoxFunDef.Items.Count);
    end;
 et:=GetTickCount;
 ListBoxResult.Items.Add('编译耗费时间:'+IntToStr(et-bt)+'ms');