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

📄 fm_newengineering.pas

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

interface

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

type
  TFM_NewEngineering1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    FMNE_ED1: TEdit;
    FMNE_ED2: TEdit;
    TabSheet2: TTabSheet;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    FMNE_ED4: TEdit;
    FMNE_ED5: TEdit;
    FMNE_ComB1: TComboBox;
    FMNE_ComB3: TComboBox;
    FMNE_ComB2: TComboBox;
    FMNE_ComB4: TComboBox;
    FMNE_ED6: TEdit;
    FMNE_ED7: TEdit;
    FMNE_ED8: TEdit;
    FMNE_ED9: TEdit;
    FMNE_ED10: TEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    FMNE_ED3: TEdit;
    FMNE_ComD1: TBitBtn;
    FMNE_ComD2: TBitBtn;
    ProgressBar1: TProgressBar;
    CheckBox1: TCheckBox;
    TabSheet3: TTabSheet;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    FMNE_ED12: TEdit;
    FMNE_ED13: TEdit;
    GroupBox3: TGroupBox;
    Label19: TLabel;
    Label20: TLabel;
    FMNE_Comb5: TComboBox;
    FMNE_ComB6: TComboBox;
    Label21: TLabel;
    Label22: TLabel;
    FMNE_ComB7: TComboBox;
    FMNE_ComB8: TComboBox;
    Label23: TLabel;
    Label24: TLabel;
    FMNE_ED14: TEdit;
    FMNE_ED15: TEdit;
    Label25: TLabel;
    FMNE_ED16: TEdit;
    Label26: TLabel;
    FMNE_ED17: TEdit;
    Label27: TLabel;
    FMNE_ED18: TEdit;
    Label28: TLabel;
    GroupBox4: TGroupBox;
    FMNE_ED11: TEdit;
    procedure FMNE_ED1Change(Sender: TObject);
    procedure FMNE_ComD1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Copy_File(Source:String;Target:String);
    procedure GaugeProgress;
    procedure GaugeProgress1;
    procedure FMTreeAndProject(Tree: TTreeView; Directory: string; Item: TTreeNode);
    procedure FMTreeAndProject1(Tree: TTreeView; Directory: string; Item: TTreeNode);
    procedure CheckBox1Click(Sender: TObject);
  private
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FM_NewEngineering1: TFM_NewEngineering1;
  FMProjectWait1:TSearchRec;
  NewProjectSize:integer;
  NewProjectPath:String;
  c:string;
  FromF, ToF: file;
  NumRead, NumWritten: Integer;
  Buf: array[1..2048] of Char;
implementation
uses
 FM_Main,FM_NewProject;
{$R *.dfm}
procedure TFM_NewEngineering1.FMNE_ED1Change(Sender: TObject);
var
 EngineeringInfo:Tinifile;
begin
 FMNE_ED3.Text:=FMNE_ED1.TEXT;
 EngineeringInfo:=Tinifile.Create(FMNE_Path+'\'+FMNE_ED1.Text+'\'+FMNE_ED1.Text+'.ini');
 FMNE_ED4.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerDesign','');
 FMNE_ED5.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerConstruction','');
 FMNE_ComB1.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerConstruction1','');
 FMNE_ComB2.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerCharacteristic','');
 FMNE_ComB3.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerForm','');
 FMNE_ComB4.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerCategory','');
 FMNE_ED6.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerEstablishment','');
 FMNE_ED7.Text:=EngineeringInfo.ReadString('EngineeringInfo','EngineerExamine','');
 EngineeringInfo.Free;
end;

procedure TFM_NewEngineering1.FMNE_ComD1Click(Sender: TObject);
var
 EngineeringInfo:Tinifile;
begin
 if CheckBox1.Checked then
    begin
     if (FMNE_ED1.Text='')or (FMNE_ED11.Text='') Then
         Application.MessageBox('至少需要有一个工程名称或分项工程名称','真诚提醒您',MB_OK or MB_ICONINFORMATION)
     else
       begin
        CreateDirectory(PChar(FMNE_Path+'\'+FMNE_ED1.Text),nil);
        if not CreateDirectory(PChar(FMNE_Path+'\'+FMNE_ED1.Text+'\'+FMNE_ED11.Text), nil) then
           begin
            Application.MessageBox('已经存在这项分项工程','真诚提醒您',MB_OK or MB_ICONINFORMATION)
           end
        else
           begin
            EngineeringInfo:=Tinifile.Create(FMNE_Path+'\'+FMNE_ED1.Text+'\'+FMNE_ED11.Text+'\'+FMNE_ED11.Text+'.ini');
            EngineeringInfo.WriteString('EngineeringInfo','EngineerName',FMNE_ED11.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerDesign',FMNE_ED12.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerConstruction',FMNE_ED13.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerConstruction1',FMNE_ComB5.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerCharacteristic',FMNE_ComB6.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerForm',FMNE_ComB7.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerCategory',FMNE_ComB8.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerEstablishment',FMNE_ED14.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerExamine',FMNE_ED15.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerYearMonthDay',FMNE_ED16.Text+'年'+FMNE_ED17.Text+'月'+FMNE_ED18.Text+'日');
            EngineeringInfo.Free;
            EngineeringInfo:=Tinifile.Create(FMNE_Path+'\'+FMNE_ED1.Text+'\'+FMNE_ED1.Text+'.ini');
            EngineeringInfo.WriteString('EngineeringInfo','EngineerName',FMNE_ED1.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerDesign',FMNE_ED4.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerConstruction',FMNE_ED5.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerConstruction1',FMNE_ComB1.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerCharacteristic',FMNE_ComB2.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerForm',FMNE_ComB3.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerCategory',FMNE_ComB4.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerEstablishment',FMNE_ED6.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerExamine',FMNE_ED7.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerYearMonthDay',FMNE_ED8.Text+'年'+FMNE_ED9.Text+'月'+FMNE_ED10.Text+'日');
            EngineeringInfo.Free;
            ProgressBar1.Visible:=True;
            FMNE_ComD2.Enabled:=False;
            GaugeProgress1;
           end;
       end;
    end
 else
  begin
   if FMNE_ED1.Text='' Then
      Application.MessageBox('至少需要有一个工程名称','真诚提醒您',MB_OK or MB_ICONINFORMATION)
   else
      begin
       if not CreateDirectory(PChar(FMNE_Path+'\'+FMNE_ED1.Text), nil) then
          begin
           Application.MessageBox('已经存在这项工程','真诚提醒您',MB_OK or MB_ICONINFORMATION)
          end
       else
          begin
            EngineeringInfo:=Tinifile.Create(FMNE_Path+'\'+FMNE_ED1.Text+'\'+FMNE_ED1.Text+'.ini');
            EngineeringInfo.WriteString('EngineeringInfo','EngineerName',FMNE_ED1.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerDesign',FMNE_ED4.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerConstruction',FMNE_ED5.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerConstruction1',FMNE_ComB1.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerCharacteristic',FMNE_ComB2.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerForm',FMNE_ComB3.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerCategory',FMNE_ComB4.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerEstablishment',FMNE_ED6.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerExamine',FMNE_ED7.Text);
            EngineeringInfo.WriteString('EngineeringInfo','EngineerYearMonthDay',FMNE_ED8.Text+'年'+FMNE_ED9.Text+'月'+FMNE_ED10.Text+'日');
            EngineeringInfo.Free;
            ProgressBar1.Visible:=True;
            FMNE_ComD2.Enabled:=False;
            GaugeProgress;
         end;
       end;
   end;
end;
procedure TFM_NewEngineering1.FormCreate(Sender: TObject);
begin
 CheckBoxSelect:=False;
end;

procedure TFM_NewEngineering1.Copy_File(Source, Target: String);
begin
 AssignFile(FromF, Source+Target);
 Reset(FromF, 1);
 AssignFile(ToF, FMNE_Path+Target);
 Rewrite(ToF, 1);
 repeat
  BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
  BlockWrite(ToF, Buf, NumRead, NumWritten);
  ProgressBar1.Position:=ProgressBar1.Position+Numread;
 until (NumRead = 0) or (NumWritten <> NumRead);
  CloseFile(FromF);
  CloseFile(ToF);
end;

procedure TFM_NewEngineering1.GaugeProgress;
Var
 NewEngineerName:TTreeNode;
begin
 NewProjectSize:=0;
 NewProjectPath:=ExtractFilePath(Application.ExeName)+'\'+'Projectfile\';
 if FindFirst(NewProjectPath+'*.',faDirectory,FMProjectWait1) = 0 then
    begin
     repeat
      if(FMProjectWait1.Name[1]<>'.') then
         begin
          NewProjectSize:=FMProjectWait1.Size+NewProjectSize;
         end;
      until FindNext(FMProjectWait1) <> 0;
      FindClose(FMProjectWait1);
      ProgressBar1.Max:=NewProjectSize;
      ProgressBar1.Min:=0;
    end;
 if FindFirst(NewProjectPath+'*.',faDirectory,FMProjectWait1) = 0 then
    begin
     FMNE_Path:=FMNE_Path+'\'+FMNE_ED1.Text+'\';
     repeat
      if(FMProjectWait1.Name[1]<>'.') then
         begin
          Copy_File(NewProjectPath,FMProjectWait1.Name);
          if ProgressBar1.Position=ProgressBar1.Max then
             begin
              Application.MessageBox('工程已经创建完毕','真诚提醒您',MB_OK or MB_ICONINFORMATION);
              FM_Main1.TreeView1.Items.Clear;
              NewEngineerName:=FM_Main1.TreeView1.Items.Add(nil,FMNE_ED1.Text);
              FMTreeAndProject(FM_Main1.TreeView1,FMNE_Path,NewEngineerName);
              Close;
             end;
         end;
     until FindNext(FMProjectWait1) <> 0;
     FindClose(FMProjectWait1);
   end;
end;
procedure TFM_NewEngineering1.FMTreeAndProject(Tree: TTreeView;
  Directory: string; Item: TTreeNode);
var
 SearchRec: TSearchRec;
begin
 FM_Main1.TreeView1.Items.BeginUpdate;
 if Directory[length(Directory)] <> '\' then
    Directory := Directory + '\';
 if FindFirst(Directory + '*.',faDirectory,SearchRec) = 0 then
    begin
     repeat
      if SearchRec.Name[1] <> '.' then
         begin
          Tree.Items.AddChild(Item,SearchRec.Name);
         end
     until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
   end;
FM_Main1.TreeView1.Items.EndUpdate;
end;
procedure TFM_NewEngineering1.CheckBox1Click(Sender: TObject);
begin
 if CheckBox1.Checked then
    begin
     TabSheet3.TabVisible:=True;
     CheckBoxSelect:=True;
    end
 else
   begin
    TabSheet3.TabVisible:=False;
    CheckBoxSelect:=False;
   end;
end;

procedure TFM_NewEngineering1.GaugeProgress1;
Var
 NewEngineerName:TTreeNode;
begin
 NewProjectSize:=0;
 NewProjectPath:=ExtractFilePath(Application.ExeName)+'\'+'Projectfile\';
 if FindFirst(NewProjectPath+'*.',faDirectory,FMProjectWait1) = 0 then
    begin
     repeat
      if(FMProjectWait1.Name[1]<>'.') then
         begin
          NewProjectSize:=FMProjectWait1.Size+NewProjectSize;
         end;
      until FindNext(FMProjectWait1) <> 0;
      FindClose(FMProjectWait1);
      ProgressBar1.Max:=NewProjectSize;
      ProgressBar1.Min:=0;
    end;
 if FindFirst(NewProjectPath+'*.',faDirectory,FMProjectWait1) = 0 then
    begin
     FMNE_Path:=FMNE_Path+'\'+FMNE_ED1.Text+'\'+FMNE_ED11.Text+'\';
     repeat
      if(FMProjectWait1.Name[1]<>'.') then
         begin
          Copy_File(NewProjectPath,FMProjectWait1.Name);
          if ProgressBar1.Position=ProgressBar1.Max then
             begin
              Application.MessageBox('工程已经创建完毕','真诚提醒您',MB_OK or MB_ICONINFORMATION);
              FM_Main1.TreeView1.Items.Clear;
              NewEngineerName:=FM_Main1.TreeView1.Items.Add(nil,FMNE_ED11.Text);
              FMTreeAndProject1(FM_Main1.TreeView1,FMNE_Path,NewEngineerName);
              Close;
             end;
         end;
     until FindNext(FMProjectWait1) <> 0;
     FindClose(FMProjectWait1);
   end;
end;

procedure TFM_NewEngineering1.FMTreeAndProject1(Tree: TTreeView;
  Directory: string; Item: TTreeNode);
var
 SearchRec: TSearchRec;
begin
 FM_Main1.TreeView1.Items.BeginUpdate;
 if Directory[length(Directory)] <> '\' then
    Directory := Directory + '\';
 if FindFirst(Directory + '*.',faDirectory,SearchRec) = 0 then
    begin
     repeat
      if SearchRec.Name[1] <> '.' then
         begin
          Tree.Items.AddChild(Item,SearchRec.Name);
         end
     until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
   end;
FM_Main1.TreeView1.Items.EndUpdate;
end;
end.

⌨️ 快捷键说明

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