Главная страница
    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.015 c
3-66204
tns
2001-12-18 11:47
2002.01.21
QuickReport


14-66360
Феликс
2001-11-23 13:03
2002.01.21
Жизнь все лучше и лучше?


1-66268
Tosov
2002-01-02 23:37
2002.01.21
Оптимизация процедуры


1-66299
ctapik-net
2002-01-02 14:36
2002.01.21
Есть форма, необходимо нарисованное изображение на ней увеличить или уменьшить.


6-66327
Юра
2001-10-29 13:18
2002.01.21
О TIdMappedPortTCP





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский