⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pas

📁 将某个目录下的子目录结构转换为excle文件中
💻 ~PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl,ExtCtrls,OleServer, ExcelXP, ComObj,Printers,DateUtils,
  XPMenu, cxControls, cxSplitter;

type
  TForm1 = class(TForm)
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    Button1: TButton;
    ListBox1: TListBox;
    XPMenu1: TXPMenu;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    FileListBox1: TFileListBox;
    cxSplitter1: TcxSplitter;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function CharCount(s:string;c:Char):Integer;
  end;

var
  Form1: TForm1;
     Tname:Tstrings;
  Tnumber:Tstrings;
implementation

{$R *.dfm}
function TForm1.CharCount(s:string;c:Char):Integer;
 var
 i:integer;
begin
      Result:=0;
      for i:=1 to Length(s)   do
      if   s[i]=c then Inc(Result);
end;
procedure TForm1.Button1Click(Sender: TObject);
var i,j,k,first_number,last_number,dqml:integer;
 s:string;
  Excel: variant;
  WorkBook, Sheet: Variant;
 is_dqml:bool;
begin
Tname:=Tstringlist.Create;
Tnumber:=Tstringlist.Create;
is_dqml:=false;
//edit1.text:=DirectoryListBox1.Directory;
self.ListBox1.Clear;
for i:=0 to DirectoryListBox1.Count-1 do
  begin
    if self.DirectoryListBox1.Directory=DirectoryListBox1.GetItemPath(i) then
      begin
         dqml:=i;
         break;
      end;
  end;
for i:=dqml to DirectoryListBox1.Count-1 do
  begin
    self.ListBox1.Items.Add(DirectoryListBox1.GetItemPath(i));
  end;
for i:=0 to self.ListBox1.Count-1 do
   begin
      // s:=self.ListBox1.Items(j).Text;
    {  if i=0 then
        begin
           s:=copy(self.ListBox1.Items.Strings[i],1,LastDelimiter('\',self.ListBox1.Items.Strings[i]));
           Tnumber.Add('0');
           Tname.Add(s);
        end
      else
        begin }
          k:=self.CharCount(self.ListBox1.Items.Strings[i],'\');
          s:=copy(self.ListBox1.Items.Strings[i],LastDelimiter('\',self.ListBox1.Items.Strings[i])+1,length(self.ListBox1.Items.Strings[i]));
          Tnumber.Add(inttostr(k));
          Tname.Add(s);
          if (self.DirectoryListBox1.Directory=self.ListBox1.Items.Strings[i]) and (self.FileListBox1.Count<>0) and (self.CheckBox1.Checked) then //判断选择的文件夹下是否有文件
            begin
               for j:=0 to self.FileListBox1.Count-1 do
                 begin
                    Tnumber.Add(inttostr(k+1));
                    Tname.Add(self.FileListBox1.Items.Strings[j]);
                 end;
               //j:=i+1;
               for j:=i+1 to  self.ListBox1.Count-1 do
                begin
                    s:=copy(self.ListBox1.Items.Strings[j],LastDelimiter('\',self.ListBox1.Items.Strings[j])+1,length(self.ListBox1.Items.Strings[j]));
                    Tnumber.Add(inttostr(k+1));
                    Tname.Add(s);
                end;
               break;
            end;
        //end;
   end;
  try
    Excel:=UnAssigned;
    Excel:=CreateOleObject('Excel.Application');
    Excel.Visible := True;
  except
    Excel:=UnAssigned;
   raise Exception.Create('无法启动 Excel');
  end;
       WorkBook := Excel.WorkBooks.Add(extractfilepath(application.ExeName)+'dayin.xlt');
       Excel.WorkSheets[1].activate;
       Sheet := WorkBook.WorkSheets[1];
   first_number:=strtoint(Tnumber.Strings[0]);
   sheet.cells[1,1]:=Tname.Strings[0];
   j:=1;

for i:=1 to Tnumber.Count-1 do
   begin
   // self.ListBox2.Items.Add(Tnumber.Strings[i]);
   // self.ListBox3.Items.Add(Tname.Strings[i]);
    //  sheet.cells[4+i,1]:=SmartQuery3.FieldByName('VSL_NAME_EN').Value;
     // sheet.cells[4+i,2]:=SmartQuery3.FieldByName('VOYAGE_NO').Value;
      last_number:=strtoint(Tnumber.Strings[i]);
      if first_number=last_number then
          begin
            sheet.cells[i+1,j]:=Tname.Strings[i];
            first_number:=last_number;
          end
      else
          begin
             sheet.cells[i+1,j+1]:=Tname.Strings[i];
             first_number:=last_number;
             j:=j+1;
          end;
    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -