做一个自己的任务栏

2008-04-10 02:57:55来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

用该程序可以做一个自己的任务栏,包括列举出任务栏上程序的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;

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:入世对我国软件产业的影响及对策

下一篇:Delphi6/7 中XML 文档的应用