Skip to content

W
WZGL

cz_012273 / WZGL

通知 2
Star 1
Fork 0
W
WZGL

前往新版Gitcode，体验更适合开发者的 AI 搜索 >>

提交 0f37cb77 编写于 作者: C cz_012273
浏览文件
操作

入库、发放、查询、提示添加导出EXCEL按钮，增加导出多个工作表功能。

上级 7910da7d
隐藏空白更改
内联 并排
Showing with 115 addition and 39 deletion
ChaXun.pas
浏览文件 @ 0f37cb77
......@@ -51,7 +51,7 @@ procedure TForm4.Button1Click(Sender: TObject);
begin
try
Screen.Cursor := crHourGlass;
ExportDBGrid(DBGrid1, '导出数据'); //暂时将导出的文件名称为“导出数据”（的execl文件）
ExportDBGrid([DBGrid1], '导出库存数据'); //导出文件默认名称，可修改。
finally
Screen.Cursor := crDefault;
end;
......
ChuKu.dfm
浏览文件 @ 0f37cb77
......@@ -89,7 +89,7 @@ object Form3: TForm3
Caption = #21457#25918#29702#30001
end
object Button1: TButton
Left = 140
Left = 65
Top = 343
Width = 111
Height = 41
......@@ -98,7 +98,7 @@ object Form3: TForm3
OnClick = Button1Click
end
object Button2: TButton
Left = 370
Left = 444
Top = 343
Width = 111
Height = 41
......@@ -200,4 +200,13 @@ object Form3: TForm3
DataSource = DM1.DataSource3
TabOrder = 10
end
object Button3: TButton
Left = 254
Top = 343
Width = 111
Height = 41
Caption = #23548#20986'EXCEL'
TabOrder = 11
OnClick = Button3Click
end
end
ChuKu.pas
浏览文件 @ 0f37cb77
......@@ -30,12 +30,14 @@ type
DBEdit3: TDBEdit;
DBEdit4: TDBEdit;
DBEdit5: TDBEdit;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DBLookupComboBox1CloseUp(Sender: TObject);
procedure DBLookupComboBox2CloseUp(Sender: TObject);
procedure DBLookupComboBox3CloseUp(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
......@@ -139,6 +141,16 @@ end;
procedure TForm3.Button3Click(Sender: TObject);
begin
try
Screen.Cursor := crHourGlass;
ExportDBGrid([DBGrid1], '导出发放数据'); //导出文件默认名称，可修改。
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm3.DBLookupComboBox1CloseUp(Sender: TObject);
begin
DM1.FDQuery3.FieldByName('品名').value := DBlookupcombobox1.text;
......
DataUnit.pas
浏览文件 @ 0f37cb77
......@@ -46,7 +46,7 @@ type
var
DM1: TDM1;
function ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;
function ExportDBGrid(Args: array of const; SheetName: string): boolean;
const
dbPath = 'E:\WZGL\';
......@@ -93,51 +93,64 @@ begin
end;
end;
function ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存，不显示EXCEL
function ExportDBGrid(Args: array of const; SheetName: string): boolean;//直接保存，不显示EXCEL
var
c, r, i, j: integer;
c, r, i, j, k: integer;
app: Olevariant;
Sheet: Variant;
TempFileName, ResultFileName:string;
begin
try
result := True;
app := CreateOLEObject('Excel.application');
app := CreateOLEObject('Excel.application'); //创建EXCEL表对象
// app.WorkBooks.Add(xlWBatWorkSheet);
except
Application.MessageBox('Excel没有正确安装！','警告',MB_OK);
result := False;
exit;
end;
dm1.SaveDialog1.DefaultExt := 'xls';
dm1.SaveDialog1.FileName := SheetName;
if dm1.SaveDialog1.Execute then
TempFileName := dm1.SaveDialog1.FileName
dm1.SaveDialog1.DefaultExt := 'xls'; //默认文件名后缀为xls
dm1.SaveDialog1.FileName := SheetName; //读取EXCEL工作簿名称参数
if dm1.SaveDialog1.Execute then //调用保存文件对话框
TempFileName := dm1.SaveDialog1.FileName //设定保存文件名
else
Exit;
app.Workbooks.add;
app.Visible := false;
Screen.Cursor := crHourGlass;
DBGrid.DataSource.DataSet.First;
c := DBGrid.DataSource.DataSet.FieldCount;
r := DBGrid.DataSource.DataSet.RecordCount;
Application.ProcessMessages;
for i := 0 to c - 1 do
app.cells(1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].DisplayLabel;
for j := 1 to r do
app.Workbooks.add; //添加工作表
App.SheetsInNewWorkbook := High(Args)+1; //取最大工作表数
for K := Low(Args) to High(Args) do //逐个工作表循环
begin
for i := 0 to c - 1 do
app.cells(j + 1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].AsString;
DBGrid.DataSource.DataSet.Next;
App.WorkBooks[1].WorkSheets[K+1].Name := '表'+inttostr(k+1); //设工作表名
Sheet := App.Workbooks[1].WorkSheets['表'+inttostr(k+1)]; //设定工作表对象
app.Visible := false; //设为不可见
Screen.Cursor := crHourGlass; //光标显示正在运行中
TDBGrid(Args[K].VObject).DataSource.DataSet.First; //回到首记录
c := TDBGrid(Args[K].VObject).DataSource.DataSet.FieldCount; //取字段总数
r := TDBGrid(Args[K].VObject).DataSource.DataSet.RecordCount; //取记录总数
Application.ProcessMessages; //使程序在循环时能够响应外界事件
for i := 0 to c - 1 do //按列读取数据
Sheet.cells(1, 1 + i) := TDBGrid(Args[K].VObject).DataSource.DataSet.Fields[i].DisplayLabel; //读取各列字段名
for j := 1 to r do //按行读取数据
begin
for i := 0 to c - 1 do //当前行按列读取
Sheet.cells(j + 1, 1 + i) := TDBGrid(Args[K].VObject).DataSource.DataSet.Fields[i].AsString; //以文本方式读取各列数据
TDBGrid(Args[K].VObject).DataSource.DataSet.Next; //到下一记录
end;
end;
ResultFileName := TempFileName;
if ResultFileName = '' then
ResultFileName := TempFileName; //确定文件名
if ResultFileName = '' then //如为空则默认名称为“数据导出”
ResultFileName := '数据导出';
if FileExists(TempFileName) then
DeleteFile(PWideChar(WideString(TempFileName)));
app.Activeworkbook.saveas(TempFileName);
app.Activeworkbook.close(false);
app.quit;
app := unassigned;
if FileExists(TempFileName) then //判断文件是否存在
DeleteFile(PWideChar(WideString(TempFileName))); //如同名文件已存在，则先删除
app.Activeworkbook.saveas(TempFileName); //保存文件
app.Activeworkbook.close(false); //关闭文件
app.quit; //退出excel表对象
app := unassigned; //文件注销
end;
end.
RuKu.dfm
浏览文件 @ 0f37cb77
......@@ -82,7 +82,7 @@ object Form2: TForm2
Caption = #20445#36136#26399#65288#22825#65289
end
object Button1: TButton
Left = 140
Left = 72
Top = 343
Width = 111
Height = 41
......@@ -91,7 +91,7 @@ object Form2: TForm2
OnClick = Button1Click
end
object Button2: TButton
Left = 370
Left = 439
Top = 343
Width = 111
Height = 41
......@@ -187,4 +187,13 @@ object Form2: TForm2
DataSource = DM1.DataSource1
TabOrder = 10
end
object Button3: TButton
Left = 255
Top = 343
Width = 111
Height = 41
Caption = #23548#20986'EXCEL'
TabOrder = 11
OnClick = Button3Click
end
end
RuKu.pas
浏览文件 @ 0f37cb77
......@@ -30,11 +30,13 @@ type
DBEdit4: TDBEdit;
DBEdit5: TDBEdit;
DBEdit6: TDBEdit;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DBLookupComboBox1CloseUp(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
......@@ -126,6 +128,16 @@ end;
procedure TForm2.Button3Click(Sender: TObject);
begin
try
Screen.Cursor := crHourGlass;
ExportDBGrid([DBGrid1], '导出入库数据'); //导出文件默认名称，可修改。
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm2.DBLookupComboBox1CloseUp(Sender: TObject);
begin
DM1.FDQuery1.FieldByName('品名').value := DBlookupcombobox1.text;
......
TiShi.dfm
浏览文件 @ 0f37cb77
......@@ -32,7 +32,7 @@ object Form6: TForm6
Caption = #21457#25918#21040#26399#25552#31034#65306
end
object Button1: TButton
Left = 140
Left = 76
Top = 343
Width = 111
Height = 41
......@@ -41,7 +41,7 @@ object Form6: TForm6
OnClick = Button1Click
end
object Button2: TButton
Left = 370
Left = 434
Top = 343
Width = 111
Height = 41
......@@ -79,4 +79,13 @@ object Form6: TForm6
TitleFont.Style = []
OnDrawDataCell = DBGrid2DrawDataCell
end
object Button3: TButton
Left = 255
Top = 343
Width = 111
Height = 41
Caption = #23548#20986'EXCEL'
TabOrder = 4
OnClick = Button3Click
end
end
TiShi.pas
浏览文件 @ 0f37cb77
......@@ -15,6 +15,7 @@ type
Button2: TButton;
DBGrid1: TDBGrid;
DBGrid2: TDBGrid;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
......@@ -22,6 +23,7 @@ type
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid2DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
......@@ -48,6 +50,16 @@ begin
end;
procedure TForm6.Button3Click(Sender: TObject);
begin
try
Screen.Cursor := crHourGlass;
ExportDBGrid([DBGrid1,DBGrid2], '导出发放提示'); //导出文件默认名称，可修改。
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm6.FormShow(Sender: TObject);
begin
dm1.FDConnection1.Connected := True;
......
WZGL.dproj
浏览文件 @ 0f37cb77
......@@ -88,9 +88,9 @@
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.7.19;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Release>7</VerInfo_Release>
<VerInfo_Build>19</VerInfo_Build>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.8.5;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Release>8</VerInfo_Release>
<VerInfo_Build>5</VerInfo_Build>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
......
WZGL.res
浏览文件 @ 0f37cb77
无法预览此类型文件
Markdown is supported
0% 或 .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑！
想要评论请 注册 或