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

📄 fm_openengineer.pas

📁 档案资料管理系统
💻 PAS
字号:
unit FM_OpenEngineer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, ComCtrls, Forms,
  Dialogs, StdCtrls, Buttons, Controls;

type
  TFM_OpenEngineer1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    ComboBox1: TComboBox;
    ListBox1: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FMTreeAndProject(Tree: TTreeView; Directory: string; Item: TTreeNode;IncludeFiles: boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FM_OpenEngineer1: TFM_OpenEngineer1;
implementation
uses
 FM_Main,FM_NewEngineering,FM_NewProject;
{$R *.dfm}

procedure TFM_OpenEngineer1.FormCreate(Sender: TObject);
var
 EngineerName:TSearchRec;
 EngineerNamePath:string;
begin
 EngineerNamePath:=ExtractFilePath(Application.ExeName)+'\'+'Project'+'\';
 if EngineerNamePath[length(EngineerNamePath)] <> '\' then
    EngineerNamePath := EngineerNamePath+ '\';
 if FindFirst(EngineerNamePath + '*.*',faDirectory,EngineerName) = 0 then
    begin
     repeat
      if (EngineerName.Attr and faDirectory = faDirectory) and (EngineerName.Name[1] <> '.') then
          begin
           if (EngineerName.Attr and faDirectory > 0) then
              ComboBox1.AddItem(EngineerName.Name,nil)
           end;
     until FindNext(EngineerName) <> 0;
     FindClose(EngineerName);
   end;
end;
procedure TFM_OpenEngineer1.ComboBox1Click(Sender: TObject);
var
 EngineerName1:TSearchRec;
 EngineerNamePath1:string;
 EngineerListCount:integer;
begin
 EngineerListCount:=0;
 While EngineerListCount<ListBox1.Items.Count do
       ListBox1.Items.Delete(EngineerListCount);
 EngineerNamePath1:=ExtractFilePath(Application.ExeName)+'\'+'Project'+'\'+ComBoBox1.Text;
 if EngineerNamePath1[length(EngineerNamePath1)] <> '\' then
    EngineerNamePath1 := EngineerNamePath1+ '\';
 if FindFirst(EngineerNamePath1+'*.*',faDirectory,EngineerName1) = 0 then
    begin
     repeat
      if (EngineerName1.Attr and faDirectory = faDirectory) and (EngineerName1.Name[1] <> '.') then
          begin
           if (EngineerName1.Attr and faDirectory > 0) then
              ListBox1.Items.Add(EngineerName1.Name)
           end;
     until FindNext(EngineerName1) <> 0;
     FindClose(EngineerName1);
   end;
end;
procedure TFM_OpenEngineer1.BitBtn1Click(Sender: TObject);
Var
 NewEngineerName:TTreeNode;
 ListBo1:string;
begin
 if (listbox1.ItemIndex<>-1) and (Combobox1.Text<>'') then
   begin
     ListBo1:=ListBox1.Items.Strings[listbox1.ItemIndex];
     FMNE_Path:=ExtractFilePath(Application.ExeName)+'\'+'Project'+'\'+ComboBox1.Text+'\'+Listbo1+'\';
     FM_Main1.TreeView1.Items.Clear;
     NewEngineerName:=FM_Main1.TreeView1.Items.Add(nil,ListBo1);
     FMTreeAndProject(FM_Main1.TreeView1,FMNE_Path,NewEngineerName,True);
     CheckBoxSelect:=True;
     Close;
   end
 else
    Application.MessageBox('必须要选择项目或工程','真诚提醒您',MB_OK or MB_ICONINFORMATION)
end;

procedure TFM_OpenEngineer1.FMTreeAndProject(Tree: TTreeView;
  Directory: string; Item: TTreeNode; IncludeFiles: boolean);
var
 SearchRec: TSearchRec;
 ItemTemp: TTreeNode;
begin
 FM_Main1.TreeView1.Items.BeginUpdate;
 if Directory[length(Directory)] <> '\' then
    Directory := Directory + '\';
 if FindFirst(Directory + '*.',faDirectory,SearchRec) = 0 then
    begin
     repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
          begin
           if (SearchRec.Attr and faDirectory > 0) then
              Item := Tree.Items.AddChild(Item,SearchRec.Name);
            ItemTemp := Item.Parent;
            FMTreeAndProject(FM_Main1.Treeview1,Directory + SearchRec.Name,Item,IncludeFiles);
            Item := ItemTemp;
          end
       else if IncludeFiles then
             if SearchRec.Name[1] <> '.' then
                Tree.Items.AddChild(Item,SearchRec.Name);
     until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
   end;
FM_Main1.TreeView1.Items.EndUpdate;
end; 
end.

⌨️ 快捷键说明

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