开发工具:
文件大小: 2mb
下载次数: 0
上传时间: 2010-09-21
详细说明： 用该程序可以做一个自己的任务栏，包括列举出任务栏上程序的Handle、WindowName、程序路径、图标。可选定窗口并提前，或者在程序间切换。 如果你的程序是满屏的，并且屏蔽了系统键的话，或许可以用到下面的技巧。 ********************* AppTabP.dpr program AppTabP; uses Forms, AppTab_f in 'AppTab_f.pas' {AppTab}; {$R *.res} begin Application.Initialize; Application.CreateForm(TAppTab, AppTab); Application.Run; end. ************************ AppTab_f.pas unit AppTab_f; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TLHelp32,Buttons,ShellAPI, ExtCtrls, Im gList; type TAppTab = class(TForm) ListBox1: TListBox; BitBtn1: TBitBtn; CaptionListBox: TListBox; PathListBox: TListBox; HwndListBox: TListBox; Label1: TLabel; tempImageList: TImageList; tempImage: TImage; procedure BitBtn1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } AppList:TStrings; AppName_Btn:Array[0..20] of TBitBtn; procedure AppName_BtnClickHandle(Sender:TObject); public { Public declarations } end; var AppTab: TAppTab; //得到窗口WindowName function GetText(Wnd:HWND):string; //遍历窗口 function EnumWindowsProc(Wnd:HWND;LParam:LPARAM):BOOL;stdcall; //由进程Handle得到程序名（含路径） function WndToProc(hwnd:HWND):String; //取得外部程序的图标，是目录就取文件夹图标 function GetFileIcon(const Filename:String;SmallIcon:Boolean):HICON; implementation {$R *.dfm} function GetText(Wnd:HWND):string; var TextLength:Integer; Text:PChar; begin TextLength:=SendMessage(Wnd,WM_GETTEXTLENGTH,0,0); if TextLength=0 then Result:='' else begin GetMem(Text,TextLength+1); SendMessage(Wnd,WM_GETTEXT,TextLength+1,Integer(Text)); Result:=Text; FreeMem(Text); end; end; function EnumWindowsProc (Wnd: HWND; LParam: LPARAM): BOOL; stdcall; begin Result := True; if (IsWindowVisible(Wnd) or IsIconic(wnd)) and ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or (GetWindowLong(Wnd, GWL_HWNDPARENT) = GetDesktopWindow)) and (GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) then begin if Wnd<>Application.Handle then begin AppTab.Listbox1.items.add(Inttostr(Wnd)+'*****'+GetText(Wnd)+'*****'+WndToProc(Wnd)); AppTab.HwndListBox.items.add(Inttostr(Wnd)); AppTab.CaptionListBox.items.add(GetText(Wnd)); AppTab.PathListBox.Items.Add(WndToProc(Wnd)); //以下把图标加到ImageList中，为了动态生成按纽时使用 if Copy(WndToProc(Wnd),Length(WndToProc(Wnd))-12,13)='\EXPLORER.EXE' then AppTab.tempImage.Picture.Icon.Handle:=ExtractIcon(// HINSTANCE,PChar(GetEnvironmentVariable('windir')+'\system\Shell32.dll'),3) else AppTab.tempImage.Picture.Icon.Handle:=ExtractIcon(hInstance,PChar(WndToProc(Wnd)),0); AppTab.tempImageList.AddIcon(AppTab.tempImage.Picture.Icon); end; end; end; procedure TAppTab.BitBtn1Click(Sender: TObject); var AppNum:Integer; begin for AppNum:=0 to ListBox1.Items.Count-1 do begin AppName_Btn[AppNum]:=TBitBtn.Create(Self); AppName_Btn[AppNum].Hint:=CaptionListBox.Items[AppNum]; AppName_Btn[AppNum].Caption:=Copy(CaptionListBox.Items[AppNum],1,8); AppName_Btn[AppNum].Parent:=Self; AppName_Btn[AppNum].Left:=82*AppNum; AppName_Btn[AppNum].Width:=80; AppName_Btn[AppNum].ShowHint:=True; AppName_Btn[AppNum].Layout:=blGlyphLeft; AppName_Btn[AppNum].OnClick:=AppName_BtnClickHandle; AppName_BTN[AppNum].Tag:=StrToInt(HwndListBox.Items[AppNum]);//把Tag属性使用起来，在SetForegroundWindow时可以直接用 //给按纽加图标 tempImageList.GetBitmap(AppNum,AppName_Btn[AppNum].Glyph); end; end; function WndToProc(hwnd:HWND):String; var PID:DWORD; ok:Boolean; ProcessListHandle: THandle;//进程列表的句柄 ProcessStruct:PROCESSENTRY32; //进程的结构，进程的信息都在这个结构里 begin Result:=''; GetWindowThreadProcessId(hwnd, PID); ProcessListHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); ProcessStruct.dwSize:=Sizeof(ProcessStruct); ok:=Process32First(ProcessListHandle,ProcessStruct); while ok do begin if PID=ProcessStruct.th32ProcessID then Break; ok:=Process32Next(ProcessListHandle,ProcessStruct); end; CloseHandle(ProcessListHandle); Result:=ProcessStruct.szExeFile; end; procedure TAppTab.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin AppList.Free; end; procedure TAppTab.FormShow(Sender: TObject); begin ListBox1.Clear; EnumWindows(@EnumWindowsProc,Sizeof(Integer)); end; procedure TAppTab.FormCreate(Sender: TObject); begin AppList:=TStringList.Create; end; procedure TAppTab.AppName_BtnClickHandle(Sender:TObject); begin //把Tag使用起来,它不是废物!! ShowWindow(TBitBtn(Sender).Tag, SW_SHOW); ShowWindow(TBitBtn(Sender).Tag, SW_RESTORE); SetForegroundWindow(TBitBtn(Sender).Tag); //上面为什么要用三句呢？奇怪啊 end; function GetFileIcon(const Filename:String;SmallIcon:Boolean):HICON; var info:TSHFILEINFO; Flag:Integer; begin if SmallIcon then Flag:=(SHGFI_SMALLICON or SHGFI_ICON) else Flag:=(SHGFI_LARGEICON or SHGFI_ICON); SHGetFileInfo(Pchar(Filename),0,info,Sizeof(info),Flag); Result:=info.hIcon; end; end. ****************************** AppTab_f.dfm object AppTab: TAppTab Left = 4 Top = 87 Width = 797 Height = 424 Caption = 'AppTab' Color = clBtnFace Font.Charset = GB2312_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = '宋体' Font.Style = [] OldCreateOrder = False OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel Left = 24 Top = 216 Width = 521 Height = 13 Caption = 'Handle 程序路径 Win' + 'dowName' end object tempImage: TImage Left = 528 Top = 16 Width = 41 Height = 41 Visible = False end object BitBtn1: TBitBtn Left = 0 Top = 52 Width = 137 Height = 25 Caption = '生成按纽' TabOrder = 1 OnClick = BitBtn1Click Glyph.Data = { DE010000424DDE01000000000000760000002800000024000000120000000100 0400000000006801000000000000000000001000000000000000000000000000 80000080000000808000800000008000800080800000C0C0C000808080000000 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333336633 3333333333333FF3333333330000333333364463333333333333388F33333333 00003333333E66433333333333338F38F3333333000033333333E66333333333 33338FF8F3333333000033333333333333333333333338833333333300003333 3333446333333333333333FF3333333300003333333666433333333333333888 F333333300003333333E66433333333333338F38F333333300003333333E6664 3333333333338F38F3333333000033333333E6664333333333338F338F333333 0000333333333E6664333333333338F338F3333300003333344333E666433333 333F338F338F3333000033336664333E664333333388F338F338F33300003333 E66644466643333338F38FFF8338F333000033333E6666666663333338F33888 3338F3330000333333EE666666333333338FF33333383333000033333333EEEE E333333333388FFFFF8333330000333333333333333333333333388888333333 0000} NumGlyphs = 2 end object CaptionListBox: TListBox Left = 456 Top = 232 Width = 332 Height = 162 ItemHeight = 13 TabOrder = 2 end object PathListBox: TListBox Left = 104 Top = 232 Width = 345 Height = 163 ItemHeight = 13 TabOrder = 3 end object ListBox1: TListBox Left = 1 Top = 81 Width = 784 Height = 128 ItemHeight = 13 TabOrder = 0 end object HwndListBox: TListBox Left = 0 Top = 232 Width = 101 Height = 161 ItemHeight = 13 TabOrder = 4 end object tempImageList: TImageList Left = 496 Top = 24 end end ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
