📄 thdmwh.pas
字号:
unit thdmwh;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, ADODB, StdCtrls, Buttons, ExtCtrls, Mask,
DBCtrls, Excel2000, OleServer, DBTables, CheckLst;
type
TthwhForm = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Panel2: TPanel;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Panel4: TPanel;
BitBtn4: TBitBtn;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
ExcelApplication1: TExcelApplication;
ExcelWorksheet1: TExcelWorksheet;
ExcelWorkbook1: TExcelWorkbook;
Panel3: TPanel;
Label1: TLabel;
Label3: TLabel;
DBEdit1: TDBEdit;
DBEdit3: TDBEdit;
Query1: TQuery;
UpdateSQL1: TUpdateSQL;
Query2: TQuery;
CheckListBox1: TCheckListBox;
Label2: TLabel;
Query3: TQuery;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Formbtn;
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure BitBtn8Click(Sender: TObject);
procedure DBEdit1Exit(Sender: TObject);
procedure CheckListBox1Click(Sender: TObject);
procedure Query1AfterScroll(DataSet: TDataSet);
private
btn:string;
{ Private declarations }
public
{ Public declarations }
end;
var
thwhForm: TthwhForm;
func:string;
implementation
{$R *.dfm}
procedure TthwhForm.FormActivate(Sender: TObject);
begin
if btn<>'' then exit;
panel1.Enabled:=true;
panel2.Enabled:=false;
panel3.Enabled:=false;
dbgrid1.Enabled:=true;
query1.Open;
query3.Open;
checklistbox1.Items.Clear;
while not query3.Eof do
begin
checklistbox1.Items.Add(query3.FieldByName('ctmc').AsString+'('+query3.FieldByName('ctbh').AsString+')');
query3.Next;
end;
query3.Close;
end;
procedure TthwhForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
btn:='';
func:='';
query1.Close;
end;
procedure TthwhForm.BitBtn4Click(Sender: TObject);
begin
close;
end;
procedure TthwhForm.formBtn;
begin
dbgrid1.Enabled:=not dbgrid1.Enabled;
panel1.Enabled:=not panel1.Enabled;
panel2.Enabled:=not panel2.Enabled;
panel3.Enabled:=not panel3.Enabled;
if panel1.Enabled then bitbtn1.SetFocus else bitbtn5.SetFocus;
end;
procedure TthwhForm.BitBtn5Click(Sender: TObject);
begin
if (btn='add') or (btn='mod') then
begin
if query1.FieldByName('twbh').AsString='' then
begin
messagedlg('编码不能为空!!',mtwarning,[mbok],0);
dbedit1.SetFocus;
exit;
end;
if query1.FieldByName('twmc').AsString='' then
begin
messagedlg('名称不能为空!!',mtwarning,[mbok],0);
exit;
end;
query1.Post;
query1.ApplyUpdates;
end;
if btn='del' then begin
query1.Delete;
query1.ApplyUpdates;
end;
formBtn;
end;
procedure TthwhForm.BitBtn6Click(Sender: TObject);
begin
if (btn='add') or (btn='mod') then query1.Cancel;
formBtn;
end;
procedure TthwhForm.BitBtn2Click(Sender: TObject);
begin
formBtn;
btn:='mod';
query1.Edit;
dbedit1.SetFocus;
end;
procedure TthwhForm.BitBtn1Click(Sender: TObject);
begin
formBtn;
btn:='add';
query1.Append;
dbedit1.SetFocus;
end;
procedure TthwhForm.BitBtn3Click(Sender: TObject);
begin
formBtn;
btn:='del';
end;
procedure TthwhForm.FormCreate(Sender: TObject);
begin
func:='';
btn:='';
end;
procedure TthwhForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=chr(13) then perform($28,0,0);
end;
procedure TthwhForm.BitBtn8Click(Sender: TObject);
var
i,row,column:integer;
begin
Try
ExcelApplication1.Connect;
Except
MessageDlg('Excel 没有安装,无法报表!!',
mtError, [mbOk], 0);
Abort;
End;
ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='Excel 报表';
ExcelApplication1.Workbooks.Add(Null,0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
column:=1;
for i:=1 to query1.FieldCount do
begin
ExcelWorksheet1.Cells.Item[1,column]:=query1.fields[i-1].FieldName;
column:=column+1;
end;
row:=2;
query1.First;
While Not(query1.Eof) do
begin
column:=1;
for i:=1 to query1.FieldCount do
begin
ExcelWorksheet1.Cells.Item[row,column]:=query1.fields[i-1].AsString;
column:=column+1;
end;
query1.Next;
row:=row+1;
end;
ExcelApplication1.Visible[0]:=true;
ExcelApplication1.ActiveWorkbook.Save(0);
ExcelApplication1.Save('付款方式编码表.xls');
ExcelApplication1.Workbooks.Close(1);
ExcelApplication1.Visible[0]:=false;
ExcelApplication1.Quit;
end;
procedure TthwhForm.DBEdit1Exit(Sender: TObject);
begin
if (btn='add') or ((btn='mod') and (query1.FieldByName('twbh').Value<>query1.FieldByName('twbh').OldValue)) then
begin
query2.Close;
query2.ParamByName('cs').AsString:=dbedit1.Text;
query2.Open;
if query2.RecordCount>0 then begin
showmessage('该编号已经存在,请另选');
dbedit1.Text:=query1.FieldByName('twbh').OldValue;
dbedit1.SetFocus;
end;
query2.Close;
end;
end;
procedure TthwhForm.CheckListBox1Click(Sender: TObject);
var ii,jj,kk:integer;
sst:string;
begin
query1.Edit;
query1.FieldByName('ctbm').AsString:='';
query1.FieldByName('ctmc').AsString:='';
for ii:=0 to checklistbox1.Items.Count -1 do
if checklistbox1.Checked[ii] then
begin
jj:=pos('(',checklistbox1.Items[ii]);
sst:=copy(checklistbox1.Items[ii],1,jj-1);
query1.FieldByName('ctmc').AsString:=query1.FieldByName('ctmc').AsString+sst+';';
kk:=pos(')',checklistbox1.Items[ii]);
kk:=kk - jj-1;
sst:=copy(checklistbox1.Items[ii],jj+1,kk);
query1.FieldByName('ctbm').AsString:=query1.FieldByName('ctbm').AsString+sst+';';
end;
end;
procedure TthwhForm.Query1AfterScroll(DataSet: TDataSet);
var ii,jj:integer;
sst:string;
begin
for ii:=0 to checklistbox1.Items.Count -1 do
begin
jj:=pos('(',checklistbox1.Items[ii]);
sst:=copy(checklistbox1.Items[ii],1,jj -1);
if pos(sst,query1.FieldByName('ctmc').AsString)>0 then checklistbox1.Checked[ii]:=true
else checklistbox1.Checked[ii]:=false;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -