在delphi中XLSReadWriteII.组件的应用实例（1）

第三方组件：XLSReadWriteII.v.5.20.67_XE3

实例源码如下：

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  XLSSheetData5, XLSReadWriteII5,
  Vcl.StdCtrls, Vcl.ComCtrls, RzLabel;
 
type
  TForm1 = class(TForm)
    XLSReadWriteII51: TXLSReadWriteII5;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    pb: TProgressBar;
    Label2: TLabel;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
     uses strUtils,
       XLSDbRead5, Xc12Manager5, Xc12Utils5, XLSUtils5,
     Xc12DataStyleSheet5, XLSFormattedObj5, Xc12DataWorksheet5;
{$R *.dfm}
 
type
  TDelFlags = set of (dfDelBefore, dfDelAfter);
 
function Delstr(var ms: String; endstr: String; Flags: TDelFlags;
  bself: Boolean = True): String;
var
  l: Integer;
begin
  l := length(endstr);
  if dfDelBefore in Flags then
  begin
    if bself then
    begin
      Result := copy(ms, 1, pos(endstr, ms) + l - 1);
      Delete(ms, 1, pos(endstr, ms) + l - 1);
    end
    else
    begin
      Result := copy(ms, 1, pos(endstr, ms) - 1);
      Delete(ms, 1, pos(endstr, ms) - 1);
    end;
  end
  else
  begin
    if bself then
    begin
      Result := copy(ms, pos(endstr, ms), length(ms));
      Delete(ms, pos(endstr, ms), length(ms));
    end
    else
    begin
      Result := copy(ms, pos(endstr, ms) + l, length(ms));
      Delete(ms, pos(endstr, ms) + l, length(ms));
    end;
  end;
end;
 
function Matchstrings(Source, pattern: String): Boolean;
var
  pSource: array[0..255] of Char;
  pPattern: array[0..255] of Char;
  function MatchPattern(element, pattern: PChar): Boolean;
    function IsPatternWild(pattern: PChar): Boolean;
    begin
      Result := StrScan(pattern, '*') <> nil;
      if not Result then
        Result := StrScan(pattern, '?') <> nil;
    end;
  begin
    if 0 = StrComp(pattern, '*') then
      Result := True
    else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
      Result := False
    else if element^ = Chr(0) then
      Result := True
    else
    begin
      case pattern^ of
        '*':
          if MatchPattern(element, @pattern[1]) then
            Result := True
          else
            Result := MatchPattern(@element[1], pattern);
          '?':
          Result := MatchPattern(@element[1], @pattern[1]);
        else
          if element^ = pattern^ then
            Result := MatchPattern(@element[1], @pattern[1])
          else
            Result := False;
      end;
    end;
  end;
begin
  StrPCopy(pSource, Source);
  StrPCopy(pPattern, pattern);
  Result := MatchPattern(pSource, pPattern);
end;
 
procedure FindFiles(ASourceDir, SearchFileType: String; var List: TStrings);
var
  FileRec: TSearchrec;
  Sour: String;
begin
  Sour := ASourceDir;
  if Sour[length(Sour)] <> '\' then
    Sour := Sour + '\';
  if FindFirst(Sour + '*.*', faAnyfile, FileRec) = 0 then
    {循环}
    repeat
      if ((FileRec.Attr and faDirectory) <> 0) then
      begin
        if (FileRec.Name <> '.') and (FileRec.Name <> '..') then //找到目录
        begin
          FindFiles(Sour + FileRec.Name, SearchFileType, List);
        end;
      end
      else //找到文件
      begin
        {拷贝所有类型的文件}
        if Matchstrings(LowerCase(FileRec.Name), SearchFileType) then
        begin
          List.Add(Sour + FileRec.Name);
        end; {拷贝所有类型的文件}
      end;
    until FindNext(FileRec) <> 0;
  FindClose(FileRec);
end; {从磁盘中搜索指定类型的所有文件}
 
procedure SetCellFontStyle(ACell: TXLSCell; AFontStyle: TFontStyles);
var
   CellFontStyle   : TXc12FontStyles;
begin
   CellFontStyle:=[];
 
   if fsBold in AFontStyle then CellFontStyle:=CellFontStyle+[xfsBold];
   if fsItalic in AFontStyle then CellFontStyle:=CellFontStyle+[xfsItalic];
   if fsStrikeOut in AFontStyle then CellFontStyle:=CellFontStyle+[xfsStrikeOut];
 
   ACell.FontStyle := CellFontStyle;
 
   if fsUnderline in AFontStyle then ACell.FontUnderline:=xulSingle;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  txtList: TStrings;
  i: Integer;
  XLS3: TXLSReadWriteII5;
  sFileName: string;
  sQuezi: string;
  sTitle: string;
  sBanci: string;
  sRiqi: string;
  firstRow: Integer;
  row: Integer;
  readTxt: TStringList;
  xlsFileName: string;
  zhenwen: string;
  j: Integer;
  aline: string;
  pNnum,kNum: Integer;
  eNum: Integer;
  AFullXLSXFilePath: string;
  AURLOrPath: string;
  AText: string;
  ATooltip: string;
  sNewCellFormat    : AxUCString;
begin
   button1.Enabled:=false;   button1.Caption:='正在生成';
 
   xlsFileName:=Edit2.Text;
 
   txtList:=TStringlist.Create ;
   findfiles(edit1.Text,'*.txt',txtList);
 
   if txtList.Count=0 then Exit;
 
   pb.Position:=0;
   pb.Max:=txtlist.Count;
 
   XLS3 := TXLSReadWriteII5.Create(nil);
 
   AFullXLSXFilePath:=xlsFileName;
   if UpperCase(ExtractFileExt(AFullXLSXFilePath))='.XLSX' then
      XLS3.Version:=xvExcel2007
   else
      XLS3.Version:=xvExcel97;
 
 //  XLS3.DirectWrite:=false;
 
   XLS3[0].AsString[0, 0] := '日期';
   XLS3[0].AsString[1, 0] := '版次';
   XLS3[0].AsString[2, 0] := '标题';
   XLS3[0].AsString[3, 0] := '缺字';
   XLS3[0].AsString[4, 0] := '文件名';
 
   XLS3[0].AsString[5, 0] := '生成时间';
 
   XLS3[0].Cell[0,0].FontStyle:=[xfsBold];
   XLS3[0].Cell[1,0].FontStyle:=[xfsBold];
   XLS3[0].Cell[2,0].FontStyle:=[xfsBold];
   XLS3[0].Cell[3,0].FontStyle:=[xfsBold];
   XLS3[0].Cell[4,0].FontStyle:=[xfsBold];
   XLS3[0].Cell[5,0].FontStyle:=[xfsBold];
 
   XLS3[0].Columns[0].PixelWidth:=100;
   XLS3[0].Columns[1].PixelWidth:=80;
   XLS3[0].Columns[2].PixelWidth:=250;
   XLS3[0].Columns[3].PixelWidth:=300;
   XLS3[0].Columns[4].PixelWidth:=300;
   XLS3[0].Columns[5].PixelWidth:=130;
 
   XLS3[0].Columns[0].HorizAlignment:=chaLeft;  //对齐方式
 
  //
 
   sRiqi:=''; sBanci:='';sTitle:='';sQuezi:='';sFileName:='';
 
   firstRow:=0;row:=0; kNum:=0;
   readTxt:=TStringList.Create;
 
   try
 
  // row:=1;
 
   for i := 0 to txtList.Count-1 do
   begin
          pb.Position:=i+1;
          application.ProcessMessages ;
 
          readTxt.LoadFromFile(txtList[i]);
 
          sRiqi:=readTxt.Values['<日期>'];
          sBanci:=readTxt.Values['<版次>'];
          sTitle:=readTxt.Values['<正题>'];
 
          pNnum:=0; sQuezi:=''; eNum:=0;
 
          for j := 0 to readTxt.Count-1 do
          begin
              application.ProcessMessages;
              aline:=readTxt.Strings[j];
 
              kNum:=pos('□',aline);
              if kNum>0 then
              begin
                 inc(pNnum);
 
               //
                  if length(aline)>=16  then
                  begin
                      if sQuezi='' then
                      begin
                          sQuezi:=aline;
                          sQuezi:='（'+inttostr(pNnum)+'）'+copy(sQuezi,kNum-6,20);
                      end
                      else
                      begin
                          eNum:=posEx('□',aline,kNum);
 
                          if eNum-eNum=1 then
                          begin
                             kNum:=eNum;
                             dec(pNnum);
                          end
                          else
                            begin
                                kNum:=eNum;
                                sQuezi:=sQuezi+slinebreak+'（'+inttostr(pNnum)+'）'+copy(aline,kNum-6,20);
                            end;
 
                      end;
 
                  end
                  else
                  begin
                     if sQuezi='' then
                       sQuezi:='（'+inttostr(pNnum)+'）'+copy(aline,kNum-6,20)
                     else
                       sQuezi:=sQuezi+slinebreak+'（'+inttostr(pNnum)+'）'+copy(aline,kNum-6,20);
                  end;
 
              end;
 
          end;//for j end
 
          readTxt.Clear ;
 
          if ''<>trim(sQuezi) then  inc(row);
 
          kNum:=0;  eNum:=0;  pNnum:=0;
 
          //showmessage(sQuezi);
 
         // if row=0 then
 
         if ''<>trim(sQuezi) then
         begin
          XLS3[0].AsString[0, row] := sRiqi;
          XLS3[0].AsString[1, row] :=sBanci;
          XLS3[0].AsString[2, row] := sTitle;
          XLS3[0].Cell[2,row].ShrinkToFit:=false;
          XLS3[0].Cell[2,row].WrapText:=true;
 
          XLS3[0].AsString[3, row] := sQuezi;
          XLS3[0].Cell[3,row].FontSize:=12;
          XLS3[0].Cell[3,row].ShrinkToFit:=false;
          XLS3[0].Cell[3,row].WrapText:=true;
 
        //  XLS3[0].Cell[4,row].FontStyle:=Xc12DataStyleSheet5.TXc12FontStyles.
          XLS3[0].AsString[4, row] :=extractfilename(txtList[i]);
 
          AURLOrPath:=txtList[i];
          AText:=XLS3[0].AsString[4, row];
          ATooltip:=AURLOrPath;
          XLS3[0].MakeHyperlink(4,row,AURLOrPath,AText,ATooltip);  //超链接
 
          //日期和时间格式
          sNewCellFormat:='';
         // sNewCellFormat := ExcelStandardNumFormats[XLS_NUMFMT_STD_TIME];  //XLS_NUMFMT_STD_DATE , XLS_NUMFMT_STD_TIME
          // sNewCellFormat := 'dd/mm/yyyy  hh:mm';
           sNewCellFormat := 'dd/mm/yyyy hh:mm:SS';
          //sNewCellFormat := 'hh:mm' ;
         // sNewCellFormat := 'hh:mm:SS';
 
          XLS3[0].AsDateTime[5,row]:=now;
          if sNewCellFormat<>'' then
             XLS3[0].Cell[5,row].NumberFormat:=sNewCellFormat;
 
         end;
 
          sQuezi:='';
 
   end;//for i end
   XLS3.SaveToFile(xlsFileName);
 
   if pb.Max=pb.Position then
   begin
      showmessage('生成完毕！');
 
   end;
 
   finally
       freeandnil(txtlist);
       freeandnil(readtxt);
       freeandnil(XLS3);
       button1.Enabled:=true;   button1.Caption:='生成清单';
   end;
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 edit1.Clear ;
 edit2.Clear ;
 
 edit1.Text:='C:\Users\Administrator\Desktop\test';
 edit2.Text:='C:\Users\Administrator\Desktop\test\xx.xls';
end;
 
end.