Исходники и листинги ::: Delphi ::: Будильник v. 1.0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
  unit MainUnit;
  interface
  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls,mmsystem, MPlayer,shellapi, Menus;
  type
      TMainForm = class(TForm)
      LabelTime: TLabel;
      TimerTime: TTimer;
      ButtonOptions: TButton;
      ButtonHide: TButton;
      ButtonExit: TButton;
      TimerFixed: TTimer;
      MediaPlayer: TMediaPlayer;
      PopupMenuTray: TPopupMenu;
      NOpenBud: TMenuItem;
      NCloseBud: TMenuItem;
      procedure FormCreate(Sender: TObject);
      procedure TimerTimeTimer(Sender: TObject);
      procedure ButtonExitClick(Sender: TObject);
      procedure ButtonOptionsClick(Sender: TObject);
      procedure TimerFixedTimer(Sender: TObject);
      procedure ButtonHideClick(Sender: TObject);
      procedure NCloseBudClick(Sender: TObject);
      procedure NOpenBudClick(Sender: TObject);
    private
      procedure budOK;
      Procedure Ic(n:Integer;Icon:TIcon);
      Procedure ControlWindow(Var Msg:TMessage); message WM_SYSCOMMAND;
      Procedure IconMouse(var Msg:TMessage); message WM_USER+1;
    public
      { Public declarations }
    end;
  var
    MainForm: TMainForm;
    NowDateMain:TDateTime;
    NowTimeMain:TDateTime;
    namesoundbud:string;
  implementation
  uses UnitOptions;
  {$R *.dfm}
  procedure TMainForm.FormCreate(Sender: TObject);
  begin
    labelTime.Caption:=timetostr(now);
  end;
  procedure TMainForm.TimerTimeTimer(Sender: TObject);
  begin
    labeltime.Caption:=timetostr(now);
  end;
  procedure TMainForm.ButtonExitClick(Sender: TObject);
  begin
    mainform.Close;
  end;
  procedure TMainForm.ButtonOptionsClick(Sender: TObject);
  begin
    formOptions.show;
  end;
  procedure TMainForm.BudOk;
  begin
    Ic(2,Application.Icon);
    ShowWindow(Application.Handle,SW_SHOW);
    ShowWindow(Handle,SW_SHOW);
    mediaplayer.Play;
  end;
  procedure TMainForm.TimerFixedTimer(Sender: TObject);
  begin
    if labelTime.Caption=timetostr(nowtimeMain) then
    begin
      budok;
      exit;
    end;
  end;
  Procedure TMainform.Ic(n:Integer;Icon:TIcon);
  Var Nim:TNotifyIconData;
  begin
   With Nim do
    Begin
     cbSize:=SizeOf(Nim);
     Wnd:=Mainform.Handle;
     uID:=1;
     uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
     hicon:=Icon.Handle;
     uCallbackMessage:=wm_user+1;
     szTip:='Будильник v. 1.0';
    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 TMainForm.ButtonHideClick(Sender: TObject);
  begin
    Ic(1,Application.Icon);  // Добавляем значок в трей
    ShowWindow(Handle,SW_HIDE);  // Скрываем программу
    ShowWindow(Application.Handle,SW_HIDE);
  end;
  procedure tMainform.IconMouse(var Msg:TMessage);
  Var p:tpoint;
  begin
   GetCursorPos(p);
   Case Msg.LParam OF
    WM_LBUTTONUP,WM_LBUTTONDBLCLK:
                     Begin
                      Ic(2,Application.Icon);
                      ShowWindow(Application.Handle,SW_SHOW);
                      ShowWindow(Handle,SW_SHOW);
                     End;
    WM_RBUTTONUP:
     Begin
      SetForegroundWindow(Handle);
      PopupMenuTray.Popup(p.X,p.Y);
      PostMessage(Handle,WM_NULL,0,0);
     end;
   End;
  end;
  Procedure TMainform.ControlWindow(Var Msg:TMessage);
  Begin
   IF Msg.WParam=SC_MINIMIZE then
    Begin
     Ic(1,Application.Icon);
     ShowWindow(Handle,SW_HIDE);
     ShowWindow(Application.Handle,SW_HIDE);
   End else inherited;
  End;
  procedure TMainForm.NCloseBudClick(Sender: TObject);
  begin
  mainform.Close;
  end;
 
  procedure TMainForm.NOpenBudClick(Sender: TObject);
  begin
    Ic(2,Application.Icon);
    ShowWindow(Application.Handle,SW_SHOW);
    ShowWindow(Handle,SW_SHOW);
  end;
 
  end.
 
  unit UnitOptions;
 
  interface
 
  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ComCtrls, Spin, ExtCtrls, MPlayer;
 
  type
    TFormOptions = class(TForm)
      ButtonOk: TButton;
      ButtonCancel: TButton;
      GroupBoxInstTime: TGroupBox;
      DateTimePickerTime: TDateTimePicker;
      DateTimePickerDate: TDateTimePicker;
      GroupBoxInstSound: TGroupBox;
      ButtonBrSound: TButton;
      StaticSound: TStaticText;
      OpenDialog1: TOpenDialog;
      ButtonFormColor: TButton;
      ColorDialog1: TColorDialog;
      PanelColor: TPanel;
      procedure ButtonCancelClick(Sender: TObject);
      procedure ButtonBrSoundClick(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure ButtonOkClick(Sender: TObject);
      procedure DateTimePickerTimeChange(Sender: TObject);
      procedure DateTimePickerDateChange(Sender: TObject);
      procedure ButtonFormColorClick(Sender: TObject);
    private
      { Private declarations }
    public
      { Public declarations }
    end;
  var
    FormOptions: TFormOptions;
    SoundName:string;
    NowTime:TDateTime;
    NowDate:TDateTime;
  implementation
  uses MainUnit;
  {$R *.dfm}
  procedure TFormOptions.ButtonCancelClick(Sender: TObject);
  begin
    FormOptions.Close;
  end;
  procedure TFormOptions.ButtonBrSoundClick(Sender: TObject);
  begin
    if opendialog1.Execute then soundname:=opendialog1.FileName;
    staticsound.caption:=soundname;
    staticsound.hint:=soundname;
  end;
 
  procedure TFormOptions.FormCreate(Sender: TObject);
  begin
    datetimepickerdate.Date:=now;
    datetimepickerdate.time:=now;
    datetimepickerdate.MinDate:=date;
    NowTime:=datetimepickertime.DateTime;
    nowdate:=datetimepickertime.date;
    staticsound.Caption:=mainform.MediaPlayer.FileName;
    staticsound.Hint:=staticsound.Caption;
    panelcolor.Color:=formoptions.Color;
  end;
 
  procedure TFormOptions.ButtonOkClick(Sender: TObject);
  begin
    soundname:=staticsound.Caption;