Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.01.21;
Скачать: [xml.tar.bz2];

Вниз

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

 
Строр   (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]

Всегда рад!



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.01.21;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.022 c
6-66335
Kornet
2001-10-08 16:04
2002.01.21
Как найти свободный порт?


4-66415
Константин
2001-11-17 21:50
2002.01.21
По(ту)сторонние звуки


4-66391
Floyn
2001-11-20 10:00
2002.01.21
Как в DLL создать окно?


1-66289
LAlex
2002-01-04 18:38
2002.01.21
Искуственный интеллект


3-66195
kserg@ukr.net
2001-12-17 17:00
2002.01.21
Кто работал с DBGridEh из EhLib ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский