www.pudn.com > IsMenu-v1.4.rar > Unit2.pas, change:2014-08-11,size:17575b


unit Unit2; 
 
interface 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Menus, Dialogs,ExtCtrls, ComCtrls, ShellCtrls, AdvGlowButton,StdCtrls,shellapi, 
  ComObj,shlobj,ActiveX,StrUtils,Registry, AdvEdit, AdvEdBtn, 
  AdvDirectoryEdit, FolderDialog, RzShellDialogs, FlatUtils, FlatCtrls, AdvOfficeButtons, 
  RzLabel, AdvReflectionLabel, EllipsLabel, AdvProgr, RzStatus, 
  CoolTrayIcon,tsForm,unit3; 
 
type 
  TForm2 = class(TForm) 
    RzButton1: TAdvGlowButton; 
    sShellListView1: TShellListView; 
    PopupMenu1: TPopupMenu; 
    N5: TMenuItem; 
    N4: TMenuItem; 
    ss1: TMenuItem; 
    N111: TMenuItem; 
    RzButton2: TAdvGlowButton; 
    RzButton3: TAdvGlowButton; 
    RzButton4: TAdvGlowButton; 
    RzButton5: TAdvGlowButton; 
    AdvGlowButton7: TAdvGlowButton; 
    FolderDialog1: TFolderDialog; 
    Button1: TButton; 
    AdvGlowButton3: TAdvGlowButton; 
    CoolTrayIcon1: TCoolTrayIcon; 
    PopupMenu2: TPopupMenu; 
    N1: TMenuItem; 
    N3: TMenuItem; 
    N2: TMenuItem; 
    N6: TMenuItem; 
    N9: TMenuItem; 
    procedure FormShow(Sender: TObject); 
    procedure RzButton1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure AdvGlowButton3Click(Sender: TObject); 
    procedure N5Click(Sender: TObject); 
    procedure N4Click(Sender: TObject); 
    procedure ss1Click(Sender: TObject); 
    procedure N111Click(Sender: TObject); 
    procedure sShellListView1MouseDown(Sender: TObject; 
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
    procedure sShellListView1DblClick(Sender: TObject); 
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean); 
    procedure RzButton2Click(Sender: TObject); 
    procedure RzButton3Click(Sender: TObject); 
    procedure RzButton4Click(Sender: TObject); 
    procedure RzButton5Click(Sender: TObject); 
    procedure FlatPanel2MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure AdvGlowButton7Click(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure CoolTrayIcon1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure N1Click(Sender: TObject); 
    procedure N2Click(Sender: TObject); 
    procedure N3Click(Sender: TObject);   //拖放过程 
    procedure wmmove(var message:TWMMove);message wm_move; 
    procedure WndProc(var nMsg:TMessage);//拦截系统消息 
    message wm_queryendsession; 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    procedure N6Click(Sender: TObject); 
    procedure N9Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
  t1:Boolean; 
  showform,showsm:Boolean; 
  nuber:Integer; 
    { Public declarations } 
  end; 
 
//打开快捷方式 
type//加在全局变量VAR前面 
  ShellLinkData = record 
    path: array[1..MAX_PATH] of Char; // 路径 
    arguments: array[1..MAX_PATH] of char; // 参数 
    // 更多自己加 
  end; 
 
 
var 
 // t1:Boolean; 
  Form2: TForm2; 
  s,n:array[1..5] of string; //数组声明 
  p,t,sm:Boolean; 
  p1:string; 
  sn:string; 
implementation 
 
 
{$R *.dfm} 
 
procedure ExeFromLink(const linkName: WideString; var sld: ShellLinkData); 
var 
  link: IShellLink; 
  storage: IPersistFile; 
  fileData: TWin32FindData; 
  widePath: WideString; 
begin 
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, 
    IShellLink, link)); 
  OleCheck(link.QueryInterface(IPersistFile, storage)); 
  widePath := linkName; 
  
  if Succeeded(storage.Load(@widepath[1], STGM_READ)) then 
    if Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) then 
    begin 
      link.GetPath(@sld.path, MAX_PATH, fileData, SLGP_UNCPRIORITY); 
      link.GetArguments(@sld.arguments, MAX_PATH); 
    end; 
  
  storage := nil; 
  link := nil; 
end; 
 
 
procedure tform2.WndProc(var nMsg:TMessage); 
begin 
   n2.Click; 
   nMsg.Result:=1; 
end; 
 
 
procedure tform2.wmmove(var message:TWMMove); 
begin 
if Assigned(Form1) then 
begin 
Form1.Left:=left-10; 
Form1.Top:=top-5; 
end; 
inherited; 
end; 
 
 
//创建快捷方式 
function AddLink(allpath,npath: string): Boolean; 
//procedure AddLink; 
var 
  tmpObject : IUnknown; 
  tmpSLink : IShellLink; 
  tmpPFile : IPersistFile; 
  PIDL : PItemIDList; 
  LinkFilename : WideString; 
  s,linkshortname:string; 
begin 
  Result:=False; 
  tmpObject := CreateComObject(CLSID_ShellLink);//创建建立快捷方式的外壳扩展 
  tmpSLink := tmpObject as IShellLink;//取得接口 
  tmpPFile := tmpObject as IPersistFile;//用来储存*.lnk文件的接口 
  tmpSLink.SetPath(pChar(allpath));//设定nFolder所在路径 
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(allpath)));//设定工作目录 
  if DirectoryExists(allpath) then   //如果是文件夹 
  linkshortname:=extractFileName(allpath) 
  else 
  begin 
 // s:=reversestring(ExtractFileName(allpath)); 
//  linkshortname:=reversestring(Copy(s,pos('.',s)+1,Length(s))); 
  linkshortname:=ExtractFileName(allpath); 
  end; 
  LinkFilename := string(npath)+'\'+linkshortname+'.lnk'; 
  tmpPFile.Save(pWChar(LinkFilename),FALSE);//保存*.lnk文件 
  Result:=True; 
end; 
 
procedure TForm2.AppMessage(var Msg: TMsg; var Handled: Boolean);     //拖放过程 
var 
nFiles, I: Integer; 
Filename: String; 
buffer:array[0..1024] of Char; 
s:string; 
begin 
inherited; 
buffer[0]:=#0; 
if (Msg.message = WM_DROPFILES) and (msg.hwnd = sShellListView1.Handle) then  //判断edit 
begin 
nFiles := DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0); 
try 
for I := 0 to nFiles - 1  do 
begin 
SetLength(Filename, 80); 
DragQueryFile(Msg.wParam, I, buffer, SizeOf(buffer)); 
Filename := buffer; 
s:=ExtractFileExt(filename); 
s:=reversestring(Filename); 
s:=reversestring(Copy(s,0,pos('.',s)-1)); //获取扩展名 
if s='lnk' then 
begin 
if p1='true' then 
begin 
CopyFile(PChar(Filename),PChar(sShellListView1.RootFolder.PathName+'\'+ Extractfilename(filename)),False); 
DeleteFile(PChar(Filename)); 
sShellListView1.Refresh; 
end 
else 
begin 
CopyFile(PChar(Filename),PChar(sShellListView1.RootFolder.PathName+'\'+ Extractfilename(filename)),False); 
sShellListView1.Refresh; 
end; 
end 
else 
begin 
if AddLink(Filename,sShellListView1.RootFolder.PathName) then                //添加快捷方式 
sShellListView1.Refresh; 
end; 
end; 
finally 
DragFinish(Msg.wParam); 
end; 
Handled := True; 
end; 
end; 
 
 
procedure TForm2.FormShow(Sender: TObject); 
begin 
Top := Screen.WorkAreaHeight - Height-2; 
Left := Screen.WorkAreaWidth - Width+2; 
Form1.Left:=left-10; 
Form1.Top:=top-5; 
if p=False then 
begin 
Form1.CheckBox6.Checked:=False; 
Form2.Close; 
end; 
TransparentColor:=True; 
TransparentColorValue:=25; 
Color:=Form2.TransparentColorValue; 
DragAcceptFiles(sShellListView1.Handle,TRUE);     //允许edit2拖拽 
Application.OnMessage := AppMessage; 
form1.Show; 
end; 
 
procedure TForm2.RzButton1Click(Sender: TObject); 
begin 
RzButton1.Font.Color:=clRed; 
RzButton2.Font.Color:=clWindowText; 
RzButton3.Font.Color:=clWindowText; 
RzButton4.Font.Color:=clWindowText; 
RzButton5.Font.Color:=clWindowText; 
sShellListView1.Root:=s[1]; 
end; 
 
procedure TForm2.FormCreate(Sender: TObject); 
var 
reg:tregistry; 
c,nu:integer; 
s3:string; 
  label 
  loop_start; 
begin 
//    SetWindowPos(Form2.Handle,HWND_TOPMOST,0,0,394,411,SWP_NOMOVE or SWP_NOSIZE); 
    showsm:=True; 
    showform:=True; 
    reg:=tregistry.create; 
    reg.rootkey:=HKEY_CURRENT_USER; 
 if reg.OpenKey('\software\ismenu',False) then    //删除老版本信息 
 begin 
  if reg.ReadString('version')='' then 
  reg.DeleteKey('\software\ismenu'); 
 end; 
// SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW); //不在任务栏出现 
 DragAcceptFiles(sShellListView1.Handle, TRUE);     //允许edit2拖拽 
 Application.OnMessage := AppMessage; 
  Application.HintPause:=0;{使文本提示盒立即出现} 
      if reg.openkey('\software\ismenu',False)then   //如果打开成功 
             begin 
              if DirectoryExists(reg.readstring('path1'))=False then 
              begin 
                ShowMessage('路径已经失效,请重新指定'); 
                goto loop_start; 
              end; 
               p:=True; 
               for c:=1 to 5 do 
               begin 
                   n[c]:=reg.readstring('name'+inttostr(c)); 
                   s[c]:=reg.readstring('path'+inttostr(c)); 
               end; 
      RzButton1.Caption:=n[1]; 
      RzButton2.Caption:=n[2]; 
      RzButton3.Caption:=n[3]; 
      RzButton4.Caption:=n[4]; 
      RzButton5.Caption:=n[5]; 
      RzButton1.Click; 
             end 
      else 
      begin 
//      ShowMessage(''); 
loop_start: 
     // if  RzSelectFolderDialog1.Execute then 
     if Form3.SelectFolderDialog(Handle, '温馨提示:首次运行请先设定快捷方式存放位置', '', s3) then 
      begin 
      p:=True; 
     // s3:=RzSelectFolderDialog1.SelectedFolder.PathName; 
      if s3='' then 
      begin 
      ShowMessage('请重新指定位置,此位置无效'); 
      p:=False; 
      goto loop_start; 
      end 
      else 
      begin 
     // if Copy(ReverseString(s3),1,1)='\' then 
      s3 := s3+'IsMenu快捷文件' 
     // else 
    //  s3 := s3+'\IsMenu快捷文件'; 
      end; 
      if ForceDirectories(s3+'\Path1')=False then  //创建文件夹 
      begin 
      ShowMessage('文件夹创建失败、请重新选择位置'); 
      p:=False; 
      goto loop_start; 
      end; 
      for nu:=2 to 5 do 
      begin 
      ForceDirectories(s3+'\Path'+inttostr(nu)); 
      end; 
      for nu:=1 to 5 do 
      begin 
      s[nu]:=s3+'\path'+inttostr(nu); 
      if reg.openkey('\software\ismenu',True)then   //如果打开成功 
      reg.WriteString('Path'+inttostr(nu),s[nu]); 
      end; 
      RzButton1.Click; 
      if reg.openkey('\software\ismenu',True)then   //如果打开成功 
      begin 
      reg.WriteString('delete','true'); 
      reg.WriteString('name1',RzButton1.Caption); 
      reg.WriteString('name2',RzButton2.Caption); 
      reg.WriteString('name3',RzButton3.Caption); 
      reg.WriteString('name4',RzButton4.Caption); 
      reg.WriteString('name5',RzButton5.Caption); 
      reg.WriteString('Path',s3); 
      reg.WriteString('version','1'); 
      reg.WriteString('showsm','2'); 
      end; 
      end 
      else 
      begin 
      p:=False; 
      end; 
      nuber:=1; 
      end; 
      if reg.openkey('\software\ismenu',False)then   //如果打开成功 
      p1:=reg.ReadString('delete'); 
           reg.closekey;     //关闭注册表 
           reg.free;           //释放内存 
{      if showsm=True then 
      N6.Caption:='显示说明◆' 
      else 
      N6.Caption:='显示说明◇'      } 
end; 
 
procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  ReleaseCapture; 
  Perform(WM_SysCommand,$f017,0) 
end; 
 
procedure TForm2.AdvGlowButton3Click(Sender: TObject); 
begin 
Form2.Close; 
end; 
 
procedure TForm2.N5Click(Sender: TObject); 
var 
 n:Integer; 
begin 
 if  sShellListView1.Selcount=0 then 
 Exit; 
for n:= 0 to sshelllistview1.Items.Count -1 do 
begin 
     if sshelllistview1.Items.Item[n].Selected then 
     begin 
     if (ShellExecute(0,nil,PChar(sshelllistview1.Folders[n].PathName),nil,nil,SW_SHOWNORMAL))<=32 then 
     begin 
     ShowMessage('打开失败'); 
     end; 
     end; 
end; 
end; 
 
procedure TForm2.N4Click(Sender: TObject); 
begin 
sShellListView1.Refresh; 
end; 
 
procedure TForm2.ss1Click(Sender: TObject); 
var 
 n:Integer; 
begin 
if  sShellListView1.Selcount=0 then  Exit; 
if  (Application.MessageBox(PChar('删除所选'+inttostr(sShellListView1.Selcount)+'项目'),'Isaac提示:',MB_YESNO + MB_ICONQUESTION) =IDYES) then 
begin 
for n:= 0 to sshelllistview1.Items.Count -1 do 
begin 
      if sshelllistview1.Items.Item[n].Selected then 
      begin 
      if DeleteFile(sshelllistview1.Folders[n].PathName)then 
      else 
      Form3.DeleteDirectory(sshelllistview1.Folders[n].PathName); 
      end; 
end; 
end; 
sShellListView1.Refresh; 
end; 
 
procedure TForm2.N111Click(Sender: TObject); 
begin 
sShellListView1.Selected.EditCaption; 
end; 
 
procedure TForm2.sShellListView1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
var 
d:TPoint; 
begin 
if ssRight in Shift then          //根据右键点击判断POPmenu 
begin 
  if sShellListView1.SelCount>0 then 
  begin 
  GetCursorPos(d); 
  N5.Enabled:=True; 
  ss1.Enabled:=True; 
  N111.Enabled:=True; 
  N9.Enabled:=True; 
  PopupMenu1.Popup(d.x,d.y); 
  end 
  else 
  begin 
  GetCursorPos(d); 
  N5.Enabled:=False; 
  ss1.Enabled:=False; 
  N111.Enabled:=False; 
  N9.Enabled:=False; 
  PopupMenu1.Popup(d.x,d.y); 
  end; 
end; 
end; 
 
procedure TForm2.sShellListView1DblClick(Sender: TObject); 
var 
 n:Integer; 
begin 
 if  sShellListView1.Selcount=0 then 
 Exit; 
for n:= 0 to sshelllistview1.Items.Count -1 do 
begin 
     if sshelllistview1.Items.Item[n].Selected then 
     begin 
     if (ShellExecute(0,nil,PChar(sshelllistview1.Folders[n].PathName),nil,nil,SW_SHOWNORMAL))<=32 then 
     begin 
     ShowMessage('打开失败'); 
     end; 
     end; 
end; 
end; 
 
procedure TForm2.RzButton2Click(Sender: TObject); 
begin 
RzButton1.Font.Color:=clWindowText; 
RzButton2.Font.Color:=clRed; 
RzButton3.Font.Color:=clWindowText; 
RzButton4.Font.Color:=clWindowText; 
RzButton5.Font.Color:=clWindowText; 
sShellListView1.Root:=s[2]; 
end; 
 
procedure TForm2.RzButton3Click(Sender: TObject); 
begin 
RzButton1.Font.Color:=clWindowText; 
RzButton2.Font.Color:=clWindowText; 
RzButton3.Font.Color:=clRed; 
RzButton4.Font.Color:=clWindowText; 
RzButton5.Font.Color:=clWindowText; 
sShellListView1.Root:=s[3]; 
end; 
 
procedure TForm2.RzButton4Click(Sender: TObject); 
begin 
RzButton1.Font.Color:=clWindowText; 
RzButton2.Font.Color:=clWindowText; 
RzButton3.Font.Color:=clWindowText; 
RzButton4.Font.Color:=clRed; 
RzButton5.Font.Color:=clWindowText; 
sShellListView1.Root:=s[4]; 
end; 
 
procedure TForm2.RzButton5Click(Sender: TObject); 
begin 
RzButton1.Font.Color:=clWindowText; 
RzButton2.Font.Color:=clWindowText; 
RzButton3.Font.Color:=clWindowText; 
RzButton4.Font.Color:=clWindowText; 
RzButton5.Font.Color:=clRed; 
sShellListView1.Root:=s[5]; 
end; 
 
procedure TForm2.FlatPanel2MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  ReleaseCapture; 
  SendMessage(form1.Handle, WM_SYSCOMMAND,SC_MOVE+HTCAPTION, 0);   //无边框移动 
end; 
 
procedure TForm2.AdvGlowButton7Click(Sender: TObject); 
begin 
  Form1.Visible:=False; 
Form2.Visible:=False; 
  Form3:=TForm3.Create(Application); 
  form3.show; 
 
end; 
 
 
procedure TForm2.Button1Click(Sender: TObject); 
var 
reg:tregistry; 
m:Integer; 
begin 
reg:=tregistry.create; 
reg.rootkey:=HKEY_CURRENT_USER; 
if reg.openkey('\software\ismenu',False)then   //如果打开成功 
p1:=reg.ReadString('delete'); 
for m:=1 to 5 do 
begin 
s[m]:=reg.ReadString('path'+inttostr(m)); 
end; 
sShellListView1.Root:=s[1]; 
end; 
 
procedure TForm2.CoolTrayIcon1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
 
if button=mbLeft then 
begin 
 if t1=True then 
 begin 
  CoolTrayIcon1.ShowMainForm; 
  //Form2.Visible:=True; 
  t1:=false; 
 end 
 else 
  SetForegroundWindow(GetLastActivePopup( Form2.Handle)); 
//  SetWindowPos(form2.Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE); 
end; 
end; 
 
procedure TForm2.N1Click(Sender: TObject); 
begin 
 if showform=True then 
 begin 
 Form2.Close; 
 t1:=True; 
 showform:=False; 
 N1.Caption:='显示'; 
 end 
 else 
 begin 
 if t1=True then 
 begin 
  CoolTrayIcon1.ShowMainForm; 
//  Form2.Show; 
  t1:=false; 
  showform:=true; 
  N1.Caption:='隐藏'; 
 end 
 end; 
end; 
 
procedure TForm2.N2Click(Sender: TObject); 
begin 
form1.CheckBox6.Checked:=False; 
Form2.Close; 
end; 
 
procedure TForm2.N3Click(Sender: TObject); 
begin 
  form2.coolTrayIcon1.ShowBalloonHint('IsMenu v1.4.1', '软件作者:Isaac' + #13 +'          QQ:236572970'+#13+ 
                            'v1.4.0 日期:2014.06.03'+ #13 +'v1.3.1 日期:2012.02.01'+ #13+'v1.0.0 日期:2010.03.05', 
                            bitInfo, 10); 
end; 
 
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
  t1:=true; 
  CanClose := (not form1.CheckBox6.Checked); 
  if not CanClose then 
  begin 
    CoolTrayIcon1.HideMainForm; 
    Form1.Hide; 
    Form2.Visible:=False; 
    CoolTrayIcon1.IconVisible := True; 
    if nuber=1 then 
    begin 
    form2.coolTrayIcon1.ShowBalloonHint('IsMenu v1.4','我在这里',bitNone,10); 
    nuber:=nuber+1; 
    end; 
  end; 
end; 
 
procedure TForm2.N6Click(Sender: TObject); 
var 
  reg:TRegistry; 
begin 
 
if showsm=false then 
begin 
N6.Caption:='帮助开'; 
sShellListView1.Visible:=True; 
//Form1.UpdateDisplay(ClientRect); 
form1.Refresh; 
showsm:=true; 
end 
else 
begin 
N6.Caption:='帮助关'; 
sShellListView1.Visible:=False; 
//Form1.UpdateDisplay(ClientRect); 
form1.Refresh; 
showsm:=false; 
 
end; 
 
end; 
 
procedure TForm2.N9Click(Sender: TObject); 
var 
 n:Integer; 
 linkData: ShellLinkData; 
begin 
 if  sShellListView1.Selcount=0 then 
 Exit; 
for n:= 0 to sshelllistview1.Items.Count -1 do 
begin 
     if sshelllistview1.Items.Item[n].Selected then 
     begin 
 
 
begin 
  ExeFromLink(sshelllistview1.Folders[n].PathName,linkData); 
  //ShowMessage(ExtractFileDir(linkData.path)); 
     if ShellExecute(0,nil,PChar('explorer.exe'),PChar('/e,'+'/select,'+linkData.path),nil,SW_SHOWNORMAL)<=32 then 
     ShowMessage('打开失败'); 
     end; 
end; 
end; 
end; 
 
end.