u_htcx.pas

很好的合同管理系统完整源码,适合初学者参考

unit U_htcx;

interface

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

type
  Tfrm_htcx = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    RichEdit1: TRichEdit;
    ComboBox1: TComboBox;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    WordApplication1: TWordApplication;
    WordDocument1: TWordDocument;
    Edit1: TEdit;
    Label2: TLabel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Panel3: TPanel;
    ListView1: TListView;
    Panel4: TPanel;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    procedure FormShow(Sender: TObject);
    procedure loaddata;  
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListView1Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    path:string;
  end;

var
  frm_htcx: Tfrm_htcx;

implementation

uses U_Data, U_htgl, U_Public;

{$R *.dfm}

procedure Tfrm_htcx.loaddata;
var
newitem:Tlistitem;
begin
listview1.Clear;
with data1.ADOQuery1 do
begin
   close;
   sql.Clear;
   sql.Add('select * from 合同');
   open;
end;
while not data1.ADOQuery1.Eof do
begin
   newitem:=listview1.Items.Add;
   newitem.Caption:=data1.ADOQuery1.fieldbyname('htmc').Value;
   data1.ADOQuery1.Next;
end;
end;

procedure Tfrm_htcx.FormShow(Sender: TObject);
begin
loaddata;
combobox1.Clear;
with data1.lxsz do
begin
   close;
   sql.Clear;
   sql.Add('select distinct htlx from 合同类型');
   open;
end;
while not data1.lxsz.Eof do
begin
   combobox1.Items.Add(data1.lxsz.fieldbyname('htlx').Value);
   data1.lxsz.Next;
end;
end;

procedure Tfrm_htcx.BitBtn1Click(Sender: TObject);
var
newitem:Tlistitem;
begin
if trim(combobox1.Text)<>'' then
begin
listview1.Clear;
with data1.ADOQuery1 do
begin
   close;
   sql.Clear;
   sql.Add('select * from 合同 where htlx=:a');
   parameters.ParamByName('a').Value:=trim(combobox1.Text);
   open;
end;
while not data1.ADOQuery1.Eof do
begin
   newitem:=listview1.Items.Add;
   newitem.Caption:=data1.ADOQuery1.fieldbyname('htmc').Value;
   data1.ADOQuery1.Next;
end;
combobox1.Text:='';
end
else
application.MessageBox('请选择合同类型','提示',64);
end;

procedure Tfrm_htcx.BitBtn2Click(Sender: TObject);
var
newitem:Tlistitem;
begin
if trim(edit1.Text)<>'' then
begin
listview1.Clear;
with data1.ADOQuery1 do
begin
   close;
   sql.Clear;
   sql.Add('select * from 合同 where htmc like :a');
   parameters.ParamByName('a').Value:=trim(edit1.Text)+'%';
   open;
end;
while not data1.ADOQuery1.Eof do
begin
   newitem:=listview1.Items.Add;
   newitem.Caption:=data1.ADOQuery1.fieldbyname('htmc').Value;
   data1.ADOQuery1.Next;
end;
edit1.Clear;
end
else
application.MessageBox('请填写合同名称','提示',64);
end;

procedure Tfrm_htcx.BitBtn3Click(Sender: TObject);
var
i:integer;
del_path:string;
begin
if messagebox(self.Handle,'合同作废后将会从数据库中删除，确定要作废吗？','提示',mb_yesno+mb_iconquestion)=idyes then
begin
for i:=0 to listview1.Items.Count - 1 do
begin
if listview1.Items[i].Checked=true then
with data1.ADOQuery1 do
begin
   close;
   sql.Clear;
   sql.Add('select * from 合同 where htmc=:a');
   parameters.ParamByName('a').Value:=listview1.Items[i].Caption;
   open;
end;
path:=data1.ADOQuery1.fieldbyname('htlj').Value;
with data1.ADOPublic do
begin
   close;
   sql.Clear;
   sql.Add('delete 合同 where htlj=:b');
   parameters.ParamByName('b').Value:=path;
   execsql;
end;
CopyFile(Pchar(path),Pchar(hsz_path+'\'+ExtractFileName(path)),False);
DeleteFile(pchar(path));
end;
loaddata;
application.MessageBox('删除成功','提示',64);
Rz_Gl(czy,formatdatetime('yyyy年mm月dd日 hh:dd:ss',now),'合同作废');
end;
end;

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

procedure Tfrm_htcx.BitBtn5Click(Sender: TObject);
var
i:integer;
begin
for i:=0 to listview1.Items.Count - 1 do
   begin
      if listview1.Items[i].Checked=true then
         begin
            with data1.ADOQuery1 do
               begin
                  close;
                  sql.Clear;
                  sql.Add('select * from 合同 where htmc=:a');
                  parameters.ParamByName('a').Value:=listview1.Items[i].Caption;
                  open;
               end;
            richedit1.Text:=data1.ADOQuery1.fieldbyname('htnr').Value;
         end;
   end;
//path:=data1.ADOQuery1.fieldbyname('htlj').Value;
end;

procedure Tfrm_htcx.BitBtn6Click(Sender: TObject);
var
i:integer;
begin
if frm_main.cx=1 then
begin
for i:=0 to listview1.Items.Count - 1 do
   begin
      if listview1.Items[i].Checked=true then
         begin
           path:=hsz_path+'\'+listview1.Items[i].Caption;
           if wordpath(path) then
           OpenWordFile('true',Path,WordApplication1,worddocument1)
           else
           application.MessageBox('文件不存在，请检查设置','提示',64);
         end;
   end;
end
else
begin
for i:=0 to listview1.Items.Count - 1 do
   begin
      if listview1.Items[i].Checked=true then
         begin
           path:=qd_path+'\'+listview1.Items[i].Caption;
           if wordpath(path) then
           OpenWordFile('true',Path,WordApplication1,worddocument1)
           else
           application.MessageBox('文件不存在，请检查设置','提示',64);
         end;
   end;
end;
end;

procedure Tfrm_htcx.FormCreate(Sender: TObject);
begin
if frm_main.cx=1 then
   begin
      bitbtn3.Visible:=true;
      bitbtn7.Visible:=false;
      caption:='合同作废';
   end;
end;

procedure Tfrm_htcx.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if frm_main.cx=1 then
frm_main.loaddata;
frm_main.cx:=0;
end;

procedure Tfrm_htcx.ListView1Click(Sender: TObject);
begin
richedit1.Clear;
begin

end;
end;

procedure Tfrm_htcx.BitBtn7Click(Sender: TObject);
var
i:integer;
begin
for i:=0 to listview1.Items.Count - 1 do
   begin
      if listview1.Items[i].Checked=true then
         begin
           path:=qd_path+'\'+listview1.Items[i].Caption;
           if wordpath(path) then
           wordPrint( 'tree',Path,WordApplication1,worddocument1)
           else
           application.MessageBox('文件不存在，请检查设置','提示',64);
         end;
   end;
end;

end.