опять про трей

← →
Строр (2002-01-04 15:23) [0]

В кладовке тут, классный элементик лежит TrayIcon зовется, все круто вобщем-то, работает, а как бы это сделать своими силами без VCL, шоб прога помельче получалась?

← →
Hacker (2002-01-04 15:28) [1]

Исходники посмотри, на моей компашке с делфи был с таким названием, так я сам на его основе объект подобный написал, только с тем, что мне нужно - оптимальней выходит

← →
Red Alert (2002-01-04 16:09) [2]

Держи! Работает.. Непомню откуда взял, но у мня есть коммерческиая блуда, трай для нее отсюда взят.
Эта прога показывает обьем используемый и обший памяти..
Лишнее вырежешь.. Да, еще тут есть res-файл, так в нем
один резурс - иконка что для трай. Нарисуй сам..
Удачи!

unit RunFirst;

interface

implementation

initialization
IsLibrary := True;
end.

******************************************

unit Resform;

interface

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

const
wm_IconMessage = wm_User;

type
TMemForm = class(TForm)
RamGauge: TGauge;
VirtualGauge: TGauge;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
Details1: TMenuItem;
About1: TMenuItem;
N1: TMenuItem;
Close1: TMenuItem;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Details1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
public
procedure IconTray (var Msg: TMessage);
message wm_IconMessage;
private
nid: TNotifyIconData;
end;

var
MemForm: TMemForm;

implementation

{$R *.DFM}
{$R RYG.RES}

function FmtMem (N: Integer): string;
begin
if N > 1024*1024 then
FmtMem := Format ("%.1f MB", [n / (1024*1024)])
else
FmtMem := Format ("%.1f KB", [n / 1024])
end;

procedure TMemForm.Timer1Timer(Sender: TObject);
var
MemInfo : TMemoryStatus;
begin
MemInfo.dwLength := Sizeof (MemInfo);
GlobalMemoryStatus (MemInfo);
RamGauge.Progress := MemInfo.dwAvailPhys div
(MemInfo.dwTotalPhys div 100);
VirtualGauge.Progress := MemInfo.dwAvailPageFile div
(MemInfo.dwTotalPageFile div 100);

Caption := Format ("Memory: = %d - %d",
[RamGauge.Progress, VirtualGauge.Progress]);

Label1.Caption := Format ("RAM:"#13"%s"#13"(%s)",
[FmtMem (MemInfo.dwAvailPhys),
FmtMem (MemInfo.dwTotalPhys)]);
Label2.Caption := Format ("Swap:"#13"%s"#13"(%s)",
[FmtMem (MemInfo.dwAvailPageFile),
FmtMem (MemInfo.dwTotalPageFile)]);

// set icon color
if RamGauge.Progress > 5 then
Icon.Handle :=
LoadIcon (HInstance, "GREEN")
else if VirtualGauge.Progress > 20 then
Icon.Handle :=
LoadIcon (HInstance, "YELLOW")
else
Icon.Handle :=
LoadIcon (HInstance, "RED");

// update the NotifyIcon structure
nid.hIcon := Icon.Handle;
strcopy (nid.szTip, PChar(Caption));
nid.uFlags := nif_Icon or nif_Tip;
Shell_NotifyIcon (NIM_MODIFY, @nid);
end;

procedure TMemForm.IconTray (var Msg: TMessage);
var
Pt: TPoint;
begin
if Msg.lParam = wm_rbuttondown then
begin
GetCursorPos (Pt);
// SetForegroundWindow (Handle);
PopupMenu1.Popup (Pt.x, Pt.y);
end;
if Msg.lParam = wm_lbuttondblclk then
Details1Click (self);
end;

procedure TMemForm.FormCreate(Sender: TObject);
begin
// load the initial icon
Icon.Handle :=
LoadIcon (HInstance, "GREEN");

// fill the NotifyIcon data structure
nid.cbSize := sizeof (nid);
nid.wnd := Handle;
nid.uID := 1; // icon ID
nid.uCallBAckMessage := wm_IconMessage;
nid.hIcon := Icon.Handle;
nid.szTip := "Free memory";
nid.uFlags := nif_Message or
nif_Icon or nif_Tip;
Shell_NotifyIcon (NIM_ADD, @nid);

// update the output ASAP
Timer1Timer (self);
end;

procedure TMemForm.FormDestroy(Sender: TObject);
begin
nid.uFlags := 0;
Shell_NotifyIcon (NIM_DELETE, @nid);
end;

procedure TMemForm.Details1Click(Sender: TObject);
begin
ShowWindow (Handle, sw_ShowNormal);
SetForegroundWindow (Handle);
Show; // enables the creation of window controls
end;

procedure TMemForm.About1Click(Sender: TObject);
begin
MessageDlg ("Windows Memory Meter"#13 +
"Copyright Marco Cant• 1996",
mtInformation, [mbOk], 0);
end;

procedure TMemForm.Close1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TMemForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
ShowWindow (Handle, sw_Hide);
end;

end.

******************************************

program Mem;

uses
RunFirst in "RunFirst.pas",
Forms, Windows,
Resform in "RESFORM.PAS" {MemForm};

{$R *.RES}

begin
Application.ShowMainForm := False;
IsLibrary := False;
Application.CreateForm(TMemForm, MemForm);
Application.Run;
end.

← →
Romul (2002-01-04 17:25) [3]

Прикольно, я тоже вот это искал. Спасибо!

← →
Red Alert (2002-01-04 17:58) [4]

Всегда рад!

опять про трей Найти похожие ветки