main.pas

根据定制的数据绘图形,可以绘制胎儿生长曲线,或股票走执曲线图

    active := true;
    first;
    if eof then
    begin
      application.MessageBox('没找到相关曲线参数,请设置曲线参数','提示');
      exit;
    end;
    //rowsmaxcount := fields.Count-4;
    colsmaxcount := fields.Count-4;
    for i:= 1 to 30 do
    begin
      tempvalue[i,1] := 999;
      tempvalue[i,2] := 999;
    end;
    for i:= 3 to fields.Count-3 do
    begin
      tempvalue[i-2,1] := startx+((tempbmp.Width-6-startx*2) * (i-3) div colsmaxcount); //strtoint(copy(fields[i].FieldName,5,length(fields[i].FieldName)-4));
      tempvalue[i-2,2] := tempbmp.Height-starty- (tempbmp.Height-4-starty*2) * fields[i].AsInteger div rowmaxvalue;
    end;
    tempvalue[fields.Count-4,1] := startx+((image1.Width-6-startx*2) * colsmaxcount div colsmaxcount) ;
    tempvalue[fields.Count-4,2] := tempbmp.Height-starty-(tempbmp.Height-4-starty*2) * fields[fields.Count-2].AsInteger div rowmaxvalue;
  end;

  for i:= 1 to 30 do
  begin
    if (tempvalue[i,1]=999) or (tempvalue[i,2]=999) then
    begin
      tempvalue[i,1] := tempvalue[i-1,1];
      tempvalue[i,2] := tempvalue[i-1,2];
    end;
  end;

  with tempbmp.Canvas do
  begin
    pen.Color  := clblue;
    polyline([point(tempvalue[1,1],   tempvalue[1,2]),   point(tempvalue[2,1],    tempvalue[2,2]),    point(tempvalue[3,1],    tempvalue[3,2]),    point(tempvalue[4,1],    tempvalue[4,2]),     point(tempvalue[5,1],    tempvalue[5,2]),    point(tempvalue[6,1],    tempvalue[6,2]),    point(tempvalue[7,1],    tempvalue[7,2]),    point(tempvalue[8,1],    tempvalue[8,2]),
              point(tempvalue[9,1],   tempvalue[9,2]),   point(tempvalue[10,1],   tempvalue[10,2]),   point(tempvalue[11,1],   tempvalue[11,2]),   point(tempvalue[12,1],   tempvalue[12,2]),    point(tempvalue[13,1],   tempvalue[13,2]),   point(tempvalue[14,1],   tempvalue[14,2]),   point(tempvalue[15,1],   tempvalue[15,2]),   point(tempvalue[16,1],   tempvalue[16,2]),
              point(tempvalue[17,1],  tempvalue[17,2]),  point(tempvalue[18,1],   tempvalue[18,2]),   point(tempvalue[19,1],   tempvalue[19,2]),   point(tempvalue[20,1],   tempvalue[20,2]),    point(tempvalue[21,1],   tempvalue[21,2]),   point(tempvalue[22,1],   tempvalue[22,2]),   point(tempvalue[23,1],   tempvalue[23,2]),   point(tempvalue[24,1],   tempvalue[24,2]),
              point(tempvalue[24+1,1],tempvalue[24+1,2]),point(tempvalue[24+2,1], tempvalue[24+2,2]), point(tempvalue[24+3,1], tempvalue[24+3,2]), point(tempvalue[24+4,1], tempvalue[24+4,2]),  point(tempvalue[24+5,1], tempvalue[24+5,2]), point(tempvalue[24+6,1], tempvalue[24+6,2]) ]);
  end;
  result := true;
end;

Function  Tform1.drawcurrentpostion(tempbmp:Timage;maxheight,maxwidth,currentXpostion,currentYpostion:integer):boolean;
var topy,topx:integer;
begin
  with tempbmp.Canvas do
  begin
    pen.Color := clFuchsia;
    pen.Width := 1;
    topy := tempbmp.Height-starty-((tempbmp.Height-4-starty*2) * currentYpostion div maxheight) ;
    topx := startx+((tempbmp.Width-6-startx*2) * (currentXpostion-12) div 2  div maxwidth );  //maxwidth=14  因为从0算起只有十四个分格
    ellipse(topx-5,topy-5,topx+5,topy+5);                                                     //currentXpostion 孕龄
  end;
  result := true;
end;

Function  Tform1.drawCRLline(tempbmp:timage;itemname:string;maxheight,maxwidth:integer):boolean;
var currentitemname:string;
    currenti,colsmaxcount,i:integer;
    tempvalue : array[1..120,1..2] of integer;
    temp:integer;
begin
  //
    for i:= 1 to 120 do
    begin
      tempvalue[i,1] := 999;
      tempvalue[i,2] := 999;
    end;
  with adoqry do
  begin
    active := false;
    sql.Clear;
    sql.Add('select * from yunling order by int(itemname)');
    active := true;
    first;
    if eof then
    begin
      application.MessageBox('没找到相关曲线参数,请设置曲线参数','提示');
      exit;
    end;
    while not eof do
    begin
      try
        currenti := fieldbyname('itemname').AsInteger;
        tempvalue[currenti-2,1] := startx+((tempbmp.Width-6-startx*2) * (currenti-1) div 118)  ;//currenti-2;    //起始值为3 他的值要放到第一个里面
        tempvalue[currenti-2,2] := tempbmp.Height-starty- (tempbmp.Height-4-starty*2)* fieldbyname('itemvalue').AsInteger div 180 ;
      except
      end;
      next;
    end;
  end;

  for i:= 1 to 120 do
  begin
    if (tempvalue[i,1]=999) or (tempvalue[i,2]=999) then
    begin
      tempvalue[i,1] := tempvalue[i-1,1];
      tempvalue[i,2] := tempvalue[i-1,2];
    end;
  end;

  with tempbmp.Canvas do
  begin
    pen.Color  := clred;
    polyline([point(tempvalue[1,1],   tempvalue[1,2]),   point(tempvalue[2,1],    tempvalue[2,2]),    point(tempvalue[3,1],    tempvalue[3,2]),    point(tempvalue[4,1],    tempvalue[4,2]),     point(tempvalue[5,1],    tempvalue[5,2]),    point(tempvalue[6,1],    tempvalue[6,2]),    point(tempvalue[7,1],    tempvalue[7,2]),    point(tempvalue[8,1],    tempvalue[8,2]),
              point(tempvalue[9,1],   tempvalue[9,2]),   point(tempvalue[10,1],   tempvalue[10,2]),   point(tempvalue[11,1],   tempvalue[11,2]),   point(tempvalue[12,1],   tempvalue[12,2]),    point(tempvalue[13,1],   tempvalue[13,2]),   point(tempvalue[14,1],   tempvalue[14,2]),   point(tempvalue[15,1],   tempvalue[15,2]),   point(tempvalue[16,1],   tempvalue[16,2]),
              point(tempvalue[17,1],  tempvalue[17,2]),  point(tempvalue[18,1],   tempvalue[18,2]),   point(tempvalue[19,1],   tempvalue[19,2]),   point(tempvalue[20,1],   tempvalue[20,2]),    point(tempvalue[21,1],   tempvalue[21,2]),   point(tempvalue[22,1],   tempvalue[22,2]),   point(tempvalue[23,1],   tempvalue[23,2]),   point(tempvalue[24,1],   tempvalue[24,2]),
              point(tempvalue[24+1,1],tempvalue[24+1,2]),point(tempvalue[24+2,1], tempvalue[24+2,2]), point(tempvalue[24+3,1], tempvalue[24+3,2]), point(tempvalue[24+4,1], tempvalue[24+4,2]),  point(tempvalue[24+5,1], tempvalue[24+5,2]), point(tempvalue[24+6,1], tempvalue[24+6,2]), point(tempvalue[24+7,1], tempvalue[24+7,2]), point(tempvalue[24+8,1], tempvalue[24+8,2]),
              point(tempvalue[24+9,1],   tempvalue[24+9,2]),   point(tempvalue[24+10,1],   tempvalue[24+10,2]),   point(tempvalue[24+11,1],   tempvalue[24+11,2]),   point(tempvalue[24+12,1],   tempvalue[24+12,2]),    point(tempvalue[24+13,1],   tempvalue[24+13,2]),   point(tempvalue[24+14,1],   tempvalue[24+14,2]),   point(tempvalue[24+15,1],   tempvalue[24+15,2]),   point(tempvalue[24+16,1],   tempvalue[24+16,2]),
              point(tempvalue[24+17,1],  tempvalue[24+17,2]),  point(tempvalue[24+18,1],   tempvalue[24+18,2]),   point(tempvalue[24+19,1],   tempvalue[24+19,2]),   point(tempvalue[24+20,1],   tempvalue[24+20,2]),    point(tempvalue[24+21,1],   tempvalue[24+21,2]),   point(tempvalue[24+22,1],   tempvalue[24+22,2]),   point(tempvalue[24+23,1],   tempvalue[24+23,2]),   point(tempvalue[24+24,1],   tempvalue[24+24,2]),
              point(tempvalue[48+1,1],   tempvalue[48+1,2]),   point(tempvalue[48+2,1],    tempvalue[48+2,2]),    point(tempvalue[48+3,1],    tempvalue[48+3,2]),    point(tempvalue[48+4,1],    tempvalue[48+4,2]),     point(tempvalue[48+5,1],    tempvalue[48+5,2]),    point(tempvalue[48+6,1],    tempvalue[48+6,2]),    point(tempvalue[48+7,1],    tempvalue[48+7,2]),    point(tempvalue[48+8,1],    tempvalue[48+8,2]),
              point(tempvalue[48+9,1],   tempvalue[48+9,2]),   point(tempvalue[48+10,1],   tempvalue[48+10,2]),   point(tempvalue[48+11,1],   tempvalue[48+11,2]),   point(tempvalue[48+12,1],   tempvalue[48+12,2]),    point(tempvalue[48+13,1],   tempvalue[48+13,2]),   point(tempvalue[48+14,1],   tempvalue[48+14,2]),   point(tempvalue[48+15,1],   tempvalue[48+15,2]),   point(tempvalue[48+16,1],   tempvalue[48+16,2]),
              point(tempvalue[48+17,1],  tempvalue[48+17,2]),  point(tempvalue[48+18,1],   tempvalue[48+18,2]),   point(tempvalue[48+19,1],   tempvalue[48+19,2]),   point(tempvalue[48+20,1],   tempvalue[48+20,2]),    point(tempvalue[48+21,1],   tempvalue[48+21,2]),   point(tempvalue[48+22,1],   tempvalue[48+22,2]),   point(tempvalue[48+23,1],   tempvalue[48+23,2]),   point(tempvalue[48+24,1],   tempvalue[48+24,2]),
              point(tempvalue[96+1,1],   tempvalue[96+1,2]),   point(tempvalue[96+2,1],    tempvalue[96+2,2]),    point(tempvalue[96+3,1],    tempvalue[96+3,2]),    point(tempvalue[96+4,1],    tempvalue[96+4,2]),     point(tempvalue[96+5,1],    tempvalue[96+5,2]),    point(tempvalue[96+6,1],    tempvalue[96+6,2]),    point(tempvalue[96+7,1],    tempvalue[96+7,2]),    point(tempvalue[96+8,1],    tempvalue[96+8,2]),
              point(tempvalue[96+9,1],   tempvalue[96+9,2]),   point(tempvalue[96+10,1],   tempvalue[96+10,2]),   point(tempvalue[96+11,1],   tempvalue[96+11,2]),   point(tempvalue[96+12,1],   tempvalue[96+12,2]),    point(tempvalue[96+13,1],   tempvalue[96+13,2]),   point(tempvalue[96+14,1],   tempvalue[96+14,2]),   point(tempvalue[96+15,1],   tempvalue[96+15,2]),   point(tempvalue[96+16,1],   tempvalue[96+16,2]),
              point(tempvalue[96+17,1],  tempvalue[96+17,2]),  point(tempvalue[96+18,1],   tempvalue[96+18,2]),   point(tempvalue[96+19,1],   tempvalue[96+19,2]),   point(tempvalue[96+20,1],   tempvalue[96+20,2]),    point(tempvalue[96+21,1],   tempvalue[96+21,2]),   point(tempvalue[96+22,1],   tempvalue[96+22,2]),   point(tempvalue[96+23,1],   tempvalue[96+23,2]),   point(tempvalue[96+24,1],   tempvalue[96+24,2])
              ]);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  drawbackimage(image1,'','头围HC(mm)','孕周(Weeks)',16,14,2,25,6);
  drawbackimage(image3,'','腹围AC(mm)','孕周(Weeks)',13,14,2,30,6);
  drawbackimage(image4,'','股骨长FL(mm)','孕周(Weeks)',8,14,2,10,6);
  drawbackimage(image5,'','肱骨长HL(mm)','孕周(Weeks)',8,14,2,10,6);
  if cbstandline.Checked then
  begin
    drawstandline(image1,'头围HC',400,40);
    drawstandline(image3,'腹围AC',390,40);
    drawstandline(image4,'股骨FL',80,40);
    drawstandline(image5,'肱骨HL',80,40);
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var topy,topx,yunzhouvalue:integer;
    tempstring:string;
begin
  if yunzhou.Text='' then exit;
  if shuangdinglen.Text <>'' then
  drawcurrentpostion(image1,400,14,strtoint(yunzhou.Text),strtoint(shuangdinglen.Text));
  if fulen.Text <>'' then
  drawcurrentpostion(image3,390,14,strtoint(yunzhou.Text),strtoint(fulen.Text));
  if gugulen.Text <>'' then
  drawcurrentpostion(image4,80,14,strtoint(yunzhou.Text),strtoint(gugulen.Text));
  if gonggulen.Text <>'' then
  drawcurrentpostion(image5,80,14,strtoint(yunzhou.Text),strtoint(gonggulen.Text));
  if (toutunlen.Text<>'') and (shuangdinglen.Text='') then
  begin
    with image1.Canvas do
    begin
      pen.Color := clblue;
      pen.Width := 1;
      tempstring := copy(trim(yunzhou.Text),1,4);
      yunzhouvalue    := 0;
      while length(tempstring)>0 do
      begin
        if copy(tempstring,1,1)<>'.' then
        begin
          yunzhouvalue    := yunzhouvalue*10 + strtoint(copy(tempstring,1,1));
        end;
        tempstring := copy(tempstring,2,length(tempstring)-1);
      end;
      if length(trim(yunzhou.Text))<3 then
      yunzhouvalue    := yunzhouvalue*10;
      if (yunzhouvalue>180) or (yunzhouvalue<0) then
      begin
        application.MessageBox('孕周值超出范围了','提示');
        exit;
      end;
      if (strtoint(toutunlen.Text)>120) or (strtoint(toutunlen.Text)<0) then
      begin
        application.MessageBox('头臀长值超出范围了','提示');
        exit;
      end;
      topy := image1.Height-starty-((image1.Height-4-starty*2) * yunzhouvalue div 180) ;
      topx := startx+((image1.Width-6-startx*2) * strtoint(toutunlen.Text) div 120 );          //maxwidth=14  因为从0算起只有十四个分格
      ellipse(topx-5,topy-5,topx+5,topy+5);                                                     //currentXpostion 孕龄
    end;
  end;
  //drawcurrentpostion(image1,18,120,strtoint(toutunlen.Text),strtoint(yunzhou.Text));

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  with image2.Canvas do
  begin
    pen.Color := clblue;
    moveto(4,10);
    lineto(40,10);
    textout(50,6,'95百分点');
    pen.Color := clred;
    moveto(4,30);
    lineto(40,30);
    textout(50,26,'50百分点');
    pen.Color := clgreen;
    moveto(4,50);
    lineto(40,50);
    textout(50,46,'5百分点');
    pen.Color := clFuchsia;
    ellipse(5,70,15,80);
    textout(50,68,'当前标识点');
    pen.Color := clblue;
    ellipse(5,90,15,100);
    textout(50,88,'冠臀距估算标识点');
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  adodata.Connected := false;
  adodata.Connected := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  drawbackimage(image1,'','孕周(Weeks)','头臀长CRL(mm)',18,12,10,1,0);
  drawCRLline(image1,'头臀长CRL(mm)',180,120);
end;

end.