📄 a4.pas
字号:
unit a4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGridEh, EhLibADO, Menus, OleServer, ExcelXP,db, ComObj,
frxClass, frxDBSet, ComCtrls, ToolWin, PrnDbgeh, Printers,PrViewEh;
type
Tfa4 = class(TForm)
dg_view: TDBGridEh;
sd: TSaveDialog;
ExcelApplication1: TExcelApplication;
ExcelWorkbook1: TExcelWorkbook;
MainMenu1: TMainMenu;
File1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
PrintDBGridEh1: TPrintDBGridEh;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure dg_viewKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
procedure savedata(flag : boolean);
{ Private declarations }
public
{ Public declarations }
end;
var
fa4: Tfa4;
implementation
uses dm,vks,main;
{$R *.dfm}
//导出到excle中去
procedure Tfa4.savedata(flag : boolean);
var
ExcelApp,WorkBook: Variant;
i, j, k: Integer;
total, total1: real;
Row, Col: Integer;
FieldName: string;
DataSet: TDataSet;
begin
// 数据发送到 Excel
try
ExcelApp := CreateOleObject('Excel.Application');
except
vks.info(1024);
Exit;
end;
Application.ProcessMessages;
WorkBook := ExcelApp.WorkBooks.Add;
//加入标题
ExcelApp.Range['A1:J1'].Merge; //单元格从A1到J1
ExcelApp.Rows[1].RowHeight :=25; //行高
ExcelApp.Rows[1].Borders.LineStyle := 1; //加边框
ExcelApp.Rows[1].HorizontalAlignment := xlCenter; //水平对齐方式
ExcelApp.Rows[1].VerticalAlignment := xlCenter; //垂直对齐方式
ExcelApp.Rows[1].Interior.Color := clSkyBlue; //颜色
ExcelApp.Rows[1].Characters.Font.Name := '宋体'; //字体
ExcelApp.Rows[1].Characters.Font.FontStyle := '加粗';
ExcelApp.Rows[1].Characters.Font.Size := 16;
ExcelApp.Rows[1].Characters.Font.OutlineFont := False; //是否有下划线
ExcelApp.Cells(1, 1) := FormatDateTime('yyyymmdd',now())+'库存数据导出';
Col := 1;
Row := 2;
DataSet := dg_view.DataSource.DataSet;
if Row=2 then
begin
ExcelApp.Rows[Row].Borders.LineStyle := 1;
ExcelApp.Rows[Row].RowHeight :=15; //行高
ExcelApp.Rows[Row].Interior.Color := clSilver; //颜色
ExcelApp.Rows[Row].Characters.Font.Name := '宋体'; //字体
ExcelApp.Rows[Row].Characters.Font.FontStyle := '加粗';
for I := 1 to dg_view.Columns.Count - 2 do
begin
if dg_view.Columns[I].Visible and (i<>2) then
begin
FieldName := dg_view.Columns[I].Title.Caption;
ExcelApp.Cells(Row, Col) := FieldName;
Col := Col + 1;
end;
end;
Row := Row + 1;
DataSet.First;
end;
total := 0;
total1 := 0;
while not DataSet.Eof do
begin
ExcelApp.Rows[Row].Borders.LineStyle := 1;
Col := 1;
for J := 1 to dg_view.Columns.Count - 2 do
begin
if J<>2 then
begin
FieldName := dg_view.Columns[J].FieldName;
if J=5 then total := total + DataSet.FieldByName(FieldName).AsFloat;
if J=8 then total1 := total1 + DataSet.FieldByName(FieldName).AsFloat;
ExcelApp.Cells(Row, Col) := trim(DataSet.FieldByName(FieldName).AsString);
Col := Col + 1;
end;
end;
Row := Row + 1;
DataSet.Next;
end;
ExcelApp.Rows[Row].Borders.LineStyle := 1;
ExcelApp.Rows[Row].Borders.Color := clSilver; //颜色
ExcelApp.Rows[Row].RowHeight :=15; //行高
ExcelApp.Rows[Row].Interior.Color := clSilver; //颜色
ExcelApp.Rows[Row].Characters.Font.Name := '宋体'; //字体
ExcelApp.Rows[Row].Characters.Font.FontStyle := '加粗';
ExcelApp.Cells(Row, 1) := '合计';
ExcelApp.Cells(Row, 4) := floattostr(total);
ExcelApp.Cells(Row, 7) := floattostr(total1);
if flag=false then ExcelApp.Visible := True
else if sd.execute then
begin
WorkBook.SaveAs(sd.FileName);
WorkBook.Close;
vks.info(1104);
end;
end;
procedure Tfa4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action := cafree;
end;
procedure Tfa4.FormShow(Sender: TObject);
begin
if not fdm.qvlist.Active then fdm.qvlist.Active := true;
if not fdm.qslist.Active then fdm.qslist.Active := true;
if not fdm.qslist1.Active then fdm.qslist1.Active := true;
if not fdm.qkc.Active then fdm.qkc.Open;
end;
procedure Tfa4.dg_viewKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//打印
if key=vk_f11 then N1Click(Sender);
//导出
if key=vk_f12 then N2Click(Sender);
//刷新
if key=vk_f5 then
begin
fdm.qkc.Close;
fdm.qkc.Open;
end;
//删除
if key=vk_delete then N3Click(Sender);
end;
procedure Tfa4.N1Click(Sender: TObject);
begin
PrinterPreview.Orientation := poLandscape;
PrintDBGridEh1.Preview;
end;
procedure Tfa4.N2Click(Sender: TObject);
begin
if fmain.str[3]<>'' then savedata(false) else savedata(true);
end;
procedure Tfa4.N3Click(Sender: TObject);
begin
if (dg_view.Fields[5].AsString<>'') and (dg_view.Fields[5].asinteger=0) and (vks.box('确定要删除本库存数据吗?'#13#10'如果删除,将不能恢复,请不要删除本窗口数据.','库存数据删除窗口')) then
begin
with fdm.q do
begin
close;
sql.Text := 'delete from [kc] where gid='+dg_view.Fields[12].AsString;
try
execsql;
close;
fdm.qkc.Close;
fdm.qkc.Open;
except
close;
vks.info(1008);
end;
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -