|
用该程序可以做一个自己的任务栏，包括列举出任务栏上程序的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, ImgList;
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
[1] [2] 下一页 | 
