u_main.pas

来自「主要实现对MySql的远程访问功能。主要使用了ZEOSDBO控件」· PAS 代码 · 共 199 行

unit U_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RzLabel, RzLstBox, RzEdit, RzButton, ComCtrls,shellapi,
  RzListVw, ZConnection, DB, ZAbstractRODataset, ZAbstractDataset, ZDataset,
  RzStatus, ExtCtrls, RzPanel, Menus, AdvMenus, frxClass, frxExportXLS,
  AppEvnts;

type
  TFrm_OR = class(TForm)
    RzLabel1: TRzLabel;
    RMDList: TRzMemo;
    RzBitBtn1: TRzBitBtn;
    RLV: TRzListView;
    ZQuery1: TZQuery;
    ZQuery2: TZQuery;
    ZConnection: TZConnection;
    RzStatusBar1: TRzStatusBar;
    RSP: TRzStatusPane;
    RzClockStatus1: TRzClockStatus;
    AdvPopupMenu1: TAdvPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    AdvPopupMenu2: TAdvPopupMenu;
    N3: TMenuItem;
    frxReport1: TfrxReport;
    frxXLSExport1: TfrxXLSExport;
    Fud: TfrxUserDataSet;
    ApplicationEvents1: TApplicationEvents;
    RPS: TRzProgressStatus;
    procedure RzBitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RSPDblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure frxReport1GetValue(const VarName: String;
      var Value: Variant);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_OR: TFrm_OR;

implementation

{$R *.dfm}

procedure TFrm_OR.RzBitBtn1Click(Sender: TObject);
var
md,bm,mc:string;
i,MLine:integer;
begin
//查询
MLine:=RMDList.Line;
with zquery2 do
  begin
    close;
    sql.Clear;
    sql.Add('SET   CHARACTER   SET   GBK');
    execsql;
  end;
for i:=0 to MLine-1 do
  begin
    md:=RMDList.Lines[i];
//    rps.Percent:=Round((I/(Mline-1)))*100;
    application.ProcessMessages;
    if md='' then exit;
    with zquery1 do
      begin
        close;
        sql.Clear;
        sql.Add('SELECT GS FROM GSTMFW WHERE QSH<='''+md+'''AND ZZH>='''+md+'''');
        OPEN;
      end;
    if zquery1.RecordCount<>0 then
      begin
      //如果查询到数据
        BM:=Zquery1.FieldValues['GS'];
        with zquery2 do
          begin
            close;
            sql.Clear;
            sql.Add('select mc from gs where  bm='''+bm+'''');
            open;
            mc:=Fieldvalues['mc'];
          end;
        application.ProcessMessages;
        WITH RLV.Items.Add DO
          BEGIN
            Caption:=INTTOSTR(I+1);
            SubItems.Add(MD);
            SubItems.Add(BM);
            SubItems.Add(MC);
          END;
      end
    else
      begin
      //如果未查询到数据
        WITH RLV.Items.Add DO
          BEGIN
            Caption:=INTTOSTR(I+1);
            SubItems.Add(MD);
          END;      
      end;
  end;
end;

procedure TFrm_OR.FormCreate(Sender: TObject);
begin
try
if not zconnection.Connected then zconnection.Connected:=true;
except
RSP.Caption:='数据库连接错误';
Rmdlist.Enabled:=false;
RzBitBtn1.Enabled:=false;
exit;
end;
RSP.Caption:='数据库连接正常';
Rmdlist.Enabled:=True;
RzBitBtn1.Enabled:=True;
end;

procedure TFrm_OR.RSPDblClick(Sender: TObject);
begin
try
if not zconnection.Connected then zconnection.Connected:=true;
except
RSP.Caption:='数据库连接错误';
Rmdlist.Enabled:=false;
RzBitBtn1.Enabled:=false;
exit;
end;
RSP.Caption:='数据库连接正常';
Rmdlist.Enabled:=True;
RzBitBtn1.Enabled:=True;
end;

procedure TFrm_OR.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
zconnection.Connected:=true;
except
end;
end;

procedure TFrm_OR.N2Click(Sender: TObject);
begin
RLV.Clear;
end;

procedure TFrm_OR.N3Click(Sender: TObject);
begin
RMDList.Clear;
end;

procedure TFrm_OR.N1Click(Sender: TObject);
begin
  Fud.RangeEnd := reCount;
  Fud.RangeEndCount:=RLV.Items.Count;
  FrxReport1.LoadFromFile('Re.Fr3');
  frxReport1.ShowReport;
end;

procedure TFrm_OR.frxReport1GetValue(const VarName: String;
  var Value: Variant);
begin
  if CompareText(VarName, 'ID') = 0 then
    Value :=RLV.Items[Fud.RecNo].Caption;
  if CompareText(VarName, 'BM') = 0 then
    Value :=RLV.Items[Fud.RecNo].SubItems.Strings[0];
  if CompareText(VarName, 'CODE') = 0 then
    Value :=RLV.Items[Fud.RecNo].SubItems.Strings[1];
  if CompareText(VarName, 'MC') = 0 then
    Value :=RLV.Items[Fud.RecNo].SubItems.Strings[2];
end;

procedure TFrm_OR.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
 if   Msg.message=WM_KeyDown   then   
        if   msg.wParam=vk_f1   then   
        begin
            ShellExecute(application.handle,'open','ReadMe.txt','','',sw_show);//创建帮助窗口   
            handled:=True;   
        end;
end;

end.