开发一个delphi写的桌面图标管理代码
2024-05-22 06:04:29
参加工作了就很少有时间去玩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;interfaceusesWindows, 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;
constWM_MouseEnter = $B013;WM_MouseLeave = $B014;
typeTFormUse = 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;varFormUse: 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);
beginwith qry1 dobeginClose;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);
beginwith qry1 dobeginClose;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;
beginif (Top < 0) and (HIDE_DIRECTION = '向上隐藏') thenbegin//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); //然后取消窗体最前endelse if (Left < 0) and (HIDE_DIRECTION = '向左隐藏') thenbeginLeft := 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); //然后取消窗体最前endelse if ((Left + Self.Width) > screen.Width) and (HIDE_DIRECTION = '向右隐藏') thenbeginLeft := 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); //然后取消窗体最前endelse if ((Top + Self.Height) > Screen.Height) and (HIDE_DIRECTION = '向下隐藏') thenbeginTop := 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;
varTempDir: array[0..255] of Char;
beginGetTempPath(255, @TempDir);Result := StrPas(TempDir);end;{****************************************************************
* 过程名称: QNLoadType
* 功能描述: 加载类型选择按钮
* 参数说明: 无
* 返 回 值: 无
* 历史记录: 2013.1.28 created by xzj
*****************************************************************}
procedure TFormUse.QNLoadType();
var i, j,k,nRand : Integer;bmpName : string;
beginRandomize;with qryCmd dobeginClose;SQL.Clear;SQL.Add('select * from PRO_TYPE');Open;end;//加载前释放所有内存，防止内存冲突for k := 1 to 49 dobeginif abtnType[k] <> nil thenbeginabtnType[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 dobeginnRand := 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);
vari : Integer;lListItem: TListItem;bmp: TBitmap;sFilePath: string;
beginqryCmd.First;il1.Clear;lvPro.Clear;for i := 0 to qryCmd.RecordCount - 1 dobeginlListItem := 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))) = '' thenimage1.Picture := ImageFiles.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.txt' thenimage1.Picture := ImageTxt.Pictureelse if ((LowerCase(ExtractFileExt(sFilePath))) = '.rar') or ((LowerCase(ExtractFileExt(sFilePath))) = '.zip') thenimage1.Picture := ImageRAR.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.mdb' thenimage1.Picture := ImageMDB.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.xls' thenimage1.Picture := Imagexls.Pictureelse if ((LowerCase(ExtractFileExt(sFilePath))) = '.doc')or ((LowerCase(ExtractFileExt(sFilePath))) = '.docx') thenimage1.Picture := Imagedoc.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.ppt' thenimage1.Picture := Imageppt.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.pdf' thenimage1.Picture := Imagepdf.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.psd' thenimage1.Picture := Imagepsd.Pictureelse 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') thenimage1.Picture := ImagePhoto.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.dpr' thenimage1.Picture := Imagedpr.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.dfm' thenimage1.Picture := Imagedfm.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.pas' thenimage1.Picture := Imagepas.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.dll' thenimage1.Picture := Imagedll.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.bat' thenimage1.Picture := Imagebat.Pictureelse if (LowerCase(ExtractFileExt(sFilePath))) = '.exe' thenimage1.Picture.Icon.handle := ExtractIcon(hInstance, pchar(sFilePath), 0)elseimage1.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;
beginkeyValue := ''; //按钮直接查询要用的初始化if ActiveControl.ClassType <> TRzBitBtn thenExit;if Copy(ActiveControl.Name,1,4) <> 'btn_' thenExit;sType := TRzBitBtn(Sender).Caption;if (sTypeLoadFlag = sType) and (isEditing = false) thenbegintntpgcntrl2.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' thenbeginsqltxt := 'select * from PRO_LIST order by PRO_NAME';endelsebeginsqltxt := 'select * from PRO_LIST where PRO_TYPE = ''' + sType + ''' order by PRO_NAME';end;with qryCmd dobeginClose;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);
varsDir, connTmp: string;
begingetdir(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);
varrc: TRECT;pt: TPOINT;
beginif isEditing = True thenbeginExit;end;GetWindowRect(self.Handle, rc); //取窗体的矩形区域GetCursorPos(pt); //取得当前鼠标所在位置if (not PtInRect(rc, pt)) then //如果鼠标不在窗体范围内beginif (HIDE_DIRECTION = '向上隐藏') then //如果目前窗体正吸附在屏幕上沿，则上移隐藏窗体beginTop := 0 - Height + 2;endelse if (HIDE_DIRECTION = '向下隐藏') thenbeginTop := Screen.Height - 2;endelse if (HIDE_DIRECTION = '向左隐藏') thenbeginLeft := 0 - Self.Width + 2;Top := 0;endelsebeginLeft := 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;
beginif Key = #13 thenbeginif edtAdd.Text = '' thenbeginShowMessagePos('类名不能为空',(Self.Left + 250),(Self.Top + 300));exit;end;sqltxt := 'select * from PRO_TYPE where PRO_TYPE = ''' + edtAdd.Text + ''' ';with qryCmd dobeginClose;SQL.Clear;SQL.Add(sqltxt);Open;end;if(qryCmd.RecordCount > 0) thenbeginShowMessagePos('已存在名为' + edtAdd.Text + '的类别！',(Self.Left + 250),(Self.Top + 300));exit;end;sqltxt := 'insert into PRO_TYPE(PRO_TYPE) values(''' + edtAdd.Text + ''') ';with qryCmd dobeginClose;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);
begintntpgcntrl1.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;
beginif sActiveBtn = '' thenbeginShowMessagePos('请选中要修改的类别！',(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 thenbeginif edtEdt.Text = '' thenbeginShowMessagePos('类名不能为空',(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) thenbeginShowMessagePos('已存在名为' + edtEdt.Text + '的类别！',(Self.Left + 250),(Self.Top + 300));exit;endelsebeginExecqry(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);
begintntpgcntrl1.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;
beginif not Assigned(lvPro.Selected) then //没有选中快捷方式，运行无效beginExit;endelse if isEditing = True thenbeginShowMessagePos('现在处于编辑状态，请退出编辑',(Self.Left + 250),(Self.Top + 300));exit;endelsebegin//获取被选中的快捷方式在数据库中对应的IDsActive := 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 beginTop := 0 - Height + 2;endelse if (HIDE_DIRECTION = '向下隐藏') thenbeginTop := Screen.Height - 2;endelse if (HIDE_DIRECTION = '向左隐藏') thenbeginLeft := 0 - Self.Width + 2;Top := 0;endelsebeginLeft := 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);
beginlvPro.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);
beginlvPro.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);
beginlvPro.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 thenbeginExit;end;tntmntmEdtPro.Checked := True;//标示进入编辑状态isEditing := True;//界面变色，提示用户现在是编辑状态lvPro.Color := EDITING_COLOR;if tntmntmEdtPro.Checked = True thenbegin//快捷方式进入可编辑状态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 thentntmntmhide.Click;tntmntmhide.Enabled := False;
end;{****************************************************************
* 过程名称: tntmntmWcClick
* 功能描述: 编辑完成，做的与进入编辑状态相反
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmWcClick(Sender: TObject);
beginlvPro.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;
varlink: IShellLink;storage: IPersistFile;filedata: TWin32FindData;buf: array[0..MAX_PATH] of Char;widepath: WideString;
beginOleCheck(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)) thenif Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) thenif Succeeded(link.GetPath(buf, sizeof(buf), filedata, SLGP_UNCPRIORITY)) thenResult := buf;storage := nil;link := nil;
end;{****************************************************************
* 过程名称: LBWindowProc
* 功能描述: 辅助拖曳
* 参数说明: Message: TMessage
* 返 回 值: 无
* 历史记录: 2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.LBWindowProc(var Message: TMessage);
beginif Message.Msg = WM_DROPFILES thenWMDROPFILES_l(Message);LWindowProc(Message);
end;{****************************************************************
* 过程名称: WMDROPFILES_L
* 功能描述: 添加快捷方式
* 参数说明: Message: TMessage
* 返 回 值: 无
* 历史记录: 2013.1.30 created by xzj
*****************************************************************}
procedure TFormUse.WMDROPFILES_L(var Msg: TMessage);
varpcFileName: PChar;i, iSize, iFileCount: integer;v_ps: string;sCutPath : string;sCutName : string;sqltxt : string;
beginpcFileName := '';iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);for i := 0 to iFileCount - 1 dobeginiSize := 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)elsesCutPath := 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;
beginif not Assigned(lvPro.Selected) thenbeginExit;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);
varreg : TRegistry;isExist : Boolean;
beginActiveControl := 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 thenbegintntmntmAutoOpen.Checked := True;endelsebegintntmntmAutoOpen.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);
begintntpgcntrl1.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;
beginif Application.MessageBox(System.Pchar('是否要删除' + sActiveBtn + '?'), '询问', 1 + 32) = id_OK thenbeginsqltxt := 'delete from PRO_TYPE where PRO_TYPE = ''' + sActiveBtn + ''' ';with qryCmd dobeginClose;SQL.Clear;SQL.Add('select * from PRO_LIST where PRO_TYPE = ''' + sActiveBtn + ''' ');Open;if IsEmpty thenbeginClose;SQL.Clear;SQL.Add(sqltxt);ExecSQL;endelsebeginShowMessagePos('要删除的类别下有程序，不可删除！',(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;
beginif tntmntmhide.Checked = True thenbegintntmntmhide.Checked := False;tntscrlbxType.Visible := True;sqltxt := 'update PRO_SET set SHOW_TYPE = True where ID = 1 ';endelsebegintntmntmhide.Checked := True;tntscrlbxType.Visible := False;sqltxt := 'update PRO_SET set SHOW_TYPE = False where ID = 1 ';end;Execqry(qryCmd,sqltxt);if tntmntmTail.Checked = True thenbegintntmntmList.Click;tntmntmTail.Click;endelse if tntmntmList.Checked = True thenbegintntmntmTail.Click;tntmntmList.Click;endelsebegintntmntmList.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;
beginif isEditing = False thenbeginlvPro.Hint := '双击图标可打开文件';endelsebeginlvPro.Hint := '将快捷方式拖入本框即可添加';//修改快捷方式后刷新if(lvPro.Tag = 1) thenbeginfor i := 1 to 49 dobeginif abtnType[i] <> nil thenbeginif abtnType[i].Caption = sActiveBtn thenbeginActiveControl := 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 dobeginif HKL(Screen.Imes.Objects[i]) = hInNow thenbegin//ShowMessage(Screen.Imes.Strings[i]);Break;end;end;}//拖动窗体if (ssleft in Shift) thenbeginReleaseCapture;Perform(WM_syscommand, $F012, 0);end;
end;{****************************************************************
* 过程名称: tntmntmdelallClick
* 功能描述: 删除所有的快捷方式，并初始化数据库表
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.1.31 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmdelallClick(Sender: TObject);
var sqltxt : string;
beginif Application.MessageBox(System.Pchar('是否要删除所有程序?'), '询问', 1 + 32) = id_OK thenbeginsqltxt := 'delete from PRO_LIST';Execqry(qryCmd,sqltxt);sqltxt := 'Alter table[PRO_LIST] Alter column[ID] counter(1,1) ';Execqry(qryCmd,sqltxt);lvPro.Clear;end;
end;{****************************************************************
* 过程名称: tntmntmdelalltypeClick
* 功能描述: 删除所有的分组，并初始化数据库表
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.1.31 created by xzj
*****************************************************************}
procedure TFormUse.tntmntmdelalltypeClick(Sender: TObject);
var sqltxt : string;
beginif Application.MessageBox(System.Pchar('是否要删除所有分组?'), '询问', 1 + 32) = id_OK thenbeginsqltxt := 'select * from PRO_LIST';Openqry(qryCmd, sqltxt);if qryCmd.IsEmpty thenbeginsqltxt := 'delete from PRO_TYPE';Execqry(qryCmd,sqltxt);sqltxt := 'Alter table[PRO_TYPE] Alter column[ID] counter(1,1) ';Execqry(qryCmd,sqltxt);lvPro.Clear;endelsebeginShowMessagePos('还有快捷方式，不可做‘删除所有’操作',(Self.Left + 250),(Self.Top + 300));end;end;QNLoadType;ActiveControl := abtnType[1];abtnType[1].Click;pg3.Caption := abtnType[1].Caption;
end;{****************************************************************
* 过程名称: lvProEdited
* 功能描述: 修改快捷方式名称
* 参数说明: Sender: TObject; Item: TTntListItem;var S: WideString
* 其中S就是修改后的名称
* 返 回 值: 无
* 历史记录: 2013.1.31 created by xzj
*****************************************************************}
procedure TFormUse.lvProEdited(Sender: TObject; Item: TTntListItem;var S: WideString);var sActiveID,sqltxt : string;
begin//lvPro.Tag := 1;sActiveID := IntToStr(anID[lvPro.Selected.ImageIndex]);sqltxt := 'update PRO_LIST set PRO_NAME = ''' + S + ''' where ID = ' + sActiveID + ' ';Execqry(qryCmd,sqltxt);
end;{****************************************************************
* 过程名称: Get_HZPY_First
* 功能描述: 获取汉字拼音首字母
* 参数说明: hz : string
* 返 回 值: Char
* 历史记录: 2013.1.31 created by xzj
*****************************************************************}
function Get_HZPY_First(hz : string) : Char;
begincase WORD(hz[1])shl 8 + WORD(hz[2]) of$B0A1..$B0C4 : Result := 'a';$B0C5..$B2C0 : Result := 'b';$B2C1..$B4ED : Result := 'c';$B4EE..$B6E9 : Result := 'd';$B6EA..$B7A1 : Result := 'e';$B7A2..$B8C0 : Result := 'f';$B8C1..$B9FD : Result := 'g';$B9FE..$BBF6 : Result := 'h';$BBF7..$BFA5 : Result := 'j';$BFA6..$C0AB : Result := 'k';$C0AC..$C2E7 : Result := 'l';$C2E8..$C4C2 : Result := 'm';$C4C3..$C5B5 : Result := 'n';$C5B6..$C5BD : Result := 'o';$C5BE..$C6D9 : Result := 'p';$C6DA..$C8BA : Result := 'q';$C8BB..$C8F5 : Result := 'r';$C8F6..$CBF9 : Result := 's';$CBFA..$CDD9 : Result := 't';$CDDA..$CEF3 : Result := 'w';$CEF4..$D1B8 : Result := 'x';$D1B9..$D4D0 : Result := 'y';$D4D1..$D7F9 : Result := 'z';else//传入的为数字或字母则原样返回Result := hz[1];end;
end;{****************************************************************
* 过程名称: lvProKeyPress
* 功能描述: 按键之间查找
* 参数说明: Sender: TObject; var Key: Char
* 返 回 值: 无
* 历史记录: 2013.1.31 created by xzj
*****************************************************************}
procedure TFormUse.lvProKeyPress(Sender: TObject; var Key: Char);
var sActiveName,sSelect : string;i,j : Integer;nIsReg : Boolean; //对比是否相等
beginif isEditing = True thenbeginExit;end;nIsReg := False;keyValue := keyValue + Key;//回车键运行程序if Key = #13 thenbeginlvProDblClick(Sender);endelsebegintmrRe.Enabled := True; //打开计时器for i := 0 to lvPro.Items.Count - 1 dobeginfor j := 0 to Length(lvPro.Items.Item[i].Caption) dobeginsActiveName := Copy(lvPro.Items.Item[i].Caption,j + 1,1);if(sActiveName = '') thenbeginBreak;end;sSelect := sSelect + LowerCase(Get_HZPY_First(sActiveName));if(sSelect = keyValue) thenbeginnIsReg := True;lvPro.Items.Item[i].Selected := True;Break;end;//长度超出所输入的字母，直接退出循环，优化if(Length(sSelect) > Length(keyValue)) thenbeginBreak;end;end;if(sSelect <> KeyValue) thenbeginsSelect := '';end;if nIsReg thenbeginbreak;end;end;end;if nIsReg = False thenbeginkeyValue := '';end;
end;{****************************************************************
* 过程名称: CreateLink
* 功能描述: 创建桌面快捷方式
* 参数说明: programPath：目标文件全路径 programArg：目标文件参数
* LinkPath：快捷方式全路径 Descr:快捷方式描述
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.CreateLink(programPath,programArg,LinkPath,Descr : string);
varAnObj : IUnknown;ShellLink : IShellLink;AFile : IPersistFile;FileName : WideString;
beginif UpperCase(ExtractFileExt(LinkPath)) <> '.LNK' thenbeginraise Exception.Create('快捷方式无效！');end;tryOleInitialize(nil);AnObj := CreateComObject(CLSID_ShellLink);ShellLink := AnObj as IShellLink;AFile := AnObj as IPersistFile;ShellLink.SetPath(PChar(programPath));ShellLink.SetArguments(PChar(programArg));ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(programPath)));ShellLink.SetDescription(PChar(Descr));FileName := LinkPath;AFile.Save(PWChar(FileName),True);finallyOleUninitialize;end;
end;{****************************************************************
* 过程名称: tntmntmSendLinkClick
* 功能描述: 发送桌面快捷方式响应
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.tntmntmSendLinkClick(Sender: TObject);
vartmp : array[0..MAX_PATH] of Char;pitem : PITEMIDLIST;DeskDir : string;sSelectID : string;sqltxt : string;
begin//获取桌面路径SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,pitem);SHGetPathFromIDList(pitem,tmp);DeskDir := string(tmp);if Length(DeskDir) > 3 thenbeginDeskDir := DeskDir + '\';end;if not Assigned(lvPro.Selected) thenbeginCreateLink(ParamStr(0),'',DeskDir + Application.Title + '.lnk','');endelsebegin//获取当前获焦的快捷方式IDsSelectID := IntToStr(anID[lvPro.Selected.ImageIndex]);//获取当前获焦的快捷方式名称sqltxt := 'select * from PRO_LIST where ID = ' + sSelectID + ' ';Openqry(qryCmd, sqltxt);//发送桌面快捷方式CreateLink(qryCmd.fieldbyname('PRO_PATH').AsString,'',DeskDir + lvPro.Selected.Caption + '.lnk','');end;
end;{****************************************************************
* 过程名称: tntmntmSendAllClick
* 功能描述: 发送当前分组下的所有桌面快捷方式到桌面
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.2 created by xzj
****************************************************************}
procedure TFormUse.tntmntmSendAllClick(Sender: TObject);
vartmp : array[0..MAX_PATH] of Char;pitem : PITEMIDLIST;DeskDir : string;sqltxt : string;i : Integer;
begin//获取桌面路径SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,pitem);SHGetPathFromIDList(pitem,tmp);DeskDir := string(tmp);if Length(DeskDir) > 3 thenbeginDeskDir := DeskDir + '\';end;if sActiveBtn = '所有程序' thenbeginsqltxt := 'select * from PRO_LIST order by ID';endelsebeginsqltxt := 'select * from PRO_LIST where PRO_TYPE = ''' + sActiveBtn + ''' order by ID ';end;Openqry(qryCmd,sqltxt);qryCmd.First;for i := 0 to qryCmd.RecordCount - 1 dobegin//发送桌面快捷方式CreateLink(qryCmd.fieldbyname('PRO_PATH').AsString,'',DeskDir + qryCmd.fieldbyname('PRO_NAME').AsString + '.lnk','');qryCmd.Next;end;
end;{****************************************************************
* 过程名称: GetSystemPath
* 功能描述: 加载系统盘符
* 参数说明: 无
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.GetSystemPath();
vari : Integer;nRand : Integer;newMenu : TMenuItem;str : string;nRes : Integer;
beginRandomize;for i := 65 to 90 dobeginnRes := GetDriveType(PChar(Chr(i) + ':\'));if(nRes = 2) or (nRes = 3) thenbeginnRand := Random(97) + 1;str := Char(i);newMenu := TMenuItem.Create(self);newMenu.Caption := str + '盘';newMenu.Bitmap.LoadFromFile('emotions\' + IntToStr(nRand) + 'fixed.bmp');newMenu.Name := str;newMenu.OnClick := MenuBtnOnClick;tntpmnPC.Items.Add(newMenu);end;end;
end;{****************************************************************
* 过程名称: MenuBtnOnClick
* 功能描述: 盘符按钮响应事件
* 参数说明: 无
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.MenuBtnOnClick(Sender : TObject);
varnClickBtn : string;
beginnClickBtn := TMenuItem(Sender).Caption;nClickBtn := Copy(nClickBtn,1,1);nClickBtn := nClickBtn + ':\';//打开指定路径ShellExecute(handle, 'open', pchar(nClickBtn), nil, nil, SW_SHOWNORMAL);//运行程序后隐藏窗体if (HIDE_DIRECTION = '向上隐藏') then beginTop := 0 - Height + 2;endelse if (HIDE_DIRECTION = '向下隐藏') thenbeginTop := Screen.Height - 2;endelse if (HIDE_DIRECTION = '向左隐藏') thenbeginLeft := 0 - Self.Width + 2;Top := 0;endelsebeginLeft := Screen.Width - 2;Top := 0;end;//窗体隐藏后定时器关闭Tmr1.Enabled := False;
end;{****************************************************************
* 过程名称: btn1Click
* 功能描述: 关闭计算机
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.btn1Click(Sender: TObject);
beginif Application.MessageBox(System.Pchar('关闭计算机?'), '询问', 1 + 32) = id_OK thenbeginShellExecute(Handle,'open','shutdown.exe','-f -s -t 0', nil, SW_HIDE);end;
end;{****************************************************************
* 过程名称: tntmntmCloseClick
* 功能描述: 关闭程序
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.tntmntmCloseClick(Sender: TObject);
beginclose;
end;{****************************************************************
* 过程名称: tmr2Timer
* 功能描述: 标签变色，美化界面
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
{
procedure TFormUse.tmr2Timer(Sender: TObject);
varsColor : array[1..10] of Tcolor;i : Integer;
beginRandomize;sColor[1] := clYellow;sColor[2] := clLime;sColor[3] := clPurple;sColor[4] := clMaroon;sColor[5] := clGreen;sColor[6] := clAqua;sColor[7] := clWhite;sColor[8] := clBlue;sColor[9] := clInactiveCaption;sColor[10] := clRed;i := Random(10) + 1;lblName.Font.Color := sColor[i];i := Random(10) + 1;lbl1.Font.Color := sColor[i];btn1.Font.Color := sColor[i];i := Random(10) + 1;lbl2.Font.Color := sColor[i];btnPC.Font.Color := sColor[i];//i := Random(10) + 1;//if (i = 7) or (sActiveBtn = '所有程序') then// Exit;//lvPro.Font.Color := clRed;//tntscrlbxType.Font.Color := clRed;end;
}
{****************************************************************
* 过程名称: tntmntmAutoOpenClick
* 功能描述: 开机自启动
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.1 created by xzj
****************************************************************}
procedure TFormUse.tntmntmAutoOpenClick(Sender: TObject);
varreg: tregistry;
begin
//把程序写入到注册表的启动中if not tntmntmAutoOpen.Checked thenbeginReg := Tregistry.Create;Reg.RootKey := HKEY_LOCAL_MACHINE;tryreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);Reg.WriteString('浅诺桌面管理工具v1.0', ExtractFilePath(Application.ExeName) + 'QnDeskMng.exe');tntmntmAutoOpen.Checked := True;finallyReg.closekey;reg.Free;end;endelsebeginReg := Tregistry.Create;Reg.RootKey := HKEY_LOCAL_MACHINE;tryreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True);Reg.DeleteValue('浅诺桌面管理工具v1.0');tntmntmAutoOpen.Checked := False;finallyReg.closekey;reg.Free;end;end;
end;{****************************************************************
* 过程名称: tmr3Timer
* 功能描述: 显示当前时间
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.2 created by xzj
****************************************************************}
procedure TFormUse.tmr3Timer(Sender: TObject);
beginedtTime.Text := FormatDateTime('yyyy年mm月dd日hh时nn分ss秒',Now());
end;{****************************************************************
* 过程名称: tmrReTimer
* 功能描述: 刷新当前键值
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.2 created by xzj （解决按键查询的键值更新问题）
****************************************************************}
procedure TFormUse.tmrReTimer(Sender: TObject);
beginkeyValue := '';//关闭计时器tmrRe.Enabled := False;
end;{****************************************************************
* 过程名称: tmrsxTimer
* 功能描述: 不显示任务栏图标，没有选中快捷方式不让发送桌面快捷方式
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.2 created by xzj
* 修改记录: 2013.2.17 modified by xzj
* 窗体在隐藏状态时将窗体推到最前
****************************************************************}
procedure TFormUse.tmrsxTimer(Sender: TObject);
begin//程序不显示任务栏ShowWindow(Application.Handle,SW_HIDE);//没有选中快捷方式不让发送桌面快捷方式if not Assigned(lvPro.Selected) thenbegintntmntmSendLink.Enabled := False;endelsebegintntmntmSendLink.Enabled := True;end;//显示当前选中的快捷方式if Assigned(lvPro.Selected) thenedtKeyNow.Text := lvPro.Selected.CaptionelseedtKeyNow.Text := '无';//窗体在隐藏状态时将窗体推到最前if(Top = 0 - Height + 2) or ( Top = Screen.Height - 2) or (Left = 0 - Self.Width + 2) or (Left = Screen.Width - 2) thenSetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); //将窗体推到最前
end;{****************************************************************
* 过程名称: cbbFCChange
* 功能描述: 修改窗体颜色
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbFCChange(Sender: TObject);
varsqltxt : string;
beginsqltxt := 'update PRO_SET set FORM_COLOR = ''' + ColorToString(cbbFC.SelectedColor) + ''' where ID = 1 ';Execqry(qrySet,sqltxt);Self.Color := cbbFC.SelectedColor;SYS_COLOR := cbbFC.SelectedColor;
end;{****************************************************************
* 过程名称: cbbFONTCChange
* 功能描述: 修改字体颜色
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbFONTCChange(Sender: TObject);
varsqltxt : string;
beginsqltxt := 'update PRO_SET set FONT_COLOR = ''' + ColorToString(cbbFONTC.SelectedColor) + ''' where ID = 1 ';Execqry(qrySet,sqltxt);Self.Font.Color := cbbFONTC.SelectedColor;FONT_COLOR := cbbFONTC.SelectedColor;lblName.ParentFont := True;lblName.Font.Size := 20;
end;{****************************************************************
* 过程名称: cbbGCChange
* 功能描述: 修改选中分组字体的颜色
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbGCChange(Sender: TObject);
varsqltxt : string;
beginsqltxt := 'update PRO_SET set GROUP_COLOR = ''' + ColorToString(cbbGC.SelectedColor) + ''' where ID = 1 ';Execqry(qrySet,sqltxt);GROUP_COLOR := cbbGC.SelectedColor;
end;{****************************************************************
* 过程名称: cbbECChange
* 功能描述: 修改编辑状态时区域的颜色
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbECChange(Sender: TObject);
varsqltxt : string;
beginsqltxt := 'update PRO_SET set EDITING_COLOR = ''' + ColorToString(cbbEC.SelectedColor) + ''' where ID = 1 ';Execqry(qrySet,sqltxt);EDITING_COLOR := cbbEC.SelectedColor;
end;{****************************************************************
* 过程名称: cbbFTChange
* 功能描述: 修改窗体类型
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbFTChange(Sender: TObject);
var//sFormStyle : string;sqltxt : string;
beginsqltxt := 'update PRO_SET set FORM_STYLE = ''' + cbbFT.Text + ''' where ID = 1 ';Execqry(qrySet,sqltxt);ShowMessagePos('重启后有效！',(Self.Left + 250),(Self.Top + 300));{sFormStyle := cbbFT.Text;if sFormStyle = 'bsNone' thenSelf.BorderStyle := bsNoneelse if sFormStyle = 'bsDialog' thenSelf.BorderStyle := bsDialogelse if sFormStyle = 'bsSingle' thenSelf.BorderStyle := bsSingleelse if sFormStyle = 'bsSizeable' thenSelf.BorderStyle := bsSizeableelse if sFormStyle = 'bsSizeToolWin' thenSelf.BorderStyle := bsSizeToolWinelseSelf.BorderStyle := bsToolWindow;}
end;{****************************************************************
* 过程名称: cbbHDChange
* 功能描述: 修改窗体隐藏方向
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbHDChange(Sender: TObject);
varsqltxt : string;
beginsqltxt := 'update PRO_SET set HIDE_DIRECTION = ''' + cbbHD.Text + ''' where ID = 1 ';Execqry(qrySet,sqltxt);HIDE_DIRECTION := cbbHD.Text;
end;{****************************************************************
* 过程名称: cbbSHChange
* 功能描述: 设置是否显示帮助
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.cbbSHChange(Sender: TObject);
varsqltxt : string;
beginif Trim(cbbSH.Text) = '是' thenbeginsqltxt := 'update PRO_SET set SHOW_HELP = true where ID = 1 ';pg4.TabVisible := True;endelsebeginsqltxt := 'update PRO_SET set SHOW_HELP = False where ID = 1 ';pg4.TabVisible := False;end;Execqry(qrySet,sqltxt);
end;{****************************************************************
* 过程名称: InitForm
* 功能描述: 初始化窗体
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.6 created by xzj
****************************************************************}
procedure TFormUse.InitForm();
varsFormStyle : string;
beginOpenqry(qryInit,'select * from PRO_SET where ID = 1');SYS_COLOR := StringToColor(qryInit.fieldbyname('FORM_COLOR').AsString);self.Color := SYS_COLOR;FONT_COLOR := StringToColor(qryInit.fieldbyname('FONT_COLOR').AsString);Self.Font.Color := FONT_COLOR;EDITING_COLOR := StringToColor(qryInit.fieldbyname('EDITING_COLOR').AsString);GROUP_COLOR := StringToColor(qryInit.fieldbyname('GROUP_COLOR').AsString);if(qryInit.fieldbyname('SHOW_HELP').AsString = 'True') thenbeginpg4.TabVisible := True;cbbSH.Value := '是';endelsebeginpg4.TabVisible := False;cbbSH.Value := '否';end;sFormStyle := qryInit.fieldbyname('FORM_STYLE').AsString;if sFormStyle = 'bsNone' thenSelf.BorderStyle := bsNoneelse if sFormStyle = 'bsDialog' thenSelf.BorderStyle := bsDialogelse if sFormStyle = 'bsSingle' thenSelf.BorderStyle := bsSingleelse if sFormStyle = 'bsSizeable' thenSelf.BorderStyle := bsSizeableelse if sFormStyle = 'bsSizeToolWin' thenSelf.BorderStyle := bsSizeToolWinelseSelf.BorderStyle := bsToolWindow;HIDE_DIRECTION := qryInit.fieldbyname('HIDE_DIRECTION').AsString;cbbFC.SelectedColor := SYS_COLOR;cbbFONTC.SelectedColor := FONT_COLOR;cbbGC.SelectedColor := GROUP_COLOR;cbbEC.SelectedColor := EDITING_COLOR;cbbFT.Value := sFormStyle;cbbHD.Value := HIDE_DIRECTION;
end;{****************************************************************
* 过程名称: tntmntmexitClick
* 功能描述: 退出窗体
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.18 created by xzj
****************************************************************}
procedure TFormUse.tntmntmexitClick(Sender: TObject);
beginclose;
end;{****************************************************************
* 过程名称: tntmntmHideZTClick
* 功能描述: 隐藏状态栏
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.tntmntmHideZTClick(Sender: TObject);
var sqltxt : string;
beginif tntmntmHideZT.Checked = True thenbegintntmntmHideZT.Checked := False;tntcntrlbr1.Visible := True;sqltxt := 'update PRO_SET set SHOW_TOOL = True where ID = 1 ';endelsebegintntmntmHideZT.Checked := True;tntcntrlbr1.Visible := False;sqltxt := 'update PRO_SET set SHOW_TOOL = False where ID = 1 ';end;Execqry(qryCmd,sqltxt);if tntmntmTail.Checked = True thenbegintntmntmList.Click;tntmntmTail.Click;endelse if tntmntmList.Checked = True thenbegintntmntmTail.Click;tntmntmList.Click;endelsebegintntmntmList.Click;tntmntmdefault.Click;end;
end;{****************************************************************
* 过程名称: tntmntmHideZTClick
* 功能描述: 隐藏版本信息
* 参数说明: Sender: TObject
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.tntmntmHideVClick(Sender: TObject);
var sqltxt : string;
beginif tntmntmHideV.Checked = True thenbegintntmntmHideV.Checked := False;imglogo.Visible := True;grp1.Visible := True;sqltxt := 'update PRO_SET set SHOW_LOGO = True where ID = 1 ';endelsebegintntmntmHideV.Checked := True;imglogo.Visible := False;grp1.Visible := False;sqltxt := 'update PRO_SET set SHOW_LOGO = False where ID = 1 ';end;Execqry(qryCmd,sqltxt);if tntmntmTail.Checked = True thenbegintntmntmList.Click;tntmntmTail.Click;endelse if tntmntmList.Checked = True thenbegintntmntmTail.Click;tntmntmList.Click;endelsebegintntmntmList.Click;tntmntmdefault.Click;end;
end;{****************************************************************
* 过程名称: AddInitForm
* 功能描述: 版本信息、分组、状态栏的隐藏状况初始化
* 参数说明: 无
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.AddInitForm();
beginif(qryInit.FieldByName('SHOW_TYPE').AsString = 'True') thenbegintntscrlbxType.Visible := True;tntmntmhide.Checked := False;endelsebegintntscrlbxType.Visible := False;tntmntmhide.Checked := True;end;if(qryInit.FieldByName('SHOW_TOOL').AsString = 'True') thenbegintntcntrlbr1.Visible := True;tntmntmHideZT.Checked := False;endelsebegintntcntrlbr1.Visible := False;tntmntmHideZT.Checked := True;end;if(qryInit.FieldByName('SHOW_LOGO').AsString = 'True') thenbeginimglogo.Visible := True;tntmntmHideV.Checked := False;grp1.Visible := True;endelsebeginimglogo.Visible := False;tntmntmHideV.Checked := True;grp1.Visible := False;end;//初始化窗体透明度self.AlphaBlendValue := qryInit.fieldbyname('FORM_ABV').AsInteger;rztrckbr1.Position := qryInit.fieldbyname('FORM_ABV').AsInteger;//初始化快捷方式的字体lvPro.Font.Charset := qryInit.fieldbyname('LV_FONT_CHARSET').AsInteger;lvPro.Font.Color := StringToColor(qryInit.fieldbyname('LV_FONT_COLOR').AsString);lvPro.Font.Name := qryInit.fieldbyname('LV_FONT_NAME').AsString;lvPro.Font.Size := qryInit.fieldbyname('LV_FONT_SIZE').AsInteger;lvPro.Font.Style := [];if qryInit.FieldByName('LV_FSB').AsBoolean = True thenbeginlvPro.Font.Style := lvPro.Font.Style + [fsBold];end;if qryInit.FieldByName('LV_FSI').AsBoolean = True thenbeginlvPro.Font.Style := lvPro.Font.Style + [fsItalic];end;if qryInit.FieldByName('LV_FSU').AsBoolean = True thenbeginlvPro.Font.Style := lvPro.Font.Style + [fsUnderline];end;btn2.Text := qryInit.fieldbyname('LV_FONT_NAME').AsString + ','+ qryInit.fieldbyname('LV_FONT_SIZE').AsString + ','+ qryInit.fieldbyname('LV_FONT_COLOR').AsString;
end;{****************************************************************
* 过程名称: rztrckbr1Change
* 功能描述: 设置窗体透明度
* 参数说明: Sender
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.rztrckbr1Change(Sender: TObject);
var sqltxt : string;
beginsqltxt := 'update PRO_SET set FORM_ABV = ' + IntToStr(rztrckbr1.Position);self.AlphaBlendValue := rztrckbr1.Position;Execqry(qryCmd,sqltxt);
end;{****************************************************************
* 过程名称: FormMouseMove
* 功能描述: 窗体拖动
* 参数说明: Sender: TObject; Shift: TShiftState; X,Y: Integer
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
beginif (ssleft in Shift) thenbeginReleaseCapture;Perform(WM_syscommand, $F012, 0);end;
end;{****************************************************************
* 过程名称: imglogoMouseMove
* 功能描述: 窗体拖动
* 参数说明: Sender: TObject; Shift: TShiftState; X,Y: Integer
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.imglogoMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
beginFormMouseMove(Sender,Shift,X,Y);
end;{****************************************************************
* 过程名称: tntpnl1MouseMove
* 功能描述: 窗体拖动
* 参数说明: Sender: TObject; Shift: TShiftState; X,Y: Integer
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.tntpnl1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
beginFormMouseMove(Sender,Shift,X,Y);
end;{****************************************************************
* 过程名称: grp2MouseMove
* 功能描述: 窗体拖动
* 参数说明: Sender: TObject; Shift: TShiftState; X,Y: Integer
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.grp2MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
beginFormMouseMove(Sender,Shift,X,Y);
end;{****************************************************************
* 过程名称: tntpgcntrl2Change
* 功能描述: 设置项置中
* 参数说明: Sender
* 返 回 值: 无
* 历史记录: 2013.2.21 created by xzj
****************************************************************}
procedure TFormUse.tntpgcntrl2Change(Sender: TObject);
beginif tntpgcntrl2.ActivePage = pg5 thenbegingrp2.Top := tntpnl1.Top + (tntpnl1.Height - grp2.Height) div 2;grp2.Left := tntpnl1.Left + (tntpnl1.Width - grp2.Width) div 2;end;
end;{****************************************************************
* 过程名称: btn2ButtonClick
* 功能描述: 设置快捷方式的字体
* 参数说明: Sender
* 返 回 值: 无
* 历史记录: 2013.2.24 created by xzj
****************************************************************}
procedure TFormUse.btn2ButtonClick(Sender: TObject);
var sqltxt : string;
beginisEditing := True;//self.Left := (screen.Width - Self.Width) div 2;with dlgFont1 dobeginFont := lvPro.Font;if Execute thenlvPro.Font := Font;end;isEditing := False;btn2.Text := lvPro.Font.Name + ',' + IntToStr(lvPro.Font.Size) + ',' + ColorToString(lvPro.Font.Color);sqltxt := 'update PRO_SET set LV_FONT_CHARSET = ' + IntToStr(lvPro.Font.charset) + ', '+ 'LV_FONT_COLOR = ''' + colortostring(lvPro.Font.Color) + ''', '+ 'LV_FONT_NAME = ''' + lvpro.font.name + ''', '+ 'LV_FONT_SIZE = ' + IntToStr(lvPro.Font.size) + ' ';if lvPro.Font.Style = [] thenbeginsqltxt := sqltxt + ', LV_FSB = False, LV_FSI = False, LV_FSU = False ';endelse if lvPro.Font.Style = [fsBold] thenbeginsqltxt := sqltxt + ', LV_FSB = True, LV_FSI = False, LV_FSU = False ';endelse if lvPro.Font.Style = [fsItalic] thenbeginsqltxt := sqltxt + ', LV_FSB = False, LV_FSI = True, LV_FSU = False ';endelse if lvPro.Font.Style = [fsUnderline] thenbeginsqltxt := sqltxt + ', LV_FSB = False, LV_FSI = False, LV_FSU = True ';endelse if lvPro.Font.Style = [fsBold] + [fsItalic] thenbeginsqltxt := sqltxt + ', LV_FSB = True, LV_FSI = True, LV_FSU = False ';endelse if lvPro.Font.Style = [fsBold] + [fsUnderline] thenbeginsqltxt := sqltxt + ', LV_FSB = True, LV_FSI = False, LV_FSU = True ';endelse if lvPro.Font.Style = [fsItalic] + [fsUnderline] thenbeginsqltxt := sqltxt + ', LV_FSB = False, LV_FSI = True, LV_FSU = True ';endelsebeginsqltxt := sqltxt + ', LV_FSB = True, LV_FSI = True, LV_FSU = True ';end;Execqry(qryCmd,sqltxt);
end;end.
效果：
开发一个delphi写的桌面图标管理代码相关推荐
- 介绍两个个好软件，一个是桌面提醒，一个是桌面图标管理
第一款:桌面图标管理的:Fences 上网搜一下,有它的使用视频 第二款:蓝果桌面日程管理软件 可以自动往桌面添加背景文字,便于提醒自己: 这个截图还可以把
- 计算机个性化桌面,良好的个性化桌面图标管理软件排行榜
良好的个性化桌面图标管理软件排行榜 Conch桌面软件可以自动对桌面文件进行分类桌面图标管理,并按文件,文件夹和图标对它们进行自动排序. 桌面不再杂乱无序. 桌面直接显示天气时间,简单的小吊坠,天气时 ...
- ubuntu桌面图标管理(以pycharm图标为例)
ubuntu桌面图标管理(以pycharm图标为例) 核心: # Ubuntu中所有图标链接都放在如下文件夹中 /usr/share/applications 1.新建一个.desktop文件并编辑 ...
- 计算机桌面图标管理,酷点--很酷的桌面图标管理软件
酷点桌面图标管理软件可以帮助你打造很酷很炫的个性化桌面.喜欢的朋友可以用用. (电脑入门到精通网 www.58116.cn) (电脑入门到精通网 www.58116.cn) 官方的介绍: (电脑入门到 ...
- 一个Delphi写的DES算法, 翻译成C#
其实.NET Framework已经提供实现DES算法的类: System.Security.Cryptography.DESCryptoServiceProvider.之所以要把一个Delphi写的 ...
- Windos - 桌面图标管理
Windos - 桌面图标管理 知乎原文链接 大家推荐的好多软件,有些要花钱,好多还会拖慢电脑开机速度. 我觉得如果只是管理桌面图标的话,把图标放在文件夹中分类排列就行了. 效果图: 方法(共三步): ...
- 计算机桌面图标管理,桌面图标怎么管理 桌面图标管理方法介绍
在平时使用电脑的过程中,我们会下载各类的软件,为了更好的区分开来,每个软件都会有自己特定的图标.但是由于我们日常不能很好的管理,软件下载的越来越多,图标也是越来越多.那我们怎么能够更好的管理图标呢,今 ...
- 【Delphi】Android 桌面图标添加快捷菜单功能
目录 一.为什么需要桌面图标长按快捷菜单 二.实现Android桌面图标快捷菜单 第一步:Delphi 创建一个 FMX 工程文件:ShortCut_Demo.dpr 第二步:编辑项目中的 Andro ...
- 【如何快速的开发一个简单的iOS直播app】(代码篇)
开篇([如何快速的开发一个完整的iOS直播app](原理篇) ) 好久没写简书,因为好奇的我跑去学习直播了,今天就分享一下我的感慨. 目前为止直播还是比较热点的技术的,简书,git上有几篇阅读量和含金 ...
最新文章
- adb命令 判断锁屏
- 吉大20春学期C语言程序设计作业二,吉大18春学期《C语言程序设计》在线作业二【答案】...
- linux 键盘记录,学习笔记 kali linux 关于MS17-101漏洞攻击与键盘记录
- Byte和byte[]数组
- 衰落信道中的平均信噪比和瞬时信噪比
- php $that,PHP中$this和$that指针使用实例
- 圣诞节就这么过了.........
- setuna软件使用问题：Win10（专业版）在使用setuna时，启动快捷键（Ctrl+A）截屏后屏幕会放大
- php文字转语音amr,Android插件，TTS语音合成(文字转化语音)。
- linux manjaro配置输入法
- 静水流深,闻喧享静 空山鸣响,见惯司空
- python中文朗读_python语音朗读
- 【Bug 调试】修复注册验证问题 第十三届蓝桥杯（Web 应用开发）线上模拟赛
- STM32 启动代码分析
- Python中的np.array理解
- Feign - 独立使用 - 替代HttpClient
- 无线覆盖服务器,港口码头无线覆盖系统方案的构成及功能实现
- odoo第一次登录不进去，不知道用户名和密码
- 《计算机网络自顶向下方法-第七版》第一章总结
- 视频教程-HTML5+CSS3项目实战详解-HTML5/CSS