fm_newfile.pas

档案资料管理系统

unit FM_NewFile;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, Gauges, ComCtrls;
type
  TFM_NewFile1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Panel1: TPanel;
    ListBox1: TListBox;
    Label1: TLabel;
    ListBox2: TListBox;
    Label2: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Copy_File(Source:String;Target:String);
   // procedure GaugeProgress;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FM_NewFile1: TFM_NewFile1;
  FMNewFile:TSearchRec;
  NewFileSize:integer;
  NewFilePath:String;
  c:string;
  FromF, ToF: file;
  NumRead, NumWritten: Integer;
  Buf: array[1..2048] of Char;
implementation
{$R *.dfm}

procedure TFM_NewFile1.FormCreate(Sender: TObject);
var
 FMOpenFileSearch:TSearchRec;
 FMOpenFileNamePath:string;
begin
 FMOpenFileNamePath:=ExtractFilePath(Application.ExeName)+'\Otherfile\NewFile\';
 if FindFirst(FMOpenFileNamePath+'*.',faDirectory,FMOpenFileSearch) = 0 then
    begin
     repeat
      if(FMOpenFileSearch.Name[1]<>'.') then
         begin
          ListBox1.Items.Add(FMOpenFileSearch.Name);
          ListBox1.Selected[0]:=True;
          SpeedButton3.Enabled:=True;
          SpeedButton1.Enabled:=True;
         end;
      until FindNext(FMOpenFileSearch) <> 0;
      FindClose(FMOpenFileSearch);
    end;
end;

procedure TFM_NewFile1.ListBox1DblClick(Sender: TObject);
begin
 ListBox2.Items.Add(ListBox1.Items.Strings[listbox1.ItemIndex]);
 ListBox1.DeleteSelected;
 SpeedButton2.Enabled:=True;
 SpeedButton4.Enabled:=True;
 If listBox1.Items.Count=0 then
   begin
    SpeedButton1.Enabled:=False;
    SpeedButton3.Enabled:=False;
   end
end;

procedure TFM_NewFile1.SpeedButton1Click(Sender: TObject);
begin
 if ListBox1.ItemIndex<>-1 then
   begin
    ListBox2.Items.Add(ListBox1.Items.Strings[listbox1.ItemIndex]);
    ListBox1.DeleteSelected;
    SpeedButton2.Enabled:=True;
    SpeedButton4.Enabled:=True;
    If listBox1.Items.Count=0 then
      begin
       SpeedButton1.Enabled:=False;
       SpeedButton3.Enabled:=False;
      end
   end
 else
    Application.MessageBox('请在左侧选择一项','真诚提醒您',MB_OK or MB_ICONINFORMATION)
end;
procedure TFM_NewFile1.SpeedButton2Click(Sender: TObject);
begin
 if ListBox2.ItemIndex<>-1 then
   begin
    ListBox1.Items.Add(ListBox2.Items.Strings[listbox2.ItemIndex]);
    ListBox2.DeleteSelected;
    SpeedButton1.Enabled:=True;
    SpeedButton3.Enabled:=True;
    If listBox2.Items.Count=0 then
      begin
       SpeedButton2.Enabled:=False;
       SpeedButton4.Enabled:=False;
      end 
   end
 else
    Application.MessageBox('请在右侧选择一项','真诚提醒您',MB_OK or MB_ICONINFORMATION)
end;

procedure TFM_NewFile1.ListBox2DblClick(Sender: TObject);
begin
 ListBox1.Items.Add(ListBox2.Items.Strings[listbox2.ItemIndex]);
 ListBox2.DeleteSelected;
 SpeedButton1.Enabled:=True;
 SpeedButton3.Enabled:=True;
 If listBox2.Items.Count=0 then
   begin
    SpeedButton2.Enabled:=False;
    SpeedButton4.Enabled:=False;
   end;
end;
procedure TFM_NewFile1.SpeedButton3Click(Sender: TObject);
Var
 FMF_List1Count:integer;
begin
 ListBox1.Selected[0]:=true;
 for FMF_List1Count:=0 to ListBox1.Items.Count-1 do
   begin
    ListBox2.Items.Add(ListBox1.Items.Strings[listbox1.ItemIndex]);
    ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
  end;
 ListBox1.Clear;
 SpeedButton1.Enabled:=False;
 SpeedButton3.Enabled:=False;
 SpeedButton2.Enabled:=true;
 SpeedButton4.Enabled:=true;
end;
procedure TFM_NewFile1.SpeedButton4Click(Sender: TObject);
var
 FMF_List2Count:integer;
begin
 ListBox2.Selected[0]:=true;
 for FMF_List2Count:=0 to ListBox2.Items.Count-1 do
   begin
    ListBox1.Items.Add(ListBox2.Items.Strings[listbox2.ItemIndex]);
    ListBox2.ItemIndex:=ListBox2.ItemIndex+1;
  end;
 ListBox2.Clear;
 SpeedButton2.Enabled:=False;
 SpeedButton4.Enabled:=False;
 SpeedButton1.Enabled:=true;
 SpeedButton3.Enabled:=true;
end;
procedure TFM_NewFile1.BitBtn1Click(Sender: TObject);
var
 ListNameCount:integer;
 ListNameCount1:integer;
begin
 ListNameCount:=0;
 if ListBox2.Items.Count<>0 then
    begin
     ProgressBar1.Visible:= True;
     for ListNameCount1:=1 to ListBox2.Items.Count do
       begin
        ProgressBar1.Position:=0;
        Copy_File(ExtractFilePath(Application.ExeName)+'\Otherfile\NewFile\',ListBox2.Items.Strings[ListNameCount]);
        ListNameCount:=ListNameCount+1;
      end;
     Close;
    end
 else
  Application.MessageBox('必须至少有一个新建项','真诚提醒您',MB_OK or MB_ICONINFORMATION)
end;
procedure TFM_NewFile1.Copy_File(Source, Target: String);
begin
 AssignFile(FromF, Source+Target);
 Reset(FromF, 1);
 AssignFile(ToF, ExtractFilePath(Application.ExeName)+'\Otherfile\SaveFile\'+Target);
 Rewrite(ToF, 1);
 ProgressBar1.Max:= FileSize(FromF);
 ProgressBar1.Min:=0;
 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;
end.