分享
 
 
 

做一个自己的任务栏

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

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

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有