?? u_compare.~pas
字號:
unit u_Compare;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtnrs, ComCtrls, ExtCtrls, DB, ADODB, DBTables,
Grids, DBGrids, COMobj;
type
TSaveThread = class;
TfCompare = class(TForm)
Panel1: TPanel;
Panel7: TPanel;
Panel3: TPanel;
OpenDialog1: TOpenDialog;
Gb_Source: TGroupBox;
Panel4: TPanel;
Button1: TButton;
ADODataSetSource: TADODataSet;
Panel2: TPanel;
Label1: TLabel;
ProgressBar1: TProgressBar;
btn_Compare: TButton;
Panel5: TPanel;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
ListBox4: TListBox;
Button2: TButton;
LB1: TLabel;
LB2: TLabel;
LB3: TLabel;
LB4: TLabel;
SaveDialog1: TSaveDialog;
lb1a: TLabel;
lb2a: TLabel;
lb3a: TLabel;
lb4a: TLabel;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure btn_CompareClick(Sender: TObject);
procedure ADODataSetSourceAfterOpen(DataSet: TDataSet);
procedure FormResize(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
iSourceIndex, iDesIndex, iConditionIndex: Integer;
fBankSources, fBankDes, fCompanySources, fCompanyDes: tstringlist;
sTempData: string;
procedure RefreshMain;
procedure CompareList(var flist:tstringlist);
public
{ Public declarations }
procedure SavetoExcel;
end;
TSaveThread = class(TThread)
private
fOwner: TfCompare;
constructor Create(Aowner: TfCompare);
public
procedure Execute; override;
end;
var
fCompare: TfCompare;
implementation
{$R *.dfm}
procedure TfCompare.FormCreate(Sender: TObject);
begin
OpenDialog1.Filter := 'xls file|*.xls';
SaveDialog1.Filter := 'xls file|*.xls';
fBankSources := TStringList.Create;
fBankDes := TStringList.Create;
fCompanySources := TStringList.Create;
fCompanyDes := TStringList.Create;
sTempData := ExtractFilePath(Application.ExeName) + '\Main.db';
if FileExists(sTempData) then
DeleteFile(PCHAR(sTempData));
lb1a.Caption :='';
lb2a.Caption :='';
lb3a.Caption :='';
lb4a.Caption :='';
StringGrid1.Cells[0,0] :='銀行對帳單借方';
StringGrid1.Cells[1,0] :='銀行對帳單貸方';
StringGrid1.Cells[2,0] :='銀行日記帳借方';
StringGrid1.Cells[3,0] :='銀行日記帳貸方';
end;
procedure TfCompare.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fBankSources.Free;
fBankDes.Free;
fCompanySources.Free;
fCompanyDes.Free;
Action := caFree;
fCompare := nil;
end;
procedure TfCompare.Button1Click(Sender: TObject);
var
sFileName, sSheetName, sTemp: string;
i,j: INteger;
begin
if not OpenDialog1.Execute then exit;
sFileName := OpenDialog1.FileName;
InputQuery('載入數據', '請輸入工作表名稱：', sSheetName);
if sSheetName = '' then
begin
Application.MessageBox('工作表名稱不能未空！', '提示', mb_ok + MB_ICONINFORMATION);
exit;
end;
for i:=0 to 3 do
for j:=1 to StringGrid1.RowCount-1 do
StringGrid1.Cells[i,j] :='';
try
with ADODataSetSource do //AdoDataSet 連接Excel文件
begin
Close;
ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + sFileName + ';'
+ 'Extended Properties=Excel 8.0;Persist Security Info=False';
CommandType := cmdTableDirect;
CommandText := sSheetName + '$'; //'Sheet1$';
Open;
end;
except
Application.MessageBox('載入數據失敗！', '提示', mb_ok + MB_ICONINFORMATION);
exit;
end;
ProgressBar1.Position :=0;
end;
procedure TfCompare.btn_CompareClick(Sender: TObject);
var
iCount, i, iPro,iIndex: Integer;
sTemp: string;
ListItem: TListItem;
iTemp1,itemp2,itemp3,itemp4:extended;
fList1,flist2,flist3,flist4:tstringlist;
fList5,flist6,flist7,flist8:tstringlist;
begin
if not ADODataSetSource.Active then
begin
Application.MessageBox('請導入對帳數據！','提示',mb_ok+mb_iconinformation);
exit;
end;
fList1 :=tstringlist.Create;
fList2 :=tstringlist.Create;
fList3 :=tstringlist.Create;
fList4 :=tstringlist.Create;
try
lb1a.caption :='0';
lb2a.caption :='0';
lb3a.caption :='0';
lb4a.caption :='0';
iTemp1 :=0;
iTemp2 :=0;
iTemp3 :=0;
iTemp4 :=0;
flist1.Clear;
flist2.Clear;
flist3.Clear;
flist4.Clear;
ProgressBar1.Position :=0;
if ADODataSetSource.RecordCount>10 then
StringGrid1.RowCount :=ADODataSetSource.RecordCount+1
else
StringGrid1.RowCount :=11;
with ADODataSetSource do
begin
first ;
while not eof do
begin
if FieldByName(Fields.Fields[0].FieldName).AsFloat<>0 then
flist1.add(FieldByName(Fields.Fields[0].FieldName).Asstring);
if FieldByName(Fields.Fields[1].FieldName).AsFloat<>0 then
flist2.add(FieldByName(Fields.Fields[1].FieldName).Asstring);
if FieldByName(Fields.Fields[2].FieldName).AsFloat<>0 then
flist3.add(FieldByName(Fields.Fields[2].FieldName).Asstring);
if FieldByName(Fields.Fields[3].FieldName).AsFloat<>0 then
flist4.add(FieldByName(Fields.Fields[3].FieldName).Asstring);
next;
end;
end;
ProgressBar1.Position := 10;
////消除同列中正負數抵消
CompareList(flist1);
CompareList(flist2);
CompareList(flist3);
CompareList(flist4);
ProgressBar1.Position := 30;
for i:=flist1.Count-1 downto 0 do /////第一列中的每一條到第四列中去查找,如果找到則刪除第四列和第一列的值
begin
iIndex:= flist4.IndexOf(flist1.Strings[i]);
if iIndex>-1 then
begin
flist4.Delete(iIndex);
flist1.Delete(i);
end;
end;
ProgressBar1.Position := 50;
for i:=flist2.Count-1 downto 0 do /////第一列中的每一條到第四列中去查找,如果找到則刪除第四列和第一列的值
begin
iIndex:= flist3.IndexOf(flist2.Strings[i]);
if iIndex>-1 then
begin
flist3.Delete(iIndex);
flist2.Delete(i);
end;
end;
ProgressBar1.Position := 70;
listbox1.Items.Clear;
listbox2.Items.Clear;
listbox3.Items.Clear;
listbox4.Items.Clear;
ProgressBar1.Position := 80;
listbox1.Items.Assign(flist1);
listbox2.Items.Assign(flist2);
listbox3.Items.Assign(flist3);
listbox4.Items.Assign(flist4);
itemp1 :=0;
for I:=0 to flist1.Count-1 do
iTemp1 :=itemp1+strtofloat(flist1.Strings[i]);
itemp2 :=0;
for I:=0 to flist2.Count-1 do
iTemp2 :=itemp2+strtofloat(flist2.Strings[i]);
itemp3 :=0;
for I:=0 to flist3.Count-1 do
iTemp3 :=itemp3+strtofloat(flist3.Strings[i]);
itemp4 :=0;
for I:=0 to flist4.Count-1 do
iTemp4 :=itemp4+strtofloat(flist4.Strings[i]);
ProgressBar1.Position := 90;
lb1a.Caption :=FloatToStr(iTemp1) ;
lb2a.Caption :=FloatToStr(iTemp2) ;
lb3a.Caption :=FloatToStr(iTemp3) ;
lb4a.Caption :=FloatToStr(iTemp4) ;
finally
flist1.Free;
flist2.Free;
flist3.Free;
flist4.Free;
end;
ProgressBar1.Position := ProgressBar1.Max;
end;
procedure TfCompare.ADODataSetSourceAfterOpen(DataSet: TDataSet);
var
sTemp: string;
iCount :integer;
begin
DataSet.First;
StringGrid1.RowCount := ADODataSetSource.RecordCount+1;
with DataSet do
begin
first;
iCount :=0;
while not DataSet.Eof do
begin
inc(iCount);
StringGrid1.Cells[0,icount] := floattostr(DataSet.fieldbyname(DataSet.Fields.Fields[0].FieldName).AsFloat);
StringGrid1.Cells[1,icount] := floattostr(DataSet.fieldbyname(DataSet.Fields.Fields[1].FieldName).AsFloat);
StringGrid1.Cells[2,icount] := floattostr(DataSet.fieldbyname(DataSet.Fields.Fields[2].FieldName).AsFloat);
StringGrid1.Cells[3,icount] := floattostr(DataSet.fieldbyname(DataSet.Fields.Fields[3].FieldName).AsFloat);
next;
end;
end;
end;
procedure TfCompare.FormResize(Sender: TObject);
begin
ListBox1.Width := Width div 4;
ListBox2.Width := ListBox1.Width;
ListBox3.Width := ListBox1.Width;
ListBox4.Width := ListBox1.Width;
LB1.Left := ListBox1.Left;
LB2.Left := ListBox2.Left;
LB3.Left := ListBox3.Left;
LB4.Left := ListBox4.Left;
lb1a.Left := ListBox1.Left+5;
lb2a.Left := ListBox2.Left+5;
lb3a.Left := ListBox3.Left+5;
lb4a.Left := ListBox4.Left+5;
end;
procedure TfCompare.Button2Click(Sender: TObject);
var
fThread: TSaveThread;
begin
fThread := TSaveThread.Create(Self);
end;
procedure TfCompare.SavetoExcel;
var ExcelApp, WorkBook: Variant;
i: Integer;
begin
if (ListBox1.Count <= 0) and (ListBox2.Count <= 0) and (ListBox3.Count <= 0) and (ListBox4.Count <= 0) then exit;
if not SaveDialog1.Execute then exit;
try
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.Visible := True;
ExcelApp.Caption := SaveDialog1.FileName;
WorkBook := ExcelApp.WorkBooks.Add;
// ExcelApp.WorkSheets[1].Activate;
// ExcelApp.WorkSheets[1].caption := '未達帳數據';
ExcelApp.WorkSheets[1].name :='未達帳數據';
ExcelApp.Cells[1, 1] := lb1.caption;
for I := 0 to ListBox1.Count - 1 do
begin
ExcelApp.Cells[i + 2, 1].Value := strtofloat(ListBox1.Items.Strings[i]);
end;
ExcelApp.Cells[1, 2] := lb2.caption;
for I := 0 to ListBox2.Count - 1 do
begin
ExcelApp.Cells[i + 2, 2].Value := strtofloat(ListBox2.Items.Strings[i]);
end;
ExcelApp.Cells[1, 3] := lb3.caption;
for I := 0 to ListBox3.Count - 1 do
begin
ExcelApp.Cells[i + 2, 3].Value := strtofloat(ListBox3.Items.Strings[i]);
end;
ExcelApp.Cells[1, 4] := lb3.caption;
for I := 0 to ListBox4.Count - 1 do
begin
ExcelApp.Cells[i + 2, 4].Value := strtofloat(ListBox4.Items.Strings[i]);
end;
ExcelApp.Visible := True;
ExcelApp.WorkSheets[1].Cells.Columns.AutoFit ;
////保存銀行余額調節表
ExcelApp.WorkSheets[2].select;
ExcelApp.WorkSheets[2].name := '銀行余額調節表';
ExcelApp.Cells[3, 3] := '銀行余額調節表';
ExcelApp.Cells[3, 3].Font.Name := '宋體';
ExcelApp.Cells[3, 3].Font.Color := clblack;
ExcelApp.Cells[3, 3].Font.Bold := True;
ExcelApp.Cells[5, 1] := ' 單據號';
ExcelApp.Cells[5, 5] := '年 月' ;
ExcelApp.Cells[8, 1] := ' 對帳單余額：';
ExcelApp.Cells[8, 5] := ' 銀行帳余額：';
ExcelApp.Cells[10, 1] := ' + 企業已收銀行未收：';
ExcelApp.Cells[10, 2] := lb4a.Caption;
ExcelApp.Cells[10, 5] := ' + 銀行已收企業未收：';
ExcelApp.Cells[10, 6] := lb1a.Caption;
ExcelApp.Cells[13, 1] := ' - 企業已付銀行未付：';
ExcelApp.Cells[13, 2] := lb3a.Caption;
ExcelApp.Cells[13, 5] := ' - 銀行已付企業未付：';
ExcelApp.Cells[13, 6] := lb2a.Caption;
ExcelApp.Cells[15, 1] := ' 調節后余額：';
ExcelApp.Cells[15, 5] := ' 調節后余額：';
ExcelApp.Cells[15, 2].FormulaR1C1 :='=R[-7]C+R[-5]C-R[-2]C';
ExcelApp.Cells[15, 6].FormulaR1C1 :='=R[-7]C+R[-5]C-R[-2]C';
{ ExcelApp.ActiveSheet.Range[ 'A3:D15' ].Borders.LineStyle:=0;
ExcelApp.ActiveSheet.Range[ 'A3:D15' ].Borders.Weight :=1;
ExcelApp.ActiveSheet.Range[ 'A3:D15' ].Borders.Weight :=2;
ExcelApp.ActiveSheet.Range[ 'A3:D15' ].Borders.Weight :=2;
ExcelApp.ActiveSheet.Range[ 'A3:D15' ].Borders.Weight :=2;
ExcelApp.ActiveSheet.Range[ 'A3:D15' ].Borders.Weight :=2; }
// ExcelApp.ActiveSheet.PrintPreview ;
ExcelApp.WorkSheets[2].Cells.Columns.AutoFit ;
ExcelApp.ActiveWorkbook.SaveAs(SaveDialog1.FileName);
except
ExcelApp.quit;
end;
end;
{ TSaveThread }
constructor TSaveThread.Create(Aowner: TfCompare);
begin
fOwner := Aowner;
FreeOnTerminate := true;
inherited create(false);
end;
procedure TSaveThread.Execute;
begin
Synchronize(fOwner.SavetoExcel);
Terminate;
end;
procedure TfCompare.RefreshMain;
begin
{ with QryMain do
begin
Close;
SQL.Clear;
SQL.Add('SELECT * FROM "' + sTempData + '"');
try
Open;
except
exit;
end;
end; }
end;
procedure TfCompare.CompareList(var flist: tstringlist);
var
i,iIndex:Integer;
fTempList,fResultList,fNeedDeleteList:tstringlist;
begin
fTempList :=TStringList.Create;
fNeedDeleteList :=TStringList.Create;
fResultList :=TStringList.Create;
try
fResultList.Assign(flist);
fTempList.Assign(flist);
for i:=fResultList.Count-1 downto 0 do
begin
iIndex := fTempList.IndexOf('-'+fResultList.Strings[i]) ;
if iIndex>-1 then
begin
fNeedDeleteList.Add(inttostr(iIndex)) ;
fNeedDeleteList.Add(inttostr(i)) ;
fResultList.Delete(i);
fTempList.Delete(iIndex);
end;
end;
for I:=flist.Count-1 downto 0 do
begin
iIndex :=fNeedDeleteList.IndexOf(inttostr(i));
if iIndex>-1 then
flist.Delete(i);
end;
finally
fTempList.Free;
fNeedDeleteList.Free;
fResultList.Free;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -