| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Помогите написать "Уведомлятель"

Страницы:   < 1 2 3 4 >

Костик ©   (2008-07-11 11:38:00) 

Помогите пожалуйста написать "Уведомлятель".... Я уже смотрел faq нашел некоторые моменты, но така как я новичок то те процедуры, которые там написаны я не очень в состоянии применть (немного не понятно). Хочу чтобы программа загружалась с виндой и сворачивалась к часам в панели задач и через каждое установленное время выдавала сообщение что типа "Эй чувак - да ты заработался как я посмотрю" )))  ну чтото типа того...
Заранее благодарю.

---

Anatoly Podgoretsky   (2008-07-14 11:44:00) [21]

> Костик   (14.07.08 11:34) [43]

Что сказать то хотел?

---

Костик   (2008-07-14 11:34:00) [22]


uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ShellApi, StdCtrls, Menus, Registry;
.....
   procedure ActionIcon(n: Integer; Icon: TIcon);
   procedure WindowsMessage(var Msg:TMessage); message M_SYSCOMMAND;
   procedure OnMinimizeProc(Sender: TObject);
   procedure IconMouseClick(var Msg:TMessage); message WM_USER + 1;
.....
function IsRunWithWin: boolean;
var
Reg:  TRegistry;
bIs:  boolean;
List: TStringList;
I:    Integer;
begin
bIs  := False;
Reg  := TRegistry.Create;
List := TStringList.Create;
try
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then
   begin
     Reg.GetValueNames(List);
     for I:=0 to List.Count-1 do
       begin
        if List.Strings[I] = 'YouMemory 1.0' then
         begin
          bIs := True;
          break;
         end;
       end;
   end;
finally
   Reg.Free;
   List.Free
end;
Result :=  bIs;
end;

procedure WriteReg(Status:boolean);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
 try
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then
   begin
    if Status then
     Reg.WriteString('YouMemory 1.0','"' + Application.ExeName + '"')
    else
     Reg.DeleteValue('YouMemory 1.0');
     Reg.CloseKey;
   end;
 finally
   Reg.Free;
 end;
end;

//Посылаем подальше  RX_Tray_Icon
procedure TForm1.ActionIcon(n: Integer; Icon: TIcon);
var Nim: TNotifyIconData;
begin
with Nim do
 begin
  cbSize := SizeOf(Nim);
  Wnd    := Form1.Handle;
  uID    := 1;
  uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
  hIcon  := Icon.Handle;
  uCallbackMessage := WM_USER + 1;
  szTip := 'Уведомитель';
 end;
case n of
 1: Shell_NotifyIcon(NIM_ADD, @Nim);
 2: Shell_NotifyIcon(NIM_DELETE, @Nim);
 3: Shell_NotifyIcon(NIM_MODIFY, @Nim);
end;
end;

procedure TForm1.WindowsMessage(var Msg:TMessage);
begin
if Msg.WParam = SC_MINIMIZE then
 begin
  ActionIcon(1, Application.Icon);  //нормально показываем иконку в трэе
  ShowWindow(Handle, SW_HIDE);      //нормально скрываем приложение
  ShowWindow(Application.Handle, SW_HIDE); //нормально скрываем приложение из панели задач
 end
else
 inherited;
end;

procedure TForm1.OnMinimizeProc(Sender: TObject);
begin
PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0); //нормально запускаем WindowsMessage
end;

procedure TForm1.IconMouseClick(var Msg:TMessage);
var p: TPoint;
begin
GetCursorPos(p);
Case Msg.LParam of
 WM_LBUTTONUP, WM_LBUTTONDBLCLK:
  begin
   ActionIcon(2, Application.Icon);  //нормально удаляем иконук из трея
   ShowWindow(Application.Handle, SW_SHOW); //нормально восстанавливаем приложение на панели задач
   ShowWindow(Handle, SW_SHOW); // нормально восстанавливаем приложение на рабочем столе
   SetForegroundWindow(Handle);
  end;
 WM_RBUTTONUP:
  begin
   SetForegroundWindow(Handle);
   PopupMenu1.Popup(p.X,p.Y);
   PostMessage(Handle, WM_NULL, 0, 0);
  end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize := OnMinimizeProc;
CheckBox1.Checked := IsRunWithWin;
Application.Minimize;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 WriteReg(CheckBox1.Checked)
end;



---

Anatoly Podgoretsky   (2008-07-14 10:02:00) [23]

Зачем так много слов!
Надо просто нормально написать программу.

---

Palladin   (2008-07-14 09:58:00) [24]

> Как сделать чтобы программа нормально разворачивалась/сворачивалась
> трэй?

надо:
нормально показать иконку в трее (можно много)
нормально свернуть приложение
нормально скрыть приложение из панели задач
позже, при каком либо событии
нормально показать приложение на панели задач
нормально восстановить приложение на рабочем столе
по желанию, нормально убрать иконку из трея (можно все)

---

Dennis I. Komarov   (2008-07-14 09:50:00) [25]

Удалено модератором

---

Костик   (2008-07-14 09:44:00) [26]

> давить! оно потом банк-клиент будет писать

если Вы сейчас уже не "оно" то это не значит что надо оскарблять других...

Как сделать чтобы программа нормально разворачивалась/сворачивалась трэй?

---

Костик   (2008-07-14 09:10:00) [27]

Удалено модератором

---

Denis__   (2008-07-11 21:44:00) [28]

Удалено модератором

---

McSimm   (2008-07-11 20:08:00) [29]

> давить! оно потом банк-клиент будет писать


– Нет, конечно... – промямлил я. – Проделана большая работа... (Эдик схватился за голову.) Я, конечно, понимаю... добрые намерения... (Эдик посмотрел на меня с презрением.) Ну в самом деле, – сказал я, – человек старался... нельзя же так...
– Побойся бога, – отчетливо произнес Эдик.
– Нет... Ну что ж... Ну пусть человек работает, раз ему интересно...

:)

---

Игорь Шевченко   (2008-07-11 19:42:00) [30]

давить! оно потом банк-клиент будет писать

---

Костик   (2008-07-11 17:04:00) [31]

Ну  с брэйком я согласен... пропстил begin end;
Ну создаю лишний код .... ну я же новичок ё ма ё
)
> Еще и Rx поставить...?
> Ну объясняй каждую строчку своего кода

Вот забыл дописать:

procedure TForm1.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
RxTrayIcon1.Active := False;
Form1.Show;
end;

Но все равно не понял что Вы имеете в виду?
> Еще и Rx поставить...?
> Ну объясняй каждую строчку своего кода

---

Dennis I. Komarov   (2008-07-11 16:21:00) [32]

> Вы уверены?

Угу

> Все такие умные стали....

Думаю что за сегодня не сильно изменились...

> Как исправить что б нормально было?

Еще и Rx поставить...?
Ну объясняй каждую строчку своего кода

---

Костик   (2008-07-11 16:10:00) [33]

> выпадет из цикла после первой же итерации
> зачем цикл тогда?

Вы уверены?

> Правильный*Вася   (11.07.08 15:56) [30]
>
> > if CheckBox1.Checked then  WriteStatus(True) else  WriteStatus(False);
>
>
> вторая милашка :)

Все такие умные стали....
Ану скажите пожалуйста:
вот написал

procedure TForm1.OnMinimizeProc(Sender: TObject);
begin
RxTrayIcon1.Active := True;
Form1.Hide;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
Application.OnMinimize := OnMinimizeProc;
if IsStatus then
 CheckBox1.Checked := true
else
 CheckBox1.Checked := false;
end;

только когда разворачиваю и з трэя то не могу опять свернуть, и разворачивает в окно за всеми активными окнами....
Как исправить что б нормально было?

---

Dennis I. Komarov   (2008-07-11 16:09:00) [34]

> [28] Костик   (11.07.08 15:49)

Чего тут не понятного IsStatus какие значения принимает?
CheckBox1.Checked:=IsStatus;

А мой пост это не для тебя...

---

Правильный*Вася   (2008-07-11 15:56:00) [35]

> if CheckBox1.Checked then  WriteStatus(True) else  WriteStatus(False);

вторая милашка :)

---

Правильный*Вася   (2008-07-11 15:55:00) [36]


> for I:=0 to List.Count-1 do
>   begin
>     if List.Strings[I] = 'YouMemory 1.0' then
>        bIs := True;
>        break;
>   end;

выпадет из цикла после первой же итерации
зачем цикл тогда?

---

Костик   (2008-07-11 15:49:00) [37]

> Johnmen ©   (11.07.08 15:35) [26]
>
> > if IsStatus then  
> >   CheckBox1.Checked := true
> > else  
> > CheckBox1.Checked := false;
>
> Милашка...
> :)
> <Цитата>
>
>
> Dennis I. Komarov ©   (11.07.08 15:49) [27]
> С "конвектором" рядом не стояла

не понял?

---

Dennis I. Komarov   (2008-07-11 15:49:00) [38]

С "конвектором" рядом не стояла

---

Johnmen   (2008-07-11 15:35:00) [39]

> if IsStatus then  
>   CheckBox1.Checked := true
> else  
> CheckBox1.Checked := false;

Милашка...
:)

---

Костик   (2008-07-11 15:08:00) [40]

Вот что получается.... Вроде как работает:

function IsStatus: boolean;
var
Reg:  TRegistry;
bIs:  boolean;
List: TStringList;
I:    Integer;
begin
bIs  := False;
Reg  := TRegistry.Create;
List := TStringList.Create;
try
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then
   begin
     Reg.GetValueNames(List);
     for I:=0 to List.Count-1 do
       begin
        if List.Strings[I] = 'YouMemory 1.0' then
         bIs := True;
         break;
       end;
   end;
finally
   Reg.Free;
   List.Free
end;
Result :=  bIs;
end;

procedure WriteStatus(Status:boolean);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
 try
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then
   begin
    if Status then
     Reg.WriteString('YouMemory 1.0','"' + Application.ExeName + '"')
    else
     Reg.DeleteValue('YouMemory 1.0');
     Reg.CloseKey;
   end;
 finally
   Reg.Free;
 end;
end;

procedure TForm1.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
RxTrayIcon1.Active := False;
Form1.Visible := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RxTrayIcon1.Active := true;
Form1.Visible := false;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
 WriteStatus(True)
else
 WriteStatus(False);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
if IsStatus then
 CheckBox1.Checked := true
else
 CheckBox1.Checked := false;
end;


---

Страницы:   < 1 2 3 4 >

Наверх