Будильник

Фрагмент работы:

 Вот фрагмент программы, который отвечает за отрисовку часов и сворачивание программы в системный трей:

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, Menus, jpeg, Registry, AlarmData, IniFiles, ShellApi,

  XPMan;

 

type

  TFMain = class(TForm)

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    Timer1: TTimer;

    Timer2: TTimer;

    PopupMenu1: TPopupMenu;

    N3: TMenuItem;

    N4: TMenuItem;

    XPManifest1: TXPManifest;

    procedure FormCreate(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure N1Click(Sender: TObject);

    procedure Timer2Timer(Sender: TObject);

    procedure FormResize(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure N3Click(Sender: TObject);

 

  private

    // эти объявления вставлены вручную

    clock: TBitMap; // изображение циферблата

    x0,y0: integer; // центр циферблата

    CurrentAlarm: TAlarm; // сработавший будильник

    Resizeble: Boolean;

    InTray: Boolean;

    procedure Tray(n: Integer; Icon: TIcon);

    procedure Autorun;

    procedure ReadSetup;

    procedure WriteSetup;

    procedure ClocInit;

    procedure Vector(x0,y0,a,l: integer; bm: TBitMap);

    procedure DrawClock;

  public

    { Public declarations }

  protected

    Procedure ControlWindow(Var Msg:TMessage); message WM_SYSCOMMAND;

    Procedure OnMinimizeProc(Sender:TObject);

    Procedure IconMouse(var Msg:TMessage); message WM_USER+1;

  end;

 

var

  FMain: TFMain;

 

implementation

 

{$R *.dfm}

 

uses

   DateUtils,

   UAlarms,

   UAlarm;

 

var

  R: Integer = 120 ;    // радиус циферблата часов

 

// добавить иконку в трей

// n - номер операции ( 1 - добавить, 2 - удалить, 3 - заменить)

// Icon - сама иконка с которой будет делаться эта операция

procedure TFMain.Tray(n: Integer; Icon: TIcon);

Var Nim: TNotifyIconData;

begin

  With Nim do Begin

    cbSize := SizeOf(Nim);

    Wnd := 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: begin Shell_NotifyIcon(Nim_Add, @Nim); InTray := True; end;

    2: begin Shell_NotifyIcon(Nim_Delete, @Nim); InTray := False; end;

    3: Shell_NotifyIcon(Nim_Modify, @Nim);

  End;

end;

 

// отлавливаем минимизацию окна

Procedure TFMain.ControlWindow(Var Msg:TMessage);

Begin

 IF Msg.WParam=SC_MINIMIZE then Begin

   Tray(1, Application.Icon);  // Добавляем значок в трей

   ShowWindow(Handle, SW_HIDE);  // Скрываем программу

   ShowWindow(Application.Handle, SW_HIDE);  // Скрываем кнопку с TaskBar'а

 End else inherited;

End;

 

Procedure TFMain.OnMinimizeProc(Sender:TObject);

Begin

  PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);

End;

 

// клик по иконке в трее

procedure TFMain.IconMouse(var Msg:TMessage);

Var p: tpoint;

begin

  GetCursorPos(p); // Запоминаем координаты курсора мыши

  Case Msg.LParam OF  // Проверяем какая кнопка была нажата

    WM_LBUTTONUP,WM_LBUTTONDBLCLK: {Действия, выполняемый по одинарному или двойному щелчку левой кнопки мыши на значке.

                                    В нашем случае это просто активация приложения}

                   Begin

                     Tray(2, Application.Icon);  // Удаляем значок из трея

                     ShowWindow(Application.Handle, SW_SHOW); // Восстанавливаем кнопку программы

                     ShowWindow(Handle, SW_SHOW); // Восстанавливаем окно программы

                   End;

    WM_RBUTTONUP: {Действия, выполняемый по одинарному щелчку правой кнопки мыши}

    Begin

      SetForegroundWindow(Handle);  // Восстанавливаем программу в качестве переднего окна

      PopupMenu1.Popup(p.X, p.Y);  // Заставляем всплыть тот самый TPopUp о котором я говорил чуть раньше

      PostMessage(Handle, WM_NULL, 0, 0);

     end;

  End;

end;

 

// прописываем программу в автозагрузку

procedure TFMain.Autorun;

var

  reg: tregistry;

begin

  reg := tregistry.create;

  reg.rootkey := HKEY_CURRENT_USER;

  reg.lazywrite := false;

  reg.openkey('software\microsoft\windows\currentversion\run', false);

  reg.writestring('Alarm', application.exename);

  reg.closekey;

  reg.free;

end;

 

// чтение данных из ini-файла

procedure TFMain.ReadSetup;

var

  ini: TIniFile;

begin

  ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

  try

    R := ini.ReadInteger('Alarm', 'R', R);

    Left := ini.ReadInteger('Alarm', 'Left', Left);

    Top := ini.ReadInteger('Alarm', 'Top', Top);

    InTray := ini.ReadBool('Alarm', 'Tray', InTray);

  finally

    ini.Free;

  end;

end;

 

// запись данных в ini-файла

procedure TFMain.WriteSetup;

var

  ini: TIniFile;

begin

  ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

  try

    ini.WriteInteger('Alarm', 'R', R);

    ini.WriteInteger('Alarm', 'Left', Left);

    ini.WriteInteger('Alarm', 'Top', Top);

    ini.WriteBool('Alarm', 'Tray', InTray);

  finally

    ini.Free;

  end;

end;

 

// создание циферблата часов

procedure TFMain.ClocInit;

var

    x,y: integer;    // координаты маркера на циферблате

    a: integer;      // угол между Ox и прямой (x0,yo) (x,y)

    h: integer;      // метка часовой риски

begin

  // создаем битмап для рисования циферблата

  clock := TBitMap.Create;

  clock.Width := (R+30)*2;

  clock.Height := (R+30)*2;

  x0 := clock.Width div 2;

  y0 := clock.Height div 2;

 

  with clock do begin

    Canvas.Brush.Style := bsClear;

    Canvas.Pen.Width := 1;

    Canvas.Pen.Color := clBlack;

 

    a:=0; // метки ставим от 3-х часов, против

          // часовой стрелки

    h:=3; // угол 0 градусов - это 3 часа

 

    // циферблат

    while a < 360 do

    begin

      x:=x0+Round( R * cos(a*pi/180));

      y:=x0-Round( R * sin(a*pi/180));

      Canvas.MoveTo(x,y);

      if (a mod 30) = 0 then

          begin

              Canvas.Ellipse(x-2,y-2,x+3,y+3);

              // цифры по большему радиусу

              x:=x0+Round( (R+15) * cos(a*pi/180));

              y:=x0-Round( (R+15) * sin(a*pi/180));

              Canvas.TextOut(x-5,y-7,IntToStr(h));

              dec(h);

              if h = 0 then h:=12;

          end

          else Canvas.Ellipse(x-1,y-1,x+1,y+1);

      a:=a+6; // 1 минута - 6 градусов

    end;

  end;

end;

 

// инициализация формы

procedure TFMain.FormCreate(Sender: TObject);

begin

  Resizeble := False;

  InTray := False;

  Autorun;

  ReadSetup;

  ClocInit;

  ListLoad;

 

  CurrentAlarm.Count := 0;

 

  // зададим размер формы

  // в соответствии с размером циферблата

  ClientHeight := clock.Width;

  ClientWidth  := clock.Height;

 

  Timer1.Interval := 500; // период сигнал от таймера 0.5 сек

  Timer1.Enabled := True;  // пуск таймера

  Timer2.Enabled := True;

 

  Application.onMinimize := OnMinimizeProc;

  if InTray then

    PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);

end;

 

// вычерчивает вектор заданной длины из точки (x0,y0)

procedure TFMain.Vector(x0,y0: integer; a, l: integer; bm: TBitMap);

    // x0,y0 - начало вектора

    // a - угол между осью x и вектором

    // l - длина вектора

const

  GRAD = Pi / 180;   // коэффициент пересчета угла из градусов в радианы

var

  x,y: integer;       // координаты конца вектора

begin

  bm.Canvas.MoveTo(x0,y0);

  x := Round(x0 + l*cos(a*GRAD));

  y := Round(y0 - l*sin(a*GRAD));

  bm.Canvas.LineTo(x,y);

end;

 

// рисует стрелки

procedure TFMain.DrawClock;

var

    t: TDateTime;

    H, M, S: Word;

    ahr, amin, asec: Integer;

    str: string;

    bm: TBitMap;

begin

  // шаг секундной и минутной стрелок 6 градусов,

  // часовой - 30.

 

  // создаем битмап для рисования часов

  bm := TBitMap.Create;

  bm.Width := clock.Width;

  bm.Height := clock.Height;

  bm.Canvas.Draw(0, 0, clock);

 

  // получаем текущее время

  t := Now();

  H := HourOf(t);

  M := MinuteOf(t);

  S := SecondOf(t);

 

  // новое положение стрелок

  ahr :=  90 - H * 30-(M div 12)*6;

  amin := 90 - M * 6;

  asec := 90 - S * 6;

 

  // нарисовать стрелки

  // часовая стрелка

  bm.Canvas.Pen.Width := 4;

  bm.Canvas.Pen.Color := clBlack;

  Vector(x0,y0, ahr, R-40, bm);

 

  // минутная стрелка

  bm.Canvas.Pen.Width := 2;

  bm.Canvas.Pen.Color := clBlack;

  Vector(x0,y0, amin, R-10, bm);

 

  // секундная стрелка

  bm.Canvas.Pen.Width := 1;

  bm.Canvas.Pen.Color := clRed;

  Vector(x0,y0, asec, R-7, bm);

 

  // кружочек посредине стрелок

  bm.Canvas.Pen.Color := clBlack;

  bm.Canvas.Ellipse(x0-5, y0-5, x0+6, y0+6);

 

 

  // отображаем часы на форме

  Canvas.Draw(0, 0, bm);

  bm.Free;

 

  // выводим время в заголовок окна

  if H < 10 then str := '0' else str := '';

  str := str + IntToStr(H) + ':';

  if M < 10 then str := str + '0';

  str := str + IntToStr(M) + ':';

  if S < 10 then str := str + '0';

  str := str + IntToStr(S);

  Caption := str;

  Application.Title := str;

end;

 

// прорисовка циферблата и стрелок

procedure TFMain.FormPaint(Sender: TObject);

begin

  DrawClock;

end;

 

procedure TFMain.Timer1Timer(Sender: TObject);

begin

  DrawClock;

end;

 

procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  clock.Free;

  WriteSetup;

end;

 

procedure TFMain.N1Click(Sender: TObject);

begin

  FAlarms.ShowModal;

  ListLoad;

end;

 

// проверка будильников на срабатывание

procedure TFMain.Timer2Timer(Sender: TObject);

var

  Alarm: TAlarm;

  t: TDateTime;

  H, M: Word;

  MR: TModalResult;

begin

  Timer2.Enabled := False;

  t := Now();

  H := HourOf(t);

  M := MinuteOf(t);

  if AlarmNow(Alarm) then CurrentAlarm := Alarm;

  if (CurrentAlarm.Count > 0) and (CurrentAlarm.Hour = H) and (CurrentAlarm.Mins = M) then begin

    Application.CreateForm(TFAlarm, FAlarm);

    Dec(CurrentAlarm.Count);

    FAlarm.Alarm := CurrentAlarm;

    Inc(CurrentAlarm.Mins, CurrentAlarm.Interval);

    if CurrentAlarm.Mins > 59 then begin

      Dec(CurrentAlarm.Mins, 60);

      Inc(CurrentAlarm.Hour);

      if CurrentAlarm.Hour > 23 then Dec(CurrentAlarm.Hour, 24);

    end;

    MR := FAlarm.ShowModal;

    FAlarm.Free;

    if MR = mrAbort then CurrentAlarm.Count := 0;

  end;

  Timer2.Enabled := True;

  Resizeble := True;

end;

 

procedure TFMain.FormResize(Sender: TObject);

begin                                            

  if Resizeble then begin

    if ClientWidth > ClientHeight then ClientHeight := ClientWidth;

    if ClientHeight > ClientWidth then ClientWidth := ClientHeight;

    R := ClientWidth div 2 - 30;

    ClocInit;

    DrawClock;

  end;

end;

 

procedure TFMain.N4Click(Sender: TObject);

begin

  Close;

  Tray(2, Application.Icon);  // Удаляем значок из трея

end;

 

procedure TFMain.N3Click(Sender: TObject);

begin

  Tray(2, Application.Icon);  // Удаляем значок из трея

  ShowWindow(Application.Handle, SW_SHOW); // Восстанавливаем кнопку программы

  ShowWindow(Handle, SW_SHOW); // Восстанавливаем окно программы

end;

 

end.

 

Список использованной литературы:

 

1 Архангельский, А.Я. Программирование в Delphi 7. – М.: ЗАО «Бином – Пресс», 2010. – 1152 с.

2 Галисеев, Г. В. Программирование в среде Delphi 7. Самоучитель. – М.: Дрофа, 2012. – 765 с.

3 Фаронов, В. В. Delphi. Программирование на языке высокого уровня: Учебник для вузов. – СПб.: Питер, 2010. – 640 с.

4 Культин, Н.Б. «Основы программирования в Delphi 7». 2006г. с.608

5 Чиртик, А.А.: Программирование в Delphi. - СПб: Питер, 201 0

6 Бобровский, С.: Delphi 7. Учебный курс – СПб: Питер, 2006

Цена сегодня: 30.00 бел.руб.

---

Вы находитесь на сайте как незарегистрированный пользователь.
Для покупки работы Вам необходимо заполнить все поля ниже: