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

📄 u_drht.pas

📁 一套完整的合同管理系统,大家可以下载来看一看
💻 PAS
字号:
unit U_drht;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, ComCtrls, ShellCtrls, FileCtrl,
  Word2000, OleServer;

type
  Tfrm_drht = class(TForm)
    Panel1: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    FileListBox1: TFileListBox;
    WordDocument1: TWordDocument;
    WordApplication1: TWordApplication;
    Panel2: TPanel;
    STV: TShellTreeView;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject);
    procedure STVDblClick(Sender: TObject);
    procedure STVKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
    path,rpath:string;
  end;

var
  frm_drht: Tfrm_drht;

implementation

uses U_lx, U_Data, U_htgl, U_htqd, U_Public, U_login;

{$R *.dfm}

procedure Tfrm_drht.BitBtn2Click(Sender: TObject);
begin
application.CreateForm(Tfrm_lx,frm_lx);
frm_lx.ShowModal;
frm_lx.Free;
end;

procedure Tfrm_drht.BitBtn1Click(Sender: TObject);
begin
panel2.Visible:=true;
end;

procedure Tfrm_drht.BitBtn4Click(Sender: TObject);
begin
close;
end;

procedure Tfrm_drht.BitBtn3Click(Sender: TObject);
var
mc,bh:string;
i:integer;
begin
if frm_main.dr2= 1 then
if trim(edit3.Text)='' then
application.MessageBox('请选择合同类型','提示',64)
else
begin
for i:=0 to frm_htqd.listview1.Items.Count - 1 do
begin
with data1.htb do
begin
   close;
   sql.Clear;
   sql.Add('select max(bh) as ss from 合同');
   open;
end;
if frm_htqd.listview1.Items[i].Checked=true then
begin
mc:=frm_htqd.listview1.Items[i].Caption;
path:=frm_htqd.FileListBox1.Directory+'\'+frm_htqd.listview1.Items[i].Caption;
CopyFile(Pchar(path),Pchar(qd_path+'\'+ExtractFileName(path)),False);
DeleteFile(Pchar(path));
if data1.htb.FieldByName('ss').Value=null then
bh:='1'
else
bh:=floattostr(data1.htb.FieldByName('ss').Value+1);
rpath:=qd_path+'\'+frm_htqd.listview1.Items[i].Caption;
wordRead('tree',rpath,WordApplication1,worddocument1);
with data1.htb do
begin
   close;
   sql.Clear;
   sql.Add('insert 合同 values(:a,:b,:c,:d,:e)');
   parameters.ParamByName('a').Value:=bh;
   parameters.ParamByName('b').Value:=trim(edit3.Text);
   parameters.ParamByName('c').Value:=mc;
   parameters.ParamByName('d').Value:=qd_path+'\'+mc;
   parameters.ParamByName('e').Value:=gg;
   execsql;
end;
end;
end;
application.MessageBox('保存成功!','提示',64);
Rz_Gl(czy,formatdatetime('yyyy年mm月dd日 hh:dd:ss',now),'保存合同');
frm_main.loaddata;
frm_htqd.loaddata;
frm_htqd.Close;
close;
end
else
if trim(edit3.Text)='' then
   application.MessageBox('请选择合同类型','提示',64)
else
   if trim(edit4.Text)='' then
      application.MessageBox('请选择合同路径','提示',64)
else
begin
for i:=0 to filelistbox1.Count - 1 do
begin
with data1.htb do
begin
   close;
   sql.Clear;
   sql.Add('select max(bh) as ss from 合同');
   open;
end;
begin
mc:=filelistbox1.Items.Strings[i];
path:=edit4.Text+'\'+mc;
wordRead( 'tree',path,WordApplication1,worddocument1);
if data1.htb.FieldByName('ss').Value=null then
bh:='1'
else
bh:=floattostr(data1.htb.FieldByName('ss').Value+1);
with data1.htb do
begin
   close;
   sql.Clear;
   sql.Add('insert 合同 values(:a,:b,:c,:d,:e)');
   parameters.ParamByName('a').Value:=bh;
   parameters.ParamByName('b').Value:=trim(edit3.Text);
   parameters.ParamByName('c').Value:=mc;
   parameters.ParamByName('d').Value:=path;
   parameters.ParamByName('e').Value:=gg;
   execsql;
end;
end;
end;
application.MessageBox('导入成功!','提示',64);
Rz_Gl(czy,formatdatetime('yyyy年mm月dd日 hh:dd:ss',now),'导入合同');
frm_main.loaddata;
end;
end;

procedure Tfrm_drht.FormCreate(Sender: TObject);
begin
if frm_main.dr2=1 then
begin
frm_drht.Label3.Top:=43;
frm_drht.Edit3.Top:=40;
frm_drht.BitBtn2.Top:=40;
frm_drht.Label4.Visible:=false;
frm_drht.Edit4.Visible:=false;
frm_drht.BitBtn1.Visible:=false;
end;
end;

procedure Tfrm_drht.STVDblClick(Sender: TObject);
begin
  edit4.Text:=stv.Path;
  filelistbox1.Directory:=edit4.Text;
  panel2.Visible:=false;
end;

procedure Tfrm_drht.STVKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=vk_Escape then
panel2.Visible:=false;
end;

end.

⌨️ 快捷键说明

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