如何在系统托盘中放入窗体?不是ICO图标(200分)

  • 主题发起人 主题发起人 oliver99
  • 开始时间 开始时间
O

oliver99

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在系统托盘中放入窗体?不是ICO题标
我想作个个性化的系统时间栏,液晶形的,WINDOWS本身的不够COOL。
在托盘中加入ICO图标我会,网上的VCL也一大把。可是就是没有加入窗体的
200分请富翁们写源码。
 
你把Form的Canvas画到Icon上不就可以了
 
`````你够COOL
 
可以做一个DeskBand
 
To::tseug
没用的,只是占了那个位置,是浮在上面的效果。我要的是和系统时间一样,真正地放在
托盘中。
 
真有那么简单么?好象没有见过谁这么做过呀。除了LINUX。
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ShellAPI,
StdCtrls, ExtCtrls;

const
WM_TRAYNOTIFY = WM_USER+100; //任务区小图标自定义消息

type
TForm1 = class(TForm)
Button1: TButton;
Shape1: TShape;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }

procedure TrayNotifyMessage(var Sender: TMessage); message WM_TRAYNOTIFY;
procedure MarkTaskBarIcon(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;
tnd : TNOTIFYICONDATA;
implementation

{$R *.DFM}

procedure TForm1.MarkTaskBarIcon(Sender: TObject);
begin
Form1.Visible := False;
tnd.cbSize := sizeof(tnd);
tnd.Wnd := Handle;
tnd.uID := 128;
tnd.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
tnd.uCallbackMessage := WM_TRAYNOTIFY;
tnd.hIcon := Application.Icon.Handle;
StrPCopy(tnd.szTip,Application.Title);
Shell_NotifyIcon(NIM_ADD,@tnd);
end;

procedure TForm1.TrayNotifyMessage(var Sender: TMessage);
begin
if Sender.LParam = WM_LBUTTONDBLCLK then
begin
Shell_NotifyIcon(NIM_DELETE,@tnd);
Form1.Visible := True;
Application.Restore;
Application.BringToFront;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize := MarkTaskBarIcon;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
IconSizeX : integer;
IconSizeY : integer;
AndMask : TBitmap;
XOrMask : TBitmap;
IconInfo : TIconInfo;
Icon : TIcon;
begin
{Get the icon size}
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);

{Create the "And" mask}
AndMask := TBitmap.Create;
AndMask.Monochrome := true;
AndMask.Width := IconSizeX;
AndMask.Height := IconSizeY;

{Draw on the "And" mask}
AndMask.Canvas.Brush.Color := clWhite;
AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
AndMask.Canvas.Brush.Color := clBlack;
AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);

{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask);

{Create the "XOr" mask}
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;

{Draw on the "XOr" mask}
XOrMask.Canvas.Brush.Color := ClBlack;
XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
XOrMask.Canvas.Pen.Color := clRed;
XOrMask.Canvas.Brush.Color := clRed;
XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
XorMask.Canvas.CopyRect(Rect(0, 0, Width, Height), Canvas, Rect(0, 0, Width, Height));

{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);

{Create a icon}
Icon := TIcon.Create;
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Icon.Handle := CreateIconIndirect(IconInfo);

{Destroy the temporary bitmaps}
AndMask.Free;
XOrMask.Free;

{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);

{Assign the application icon}
Application.Icon := Icon;

{Force a repaint}
InvalidateRect(Application.Handle, nil, true);

{Free the icon}
Icon.Free;
end;



end.
 
象“开始”一样,把一个窗口“贴”到托盘区。
 
deskband:
http://www.vckbase.com/document/journal/vckbase16/images/BobjCOMToys12_.gif
 
用2个,甚至3个ICO拼出来,只要拼的巧,画面本来够COOL,做出来就绝对COOL。
 
动态生成显示时间的ICON图标,
反复重写托盘

说实在的, 花哨的界面没有太大意义啊
 
后退
顶部