历时一周，任务栏图标的问题终于解决，在此感谢给我帮助的朋友^_*（附源码）

角落的青苔 2002-07-18 03:37:07

现在问题基本上是解决了，可能还有代码优化的问题。
如果有谁个愿意进一步完善的话，青苔在此表示感谢哈^_*

********************* 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中，为了动态生成按纽时使用
//Showmessage(Copy(WndToProc(Wnd),Length(WndToProc(Wnd))-14,13));
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.

...全文