📄 unit1.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 + -