⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 女性安全期测试
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, Buttons, Grids, DBGrids, DB, DBTables, ADODB,
  StdCtrls, TeeProcs, TeEngine, Chart, DbChart, Series,DateUtils;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    M1: TMenuItem;
    D1: TMenuItem;
    P1: TMenuItem;
    X1: TMenuItem;
    G1: TMenuItem;
    R1: TMenuItem;
    A1: TMenuItem;
    maintable: TADOTable;
    ADOConnection1: TADOConnection;
    DataSource1: TDataSource;
    maintableid: TSmallintField;
    maintablestartdate: TWideStringField;
    maintableremark: TWideStringField;
    maintabledays: TSmallintField;
    subtable: TADOTable;
    DataSource2: TDataSource;
    subtableid: TSmallintField;
    subtableseq: TSmallintField;
    subtabletemp: TFloatField;
    subtableyj: TWideStringField;
    subtablexj: TWideStringField;
    subtableremark: TWideStringField;
    Panel2: TPanel;
    subtablerq: TStringField;
    qyyj: TADOQuery;
    templine: TDBChart;
    tishi: TLabel;
    Series4: TLineSeries;
    Series1: TPointSeries;
    Series2: TPointSeries;
    SpeedButton1: TSpeedButton;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    S1: TMenuItem;
    N2: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;

    procedure FormCreate(Sender: TObject);

    procedure subtableCalcFields(DataSet: TDataSet);
    procedure maintablestartdateGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);

    procedure subtabletempGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);

    procedure DataSource1DataChange(Sender: TObject; Field: TField);
    procedure subtableyjGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure subtablexjGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
  
    procedure SpeedButton1Click(Sender: TObject);
    procedure templineMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);

    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure DBGrid2CellClick(Column: TColumn);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure A1Click(Sender: TObject);



  private
    { Private declarations }
  public
    { Public declarations }
      act:string;
  end;

var
  Form1: TForm1;
  FirstDay:string;

implementation

uses formyjzq, about;

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);


begin

       ADOConnection1.connected:=false;
       ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFilePath(Application.ExeName)+'temp.mdb;Persist Security Info=False';

// showmessage(ADOConnection1.ConnectionString);

       ADOConnection1.connected:=true;
       maintable.Active:=true;
       subtable.Active:=true;
       FirstDay:=form1.maintablestartdate.AsString;
       Insert('-',FirstDay,5);
       Insert('-',FirstDay,8);
       templine.CheckDataSource(Series2);
end;



procedure TForm1.subtableCalcFields(DataSet: TDataSet);


var yj:integer;
var d1,d2,d3:string;
d4:tdatetime;
d5:integer;
begin
   d3:= maintable.fieldvalues['startdate'] ;
   //showmessage(d3);
   insert('-',d3,5);
   insert('-',d3,8);
   d4:=strtodate(d3);
   d5:=subtable.fieldvalues['seq']-1  ;
   d4:=incday(d4,d5);
   subtable.fieldvalues['rq']:=d4;

   yj:=subtableseq.value;
   d1:=subtableyj.Value;
   d2:=subtablexj.Value;

   if d1='Y' then
        series1.addxy(yj,36) ;
   if d2='Y' then
        series2.addxy(yj,36)  ;


end;

procedure TForm1.maintablestartdateGetText(Sender: TField;
  var Text: String; DisplayText: Boolean);
begin

    If DisplayText then

     begin

       Text:=maintablestartdate.Value;
       Insert('-',Text,5);
       Insert('-',Text,8);

      end;

end;




procedure TForm1.subtabletempGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
  var ss:single ;
begin
   if DisplayText then
     Begin
       ss:=subtabletemp.value;
       text:=format('%.2f',[ss]);
     end;
end;


procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);

begin

    series1.Clear;
    series2.clear;
    FirstDay:=maintable.FieldByName('startdate').AsString;
    Insert('-',FirstDay,5);
    Insert('-',FirstDay,8);
    templine.CheckDataSource(Series1);
    templine.CheckDataSource(Series2);
    templine.CheckDataSource(Series4);
 end;


procedure TForm1.subtableyjGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);

begin

  If DisplayText then

     begin

      Text:=subtableyj.Value;
      if Text='Y' then

             Text:='√'
       else
             Text:='-';
      end;

end;


procedure TForm1.subtablexjGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);

begin

  If DisplayText then
     begin

       Text:=subtablexj.Value;

       if Text='Y' then
             Text:='√'
       else
             Text:='-';
      end;

end;




procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
     act:='add';
     yjzq:=Tyjzq.create(self);
     yjzq.DateTimePicker1.date:=date;
     yjzq.Comdays.text:='28';
     yjzq.show;

end;

procedure TForm1.templineMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);

Var tmpX,tmpY:Double;
    aIndex: Integer;
    RQ,WD:string;
    temp:Double;

begin

  aIndex := Series4.GetCursorValueIndex;
  IF aIndex > -1 THEN
    BEGIN
      tmpX := Series4.CalcXPosValue(Series4.XValue[aIndex]);
      tmpY := Series4.CalcYPosValue(Series4.YValue[aIndex]);
      If (Abs(tmpX - X) <= Series4.Pointer.HorizSize) and (Abs(tmpY - Y) <= Series4.Pointer.VertSize) then
        begin
             RQ:=FloatToStr(Series4.XValue[aIndex]);
             temp:= Series4.YValue[aIndex];
             WD:=FormatFloat('0.00',temp);
             tishi.Caption:=FirstDay+' 第'+RQ+'天'+' '+WD+'℃' ;
        end;

    END
  ELSE
    BEGIN
      tishi.Caption := '';
    END;



end;



procedure TForm1.SpeedButton2Click(Sender: TObject);
begin

//取得数据库中的值加以修改。

     act:='modify';
     yjzq:=Tyjzq.create(self);
     yjzq.DateTimePicker1.date:=strtodate(FirstDay);
     yjzq.Comdays.text:=maintable.FieldByName('days').AsString;
     yjzq.Editmemo.text:=maintable.FieldByName('remark').AsString;
     yjzq.show;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var idno:integer;
begin

      idno:=strtoint(maintable.fieldvalues['id']);
     if Application.messagebox('确实要删除该周期吗?','确认',mb_yesno)=idyes then
     begin
            try
                with qyyj  do
                  begin
                      close;
                      connection:=form1.ADOConnection1;
                      sql.clear;
                      sql.text:='delete * from main where id=:a1';
                      parameters.parambyname('a1').value:=idno;
                      execsql;

                      sql.clear;
                      sql.text:='delete * from sub where id=:a1';
                      parameters.parambyname('a1').value:=idno;
                      execsql;
                   end;
                   messagedlg('删除周期成功!',mtInformation,[mbok],0);
             except
                   messagedlg('删除周期过程失败!',mtwarning,[mbok],0);
             end;
             maintable.Active:=False;
             subtable.Active:=False;
             maintable.Active:=True;
             subtable.Active:=True;
       end;
end;

procedure TForm1.DBGrid2CellClick(Column: TColumn);
var b1:string;
begin
if column.FieldName='yj' then
  begin
       subtable.Edit;
       b1:=subtable.FieldByName('yj').Asstring;
        if b1='Y' then
             subtable.FieldByName('yj').Asstring:='N'
        else
             subtable.FieldByName('yj').Asstring:='Y';
       subtable.post;
       templine.CheckDataSource(Series1);
  end;

if column.FieldName='xj' then
  begin
       subtable.Edit;   //将表处于编辑状态
       b1:=subtable.FieldByName('xj').Asstring;
       if b1='Y' then
             subtable.FieldByName('xj').Asstring:='N'
       else
             subtable.FieldByName('xj').Asstring:='Y';
       subtable.post;
       templine.CheckDataSource(Series2);
  end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
     templine.PrintLandscape;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   templine.SaveToBitmapFile('mytemp.bmp');
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin


       ADOConnection1.connected:=false;
       ADOConnection1.Free;
       maintable.Active:=false;
       subtable.Active:=false;
       maintable.Free;
       subtable.Free;
       form1.Close;
       form1.Free;

end;

procedure TForm1.A1Click(Sender: TObject);
begin
     AboutBox:=TaboutBox.create(self);
     AboutBox.showmodal;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -