u_main.pas

本程序主要实现了动态获取多个共享ACCESS数据库数据的功能

unit U_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GridsEh, DBGridEh, StdCtrls, ComCtrls, FlatBtns, ExtCtrls,math,strutils,
  Menus, Mask, RzEdit, ToolEdit, AdvDateTimePicker, frxClass, frxDBSet,inifiles,
  frxExportXLS;

type
  TFrm_Main = class(TForm)
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Panel1: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    EDH: TEdit;
    FlatButton1: TFlatButton;
    FlatButton2: TFlatButton;
    GroupBox1: TGroupBox;
    DB1: TDBGridEh;
    GroupBox2: TGroupBox;
    DB2: TDBGridEh;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    DT1: TAdvDateTimePicker;
    DT2: TAdvDateTimePicker;
    frxReport1: TfrxReport;
    frxDBDataset1: TfrxDBDataset;
    frxXLSExport1: TfrxXLSExport;
    Edit1: TEdit;
    procedure FlatButton1Click(Sender: TObject);
    procedure DB1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure DB2DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure DTimer1Change(Sender: TObject);
    procedure EDHKeyPress(Sender: TObject; var Key: Char);
    Procedure SavePassData;
    Procedure SaveFailData;
    Procedure FindData;
    procedure FlatButton2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure frxReport1GetValue(const VarName: String;
      var Value: Variant);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Edit1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_Main: TFrm_Main;
  Pflag:boolean;
implementation

uses U_DM, U_DataSetup, U_State;

{$R *.dfm}
Function DBGridRecordSize(mColumn: TColumnEh): Boolean;
begin
  Result := False;
  if not Assigned(mColumn.Field) then Exit;
  mColumn.Field.Tag := Max(mColumn.Field.Tag,
  TDBGridEh(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));
  Result := True;
end;
procedure OptimizeGrid(AGrid: TCustomDbGridEh); //dbgrideh自适应列宽
var
i: integer;
begin
 for i:=0 to AGrid.Columns.Count-1 do
  begin
    AGrid.Columns[i].OptimizeWidth;
  end;
end;
procedure TFrm_Main.FlatButton1Click(Sender: TObject);
var
  Frm_DataSetup: TFrm_DataSetup;
begin
  Frm_DataSetup:=TFrm_DataSetup.Create(self);
  Frm_DataSetup.ShowModal;
end;

procedure TFrm_Main.DB1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
begin
if DB1.DataSource.DataSet.RecNo  mod 2=0 then
      begin
        DB1.Canvas.Brush.Color:=$00eaeaea;
        DB1.Canvas.FillRect(rect);
        DB1.Canvas.font.color:=clblack;
      end
   else
      begin
        DB1.Canvas.Brush.Color:=clwhite;
        DB1.Canvas.FillRect(rect);
        DB1.Canvas.font.color:=clblack;
      end;
  if ((State=[gdSelected]) or (State=[gdSelected,gdFocused])) then
    begin
      DB1.Canvas.Brush.Color:=clinfobk;
      DB1.Canvas.FillRect(rect);
      DB1.Canvas.font.color:=clblack;
    end;
      DB1.DefaultDrawColumnCell(rect,datacol,column,state);
  DBGridRecordSize(Column);
  if Column.Index = 0 then
    if DB1.SumList.RecNo <> -1 then
      DB1.Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2,
        IntToStr(DB1.SumList.RecNo));
end;

procedure TFrm_Main.DB2DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
begin
if DB2.DataSource.DataSet.RecNo  mod 2=0 then
      begin
        DB2.Canvas.Brush.Color:=$00eaeaea;
        DB2.Canvas.FillRect(rect);
        DB2.Canvas.font.color:=clblack;
      end
   else
      begin
        DB2.Canvas.Brush.Color:=clwhite;
        DB2.Canvas.FillRect(rect);
        DB2.Canvas.font.color:=clblack;
      end;
  if ((State=[gdSelected]) or (State=[gdSelected,gdFocused])) then
    begin
      DB2.Canvas.Brush.Color:=clinfobk;
      DB2.Canvas.FillRect(rect);
      DB2.Canvas.font.color:=clblack;
    end;
      DB2.DefaultDrawColumnCell(rect,datacol,column,state);
  DBGridRecordSize(Column);
  if Column.Index = 0 then
    if DB2.SumList.RecNo <> -1 then
      DB2.Canvas.TextRect(Rect, Rect.Left + 3, Rect.Top + 2,
        IntToStr(DB2.SumList.RecNo));
end;

procedure TFrm_Main.DTimer1Change(Sender: TObject);
begin
{if dtimer1.DateTime>Dtimer2.DateTime then
  begin
    showmessage('起始时间不能大于结束时间');
    dtimer2.DateTime:=dtimer1.DateTime+1;
  end;}
end;
Procedure TFrm_Main.SavePassData;
begin
//检查数据是否重复，如果重复则抛弃
with dm.ADOQFind do
  begin
    close;
    sql.Clear;
    sql.Add('select Verifyodd from PassData where Verifyodd='''+edh.Text+'''');
    prepared:=true;
    open;
    if recordcount>0 then exit;
  end;
// 保存通过校验的数据
with dm.ADOTPassData do
  begin
    if not active then active:=true;
    append;
    FieldByName('VerifyTime').Value:=now();
    FieldByName('VerIfyODD').Value:=edh.Text;
    post;
    active:=false;
    active:=true;
  end;
OptimizeGrid(DB1);
EDH.Clear;
end;
Procedure TFrm_Main.SaveFailData;
begin
//检查数据是否重复，如果重复则抛弃
with dm.ADOQFind do
  begin
    close;
    sql.Clear;
    sql.Add('select Verifyodd from FailData where Verifyodd='''+edh.Text+'''');
    prepared:=true;
    open;
    if recordcount>0 then exit;
  end;
//保存未通过校验的数据
with dm.ADOTFailData do
  begin
    if not active then active:=true;
    append;
    FieldByName('VerifyTime').Value:=now();
    FieldByName('VerIfyODD').Value:=EDH.Text;
    POST;
  end;
OptimizeGrid(DB2);
EDH.Clear;
end;
procedure TFrm_Main.EDHKeyPress(Sender: TObject; var Key: Char);
var
i:integer;
begin
//对数据进行校验
  if key=#13 then// showmessage('按了回车');
    begin
      if length(edh.Text)<>13 then
        begin
          showmessage('你输入的单号不正确');
          edh.Clear;
          exit;
        end;
      For i:=0 to dm.ADOTpath.RecordCount-1 do
        begin
          with MyQuery[i] do
            begin
              close;
              sql.Clear;
              sql.Add('select 运单编号 from 巴枪记录表 where 运单编号='''+edh.Text+'''');
              prepared:=true;
              open;
              if RecordCount>0 then
                begin
                  SavePassData;//保存Pass数据
                  edh.SetFocus;
                  Finddata;
                  exit;
                end;
            end;
        end;
        SaveFailData;
        Finddata;
        edh.SetFocus;
      end;
end;
Procedure TFrm_Main.FindData;
var
datetime1,datetime2,temp:string;
begin
temp:=timetostr(dt1.Time);
temp:=midstr(temp,1,2)+EDIT1.Text+midstr(temp,4,2)+EDIT1.Text+midstr(temp,7,2);
datetime1:=datetostr(dt1.Date)+' '+temp;
temp:=timetostr(dt2.Time);
temp:=midstr(temp,1,2)+EDIT1.Text+midstr(temp,4,2)+EDIT1.Text+midstr(temp,7,2);
datetime2:=datetostr(dt2.Date)+' '+temp;
//exit;
with dm.ADOQPassData do
  begin
    close;
    sql.Clear;
    sql.Add('select ID,VerifyTime,VerifyODD From PassData where VerifyTime Between #'+datetime1+'# and #'+datetime2+'#');
    prepared:=true;
//    showmessage(sql.Text);
    open;
  end;
with dm.ADOQFailData do
  begin
    close;
    sql.Clear;
    sql.Add('select ID,VerifyTime,VerifyODD From failData where VerifyTime Between #'+datetime1+'# and #'+datetime2+'#');
    prepared:=true;
    open;
  end;
end;
procedure TFrm_Main.FlatButton2Click(Sender: TObject);
begin
//查询
FindData;
OptimizeGrid(DB1);
OptimizeGrid(DB2);
end;

procedure TFrm_Main.N1Click(Sender: TObject);
begin
try
dm.ADOqPassData.Delete;
except
end;
end;

procedure TFrm_Main.N2Click(Sender: TObject);
begin
with dm.ADOQFind do
  begin
    close;
    sql.Clear;
    sql.Add('delete from PassData');
    prepared:=true;
    execsql;
  end;
if dm.ADOTPassData.Active then
  dm.ADOTPassData.Refresh
else
  dm.ADOTPassData.Active:=true;
OptimizeGrid(DB1);
FindData;
end;

procedure TFrm_Main.N3Click(Sender: TObject);
begin
try
dm.ADOqFailData.Delete;
except
end;
end;

procedure TFrm_Main.N4Click(Sender: TObject);
begin
with dm.ADOQFind do
  begin
    close;
    sql.Clear;
    sql.Add('delete from FailData');
    prepared:=true;
    execsql;
  end;
if dm.ADOTFailData.Active then
  dm.ADOTFailData.Refresh
else
  dm.ADOTFailData.Active:=true;
OptimizeGrid(DB2);
FindData;
end;

procedure TFrm_Main.N5Click(Sender: TObject);
begin
//  Showmessage('正在开发');
frxDBDataset1.DataSource:=DM.DsPassData;
frxReport1.LoadFromFile('Report.fr3');
PFlag:=true;
frxReport1.ShowReport(true); 
end;

procedure TFrm_Main.N6Click(Sender: TObject);
begin
//  Showmessage('正在开发');
frxDBDataset1.DataSource:=DM.DsFailData;
frxReport1.LoadFromFile('Report.fr3');
PFlag:=fALSE;
frxReport1.ShowReport(true);
end;

procedure TFrm_Main.FormShow(Sender: TObject);
var
myini:Tinifile;
begin
Myini:=Tinifile.Create('myini.ini');
edit1.Text:=myini.ReadString('c','t',':');
Myini.WriteString('c','t',edit1.Text);
DT1.DateTime:=NOW()-1;
DT2.DateTime:=NOW()+1;
FindData;
OptimizeGrid(DB1);
OptimizeGrid(DB2);
Frm_state.Hide;
end;

procedure TFrm_Main.frxReport1GetValue(const VarName: String;
  var Value: Variant);
begin
if Pflag then
  if Varname='PTitle' THEN VALUE:='通过审核数据';
IF NOT PFLAG THEN
  if varname='PTitle' then value:='未通过审核数据';
end;

procedure TFrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
var
i:integer;
begin
Frm_state.Pshow.Caption:='程序正在退出......';
frm_state.Show;
try
application.ProcessMessages;
For i:=0 to DataBaseCount do
MyADOConn[i].Connected:=false;
SetLength(MyADOConn,0);
SetLength(MyQuery,0);
except
end;
end;

procedure TFrm_Main.Edit1Change(Sender: TObject);
var
myini:Tinifile;
begin
Myini:=Tinifile.Create('myini.ini');
Myini.WriteString('c','t',edit1.Text);
myini.Free;
end;

end.