main.pas

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

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DB, ADODB;

const
    startx = 40;
    startY = 40;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button3: TButton;
    shuangdinglen: TEdit;
    Label1: TLabel;
    fulen: TEdit;
    Label2: TLabel;
    gugulen: TEdit;
    Label3: TLabel;
    Button5: TButton;
    Label4: TLabel;
    cbleixing: TComboBox;
    Label5: TLabel;
    yunzhou: TEdit;
    Label6: TLabel;
    Image2: TImage;
    ADOdata: TADOConnection;
    adoqry: TADOQuery;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Label7: TLabel;
    gonggulen: TEdit;
    cbnetgrid: TCheckBox;
    cbstandline: TCheckBox;
    Button1: TButton;
    Label8: TLabel;
    toutunlen: TEdit;
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
                            //参数说明:  1.绘图的母体 2.曲线类型名3.横坐标4.纵坐标5.行数6.列数7.横宽8.列宽9.横坐标初始值
    Function  drawbackimage(tempbmp:Timage;itemname,itemXvalue,itemYvalue:string;rowsnumber,colsnumber,rowwidth,colwidth,tempvalue:integer):boolean;   //网格
    Function  drawstandline(tempbmp:Timage;itemname:string;maxheight,maxwidth:integer):boolean;          //曲线
    Function  drawcurrentpostion(tempbmp:Timage;maxheight,maxwidth,currentXpostion,currentYpostion:integer):boolean;
    Function  drawCRLline(tempbmp:timage;itemname:string;maxheight,maxwidth:integer):boolean;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


Function  Tform1.drawbackimage(tempbmp:Timage;itemname,itemXvalue,itemYvalue:string;rowsnumber,colsnumber,rowwidth,colwidth,tempvalue:integer):boolean;
var rows,cols,itemheight,itemwidth,tempwidth:integer;
    textrow,textcol:string;
    i : integer;
begin
    rows := rowsnumber;
    cols := colsnumber;
    itemheight := colwidth;        //横间距
    itemwidth  := rowwidth;        //列间距
    textcol    := itemXvalue;
    textrow    := itemYvalue;
    tempwidth  := tempvalue;
  with tempbmp.Canvas do
  begin
    pen.Color   := clwhite;
    brush.Color := clwhite;
    Rectangle(0,0,tempbmp.Width,tempbmp.Height);

    pen.Width := 2;
    pen.Color := clblack;
    moveto(startx,starty);
    lineto(startx,tempbmp.Height-starty);
    lineto(tempbmp.width-startx,tempbmp.Height-starty);

    pen.Width := 1;
    lineto(tempbmp.width-startx,starty);
    lineto(startx,starty);

    pen.Color := $00E1E1E1;
    for i :=0 to rows do
    begin
      moveto(startx,tempbmp.Height-startx-((tempbmp.height-4-startx*2)* i div rows) );
      if cbnetgrid.Checked then
      lineto(tempbmp.Width-startx,tempbmp.Height-starty-((tempbmp.Height-4-starty*2)* i div rows) );
      textout(startx div 2-5,tempbmp.Height-starty-((tempbmp.Height-4-startx*2)* i div rows) -5,inttoSTR(i * itemheight));
    end;

    for i:= 0 to cols do
    begin
      moveto(startx+((tempbmp.Width-6-startx*2)* i div cols),starty+1);
      if cbnetgrid.Checked then
      lineto(startx+((tempbmp.Width-6-startx*2)* i div cols),tempbmp.Height-starty-1);
      textout(startx+((tempbmp.Width-6-startx*2)* i div cols)-5,tempbmp.Height-starty + 5,inttostr((tempwidth+i)*itemwidth));
    end;
    //画文字
    pen.Color := clblack;
    Font.Size := 9;
    TextOut((tempbmp.Width - 40) div 2 ,tempbmp.Height-starty div 2,textrow);
    //Font.Name := '隶书';
    TextOut(startx div 2,starty -20,textcol);
  end;
  result := true;
end;
                              //绘图母体,曲线名,高度最大值  ,宽度最大值
Function  Tform1.drawstandline(tempbmp:Timage;itemname:string;maxheight,maxwidth:integer):boolean;
var currentXvalue,currentYvalue,topx,topy:integer;
    rowmaxvalue,colmaxvalue,colsmaxcount:integer;
    currentitemname:string;
    i : integer;
    tempvalue : array[1..30,1..2] of integer;
begin
  tempbmp.Canvas.Pen.Width := 1;
  currentitemname := itemname;      //曲线名,也是字段值
  rowmaxvalue     := maxheight;
  colmaxvalue     := maxwidth;
  with adoqry do
  begin
    active := false;
    sql.Clear;
    sql.Add('select * from itemvalue where itemname='+''''+currentitemname+''''+' and itemvalue='+''''+'tou_5'+'''');
    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+((tempbmp.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  := clgreen;
    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;

  with adoqry do
  begin
    active := false;
    sql.Clear;
    sql.Add('select * from itemvalue where itemname='+''''+currentitemname+''''+' and itemvalue='+''''+'tou_50'+'''');
    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+((tempbmp.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  := 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]) ]);
  end;

  with adoqry do
  begin
    active := false;
    sql.Clear;
    sql.Add('select * from itemvalue where itemname='+''''+currentitemname+''''+' and itemvalue='+''''+'tou_95'+'''');