向各位大虾求救，还是取图标的问题。不管你来不，我也给你发短消息

[角落的青苔]

请帮帮我吧？我在csdn泡了快一周了~~还没解决的一个问题：
我想取得任务栏上的程序的图标，现在我取得了窗口标题栏的caption。（我也说不清楚，
各位看代码就知咯）
或者用其它方法实现相同的功能也可以，先谢了吧^_*

代码下载地址：http://boyzxd.myrice.com/TabShell.zip（只有2K多）

没办法啦~~只好这样打扰各位了哈~~~

[角落的青苔]

唉~~找了一下，我只找到D5的（汉化版）：
http://soft.km169.net/soft/html/2145.htm
http://ae.km169.net/soft/down.php?at=0&id=0796A7E286A677D253968607C6564607
http://ae.km169.net/soft/down.php?at=1&id=0796A7E286A677D253968607C6564607

等我下班了加你呀~~现在还不敢挂QQ~~~我的是79343823(用于Delphi)， 346955(用于聊天^_*)

[角落的青苔]

唉~~找了一下，我只找到D5的（汉化版）：
http://soft.km169.net/soft/html/2145.htm
http://ae.km169.net/soft/down.php?at=0&id=0796A7E286A677D253968607C6564607
http://ae.km169.net/soft/down.php?at=1&id=0796A7E286A677D253968607C6564607

等我下班了加你呀~~现在还不敢挂QQ~~~我的是79343823(用于Delphi)， 346955(用于聊天^_*)

[日总是我哥]

你不是在逗我玩吧
只有9.83MB的东东也是啊？！
郁闷~~~

[日总是我哥]

你不是在逗我玩吧
只有9.83MB的东东也是啊？！
郁闷~~~

[角落的青苔]

对不起哦~~我一直找到现在都还没找到~~~~~~

我看那连接可以下载的，其它都是死的连接呢：~~~~~~

[日总是我哥]

算了吧~~

即使找到了，下班之前也下载不完了~~
我明天带盘来~~

[日总是我哥]

算了吧~~

即使找到了，下班之前也下载不完了~~
我明天带盘来~~

[日总是我哥]

算了吧~~

即使找到了，下班之前也下载不完了~~
我明天带盘来~~

[角落的青苔]

好的嘛~~~继续晒~~~~

[NowCan]

这段VB代码你参考一下，hwnd是窗口句柄。

Public Function WndToProc(hwnd As Long) As String
Dim PID As Long
Dim pl As PROCESSENTRY32
Dim hSnapshot As Long

WndToProc = ""
GetWindowThreadProcessId hwnd, PID
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnapshot Then
pl.dwSize = Len(pl)
If (Process32First(hSnapshot, pl)) Then
Do
If PID = pl.th32ProcessID Then
WndToProc = pl.szExeFile
End If
Loop Until (Process32Next(hSnapshot, pl) < 1)
End If
CloseHandle (hSnapshot)
End If

[NowCan]

这段VB代码你参考一下，hwnd是窗口句柄。

Public Function WndToProc(hwnd As Long) As String
Dim PID As Long
Dim pl As PROCESSENTRY32
Dim hSnapshot As Long

WndToProc = ""
GetWindowThreadProcessId hwnd, PID
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnapshot Then
pl.dwSize = Len(pl)
If (Process32First(hSnapshot, pl)) Then
Do
If PID = pl.th32ProcessID Then
WndToProc = pl.szExeFile
End If
Loop Until (Process32Next(hSnapshot, pl) < 1)
End If
CloseHandle (hSnapshot)
End If

[角落的青苔]

终于取出来了，看明天贴代码

明天结贴，在此先谢过大家呀^_*

[Billy_Chen28]

这里有一个取得与某个文件相关联的应用程序的图标:
uses shellapi;
var
IconIndex : word;
h : hIcon;
begin
IconIndex := 0;
h := ExtractAssociatedIcon(hInstance,
PChar(filename),
IconINdex);
//将图标显示出来DrawIcon(image1.Canvas.Handle,0,0,h);
end;

[Billy_Chen28]

这里有一个取得与某个文件相关联的应用程序的图标:
uses shellapi;
var
IconIndex : word;
h : hIcon;
begin
IconIndex := 0;
h := ExtractAssociatedIcon(hInstance,
PChar(filename),
IconINdex);
//将图标显示出来DrawIcon(image1.Canvas.Handle,0,0,h);
end;
以下是例出任务栏窗体：
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
Form1.Listbox1.items.add('Handle: ' + Inttostr(Wnd) + ',Text: ' +GetText(Wnd));
end;


procedure TForm1.Button1Click(Sender: TObject);
var
Param : Longint;
begin
EnumWindows(@EnumWindowsProc , Param);
end;

[kamochoi]

unit cash;

interface

uses Classes, Dialogs, ExtDlgs,Windows,Messages,SysUtils,Graphics,Controls,Forms,
StdCtrls,ExtCtrls,Menus,ClipBrd,ShellApi,fenxi,help, CoolTrayIcon;

const
WM_ICONMESSAGE=WM_USER+100;

type
Tcashform = class(TForm)
CoolTrayIcon1: TCoolTrayIcon;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
//热键消息处理函数
procedure WMHOTKEY(var Message:TMessage);message WM_HOTKEY;
//任务栏消息处理函数
procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;
{ Private declarations }
public
{ Public declarations }
end;
procedure CaptureControl;

var
cashform: Tcashform;
tmpBitmap:TBitmap;
iBitmapValide:Boolean;


implementation

{$R *.DFM}

procedure CaptureControl;
var
iTempWnd, iMeHwnd,iDC:LongWord;
tyRect :TRect;
tpRect : TPoint;
iWidth,
iHeight:integer;
begin
//获得光标位置
GetCursorPos(tpRect);
//获得光标所在位置的窗口句柄
iMeHwnd:=WindowFromPoint(tpRect);
//获得窗口的矩形区域
GetWindowRect(iMeHwnd,tyRect);
//获得桌面窗口的句柄
iTempWnd:=GetDesktopWindow;
iDC:=GetDC(iTempWnd);
iWidth:=tyRect.Right-tyRect.Left;
iHeight:=tyRect.Bottom-tyRect.Top;
//建立位图
tmpBitmap:=TBitmap.Create;
iBitmapValide:=True;
tmpBitmap.Width := iWidth;
tmpBitmap.Height := iHeight;
//复制窗口矩形区域到位图中
Bitblt(tmpBitmap.Canvas.Handle,0,0,iWidth,iHeight,iDC,
tyRect.Left,tyRect.Top,SRCCOPY);
ReleaseDC(iTempWnd,iDC);
cashForm.Visible := True;
//使Form1覆盖光标所在的窗口矩形
cashform.Left := tyRect.Left;
cashform.Top := tyRect.Top;
cashform.Width := iWidth;
cashform.Height := iHeight;
tyRect.Left:=0;
tyRect.Right := iWidth;
tyRect.Top:=0;
tyRect.Bottom:=iHeight;
//将位图绘制到cashform的Canvas中
cashform.Canvas.Draw(0,0,tmpBitmap);
//围绕cashform画出3个相素的红色边框
Frame3D(cashform.Canvas,tyRect,clRed,clRed,3);
end;

//响应热键，进行抓图
procedure Tcashform.WMHOTKEY(var Message:TMessage);
begin
if iBitmapValide then
begin
tmpBitmap.FreeImage;
tmpBitmap.Free;
iBitmapValide:=False;
end;
CaptureControl;
end;

procedure Tcashform.WMBarIcon (var Message:TMessage);
begin
if ((Message.LParam = WM_RBUTTONDOWN)or (Message.LParam = WM_LBUTTONDOWN)) then
//在任务栏图标上按下鼠标键退出
close;
end;

procedure Tcashform.FormCreate(Sender: TObject);
var
lpData:PNotifyIconData;
help:thelpform;
begin
help:=thelpform.create(self);
help.showmodal;
//注册热键为Ctrl+Shift+A
RegisterHotKey(cashform.handle,0,{MOD_SHIFT OR MOD_CONTROL}0,65);
//在任务栏上建立图标
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;
lpData.Wnd := cashform.Handle;
lpData.hIcon:=cashform.Icon.Handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '屏幕捕捉';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD,lpData);
dispose(lpData);
end;

procedure Tcashform.FormClose(Sender: TObject; var Action: TCloseAction);
var
lpData:PNotifyIconData;
begin
//退出时删除任务栏图标
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;
lpData.Wnd := cashform.Handle;
lpData.hIcon := cashform.Icon.Handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '屏幕捕捉';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
//退出时注销窗口热键
UnRegisterHotKey(cashform.Handle,0);
if iBitmapValide then
begin
tmpBitmap.FreeImage;
tmpBitmap.Free;
iBitmapValide:=False;
end;
end;

procedure Tcashform.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
fenxi:tfenxiform;
begin
//按下鼠标左键保存窗口图象
if (Button=mbLeft)then
// with SavePic do
// begin
// DefaultExt := 'Bmp';
// Execute;
// if FileName<>'' then
tmpBitmap.SaveToFile(Getcurrentdir+'\microscope.bmp');
// end;
//保存完图象后删除位图
tmpBitmap.FreeImage;
tmpBitmap.Free;
iBitmapValide:=False;
cashform.Visible := False;
fenxi:=tfenxiform.create(self);
fenxi.showmodal;
end;

end.

[角落的青苔]

问题已经差不多解决，首先感谢NowCan，他的WndToProc(hwnd As Long) As String使Handle和WindowName联系起来；
再次感谢CoolSlob()，是他不厌其烦帮我想办法，并且教了我一些技巧。
最后感谢给我回复或关注的朋友^_*
http://www.csdn.net/Expert/TopicView1.asp?id=884142 是我最后的代码，
大家感兴趣的话可以去看看，并且接分^_^

再一次感谢大家哈，祝快乐每一天;-p

[角落的青苔]

我已经结贴了呀~~为什么这里没有说已经结贴呢：（

请各位看看自己得分的问题哈^_*

[角落的青苔]

我已经结贴了呀~~为什么这里没有说已经结贴呢：（

请各位看看自己得分的问题哈^_*

[日总是我哥]

出来了~~~~~


http://CoolSlob.8u8.com/Download/tabshell.zip

[光明山人]

作了一些修改，不合原意不并遵守：（有些修改跟原意无关，只是我自己多事）（没修改的地方随原代码）
首先, TTabShell的属性：
BorderStyle = bsSizeable

然后
//button的onclick事件
procedure TTabShell.AppName_BtnClickHandle(Sender:TObject);
var wnd:HWND;
begin
with Sender as TBitBtn do
begin
wnd:=Windows.FindWindow(nil,PChar(Hint));
Image1.Picture.Icon.Handle := MyGetWindowIcon(wnd);
ShowWindow(wnd,SW_SHOW); // agui: 原来是SW_NORMAL
SetForegroundWindow(wnd);
end;
end;

procedure TTabShell.FormCreate(Sender: TObject);
begin
// agui: 注释掉是因为太霸道，我不想。其实可以把WindowState属性设置为wsMaximized
//TabShell.Top:=0;
//TabShell.Left:=0;
//TabShell.Width:=Screen.Width;
end;

procedure TTabShell.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
// agui: 注释掉是因为它们的Owner都是TTabShell，会自动地FREE
//var
//AppNum:Integer;
begin //free创建的button
//for AppNum:=0 to AppListBox.Items.Count-1 do
// AppName_Btn[AppNum].Free;
end;

procedure TTabShell.BitBtn1Click(Sender: TObject);
var
wnd: HWND;
AppNum: Integer;
anIcon: TIcon;
aBitmap: TBitmap;
aRect: TRect;
begin
aRect := Rect(0, 0, 16, 16); // 最后都到一样大小 16x16
AppListBox.Clear;
EnumWindows(@EnumWindowsProc,Integer(AppListBox));
anIcon := TIcon.Create;
aBitmap := TBitmap.Create;
aBitmap.Width := 32; //anIcon.Width;
aBitmap.Height := 32; //anIcon.Height;
//动态创建按纽
for AppNum:=0 to AppListBox.Items.Count-1 do
begin
AppName_Btn[AppNum]:=TBitBtn.Create(Self);
with AppName_Btn[AppNum] do
begin
Hint := AppListBox.Items[AppNum];
Caption := AppListBox.Items[AppNum]; //Copy(AppListBox.Items[AppNum],1,8);
Parent := Self;
Top := AppNum*Height;
ShowHint := True;
OnClick:=AppName_BtnClickHandle;

wnd := Windows.FindWindow(nil, PChar(AppListBox.Items[AppNum]));
if IsWindow(GetParent(wnd)) then
wnd := GetParent(wnd);

if IsWindow(wnd) then
begin
anIcon.Handle := MyGetWindowIcon(wnd);
aBitmap.Canvas.Draw(0, 0, anIcon);

NumGlyphs := 1;
Width := Canvas.TextWidth(Caption)+16+10; // 加上了宽度计算
with Glyph do
begin
Width := 16;
Height := 16;
Canvas.StretchDraw( aRect, aBitmap ); // 画成16x16大小，当然也可以是20x20
end;
end;
end;
end;
anIcon.Free; // 中间临时对象销毁
aBitmap.Free;
end;