unit3.pas

某单位需要完成N项任务

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls;

type
  TForm3 = class(TForm)
    timer1: TTimer;
    Timer2: TTimer;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    shorttime: TButton;
    caltime: TButton;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Image1: TImage;
    Memo1: TMemo;
    Label12: TLabel;
    procedure paintaxis();
    function  getaxisx(x:integer):real;
    function  getaxisy(y:integer):real;
    function  changrch(a:real):real;
    function  f(x1,x2,y1,y2,v1,v2,x:real):real;
    function fdao(x1,x2,y1,y2,v1,v2,x:real):real;
    function  checkstart(var x1,x2,y1,y2,v1,v2:real):boolean;
    procedure FormCreate(Sender: TObject);
    procedure imageclear();
    procedure repaintpoint(a:integer);
    procedure chosetorepaint();
    procedure shorttime1(x1,x2,y1,y2,v1,v2:real;var xk,sec:real);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure shorttimeClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure caltimeClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses Unit4;

{$R *.dfm}

var
 xc,sec:real;
 xq,yq,xp,yp,xd,yd,xc1:integer;
 oy:integer;    //全程变量

procedure TForm3.paintaxis(); //画坐标
var
  ox,xt,yt:integer;
  st,q:real;
begin

  with image1 do
  begin
  Canvas.Pen.Width:=1;
  ox:=30;
  oy:=round(Height/2);
  Canvas.MoveTo(ox,0);
  Canvas.LineTo(ox,Height);
  Canvas.MoveTo(0,oy);
  Canvas.LineTo(Width,oy);
  q:=(height-2)/20;
  for yt:=-9 to 9 do
    if yt<>0 then
     begin
       st:=yt*q;
       canvas.MoveTo(ox+4,oy+round(st));
       canvas.LineTo(ox,oy+round(st));
       canvas.TextOut(ox-20,oy-round(st)-2,inttostr(yt));
     end;
  q:=(width-40)/19;
  for xt:=0 to 19 do
  begin
     st:=xt*q;
     canvas.MoveTo(ox+round(st),oy-4);
     canvas.LineTo(ox+round(st),oy);
     if xt<>0 then
     canvas.TextOut(ox+round(st)-2,oy+4,inttostr(xt))
     else
     canvas.TextOut(ox+round(st)-10,oy+4,inttostr(xt));
  end
end;

end;

function TForm3.getaxisx(x:integer):real; //取坐标x
var
  q:real;
begin
   q:=(Image1.Width-40)/19;
   getaxisx:=(x-30)/q;
end;

function TForm3.getaxisy(y:integer):real; //取坐标y
var
 q:real;
begin
   oy:=round(image1.Height/2);
   q:=(image1.height-2)/20;
   getaxisy:=-(y-oy)/q;

end;

function TForm3.changrch(a:real):real;
var b:string;
begin
  b:=floattostr(a);
  b:=copy(b,1,pos('.',b)+2);
  changrch:=strtofloat(b);
end;

procedure TForm3.imageclear();
begin
 with image1.canvas do
 begin
    brush.Color:=clwhite;
    Brush.Style:=bssolid;
    Rectangle(0,0,image1.width,image1.height);
 end;
end;

procedure TForm3.repaintpoint(a:integer);//1=a,2=b,3=c
var
  x,y:integer;
  x1,y1:real;
begin
 if a=1 then
 begin
   x1:=strtofloat(edit1.text);
   y1:=strtofloat(edit2.text);
   x:=round(x1*(image1.width-40)/19)+30;
   y:=oy-round(y1*(image1.Height-2)/20);
   image1.canvas.TextOut(x+8,y-8,'A( '+edit1.text+' , '+edit2.text+' )');
 end
 else if a=2 then
   begin
   x1:=strtofloat(edit3.text);
   y1:=strtofloat(edit4.text);
   x:=round(x1*(image1.width-40)/19)+30;
   y:=oy-round(y1*(image1.Height-2)/20);
   image1.canvas.TextOut(x+8,y-8,'B( '+edit3.text+' , '+edit4.text+' )');
  end
 else if a=3 then
 begin
   x1:=strtofloat(edit7.text);
   x:=round(x1*(image1.width-40)/19)+30;
   y:=oy;
   image1.canvas.TextOut(x+5,y-20,'C1( '+edit7.text+' , 0 )');
 end;
 image1.Canvas.Ellipse(x-4,y-4,x+4,y+4);
end;


procedure TForm3.chosetorepaint(); //选择要画出的点
var x1,y1:real;
begin
  if (edit1.Text<>'')or(edit2.Text<>'') then
  try
   x1:=strtofloat(edit1.text);
   y1:=strtofloat(edit2.text);
   repaintpoint(1);
  except
   //showmessage('A坐标值输入不正确，请重新输入！');
   end;
  if (edit3.Text<>'')or(edit4.Text<>'') then
  try
    x1:=strtofloat(edit3.text);
    y1:=strtofloat(edit4.text);
  repaintpoint(2);
  except
  //showmessage('B坐标值输入不正确，请重新输入！');
  end;
  if edit7.Text<>'' then
   try
   x1:=strtofloat(edit7.text);
   repaintpoint(3);
  except
   // showmessage('自设折点坐标值输入不正确，请重新输入！');
  end;
end;




procedure TForm3.FormCreate(Sender: TObject);
begin
  paintaxis;
  timer1.Enabled:=false;
end;

procedure TForm3.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var x0,y0:real;
    x1,y1:string;
begin
   x0:=changrch(getaxisx(x));
   y0:=changrch(getaxisy(y));
   if (x0>0)and(x0<19)then
  begin
   x1:=floattostr(x0);
   y1:=floattostr(y0);
   timer2.Enabled:=false;
   timer1.Enabled:=false;
   imageclear;
   paintaxis;

   if y0>0 then
    begin
      edit1.Text:=x1;
      edit2.Text:=y1;
    end
   else if (y0>-0.2)and(y0<0.2) then  edit7.Text:=x1
   else
     begin
      edit3.Text:=x1;
      edit4.Text:=y1;
      end;
   chosetorepaint;
   end;
end;


function TForm3.checkstart(var x1,x2,y1,y2,v1,v2:real):boolean;
//检查数据的完整性
begin
  checkstart:=true;
  try
   x1:=strtofloat(edit1.text);
   y1:=strtofloat(edit2.text);
   if (x1<0)or(x1>19) then
   begin
      checkstart:=false;
      showmessage('A坐标X值应是小于19的正实数，请重新输入！');
   end;
   if (y1<-10)or(y1>10) then
   begin
      checkstart:=false;
      showmessage('A坐标y值请不要超出[-10,10]的正实数，请重新输入！');
   end;
  except
    checkstart:=false;
    showmessage('A坐标值输入不正确，请重新输入！');
  end;
  try
    x2:=strtofloat(edit3.text);
    y2:=strtofloat(edit4.text);
     if (x2<0)or(x2>19) then
   begin
      checkstart:=false;
      showmessage('B坐标X值应是小于19的正实数，请重新输入！');
   end;
    if (y2<-10)or(y2>0) then
   begin
      checkstart:=false;
      showmessage('B坐标y值请不要超出[-10,0)的正实数，请重新输入！');
   end;
  except
    checkstart:=false;
    showmessage('B坐标值输入不正确，请重新输入！');
  end;
  try
   v1:=strtofloat(edit5.text);
   v2:=strtofloat(edit6.text);
    if (v2<=0)or(v1<=0) then
   begin
      checkstart:=false;
      showmessage('速度请输入正实数，请重新输入！');
   end;
  except
   checkstart:=false;
   showmessage('速度值输入不正确，请重新输入！');
  end;
end;




procedure TForm3.shorttimeClick(Sender: TObject);
var
  x1,x2,y1,y2,v1,v2:real;
  x,y:integer;
begin
  if checkstart(x1,x2,y1,y2,v1,v2)=false then exit
  else
  begin
    xd:=round(x1*(image1.width-40)/19)+30;
    yd:=oy-round(y1*(image1.Height-2)/20);
    xp:=round(x2*(image1.width-40)/19)+30;
    yp:=oy-round(y2*(image1.Height-2)/20);
    shorttime1(x1,x2,y1,y2,v1,v2,xc,sec);
    imageclear;
    paintaxis;
    chosetorepaint;
    //画C点
    x:=round(xc*(image1.width-40)/19)+30;
    y:=oy;
    xc:=changrch(xc);
    image1.canvas.TextOut(x+5,y-20,'C( '+floattostr(xc)+' , 0 )');
    image1.Canvas.Ellipse(x-4,y-4,x+4,y+4);
    image1.canvas.TextOut(x+8,y-40,'最短时间＝'+floattostr(sec)+'秒 ！');
    xc1:=round(xc*(image1.width-40)/19)+30;
    image1.Canvas.moveto(xd,yd);
    image1.Canvas.Pen.Width:=2;
    xq:=xd;yq:=yd;
    timer1.Enabled:=true;
  end;
end;

procedure TForm3.shorttime1(x1,x2,y1,y2,v1,v2:real;var xk,sec:real); //计算最短时间
begin
  xk:=(x1+x2)/2 ;
  repeat
  xk:=xk-f(x1,x2,y1,y2,v1,v2,xk)/fdao(x1,x2,y1,y2,v1,v2,xk);
  until abs(f(x1,x2,y1,y2,v1,v2,xk))<0.00001;
  sec:=sqrt(sqr(xk-x1)+sqr(y1))/v1+sqrt(sqr(xk-x2)+sqr(y1))/v2;
  sec:=changrch(sec);
end;


function tform3.f(x1,x2,y1,y2,v1,v2,x:real):real;
begin
  f:=(x-x1)/(sqrt(sqr(x-x1)+sqr(y1))*v1)+(x-x2)/((sqrt(sqr(x-x2)+sqr(y2))*v2));
end;

function tform3.fdao(x1,x2,y1,y2,v1,v2,x:real):real;
var a:real;
begin
  a:=sqr(y1)/(v1*sqrt(sqr(x-x1)+sqr(y1))*(sqr(x-x1)+sqr(y1)));
  fdao:=a+sqr(y2)/(v1*sqrt(sqr(x-x2)+sqr(y2))*(sqr(x-x2)+sqr(y2)));
end;

procedure TForm3.Timer1Timer(Sender: TObject);
//最短时间的时钟
begin
  yq:=yq+1;
  if yq<=oy then
  xq:=round(xc1+(oy-yq)*(xd-xc1)/(oy-yd))
  else
  xq:=round(xc1+(yq-oy)*(xp-xc1)/(yp-oy));
  image1.Canvas.LineTo(xq,yq);
  if yq>yp then
  timer1.Enabled:=false;
end;


procedure TForm3.caltimeClick(Sender: TObject);
var
  x1,x2,y1,y2,v1,v2,xc2:real;
  start1:boolean;
  x,y:integer;
begin
   if checkstart(x1,x2,y1,y2,v1,v2)=false then exit;
   try
    xc2:=strtofloat(edit7.text);
    if (xc2<0)or (xc2>19) then
    begin
     start1:=false;
     showmessage('自设折点的X值应是小于19的正实数，请重新输入！');
    end;
   except
    showmessage('自设折点的X值输入错误，请重新输入！');
    start1:=false;
   end;
   if start1=false then exit;
    xd:=round(x1*(image1.width-40)/19)+30;
    yd:=oy-round(y1*(image1.Height-2)/20);
    xp:=round(x2*(image1.width-40)/19)+30;
    yp:=oy-round(y2*(image1.Height-2)/20);
    sec:=sqrt(sqr(xc2-x1)+sqr(y1))/v1+sqrt(sqr(xc2-x2)+sqr(y1))/v2;
    sec:=changrch(sec);
    //画C点
    x:=round(xc2*(image1.width-40)/19)+30;
    y:=oy;
    xc2:=changrch(xc2);
    image1.canvas.TextOut(x+5,y-20,'C1( '+floattostr(xc2)+' , 0 )');
    image1.Canvas.Ellipse(x-4,y-4,x+4,y+4);
    image1.canvas.TextOut(x+8,y-40,'相应时间＝'+floattostr(sec)+'秒 ！');
    xc1:=round(xc2*(image1.width-40)/19)+30;
    image1.Canvas.moveto(xd,yd);
    image1.Canvas.Pen.Width:=2;
    xq:=xd;yq:=yd;
    timer2.Enabled:=true;
end;

procedure TForm3.Timer2Timer(Sender: TObject);
begin
  yq:=yq+1;
  if yq<=oy then
  xq:=round(xc1+(oy-yq)*(xd-xc1)/(oy-yd))
  else
  xq:=round(xc1+(yq-oy)*(xp-xc1)/(yp-oy));
  image1.Canvas.LineTo(xq,yq);
  if yq>yp then
  timer2.Enabled:=false;
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  form4.show;
  form3.release;
end;

end.