Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 5 034

Раздел: Delphi » Программирование баз данных (БД)
/ вопрос открыт /

Доброго времени суток, уважаемые эксперты!
В рунете нашел исходник простой напоминалки...
Добавил дату... в трей выходит и на этом все...
Что не так? (новичок, прошу строго не судить..)

Приложение:
  1. unit Napom;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, DB, GridsEh, DBGridEh, ComCtrls, RzBorder, StdCtrls, Mask,
  8. DBCtrls, ExtCtrls, JvExExtCtrls, DateUtils, JvExtComponent, JvClock,
  9.  
  10.  
  11. type
  12. TNap = class(TForm)
  13. JvClock1: TJvClock;
  14. DBEdit1: TDBEdit;
  15. DBEdit2: TDBEdit;
  16. DBEdit3: TDBEdit;
  17. RzLEDDisplay1: TRzLEDDisplay;
  18. RzLEDDisplay2: TRzLEDDisplay;
  19. UpDown1: TUpDown;
  20. UpDown2: TUpDown;
  21. Timer1: TTimer;
  22. Button1: TButton;
  23. procedure FormCreate(Sender: TObject);
  24. procedure Timer1Timer(Sender: TObject);
  25. procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
  26. procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
  27. procedure Button1Click(Sender: TObject);
  28. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  29.  
  30. procedure CreateTrayIcon(n: integer; Tip: String);
  31. procedure DeleteTrayIcon(n: integer);
  32. procedure SetSound;
  33. private
  34. { Private declarations }
  35. public
  36. { Public declarations }
  37. end;
  38.  
  39. var
  40. Nap: TNap;
  41.  
  42. implementation
  43.  
  44. uses
  45. MPlayer,O;
  46.  
  47. {$R *.dfm}
  48. var
  49.  
  50.  
  51. Date : Word;
  52. AlDate: Word;
  53.  
  54.  
  55. procedure TNap.FormCreate(Sender: TObject);
  56. begin
  57. Hour := HourOf(Now);
  58. Min := MinuteOf(Now);
  59.  
  60. Date := DayOf(Now);
  61.  
  62.  
  63. end;
  64.  
  65. procedure TNap.Timer1Timer(Sender: TObject);
  66.  
  67. var
  68. cHour,cMin: word;
  69. cDate :Word;
  70. begin
  71.  
  72. cHour := HourOf(Now);
  73. cMin := MinuteOf(Now);
  74. cDate := DayOf(Now);
  75.  
  76. then begin
  77.  
  78.  
  79. if cDate <> Date then
  80. begin
  81. Date := cDate;
  82.  
  83. end;
  84. if cHour <> Hour then
  85. begin
  86. Hour := cHour;
  87.  
  88. end;
  89.  
  90. if cMin <> Min then
  91. begin
  92. Min := cMin;
  93.  
  94. end;
  95.  
  96.  
  97. end
  98.  
  99.  
  100.  
  101. if (cDate=AlDate) and(cHour = AlHour) and (cMin = AlMin)
  102.  
  103. then begin
  104. Nap.Show;
  105. Timer1.Tag := 0;
  106. Timer1.Interval := 1000;
  107. try
  108.  
  109. except
  110. on EMCIDeviceError do ;
  111. end;
  112. end;
  113. end;
  114.  
  115. procedure TNap.UpDown1Click(Sender: TObject; Button: TUDBtnType);
  116. begin
  117. if UpDown1.Position < 10
  118. then RzLEDDisplay1.Caption := '0' + IntToStr(UpDown1.Position)
  119. else RzLEDDisplay1.Caption := IntToStr(UpDown1.Position);
  120. end;
  121.  
  122. procedure TNap.UpDown2Click(Sender: TObject; Button: TUDBtnType);
  123. begin
  124. if UpDown2.Position < 10
  125. then RzLEDDisplay2.Caption := '0' + IntToStr(UpDown2.Position)
  126. else RzLEDDisplay2.Caption := IntToStr(UpDown2.Position);
  127. end;
  128.  
  129. procedure TNap.Button1Click(Sender: TObject);
  130. begin
  131.  
  132. AlDate := DBEdit1.Height;
  133. AlHour := UpDown1.Position;
  134. AlMin := UpDown2.Position;
  135. Timer1.Tag := 1;
  136. CreateTrayIcon(1,'Nap '+
  137.  
  138.  
  139. Nap.Hide; //
  140.  
  141. end;
  142.  
  143. procedure TNap.FormClose(Sender: TObject; var Action: TCloseAction);
  144. begin
  145.  
  146. DeleteTrayIcon(1);
  147. end;
  148. const
  149. WM_MYTRAYNOTIFY = WM_USER + 123;
  150.  
  151. procedure TNap.CreateTrayIcon(n: integer; Tip: string);
  152. var
  153. nidata: TNotifyIconData;
  154. begin
  155.  
  156.  
  157.  
  158. with nidata do
  159. begin
  160. cbSize := SizeOf(TNotifyIconData);
  161.  
  162.  
  163.  
  164. uCallBackMessage := WM_MYTRAYNOTIFY;
  165. hIcon := Application.Icon.Handle;
  166.  
  167.  
  168. end;
  169. Shell_NotifyIcon(NIM_ADD, @nidata);
  170. end;
  171.  
  172.  
  173. procedure TNap.DeleteTrayIcon(n: integer);
  174. var
  175. nidata: TNotifyIconData;
  176. begin
  177.  
  178.  
  179.  
  180. with nidata do
  181. begin
  182. cbSize := SizeOf(TNotifyIconData);
  183.  
  184.  
  185. end;
  186. Shell_NotifyIcon(NIM_DELETE, @nidata);
  187. end;
  188.  
  189.  
  190. procedure TNap.SetSound;
  191. var
  192.  
  193. sWinDir: String[80];
  194. begin
  195.  
  196. MediaPlayer := TMediaPlayer.Create(Nap);
  197. MediaPlayer.ParentWindow := Nap.Handle;
  198. MediaPlayer.Visible := False;
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211. sWinDir := pWindir;
  212.  
  213.  
  214. if ParamStr(1) = ''
  215. then MediaPlayer.FileName := 'Sound.wav'
  216. else MediaPlayer.FileName := sWinDir + '\media\' + ParamStr(1);
  217.  
  218. try
  219. MediaPlayer.Open;
  220. except
  221. on EMCIDeviceError do ;
  222. end;
  223. end;
  224.  
  225. end.


Khabi Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Khabi (статус: Посетитель)
Вопрос отправлен: 20 февраля 2011, 08:47
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:22
Выполнено за 0.02 сек.