fm_leadview.pas

档案资料管理系统

unit FM_LeadView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellCtrls, Menus, StdCtrls,ExtCtrls, Buttons,StrUtils, Gauges;
type
  TFM_LeadView1 = class(TForm)
    ShellListView1: TShellListView;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    N6: TMenuItem;
    BitBtn1: TBitBtn;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    N7: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Copy_File(Source: String;Target:String);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure N7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FM_LeadView1: TFM_LeadView1;
  FromF, ToF: file;
  NumRead, NumWritten: Integer;
  Buf: array[1..2048] of Char;
implementation

{$R *.dfm}

procedure TFM_LeadView1.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
 Action:=caFree;
end;

procedure TFM_LeadView1.N2Click(Sender: TObject);
begin
 ShellListView1.ViewStyle:=vsIcon;
end;

procedure TFM_LeadView1.N3Click(Sender: TObject);
begin
 ShellListView1.ViewStyle:=vsSmallIcon;
end;

procedure TFM_LeadView1.N4Click(Sender: TObject);
begin
 ShellListView1.ViewStyle:=vsList;
end;

procedure TFM_LeadView1.N5Click(Sender: TObject);
begin
 ShellListView1.ViewStyle:=vsReport;
end;

procedure TFM_LeadView1.ComboBox1Click(Sender: TObject);
begin
 if (ComboBox1.Text<>'') and (ComboBox1.Text<>'所有项目') then
    begin
     ShellListView1.Root:=ExtractFilePath(Application.ExeName)+'project\'+ComboBox1.Text+'\';
     ShellListView1.Refresh;
    end
 else
 if ComboBox1.Text='所有项目' then
    begin
     ShellListView1.Root:=ExtractFilePath(Application.ExeName)+'project\';
     ShellListView1.Refresh;
    end;
end;
procedure TFM_LeadView1.N6Click(Sender: TObject);
begin
 ShellListView1.Refresh;
end;

procedure TFM_LeadView1.BitBtn1Click(Sender: TObject);
var
 Cot:integer;
 Cot1:integer;
 Cot2:integer;
 CotName:string;
 ShellPath:string;
begin
 for COt2:=1 to Length(Shelllistview1.RootFolder.PathName) do
   begin
    ShellPath:=MidStr(Rightstr(Shelllistview1.RootFolder.PathName,Cot2),1,1);
    if ShellPath='\' then
      begin
       ShellPath:=RightStr(Shelllistview1.RootFolder.PathName,Cot2-1);
       Break;
      end;
   end;
 if Application.MessageBox(PChar('确实要向【'+ShellPath+'】添加档案吗?'),'真诚提醒您',MB_YESNO or MB_ICONQUESTION)=IDYes then
  if (OpenDialog1.Execute) and (OpenDialog1.FileName<>'') then
   begin
     ProgressBar1.Visible:=True;
     for Cot:=0 to Opendialog1.Files.Count-1 do
      for Cot1:=1 to Length(OpenDialog1.Files.Strings[Cot]) do
        begin
        CotName:=MidStr(RightStr(OpenDialog1.Files.Strings[Cot],Cot1),1,1);
        if CotName='\' then
          begin
           CotName:=RightStr(OpenDialog1.Files.Strings[Cot],Cot1-1);
           Copy_File(OpenDialog1.Files.Strings[Cot],CotName);
           Break;
          end;
        end;
     ProgressBar1.Visible:=False;
     Application.MessageBox('档案文件添加完毕','真诚提醒您',MB_OK or MB_ICONINFORMATION);
   end;
end;

procedure TFM_LeadView1.Copy_File(Source,Target: String);
begin
 ProgressBar1.Position:=0;
 AssignFile(FromF, Source);
 Reset(FromF, 1);
 AssignFile(ToF, Shelllistview1.RootFolder.PathName+'\'+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;
procedure TFM_LeadView1.FormCreate(Sender: TObject);
begin
 Height:=Screen.Height-100;
 ShellListView1.Height:=Height-150;
 BitBtn1.Top:=ShellListView1.Height+ShellListView1.Top+10;
 ProgressBar1.Top:=BitBtn1.Top+5;
end;
procedure TFM_LeadView1.FormResize(Sender: TObject);
begin
  ShellListView1.Width:=Width-10;
end;

procedure TFM_LeadView1.N7Click(Sender: TObject);
var
 Directory:String;
begin
 Directory:=Inputbox('新建档案文件夹','填写档案文件夹名称','');
 if Directory<>'' then
    CreateDirectory(PChar(Shelllistview1.RootFolder.PathName+'\'+Directory),nil);
end;

end.