做一个自己的任务栏 (转)

做一个自己的任务栏 (转)[@more@]

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

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10752043/viewspace-991958/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/10752043/viewspace-991958/