转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
做一个自己的任务栏         ★★★★

做一个自己的任务栏

作者:闵涛 文章来源:闵涛的学习笔记 点击数:1892 更新时间:2009/4/23 18:39:13

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

[1] [2]  下一页


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台