sel_sg.pas

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

unit sel_sg;

interface

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

type
  Tselect_sgtfrm = class(TForm)
    odsg: TOpenDialog;
    Panel1: TPanel;
    GroupBox2: TGroupBox;
    FileList: TFileListBox;
    PopupMenu1: TPopupMenu;
    sdf1: TMenuItem;
    Panel2: TPanel;
    Panel3: TPanel;
    BitBtn1: TBitBtn;
    btnCancel: TBitBtn;
    Panel4: TPanel;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    Edit1: TEdit;
    procedure btn1Click(Sender: TObject);
    function CopyFiles(Source:TStrings;DestDir: string): boolean;
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton6Click(Sender: TObject);
    procedure FileListMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure sdf1Click(Sender: TObject);
    procedure RadioButton5Enter(Sender: TObject);
    procedure RadioButton5Exit(Sender: TObject);
    procedure RadioButton2Exit(Sender: TObject);
    procedure RadioButton2Enter(Sender: TObject);
    procedure RadioButton3Enter(Sender: TObject);
    procedure RadioButton4Enter(Sender: TObject);
    procedure RadioButton1Enter(Sender: TObject);
    procedure RadioButton6Enter(Sender: TObject);
    procedure RadioButton3Exit(Sender: TObject);
    procedure RadioButton4Exit(Sender: TObject);
    procedure RadioButton1Exit(Sender: TObject);
    procedure RadioButton6Exit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  select_sgtfrm: Tselect_sgtfrm;

implementation

{$R *.dfm}
uses progress,shellapi;

function Tselect_sgtfrm.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 Tselect_sgtfrm.btn1Click(Sender: TObject);
var imgstr1,path :string;
begin

if odsg.Execute then
 begin
  if RadioButton1.Checked=true then
    begin
     imgstr1 :=ExtractFileName(odsg.FileName);
     path := ExtractFilePath(Application.ExeName);
     if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\relief_map\' + imgstr1))=true then
        MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
   end
    else
      if RadioButton2.Checked=true then
           begin
            imgstr1 :=ExtractFileName(odsg.FileName);
            path := ExtractFilePath(Application.ExeName);
            if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\tour_res_map\' + imgstr1))=true then
                  MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
           end
       else
         if RadioButton3.Checked=true then
           begin
            imgstr1 :=ExtractFileName(odsg.FileName);
            path := ExtractFilePath(Application.ExeName);
           if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\tour_res_map\' + imgstr1))=true then
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
             end
         else
           if RadioButton4.Checked=true then
            begin
             imgstr1 :=ExtractFileName(odsg.FileName);
             path := ExtractFilePath(Application.ExeName);
            if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\water_sys_map\' + imgstr1))=true then
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
           end
           else
            if RadioButton6.Checked=true then
            begin
            imgstr1 :=ExtractFileName(odsg.FileName);
            path := ExtractFilePath(Application.ExeName);
           // if FileExists(path + 'grid_pic\other_map\' +imgstr1 ) then
           // begin
           // MessageBox(handle, '文件已存在!', '提示', mb_IconWarning + mb_Ok);
          //  exit;
          //  end;
              if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\other_map\' + imgstr1))=true then
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);

             end
            else
              if RadioButton5.Checked=true then
            begin
              imgstr1 :=ExtractFileName(odsg.FileName);
              path := ExtractFilePath(Application.ExeName);
              if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\canton_map\' + imgstr1))=true then
                 MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
            end;

end;
end;
procedure Tselect_sgtfrm.FormShow(Sender: TObject);
begin

radiobutton5.Checked :=true ;
//radiobutton5.Color :=clMenuHighlight;

 FileList.PopupMenu:=PopupMenu1;
end;

procedure Tselect_sgtfrm.btnCancelClick(Sender: TObject);
begin
close;
end;

procedure Tselect_sgtfrm.BitBtn1Click(Sender: TObject);
var imgstr1,path :string;
begin

if odsg.Execute then
 begin
  if RadioButton1.Checked=true then
    begin
     imgstr1 :=ExtractFileName(odsg.FileName);
     path := ExtractFilePath(Application.ExeName);
     if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\relief_map\' + imgstr1))=true then
     begin
        MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
        filelist.Update;
     end;
   end
    else
      if RadioButton2.Checked=true then
           begin
            imgstr1 :=ExtractFileName(odsg.FileName);
            path := ExtractFilePath(Application.ExeName);
            if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\traffic_net_map\' + imgstr1))=true then
                  begin
                  MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
                  filelist.Update;
                  end;
           end
       else
         if RadioButton3.Checked=true then
           begin
            imgstr1 :=ExtractFileName(odsg.FileName);
            path := ExtractFilePath(Application.ExeName);
           if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\tour_res_map\' + imgstr1))=true then
              begin
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
               filelist.Update;end;

             end
         else
           if RadioButton4.Checked=true then
            begin
             imgstr1 :=ExtractFileName(odsg.FileName);
             path := ExtractFilePath(Application.ExeName);
            if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\water_sys_map\' + imgstr1))=true then
              begin
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
               filelist.Update;end;
           end
           else
            if RadioButton6.Checked=true then
            begin
            imgstr1 :=ExtractFileName(odsg.FileName);
            path := ExtractFilePath(Application.ExeName);
           // if FileExists(path + 'grid_pic\other_map\' +imgstr1 ) then
           // begin
           // MessageBox(handle, '文件已存在!', '提示', mb_IconWarning + mb_Ok);
          //  exit;
          //  end;
              if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\other_map\' + imgstr1))=true then
               begin
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
               filelist.Update;end;

             end
            else
              if RadioButton5.Checked=true then
            begin
              imgstr1 :=ExtractFileName(odsg.FileName);
              path := ExtractFilePath(Application.ExeName);
              if CopyFiles(odsg.Files, pchar(path + 'upload\grid_pic\canton_map\' + imgstr1))=true then
                 begin
               MessageBox(handle, '文件添加成功!', '提示', mb_IconWarning + mb_Ok);
               filelist.Update;end;
            end;

end;
end;

procedure Tselect_sgtfrm.RadioButton5Click(Sender: TObject);

begin

edit1.Text :=ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\canton_map\';
filelist.ApplyFilePath(edit1.Text);

//listbox1.Clear;
//listbox1.Items.Add(ExtractFilename(ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\relief_map\'));
end;

procedure Tselect_sgtfrm.RadioButton3Click(Sender: TObject);
begin
edit1.Text :=ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\tour_res_map\';
filelist.ApplyFilePath(edit1.Text);
//radiobutton5.Color :=clteal;
end;

procedure Tselect_sgtfrm.RadioButton2Click(Sender: TObject);
begin
//radiobutton5.Color :=clteal;
edit1.Text :=ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\traffic_net_map\';
filelist.ApplyFilePath(edit1.Text);
end;

procedure Tselect_sgtfrm.RadioButton1Click(Sender: TObject);
begin
edit1.Text :=ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\relief_map\';
//radiobutton5.Color :=clteal;
filelist.ApplyFilePath(edit1.Text);
end;

procedure Tselect_sgtfrm.RadioButton4Click(Sender: TObject);
begin
//radiobutton5.Color :=clteal;
 edit1.Text :=ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\water_sys_map\';
filelist.ApplyFilePath(edit1.Text);
end;

procedure Tselect_sgtfrm.RadioButton6Click(Sender: TObject);
begin
//radiobutton5.Color :=clteal;
edit1.Text :=ExtractFilePath(Application.ExeName)+ 'upload\grid_pic\other_map\';
filelist.ApplyFilePath(edit1.Text);
end;

procedure Tselect_sgtfrm.FileListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if(Button=mbRight)   then

FileList.ItemIndex :=  FileList.ItemHeight;
end;

procedure Tselect_sgtfrm.sdf1Click(Sender: TObject);
var
  c:integer;
  g,i:integer;
  wj:string;
begin
c:=filelist.items.count;
for i:=c-1 downto 0 do
begin
if filelist.selected[i] then
  begin
   wj:=filelist.Items.Strings[i] ;
g := application.MessageBox('您确信真的要删除吗？', '删除信息提示', MB_YESNO + MB_ICONWARNING);
  if g = 6 then
  begin
     deletefile(wj);
     filelist.items.delete(i);
     application.MessageBox('信息删除成功!!!', '删除信息提示', MB_ICONINFORMATION);
   end;
     end;
end

end;

procedure Tselect_sgtfrm.RadioButton5Enter(Sender: TObject);
begin
// radiobutton5.Color :=clMenuHighlight;
end;

procedure Tselect_sgtfrm.RadioButton5Exit(Sender: TObject);
begin
//radiobutton5.Color :=clteal;
end;

procedure Tselect_sgtfrm.RadioButton2Exit(Sender: TObject);
begin
//radiobutton2.Color :=clteal;
end;

procedure Tselect_sgtfrm.RadioButton2Enter(Sender: TObject);
begin
// radiobutton2.Color :=clMenuHighlight;
end;

procedure Tselect_sgtfrm.RadioButton3Enter(Sender: TObject);
begin
// radiobutton3.Color :=clMenuHighlight;
end;

procedure Tselect_sgtfrm.RadioButton4Enter(Sender: TObject);
begin
// radiobutton4.Color :=clMenuHighlight;
end;

procedure Tselect_sgtfrm.RadioButton1Enter(Sender: TObject);
begin
// radiobutton1.Color :=clMenuHighlight;
end;

procedure Tselect_sgtfrm.RadioButton6Enter(Sender: TObject);
begin
// radiobutton6.Color :=clMenuHighlight;
end;

procedure Tselect_sgtfrm.RadioButton3Exit(Sender: TObject);
begin
//radiobutton3.Color :=clteal;
end;

procedure Tselect_sgtfrm.RadioButton4Exit(Sender: TObject);
begin
//radiobutton4.Color :=clteal;
end;

procedure Tselect_sgtfrm.RadioButton1Exit(Sender: TObject);
begin
//radiobutton1.Color :=clteal;
end;

procedure Tselect_sgtfrm.RadioButton6Exit(Sender: TObject);
begin
//radiobutton6.Color :=clteal;
end;

end.