unit1.pas

地理资源的录入程序运用了api的一些知识

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls, Menus, ShellCtrls, jpeg,
  WinSkinStore, WinSkinData;

type
  Tsltfrm = class(TForm)
    odsl: TOpenDialog;
    Button2: TButton;
    Edit2: TEdit;
    Label2: TLabel;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    SLV_1: TShellListView;
    SCB_1: TShellComboBox;
    STV_1: TShellTreeView;
    N5: TMenuItem;
    Panel6: TPanel;
    BitBtn1: TBitBtn;
    btnCancel: TBitBtn;
    PopupMenu2: TPopupMenu;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Panel7: TPanel;
    Image1: TImage;
    N3: TMenuItem;
    N4: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    procedure BitBtn1Click(Sender: TObject);
    function CopyFiles(Source:TStrings;DestDir: string): boolean;
    procedure btnCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N15Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  sltfrm: Tsltfrm;

implementation

{$R *.dfm}
uses datam,shellapi,sl_ll_unit,loc_unit, rename_Unit;



function DelDirectory(const Source:string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := PChar(source+#0);
    pTo := #0#0;
    fFlags := FOF_NOCONFIRMATION+FOF_SILENT;
  end;
  Result := (SHFileOperation(fo) = 0);
end;

function Tsltfrm.CopyFiles(Source:TStrings;DestDir: string): boolean;
var
  I:integer;
  fo:TSHFILEOPSTRUCT;
  Shandle:string;
begin

  for I:=0 to Source.Count-1 do
     begin
        Shandle:=Shandle+Source[I]+#0;
     end;
  Shandle:=Shandle+#0;
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := @Shandle[1];
    pTo :=pchar(DestDir);

    fFlags :=FOF_ALLOWUNDO;
  end;
  Result := (SHFileOperation(fo) = 0);
end;
procedure Tsltfrm.BitBtn1Click(Sender: TObject);
var imgstr1,path :string;
begin

if odsl.Execute then
 begin
    imgstr1 :=ExtractFileName(odsl.FileName);
     path := stv_1.SelectedFolder.PathName+'\';
      if FileExists(path +imgstr1 ) then
          MessageBox(handle, '文件已经存在!', '提示', mb_IconWarning + mb_Ok)
      else
       begin
          if CopyFiles(odsl.Files, pchar(path + imgstr1))=true then
            begin
             // MessageBox(handle, '文件已添加成功!', '提示', mb_IconWarning + mb_Ok);
              slv_1.Refresh;
              STV_1.Refresh(STV_1.TopItem);
             end;
      end;
  end;
end;

procedure Tsltfrm.btnCancelClick(Sender: TObject);
begin
CLOSE;
end;

procedure Tsltfrm.FormShow(Sender: TObject);
begin
self.STV_1.Root:=ExtractFilePath(ParamStr(0));
end;

procedure Tsltfrm.Button2Click(Sender: TObject);
var   sf:TShellFolder;
      hi:string;
  begin   
      if   slv_1.SelCount=0   then
      begin
      showmessage('请先选择文件夹!');
      exit;
      end
      else
      sf:=slv_1.Folders[slv_1.Selected.Index];
      hi:=edit2.Text;
      SHOWMESSage(hi);
      showmessage(sf.PathName);
      renamefile(sf.PathName,hi);
      slv_1.Refresh;
      STV_1.Refresh(STV_1.TopItem);
   end;

procedure Tsltfrm.N1Click(Sender: TObject);
begin
slllfrm.show;
end;

procedure Tsltfrm.N3Click(Sender: TObject);
begin
slv_1.ViewStyle:=vsicon;//RENAMEFRM.SHOW;
end;

procedure Tsltfrm.N2Click(Sender: TObject);
  var   
    Dir   :   String;
    SHFileOPStruct   :   TSHFileOPStruct;
    Confirm:   Word;
  begin
    Dir:=   STV_1.Path;
    //showmessage(dir);
    Confirm:=MessageDlg('你确认删除文件夹'+ Dir   +'吗？',mtWarning,[mbYes,mbNo],0);
    if   confirm   =   mrYes   then
      begin
       DelDirectory(DIR);
       SlV_1.Back;
       slv_1.Refresh;
       STV_1.Refresh(STV_1.TopItem);
      end;
  end;


procedure Tsltfrm.Button1Click(Sender: TObject);

 var s,sss, ss:string;
begin
s:=slv_1.Folders[SLV_1.ItemIndex].DisplayName;
sss:=stv_1.SelectedFolder.PathName;
showmessage(sss);

showmessage(s);
ss:=SLV_1.Folders[SLV_1.ItemIndex].PathName ;
showmessage(ss);
end;
procedure Tsltfrm.N4Click(Sender: TObject);


begin
  slv_1.ViewStyle:=vsSmallIcon;
End;
procedure Tsltfrm.N5Click(Sender: TObject);
begin
bitbtn1.Click;
end;

procedure Tsltfrm.N6Click(Sender: TObject);
begin
slllfrm.show;
end;

procedure Tsltfrm.N8Click(Sender: TObject);
begin
bitbtn1.Click;
end;


procedure Tsltfrm.N7Click(Sender: TObject);
Var T:TSHFileOpStruct;
P:String;
begin
if slv_1.SelCount=0 then
 showmessage('请选择文件')
else
begin
P:=SLV_1.Folders[SLV_1.ItemIndex].PathName;
setcurrentdir(Application.ExeName);
With T do
Begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar(P);
pTo:=nil;
fFlags:=FOF_SILENT+FOF_NOCONFIRMATION;
hNameMappings:=nil;
lpszProgressTitle:='正在删除文件夹';
fAnyOperationsAborted:=False;
End;
SHFileOperation(T);
slv_1.Refresh;
STV_1.Refresh(STV_1.TopItem);
End;
end;
 procedure Tsltfrm.N11Click(Sender: TObject);
begin
slv_1.ViewStyle:=vslist;
end;

procedure Tsltfrm.N9Click(Sender: TObject);
begin
slv_1.ViewStyle:=vsreport;
end;

procedure Tsltfrm.N13Click(Sender: TObject);
begin
 close;
end;

procedure Tsltfrm.N15Click(Sender: TObject);
begin
close;
end;

end.