📄 kccx_pas.pas
字号:
unit kccx_pas;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, Buttons, Grids, DBGrids,datamd_pas, DB, ADODB,comobj,comctrls;
type
Tkccx_Form = class(TForm)
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
ComboBox1: TComboBox;
CheckBox2: TCheckBox;
ComboBox2: TComboBox;
CheckBox3: TCheckBox;
ComboBox3: TComboBox;
Label1: TLabel;
ComboBox4: TComboBox;
Label2: TLabel;
Label5: TLabel;
Label4: TLabel;
Label6: TLabel;
MaskEdit1: TMaskEdit;
MaskEdit2: TMaskEdit;
BitBtn1: TBitBtn;
GroupBox2: TGroupBox;
BitBtn2: TBitBtn;
DBGrid1: TDBGrid;
BitBtn3: TBitBtn;
DataSource1: TDataSource;
ADOTable_cx: TADOTable;
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
xmid:string;
public
{ Public declarations }
end;
function ProgressBarform(max:integer):tProgressBar;
function ExportToExcel(dbgrid:tdbgrid):boolean;
var
kccx_Form: Tkccx_Form;
implementation
{$R *.dfm}
procedure Tkccx_Form.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked then
begin
combobox1.Enabled:=true;combobox1change(sender);
end
else combobox1.Enabled:=false;
end;
procedure Tkccx_Form.CheckBox2Click(Sender: TObject);
begin
if checkbox2.Checked then combobox2.Enabled:=true
else combobox2.Enabled:=false;
end;
procedure Tkccx_Form.CheckBox3Click(Sender: TObject);
begin
if checkbox3.Checked then
begin
maskedit1.Enabled:=true;maskedit2.Enabled:=true;
combobox3.Enabled:=true;combobox4.Enabled:=true;
end
else
begin
maskedit1.Enabled:=false;maskedit2.Enabled:=false;
combobox3.Enabled:=false;combobox4.Enabled:=false;
end;
end;
procedure Tkccx_Form.BitBtn1Click(Sender: TObject);
begin
datamodule1.ADOTable_xm.Active:=false;
close();
end;
procedure Tkccx_Form.BitBtn2Click(Sender: TObject);
var filterstr:string;
i:integer;
begin
if (checkbox3.Checked and (strtoint(trim(maskedit1.Text+combobox3.Text))>strtoint(trim(maskedit2.Text+combobox4.Text))))then
begin
application.MessageBox('开始日期大于结束日期,请重新输入','操作提示',mb_ok);
exit;
end;
filterstr:='';
i:=0;
if checkbox1.Checked then begin filterstr:='(项目_id='''+xmid+''')';
i:=1;
end;
if checkbox2.Checked or(not checkbox2.Enabled) then begin
if i=0 then filterstr:='(员工名='''+combobox2.Text+''')'
else filterstr:=filterstr+' and (员工名='''+combobox2.Text+''')';
i:=1;
end;
if checkbox3.Checked then begin
if i=0 then filterstr:='((年月>='+trim(maskedit1.Text+combobox3.Text)+') and (年月<='+trim(maskedit2.Text+combobox4.Text)+'))'
else filterstr:=filterstr+' and ((年月>='+trim(maskedit1.Text+combobox3.Text)+') and (年月<='+trim(maskedit2.Text+combobox4.Text)+'))';
i:=1
end;
//执行过滤
adotable_cx.Active:=false;
if i=0 then adotable_cx.Filtered:=false
else begin
adotable_cx.Filter:=filterstr;
adotable_cx.Filtered:=true;
end;
adotable_cx.Active:=true;
end;
procedure Tkccx_Form.ComboBox1Change(Sender: TObject);
begin
if not datamodule1.ADOTable_xm.Active then datamodule1.ADOTable_xm.Active:=true;
datamodule1.ADOTable_xm.locate('项目名称',ComboBox1.Items.strings[combobox1.itemindex],
[loPartialKey]);
xmid:=datamodule1.ADOTable_xm.fieldbyname('项目_id').value;
end;
function ExportToExcel(dbgrid:tdbgrid):boolean;
const
xlNormal=-4143;
var
i,j,k:integer;
str,filename:string;
excel:OleVariant;
SavePlace: TBookmark;
savedialog:tsavedialog;
ProgressBar1:TProgressBar;
begin
result:=false;
filename:='';
if dbgrid.DataSource.DataSet.RecordCount>65536 then
begin
if application.messagebox('需要导出的数据过大,Excel最大只能容纳65536行,是否还要继续?','询问',mb_yesno+mb_iconquestion)=idno then
exit;
end;
screen.Cursor:=crHourGlass;
try
excel:=CreateOleObject('Excel.Application');
excel.workbooks.add;
except
screen.cursor:=crDefault;
showmessage('无法调用Excel!');
exit;
end;
savedialog:=tsavedialog.Create(nil);
savedialog.Filter:='Excel文件(*.xls)|*.xls';
if savedialog.Execute then
begin
if FileExists(savedialog.FileName) then
try
if application.messagebox('该文件已经存在,要覆盖吗?','询问',mb_yesno+mb_iconquestion)=idyes then
DeleteFile(PChar(savedialog.FileName))
else
begin
Excel.Quit;
savedialog.free;
screen.cursor:=crDefault;
Exit;
end;
except
Excel.Quit;
savedialog.free;
screen.cursor:=crDefault;
Exit;
end;
filename:=savedialog.FileName;
end;
savedialog.free;
if filename='' then
begin
result:=true;
Excel.Quit;
screen.cursor:=crDefault;
exit;
end;
k:=0;
for i:=0 to dbgrid.Columns.count-1 do
begin
if dbgrid.Columns.Items[i].Visible then
begin
//Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;
excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;
inc(k);
end;
end;
dbgrid.DataSource.DataSet.DisableControls;
saveplace:=dbgrid.DataSource.DataSet.GetBookmark;
dbgrid.DataSource.dataset.First;
i:=2;
if dbgrid.DataSource.DataSet.recordcount>65536 then
ProgressBar1:=ProgressBarform(65536)
else
ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.recordcount);
while not dbgrid.DataSource.dataset.Eof do
begin
k:=0;
for j:=0 to dbgrid.Columns.count-1 do
begin
if dbgrid.Columns.Items[j].Visible then
begin
excel.cells[i,k+1].NumberFormat:='@';
if not dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull then
begin
str:=dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;
Excel.Cells[i, k + 1] := Str;
end;
inc(k);
end
else
continue;
end;
if i=65536 then
break;
inc(i);
ProgressBar1.StepBy(1);
dbgrid.DataSource.dataset.next;
end;
progressbar1.Parent.Free;
dbgrid.DataSource.dataset.GotoBookmark(SavePlace);
dbgrid.DataSource.dataset.EnableControls;
try
if copy(FileName,length(FileName)-3,4)<>'.xls' then
FileName:=FileName+'.xls';
Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, '', '', False, False);
except
Excel.Quit;
screen.cursor:=crDefault;
exit;
end;
Excel.Visible := true;
screen.cursor:=crDefault;
Result := true;
end;
function ProgressBarform(max:integer):tProgressBar;
var
ProgressBar1:tProgressBar;
form:tform;
begin
application.CreateForm(tform,form);
form.Position:=poScreenCenter;
form.BorderStyle:=bsnone;
form.Height:=30;
form.Width:=260;
ProgressBar1:=tProgressBar.Create(form);
ProgressBar1.Smooth:=true;
ProgressBar1.Max:=max;
ProgressBar1.Parent:=form;
ProgressBar1.Height:=20;
ProgressBar1.Width:=250;
ProgressBar1.Left:=5;
ProgressBar1.Top:=5;
ProgressBar1.Step:=1;
form.Show;
result:=ProgressBar1;
end;
procedure Tkccx_Form.BitBtn3Click(Sender: TObject);
begin
if not adotable_cx.Active then
begin
application.MessageBox('请先执行查询','操作提示',mb_ok);
exit;
end;
ExportToExcel(dbgrid1);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -