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.