參加工作了就很少有時間去玩delphi了，這個適合初學者看看，大神勿噴 工具 delhpi7.0 access資料庫 原則win下有安裝office就可用 當初不太熟悉sqlite所有沒用這做資料庫。

{*****************************************************************************
* 版本資訊:
*     淺諾桌面管理工具v1.0
* 檔名稱:
*     UseShortcutKey.pas
* 內容摘要:
*     桌面快捷方式管理（分類及執行）
* 歷史記錄:
*     2013.1.28 created by xzj
* 大型修改:
*     2013.2.5 modified by xzj
*     快捷方式名稱不顯示快捷方式ID,相關功能做相應的修改，將ID存放在陣列naID中
*
* 程式為作者原創，修改請保留作者資訊，改後程序可發至作者郵箱共同參考、共同進步，
* 謝謝支援。
******************************************************************************
 
}
unit UseShortcutKey;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TntStdCtrls, jpeg, ExtCtrls, TntExtCtrls, TntForms,
  ComCtrls, TntComCtrls, ImgList, DB, ADODB, Menus, TntMenus, Buttons, RzTray,
  TntButtons, Spin, RzButton, Mask, RzEdit, RzBtnEdt, RzBmpBtn, RzCmboBx,
  RzTabs, RzTrkBar, WinSkinStore, WinSkinData;
 
const
  WM_MouseEnter = $B013;
  WM_MouseLeave = $B014;
type
  TFormUse = class(TForm)
    imglogo: TTntImage;
    lblName: TTntLabel;
    lbl1: TTntLabel;
    lbl2: TTntLabel;
    tntscrlbxType: TTntScrollBox;
    tntpmnType: TTntPopupMenu;
    tmr1: TTimer;
    con1: TADOConnection;
    qryCmd: TADOQuery;
    il1: TImageList;
    ImageTxt: TImage;
    ImageRAR: TImage;
    ImageFiles: TImage;
    ImageMDB: TImage;
    ImageXLS: TImage;
    ImageDOC: TImage;
    ImagePPT: TImage;
    Imagepsd: TImage;
    ImagePhoto: TImage;
    Imagepdf: TImage;
    ImageDPR: TImage;
    ImagePAS: TImage;
    Imagedfm: TImage;
    ImageDLL: TImage;
    ImageWZ: TImage;
    Image1: TImage;
    Image2: TImage;
    rztrycn1: TRzTrayIcon;
    tntmntmAdd: TTntMenuItem;
    tntpgcntrl1: TTntPageControl;
    pg1: TTntTabSheet;
    edtAdd: TTntEdit;
    pg2: TTntTabSheet;
    edtEdt: TTntEdit;
    tntmntmqx: TTntMenuItem;
    tntpmnPro: TTntPopupMenu;
    tntmntmEdtPro: TTntMenuItem;
    tntmntmDelPro: TTntMenuItem;
    tntmntmTail: TTntMenuItem;
    tntmntmList: TTntMenuItem;
    tntmntmdefault: TTntMenuItem;
    tntmntmN1: TTntMenuItem;
    tntmntmWc: TTntMenuItem;
    tntpmnOperbtn: TTntPopupMenu;
    tntmntmEdit: TTntMenuItem;
    tntmntmdelete: TTntMenuItem;
    lbl3: TTntLabel;
    edtnow: TTntEdit;
    lbl4: TTntLabel;
    tntmntmN2: TTntMenuItem;
    tntmntmhide: TTntMenuItem;
    N1: TTntMenuItem;
    tntmntmdelall: TTntMenuItem;
    Imagebat: TImage;
    tntmntmdelalltype: TTntMenuItem;
    tntmntmN3: TTntMenuItem;
    tntcntrlbr1: TTntControlBar;
    tntmntmSendLink: TTntMenuItem;
    tntmntmN4: TTntMenuItem;
    tntpmnPC: TTntPopupMenu;
    btnPC: TRzMenuButton;
    btn1: TRzShapeButton;
    tntpmnMN: TTntPopupMenu;
    tntmntmClose: TTntMenuItem;
    tmr2: TTimer;
    tntmntmAutoOpen: TTntMenuItem;
    tntmntmSendAll: TTntMenuItem;
    edtTime: TTntEdit;
    tmr3: TTimer;
    tmrRe: TTimer;
    edtKeyNow: TTntEdit;
    tmrsx: TTimer;
    pnl1: TPanel;
    grp1: TGroupBox;
    qrySet: TADOQuery;
    qryInit: TADOQuery;
    tntpgcntrl2: TRzPageControl;
    pg3: TRzTabSheet;
    lvPro: TTntListView;
    pg4: TRzTabSheet;
    mmo1: TTntMemo;
    pg5: TRzTabSheet;
    tntpnl1: TTntPanel;
    tntmntmN5: TTntMenuItem;
    tntmntmexit: TTntMenuItem;
    tntmntmHideZT: TTntMenuItem;
    tntmntmHideV: TTntMenuItem;
    grp2: TTntGroupBox;
    lbl5: TTntLabel;
    cbbFC: TRzColorComboBox;
    lbl6: TTntLabel;
    cbbFONTC: TRzColorComboBox;
    cbbGC: TRzColorComboBox;
    lbl7: TTntLabel;
    lbl9: TTntLabel;
    cbbEC: TRzColorComboBox;
    cbbFT: TRzComboBox;
    lbl8: TTntLabel;
    lbl11: TTntLabel;
    cbbHD: TRzComboBox;
    cbbSH: TRzComboBox;
    lbl10: TTntLabel;
    lbl12: TTntLabel;
    rztrckbr1: TRzTrackBar;
    dlgFont1: TFontDialog;
    lbl13: TTntLabel;
    btn2: TRzButtonEdit;
    skndt1: TSkinData;
    sknstr1: TSkinStore;
    
 
procedure FormCreate(Sender: TObject);
    procedure BtnTypeClick (Sender: TObject);
    procedure LoadShortcutKey(Sender : TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure edtAddKeyPress(Sender: TObject; var Key: Char);
    procedure tntmntmAddClick(Sender: TObject);
    procedure edtEdtKeyPress(Sender: TObject; var Key: Char);
    procedure Openqry(var qry1 : TADOQuery; sqltxt : string);
    procedure Execqry(var qry1 : TADOQuery; sqltxt : string);
    procedure tntmntmqxClick(Sender: TObject);
    procedure lvProDblClick(Sender: TObject);
    procedure tntmntmTailClick(Sender: TObject);
    procedure tntmntmListClick(Sender: TObject);
    procedure tntmntmdefaultClick(Sender: TObject);
    procedure tntmntmEdtProClick(Sender: TObject);
    procedure tntmntmWcClick(Sender: TObject);
    procedure LBWindowProc(var Message: TMessage);
    procedure WMDROPFILES_L(var Msg: TMessage);
    procedure tntmntmDelProClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tntmntmEditClick(Sender: TObject);
    procedure tntmntmdeleteClick(Sender: TObject);
    procedure tntmntmhideClick(Sender: TObject);
    procedure lvProMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure tntmntmdelallClick(Sender: TObject);
    procedure lvProEdited(Sender: TObject; Item: TTntListItem;
      var S: WideString);
    procedure lvProKeyPress(Sender: TObject; var Key: Char);
    procedure tntmntmdelalltypeClick(Sender: TObject);
    procedure CreateLink(programPath,programArg,LinkPath,Descr : string);
    procedure tntmntmSendLinkClick(Sender: TObject);
    procedure GetSystemPath();
    procedure MenuBtnOnClick(Sender : TObject);
    procedure btn1Click(Sender: TObject);
    procedure tntmntmCloseClick(Sender: TObject);
    //procedure tmr2Timer(Sender: TObject);
    procedure tntmntmAutoOpenClick(Sender: TObject);
    procedure tntmntmSendAllClick(Sender: TObject);
    procedure tmr3Timer(Sender: TObject);
    procedure tmrReTimer(Sender: TObject);
    procedure tmrsxTimer(Sender: TObject);
    procedure cbbFCChange(Sender: TObject);
    procedure cbbFONTCChange(Sender: TObject);
    procedure cbbGCChange(Sender: TObject);
    procedure cbbECChange(Sender: TObject);
    procedure cbbFTChange(Sender: TObject);
    procedure cbbHDChange(Sender: TObject);
    procedure cbbSHChange(Sender: TObject);
    procedure InitForm();
    procedure AddInitForm();
    procedure tntmntmexitClick(Sender: TObject);
    procedure tntmntmHideZTClick(Sender: TObject);
    procedure tntmntmHideVClick(Sender: TObject);
    procedure rztrckbr1Change(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imglogoMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure tntpnl1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure grp2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure tntpgcntrl2Change(Sender: TObject);
    procedure btn2ButtonClick(Sender: TObject);
  private
    { Private declarations }
    abtnType: array[1..50] of TRzBitBtn;  //分組按鈕
    anID : array[0..500] of Integer;
    sActiveBtn : string;                //當前活動的按鈕
    SYS_COLOR : TColor;      //窗體顏色
    FONT_COLOR : TColor;     //字型顏色
    GROUP_COLOR : TColor;    //被選中的分組字型顏色
    EDITING_COLOR : TColor;  //修改時介面顏色
    HIDE_DIRECTION : string; //窗體隱藏方向
    sTypeLoadFlag : string;  //型別載入標識（用於不重複載入）
    procedure WMMouseEnter(var Msg: TMessage); message WM_MouseEnter;
    procedure QNLoadType();
  public
    { Public declarations }
  end;

var
  FormUse: TFormUse;
  sPath: string;
  sType: string;
  hInNow : HKL;       //當前輸入法
  keyValue : string;  //按鍵查詢
  isEditing : Boolean; //是否是編輯狀態
  RWindowProc: TWndMethod;
  LWindowProc: TWndMethod;
  OldBtn : TRzBitBtn;
implementation
uses registry, shlobj, ActiveX, ComObj, ShellAPI;
{$R *.dfm}

{****************************************************************
* 過程名稱:  Openqry
* 功能描述:  資料庫查詢
* 引數說明:  TADOQuery，string
* 返 回 值:  無
* 歷史記錄:  2013.1.28 created by xzj
*****************************************************************}
procedure  TFormUse.Openqry(var qry1 : TADOQuery; sqltxt : string);
begin
  with qry1 do
  begin
    Close;
    sql.clear;
    sql.add(sqltxt);
    Open;
  end;
end;

{****************************************************************
* 過程名稱:  Execqry
* 功能描述:  資料庫操作
* 引數說明:  TADOQuery，string
* 返 回 值:  無
* 歷史記錄:  2013.1.28 created by xzj
*****************************************************************}
procedure  TFormUse.Execqry(var qry1 : TADOQuery; sqltxt : string);
begin
  with qry1 do
  begin
    Close;
    sql.clear;
    sql.add(sqltxt);
    ExecSQL;
  end;
end;

{****************************************************************
* 過程名稱:  WMMouseEnter
* 功能描述:  滑鼠碰到隱藏的窗體，窗體下拉
* 引數說明:  TMessage
* 返 回 值:  無
* 歷史記錄:  2013.1.28 created by xzj
*****************************************************************}
procedure TFormUse.WMMouseEnter(var Msg: TMessage);
var iIndex : Integer;
begin
  if (Top < 0) and (HIDE_DIRECTION = '向上隱藏') then
  begin
    //while(Top < 0) do
    //begin
    //  iIndex := 10;
    //  Top := Top + 2;
    //  while(iIndex > 0) do
    //  begin
    //    iIndex := iIndex - 1;
    //  end;
    //end;
    Top := 0;
    //為保證下拉窗體後呈現在最前面
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //將窗體推到最前
    //發現不取消效果更好
    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //然後取消窗體最前
  end
  else if (Left < 0) and (HIDE_DIRECTION = '向左隱藏') then
  begin
    Left := 0;
    //為保證下拉窗體後呈現在最前面
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //將窗體推到最前
    //發現不取消效果更好
    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //然後取消窗體最前
  end
  else if ((Left + Self.Width) > screen.Width) and (HIDE_DIRECTION = '向右隱藏') then
  begin
    Left := Screen.Width - Self.Width;
    //為保證下拉窗體後呈現在最前面
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //將窗體推到最前
    //發現不取消效果更好
    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //然後取消窗體最前
  end
  else if ((Top + Self.Height) > Screen.Height) and (HIDE_DIRECTION = '向下隱藏') then
  begin
    Top := Screen.Height - Self.Height;
    //為保證下拉窗體後呈現在最前面
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //將窗體推到最前
    //發現不取消效果更好
    SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //然後取消窗體最前
  end;
  Tmr1.Enabled := True;
end;

{****************************************************************
* 過程名稱:  GetTempDirectory
* 功能描述:  取系統臨時路徑
* 引數說明:  無
* 返 回 值:  string 路徑
* 歷史記錄:  2013.1.28 created by xzj
*****************************************************************}
function GetTempDirectory: string; 
var
  TempDir: array[0..255] of Char;
begin
  GetTempPath(255, @TempDir);
  Result := StrPas(TempDir);

end;

{****************************************************************
* 過程名稱:  QNLoadType
* 功能描述:  載入型別選擇按鈕
* 引數說明:  無
* 返 回 值:  無
* 歷史記錄:  2013.1.28 created by xzj
*****************************************************************}
procedure TFormUse.QNLoadType();
var i, j,k,nRand : Integer;
    bmpName : string;
begin
  Randomize;
  with qryCmd do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from PRO_TYPE');
    Open;
  end;
  //載入前釋放所有記憶體，防止記憶體衝突
  for k := 1 to 49 do
  begin
    if abtnType[k] <> nil then
    begin
      abtnType[k].Destroy;
      abtnType[k] := nil;
    end;
  end;

  nRand := Random(97) + 1;
  qryCmd.First;
  //預設讓第一個按鈕為‘所有程式’
  abtnType[1] := TRzBitBtn.Create(Self);
  abtnType[1].Height := 30;
  abtnType[1].Width := tntscrlbxType.Width - 5;
  abtnType[1].Top := 1;
  abtnType[1].Left := tntscrlbxType.Left;
  abtnType[1].Name := 'btn_0';
  abtnType[1].Parent := tntscrlbxType;
  abtnType[1].Caption := '所有程式';
  abtnType[1].ParentColor := True;
  abtnType[1].ParentFont := True;
  bmpName := 'emotions\' + IntToStr(nRand) + 'fixed.bmp';
  abtnType[1].Glyph.LoadFromFile(bmpName);
  abtnType[1].OnClick := BtnTypeClick;
  abtnType[1].Visible := True;
  OldBtn := abtnType[1];
  for i := 1 to qryCmd.RecordCount do
  begin
    nRand := Random(95) + 1;
    abtnType[i + 1] := TRzBitBtn.Create(Self);
    abtnType[i + 1].Height := 30;
    abtnType[i + 1].Width := tntscrlbxType.Width - 5;
    j := trunc(i / 1);
    abtnType[i + 1].Top := 1 + (abtnType[i + 1].Height + 1) * j;
    j := i mod 1;
    abtnType[i + 1].Left := abtnType[i + 1].Width * (j);
    abtnType[i + 1].Name := 'btn_' + inttostr(i + 1);
    abtnType[i + 1].Parent := tntscrlbxType;
    abtnType[i + 1].Caption := qryCmd.FieldByName('PRO_TYPE').Value;
    abtnType[i + 1].ParentColor := True;
    abtnType[i + 1].ParentFont := True;
    abtnType[i + 1].PopupMenu := tntpmnOperbtn;
    bmpName := 'emotions\' + IntToStr(nRand + 1) + 'fixed.bmp';
    abtnType[i + 1].Glyph.LoadFromFile(bmpName);
    abtnType[i + 1].OnClick := BtnTypeClick;
    abtnType[i + 1].Visible := True;
    //nNewTop := abtnType[i + 1].Top + 31;
    qryCmd.next;
  end;
  tntpgcntrl1.Visible := False;
end;

{****************************************************************
* 過程名稱:  LoadShortcutKey
* 功能描述:  載入快捷方式
* 引數說明:  Sender : TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.28 created by xzj
*****************************************************************}
procedure TFormUse.LoadShortcutKey(Sender : TObject);
var
  i : Integer;
  lListItem: TListItem;
  bmp: TBitmap;
  sFilePath: string;
begin
  qryCmd.First;
  il1.Clear;
  lvPro.Clear;

 for i := 0 to qryCmd.RecordCount - 1 do
  begin
    lListItem := lvPro.Items.Add;
    lListItem.Caption := Trim(qryCmd.fieldbyname('PRO_NAME').value);
    lListItem.ImageIndex := i;
    anID[lListItem.ImageIndex] := qryCmd.fieldbyname('ID').value;

   //讀取程式圖示
    sFilePath := qryCmd.FieldByName('PRO_PATH').Value;


    if (LowerCase(ExtractFileExt(sFilePath))) = '' then
      image1.Picture := ImageFiles.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.txt' then
      image1.Picture := ImageTxt.Picture
    else if ((LowerCase(ExtractFileExt(sFilePath))) = '.rar') or ((LowerCase(ExtractFileExt(sFilePath))) = '.zip') then
      image1.Picture := ImageRAR.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.mdb' then
      image1.Picture := ImageMDB.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.xls' then
      image1.Picture := Imagexls.Picture
    else if ((LowerCase(ExtractFileExt(sFilePath))) = '.doc')
            or ((LowerCase(ExtractFileExt(sFilePath))) = '.docx') then
      image1.Picture := Imagedoc.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.ppt' then
      image1.Picture := Imageppt.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.pdf' then
      image1.Picture := Imagepdf.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.psd' then
      image1.Picture := Imagepsd.Picture
    else if ((LowerCase(ExtractFileExt(sFilePath))) = '.jpg')
              or ((LowerCase(ExtractFileExt(sFilePath))) = '.bmp')
              or ((LowerCase(ExtractFileExt(sFilePath))) = '.jpeg')
              or ((LowerCase(ExtractFileExt(sFilePath))) = '.gif')
              or ((LowerCase(ExtractFileExt(sFilePath))) = '.cdr') then
      image1.Picture := ImagePhoto.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.dpr' then
      image1.Picture := Imagedpr.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.dfm' then
      image1.Picture := Imagedfm.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.pas' then
      image1.Picture := Imagepas.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.dll' then
      image1.Picture := Imagedll.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.bat' then
      image1.Picture := Imagebat.Picture
    else if (LowerCase(ExtractFileExt(sFilePath))) = '.exe' then
      image1.Picture.Icon.handle := ExtractIcon(hInstance, pchar(sFilePath), 0)
    else
      image1.Picture := Imagewz.Picture;

    bmp := TBitmap.Create;
    bmp.width := image1.Picture.Width;
    bmp.height := image1.Picture.Height;
    bmp.canvas.Draw(0, 0, image1.Picture.Graphic);
    bmp.SaveToFile(GetTempDirectory + 'QNsystem.bmp');
    image2.Picture.LoadFromFile(GetTempDirectory + 'QNsystem.bmp');
    il1.Add(image2.Picture.Bitmap, image2.Picture.bitmap);

    qryCmd.Next;
  end;
  qryCmd.Close;
end;

{****************************************************************
* 過程名稱:  BtnTypeClick
* 功能描述:  型別按鈕響應
* 引數說明:  Sender : TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.28 created by xzj
* 修改描述： 2013.2.3 modified by xzj
*            新增按鈕顏色改變功能，當前分組變為綠色
*            2013.2.17 modified by xzj
*            如果型別選擇與先前一樣則不重複載入快捷方式
*            2013.2.18 modified by xzj
*            修改2.17所修改的不重複載入，編輯後重新整理問題
*****************************************************************}
procedure TFormUse.BtnTypeClick(Sender : TObject);
var sqltxt : string;
begin
  keyValue := '';   //按鈕直接查詢要用的初始化
  if ActiveControl.ClassType <> TRzBitBtn then
    Exit;
  if Copy(ActiveControl.Name,1,4) <> 'btn_' then
    Exit;

  sType := TRzBitBtn(Sender).Caption;
  if (sTypeLoadFlag = sType) and (isEditing = false) then
  begin
    tntpgcntrl2.ActivePage := pg3;
    Exit;
  end;
  //按鈕顏色改變
  sTypeLoadFlag := sType;
  OldBtn.Font.Color := FONT_COLOR;
  OldBtn.ParentFont := True;
  TRzBitBtn(Sender).Font.Color := GROUP_COLOR;
  OldBtn := TRzBitBtn(Sender);

  if TRzBitBtn(Sender).Name = 'btn_0' then
  begin
    sqltxt := 'select * from PRO_LIST order by PRO_NAME';
  end
  else
  begin
    sqltxt := 'select * from PRO_LIST where PRO_TYPE = ''' + sType + ''' order by PRO_NAME';
  end;
  with qryCmd do
  begin
    Close;
    SQL.Clear;
    SQL.Add(sqltxt);
    Open;
  end;
  sActiveBtn := sType;
  edtnow.Text := sActiveBtn;
  pg3.Caption := sActiveBtn;
  LoadShortcutKey(Sender);
  tntpgcntrl2.ActivePage := pg3;
end;

{****************************************************************
* 過程名稱:  FormCreate
* 功能描述:  資料庫連線，載入分組
* 引數說明:  Sender : TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.29 created by xzj
*****************************************************************}
procedure TFormUse.FormCreate(Sender: TObject);
var
  sDir, connTmp: string;
begin
  getdir(0, sPath);
  sDir := ExtractFilePath(Application.ExeName);
  chDir(sDir); // 設定工作目錄為程式目錄。
  SetCurrentDir(sDir);
  connTmp := 'Provider=Microsoft.ACE.OLEDB.12.0;Data Source=' + sDir + '\LIST.accdb;Persist Security Info=False';

  con1.ConnectionString := connTmp;
  con1.Open;

  TOP := 0;
  LEFT := 0;
  FormUse.Width := screen.Width div 2 - 20;
  FormUse.Height := screen.Height - 32;
  tntpgcntrl2.Align := alclient;
  lvPro.Align := alclient;
  InitForm();
  QNLoadType; //載入型別按鈕
end;

{****************************************************************
* 過程名稱:  tmr1Timer
* 功能描述:  滑鼠不在軟體介面時自動隱藏介面
* 引數說明:  Sender : TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.29 created by xzj
* 修改描述:  2013.2.1 modified by xzj
*            添加發送桌面快捷方式控制
*****************************************************************}
procedure TFormUse.tmr1Timer(Sender: TObject);
var
  rc: TRECT;
  pt: TPOINT;
begin
  if isEditing = True then
  begin
    Exit;
  end;
  GetWindowRect(self.Handle, rc);         //取窗體的矩形區域
  GetCursorPos(pt);                       //取得當前滑鼠所在位置
  if (not PtInRect(rc, pt)) then          //如果滑鼠不在窗體範圍內
  begin
    if (HIDE_DIRECTION = '向上隱藏') then          //如果目前窗體正吸附在螢幕上沿，則上移隱藏窗體
    begin
      Top := 0 - Height + 2;
    end
    else if (HIDE_DIRECTION = '向下隱藏') then
    begin
      Top := Screen.Height - 2;
    end
    else if (HIDE_DIRECTION = '向左隱藏') then
    begin
      Left := 0 - Self.Width + 2;
      Top := 0;
    end
    else
    begin
      Left := Screen.Width - 2;
      Top := 0;
    end;
    Tmr1.Enabled := False;      //窗體隱藏後定時器關閉
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //將窗體推到最前
  end;
end;

{****************************************************************
* 過程名稱:  edtAddKeyPress
* 功能描述:  新增新分組，使用回車鍵按鈕事件來修改資料庫內容
* 引數說明:  Sender: TObject; var Key: Char
* 返 回 值:  無
* 歷史記錄:  2013.1.29 created by xzj
* 修改描述:  2013.2.1 modified by xzj
*            控制分組名不為空
*****************************************************************}
procedure TFormUse.edtAddKeyPress(Sender: TObject; var Key: Char);
var sqltxt : string;
begin
  if Key = #13 then
  begin
    if edtAdd.Text = '' then
    begin
      ShowMessagePos('類名不能為空',(Self.Left + 250),(Self.Top + 300));
      exit;
    end;

    sqltxt := 'select * from PRO_TYPE where PRO_TYPE = ''' + edtAdd.Text + ''' ';
    with qryCmd do
    begin
      Close;
      SQL.Clear;
      SQL.Add(sqltxt);

      Open;
    end;
    if(qryCmd.RecordCount > 0) then
    begin
      ShowMessagePos('已存在名為' + edtAdd.Text + '的類別！',(Self.Left + 250),(Self.Top + 300));
      exit;
    end;
    sqltxt := 'insert into PRO_TYPE(PRO_TYPE) values(''' + edtAdd.Text + ''') ';
    with qryCmd do
    begin
      Close;
      SQL.Clear;
      SQL.Add(sqltxt);

      ExecSQL;
    end;
    edtAdd.Text := '按回車鍵確認';
    QNLoadType;   //重新載入分組
  end;
end;

{****************************************************************
* 過程名稱:  tntmntmAddClick
* 功能描述:  新增新分組，顯示輸入框
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.29 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmAddClick(Sender: TObject);
begin
  tntpgcntrl1.visible := True;
  tntpgcntrl1.activepage := pg1;
  edtAdd.SetFocus;
end;

{****************************************************************
* 過程名稱:  edtEdtKeyPress
* 功能描述:  修改分組，使用回車鍵按鈕事件來修改資料庫內容
* 引數說明:  Sender: TObject; var Key: Char
* 返 回 值:  無
* 歷史記錄:  2013.1.29 created by xzj
*****************************************************************}
procedure TFormUse.edtEdtKeyPress(Sender: TObject; var Key: Char);
var sqltxt,sqlEdtType,sqlEdtList : string;
begin
  if sActiveBtn = '' then
  begin
    ShowMessagePos('請選中要修改的類別！',(Self.Left + 250),(Self.Top + 300));
    exit;
  end;
  sqlEdtType := 'update PRO_TYPE set PRO_TYPE = ''' + edtEdt.Text +''' where PRO_TYPE = ''' + sActiveBtn + ''' ';
  sqlEdtList := 'update PRO_LIST set PRO_TYPE = ''' + edtEdt.Text +''' where PRO_TYPE = ''' + sActiveBtn + ''' ';
  if Key = #13 then
  begin
    if edtEdt.Text = '' then
    begin
      ShowMessagePos('類名不能為空',(Self.Left + 250),(Self.Top + 300));
      exit;
    end;
    sqltxt := 'select * from PRO_TYPE where PRO_TYPE = ''' + edtEdt.Text + ''' ';
    Openqry(qrycmd,sqltxt);
    if(qryCmd.RecordCount > 0) then
    begin
      ShowMessagePos('已存在名為' + edtEdt.Text + '的類別！',(Self.Left + 250),(Self.Top + 300));
      exit;
    end
    else
    begin
      Execqry(qryCmd,sqlEdtType);
      Execqry(qrycmd,sqlEdtList);
    end;
    edtAdd.Text := '按回車鍵確認';
    QNLoadType;  //重新載入分組
  end;
end;

{****************************************************************
* 過程名稱:  tntmntmqxClick
* 功能描述:  取消操作，隱藏新增和修改的page
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.29 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmqxClick(Sender: TObject);
begin
  tntpgcntrl1.visible := False;
end;

{****************************************************************
* 過程名稱:  lvProDblClick
* 功能描述:  雙擊快捷方式執行相應的程式
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
* 修改描述:
*            2013.1.31 modified by xzj
*            處於編輯狀態不讓執行程式
*****************************************************************}
procedure TFormUse.lvProDblClick(Sender: TObject);
var sActive,sqltxt : string;
begin

  if not Assigned(lvPro.Selected) then  //沒有選中快捷方式，執行無效
  begin
    Exit;
  end
  else if isEditing = True then
  begin
    ShowMessagePos('現在處於編輯狀態，請退出編輯',(Self.Left + 250),(Self.Top + 300));
    exit;
  end
  else
  begin
    //獲取被選中的快捷方式在資料庫中對應的ID
    sActive := IntToStr(anID[lvPro.Selected.ImageIndex]);
    //查詢對應的快捷方式記錄
    sqltxt := 'select * from PRO_LIST where ID = ' + sActive + '';
    Openqry(qryCmd,sqltxt);
    //找到記錄中的快捷方式路徑，開啟.exe檔案
    ShellExecute(handle, 'open', pchar(Trim(qryCmd.FieldByName('PRO_PATH').Value)), nil, nil, SW_SHOWNORMAL);

    //執行程式後隱藏窗體
    if (HIDE_DIRECTION = '向上隱藏') then          
    begin
      Top := 0 - Height + 2;
    end
    else if (HIDE_DIRECTION = '向下隱藏') then
    begin
      Top := Screen.Height - 2;
    end
    else if (HIDE_DIRECTION = '向左隱藏') then
    begin
      Left := 0 - Self.Width + 2;
      Top := 0;
    end
    else
    begin
      Left := Screen.Width - 2;
      Top := 0;
    end;
    //窗體隱藏後定時器關閉
    Tmr1.Enabled := False;
  end;
end;

{****************************************************************
* 過程名稱:  tntmntmTailClick
* 功能描述:  修改檢視方式為‘詳情’
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmTailClick(Sender: TObject);
begin
  lvPro.ViewStyle := vsSmallIcon;
  tntmntmTail.Checked := True;
  tntmntmList.Checked := False;
  tntmntmdefault.Checked := False;
end;

{****************************************************************
* 過程名稱:  tntmntmListClick
* 功能描述:  修改檢視方式為‘列表’
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmListClick(Sender: TObject);
begin
  lvPro.ViewStyle := vsList;
  tntmntmTail.Checked := False;
  tntmntmList.Checked := True;
  tntmntmdefault.Checked := False;
end;

{****************************************************************
* 過程名稱:  tntmntmdefaultClick
* 功能描述:  修改檢視方式為‘預設’
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmdefaultClick(Sender: TObject);
begin
  lvPro.ViewStyle := vsIcon;
  tntmntmTail.Checked := False;
  tntmntmList.Checked := False;
  tntmntmdefault.Checked := True;
end;

{****************************************************************
* 過程名稱:  tntmntmEdtProClick
* 功能描述:  進入編輯狀態，做好編輯準備
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmEdtProClick(Sender: TObject);
begin
  //防止使用者多次點選編輯按鈕
  if isEditing = True then
  begin
    Exit;
  end;
  tntmntmEdtPro.Checked := True;
  //標示進入編輯狀態
  isEditing := True;
  //介面變色，提示使用者現在是編輯狀態
  lvPro.Color := EDITING_COLOR;
  if  tntmntmEdtPro.Checked = True then
  begin
    //快捷方式進入可編輯狀態
    lvPro.ReadOnly := False;
    //新增快捷方式時使用拖曳方式
    LWindowProc := lvPro.WindowProc;
    lvPro.WindowProc := LBWindowProc;
    DragAcceptFiles(lvPro.Handle, True);
    //刪除按鈕可用
    tntmntmDelPro.Enabled := True;
    //完成按鈕可用
    tntmntmWc.Enabled := True;
    //刪除所有按鈕可用
    tntmntmdelall.Enabled := True;
  end;
  if tntmntmhide.Checked = True then
    tntmntmhide.Click;
  tntmntmhide.Enabled := False;
end;

{****************************************************************
* 過程名稱:  tntmntmWcClick
* 功能描述:  編輯完成，做的與進入編輯狀態相反
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmWcClick(Sender: TObject);
begin
  lvPro.Color := SYS_COLOR;
  lvPro.ParentColor := True;
  //lvPro.ParentFont := True;
  isEditing := False;
  tntmntmEdtPro.Checked := False;
  tntmntmDelPro.Enabled := False;
  tntmntmWc.Enabled := False;
  tntmntmdelall.Enabled := False;
  lvPro.ReadOnly := True;
  tntmntmhide.Enabled := True;
  //關閉拖曳
  lvPro.WindowProc := LWindowProc;
  DragAcceptFiles(lvPro.Handle, False);
end;

{****************************************************************
* 過程名稱:  tntmntmEdtProClick
* 功能描述:  取快捷連結的目標檔案
* 引數說明:  const linkname: string
* 返 回 值:  string
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
function ExeFromLink(const linkname: string): string;
var
  link: IShellLink;
  storage: IPersistFile;
  filedata: TWin32FindData;
  buf: array[0..MAX_PATH] of Char;
  widepath: WideString;
begin
  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, link));
  OleCheck(link.QueryInterface(IPersistFile, storage));
  widepath := linkname;
  Result := '無效的快捷方式！快捷連結已失效！';
  if Succeeded(storage.Load(@widepath[1], STGM_READ)) then
    if Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) then
      if Succeeded(link.GetPath(buf, sizeof(buf), filedata, SLGP_UNCPRIORITY)) then
        Result := buf;
  storage := nil;
  link := nil;
end;

{****************************************************************
* 過程名稱:  LBWindowProc
* 功能描述:  輔助拖曳
* 引數說明:  Message: TMessage
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.LBWindowProc(var Message: TMessage);
begin
  if Message.Msg = WM_DROPFILES then
    WMDROPFILES_l(Message);
  LWindowProc(Message);
end;

{****************************************************************
* 過程名稱:  WMDROPFILES_L
* 功能描述:  新增快捷方式
* 引數說明:  Message: TMessage
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.WMDROPFILES_L(var Msg: TMessage);
var
  pcFileName: PChar;
  i, iSize, iFileCount: integer;
  v_ps: string;
  sCutPath : string;
  sCutName : string;
  sqltxt : string;
begin
  pcFileName := '';
  iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
  for i := 0 to iFileCount - 1 do
  begin
    iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
    pcFileName := StrAlloc(iSize);
    DragQueryFile(Msg.wParam, i, pcFileName, iSize);
//    if FileExists(pcFileName) then  //判斷是否存在
    v_ps := pcFileName;

    StrDispose(pcFileName);
  end;
  DragFinish(Msg.wParam);

  //Delphi取快捷方式的目標路徑
  if LowerCase(ExtractFileExt(v_ps)) = '.lnk' then //判斷是否為快捷字尾檔案
    sCutPath := ExeFromLink(v_ps)
  else
    sCutPath := LowerCase(v_ps);
  sCutName := ExtractFilename(sCutPath);
  sqltxt := 'insert into PRO_LIST(PRO_TYPE,PRO_NAME,PRO_PATH) '
          + 'values(''' + sActiveBtn + ''', ''' + copy(sCutName, 1, pos(ExtractFileExt(sCutName), sCutName) - 1) + ''', ''' + sCutPath + ''') ';
  Execqry(qryCmd,sqltxt);
  //使用滑鼠移動事件重新整理
  lvPro.Tag := 1;
end;

{****************************************************************
* 過程名稱:  tntmntmDelProClick
* 功能描述:  刪除快捷方式
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmDelProClick(Sender: TObject);
var sqltxt : string;
begin
  if not Assigned(lvPro.Selected) then
  begin
    Exit;
  end;

  sqltxt := 'delete from PRO_LIST where ID = ' + IntToStr(anID[lvPro.Selected.ImageIndex]) + ' ';
  Execqry(qryCmd,sqltxt);
  //使用滑鼠移動事件重新整理
  lvPro.Tag := 1;
end;

{****************************************************************
* 過程名稱:  FormShow
* 功能描述:  佈置進入介面初始狀態
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
* 修改描述： 2013.2.1 modified by xzj
*            如果本程式開機自啟動，則選單按鈕開機自啟動選中
*            2013.2.21 modified by xzj
*            新增隱藏項的初始化
*****************************************************************}
procedure TFormUse.FormShow(Sender: TObject);
var
  reg : TRegistry;
  isExist : Boolean;
begin
  ActiveControl := abtnType[1];
  abtnType[1].click;
  tntpgcntrl2.ActivePage := pg3;
  pg3.Caption := sActiveBtn;
  rztrycn1.Hint := '淺諾桌面管理工具v1.0';
  GetSystemPath();

  Reg := Tregistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);
  isExist := reg.ValueExists('淺諾桌面管理工具v1.0');
  if isExist = True then
  begin
    tntmntmAutoOpen.Checked := True;
  end
  else
  begin
    tntmntmAutoOpen.Checked := False;
  end;

  lblName.Font.Size := 20;
  AddInitForm();
  //skndt1.LoadFromCollection(sknstr1,4);
  //skndt1.Active := True;
end;

{****************************************************************
* 過程名稱:  tntmntmEditClick
* 功能描述:  顯示修改分組框
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmEditClick(Sender: TObject);
begin
  tntpgcntrl1.visible := True;
  pg2.Visible := True;
  tntpgcntrl1.activepage := pg2;
  pg1.Visible := False;
  edtnow.Text := sActiveBtn;
  edtEdt.SetFocus;
end;

{****************************************************************
* 過程名稱:  tntmntmdeleteClick
* 功能描述:  刪除已選中分組
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmdeleteClick(Sender: TObject);
var sqltxt : string;
begin
  if Application.MessageBox(System.Pchar('是否要刪除' + sActiveBtn + '?'), '詢問', 1 + 32) = id_OK then
  begin
    sqltxt := 'delete from PRO_TYPE where PRO_TYPE = ''' + sActiveBtn + ''' ';

    with qryCmd do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from PRO_LIST where PRO_TYPE = ''' + sActiveBtn + ''' ');
      Open;

      if IsEmpty then
      begin
        Close;
        SQL.Clear;
        SQL.Add(sqltxt);
        ExecSQL;
      end
      else
      begin
        ShowMessagePos('要刪除的類別下有程式，不可刪除！',(Self.Left + 250),(Self.Top + 300));
      end;
    end;
    QNLoadType;
    ActiveControl := abtnType[1];
    abtnType[1].Click;
    pg3.Caption := abtnType[1].Caption;
  end;
end;

{****************************************************************
* 過程名稱:  tntmntmhideClick
* 功能描述:  顯示和隱藏分組
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmhideClick(Sender: TObject);
var sqltxt : string;
begin
  if tntmntmhide.Checked = True then
  begin
    tntmntmhide.Checked := False;
    tntscrlbxType.Visible := True;
    sqltxt := 'update PRO_SET set SHOW_TYPE = True where ID = 1 ';
  end
  else
  begin
    tntmntmhide.Checked := True;
    tntscrlbxType.Visible := False;
    sqltxt := 'update PRO_SET set SHOW_TYPE = False where ID = 1 ';
  end;
  Execqry(qryCmd,sqltxt);
  if tntmntmTail.Checked = True then
  begin
    tntmntmList.Click;
    tntmntmTail.Click;
  end
  else if tntmntmList.Checked = True then
  begin
    tntmntmTail.Click;
    tntmntmList.Click;
  end
  else
  begin
    tntmntmList.Click;
    tntmntmdefault.Click;
  end;
end;

{****************************************************************
* 過程名稱:  lvProMouseMove
* 功能描述:  顯示操作幫助，修改快捷方式後重新整理
* 引數說明:  Sender: TObject; Shift: TShiftState; X,Y: Integer
* 返 回 值:  無
* 歷史記錄:  2013.1.31 created by xzj
* 修改描述:  2013.2.21 modified by xzj
*            新增滑鼠拖動窗體效果
*****************************************************************}
procedure TFormUse.lvProMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var i : Integer;
begin
  if isEditing = False then
  begin
    lvPro.Hint := '雙擊圖示可開啟檔案';
  end
  else
  begin
    lvPro.Hint := '將快捷方式拖入本框即可新增';


    //修改快捷方式後重新整理
    if(lvPro.Tag = 1) then
    begin
        for i := 1 to 49 do
        begin
          if abtnType[i] <> nil then
          begin
            if abtnType[i].Caption = sActiveBtn then
            begin
              ActiveControl := abtnType[i];
              abtnType[i].Click;
              Break;
            end;
          end;
        end;
        lvPro.Tag := 0;
    end;
    
  end;
    lvPro.ShowHint := True;
    {
  //獲取當前輸入法
  hInNow := GetKeyboardLayout(0);
  for i := 0 to Screen.Imes.Count - 1 do
  begin
    if HKL(Screen.Imes.Objects[i]) = hInNow then
    begin
      //ShowMessage(Screen.Imes.Strings[i]);
      Break;
    end;
  end;
  }
  //拖動窗體
  if (ssleft in Shift) then
  begin
    ReleaseCapture;
    Perform(WM_syscommand, $F012, 0);
  end;
end;

{****************************************************************
* 過程名稱:  tntmntmdelallClick
* 功能描述:  刪除所有的快捷方式，並初始化資料庫表
* 引數說明:  Sender: TObject
* 返 回 值:  無
* 歷史記錄:  2013.1.31 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmdelallClick(Sender: TObject);
var sqltxt : string;
begin
  if Application.MessageBox(System.Pchar('是否要刪除所有程式?'), '詢問', 1 + 32) = id_OK then
  begin
    sqltxt := 'delete from PRO_LIST';
    Execqry(qryCmd,sqltxt);
    sqltxt := 'Alter table[PRO_LIST] Alter column[I