main.~pas

这是个delphi编写的小闹钟！大家用用看看 应该瞒好用的吧

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, MMSystem, ShellAPI;

const
  App_Name = 'Alarm Clock';
  App_Ver = 'v1.0';
  WM_CallBack = WM_USER;

type
  TAClockSettings = record
    SaveAfterClose: Boolean;
    AutoEnable: Boolean;
    AlarmSound: String;
  end;

  TfrmMain = class(TForm)
    btnAdd: TBitBtn;
    btnAlarm: TSpeedButton;
    btnDel: TBitBtn;
    btnEdit: TBitBtn;
    btnSettings: TBitBtn;
    bvSep1: TBevel;
    edTime: TEdit;
    gbActions: TGroupBox;
    gbAlarms: TGroupBox;
    gbDetails: TGroupBox;
    lbAlarms: TListBox;
    lblMessage: TLabel;
    lblTime: TLabel;
    memMessage: TMemo;
    tmrAlarm: TTimer;
    procedure WM_CallBackPro(var MSG: TMessage); message WM_CallBack;
    procedure MinimizeToTray(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnEditClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure lbAlarmsClick(Sender: TObject);
    procedure lbAlarmsDblClick(Sender: TObject);
    procedure lbAlarmsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure tmrAlarmTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnAlarmClick(Sender: TObject);
    procedure btnSettingsClick(Sender: TObject);
  private
  public
    Alarms: TStringList;
    Times: TStringList;
    Messages: TStringList;
    function GetShortName(sLongName: String): String;
  end;

var
  frmMain: TfrmMain;
  TheSettings: TAClockSettings;
  Mode: Integer;
  Busy: Boolean;
  SAlarm: Boolean;
  T, D, C: String;
  hh, mm, ss, ms: Word;
  tmp: PChar;
  ICO: HICON;
  TrayIcon: TNotifyIconData;

implementation

uses Alarms, Alarm, Settings;

{$R *.dfm}

procedure TfrmMain.WM_CALLBACKPRO(var MSG: TMessage);
begin
  case MSG.LParam of
    WM_LBUTTONDOWN: begin
        Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
        frmMain.Visible := True;
        Application.Restore;
      end; {WM_LBUTTONDOWN}
  end; {case}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.MinimizeToTray(Sender: TObject);
begin
  frmMain.Visible := False;
  ICO := Application.Icon.Handle;
  Trayicon.cbSize := SizeOf(TNotifyIconData);
  Trayicon.Wnd := Handle;
  Trayicon.szTip := (App_Name + ' ' + App_Ver);
  Trayicon.uID := 1;
  TrayIcon.hIcon := ICO;
  TrayIcon.uCallBackMessage := WM_CallBack;
  Trayicon.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  Shell_NotifyIcon(NIM_ADD, @TrayIcon);
end;

//=============================================================================
//=============================================================================

function DATFile: String;
begin
  Result := ExtractFilePath(ParamStr(0)) + 'alarms.dat';
end;

//=============================================================================
//=============================================================================

function TfrmMain.GetShortName(sLongName: String): String;
var
  sShortName: String;
  nShortNameLen: Integer;
begin
  SetLength(sShortName, MAX_PATH);
  nShortNameLen := GetShortPathName(PChar(sLongName), PChar(sShortName), MAX_PATH - 1);
  SetLength(sShortName, nShortNameLen);
  Result := sShortName;
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.FormCreate(Sender: TObject);
var
  Source: TextFile;
  Bucket: String;
begin
  Application.Title := (App_Name + ' ' + App_Ver);
  frmMain.Caption := Application.Title;

  Alarms := TStringList.Create;
  Times := TStringList.Create;
  Messages := TStringList.Create;

  if FileExists(DATFile) then begin
    AssignFile(Source, DATFile);
    Reset(Source);

    try

      // Reading Settings...
      ReadLn(Source, Bucket);
      case StrToInt(Bucket) of
        0: TheSettings.SaveAfterClose := False;
        1: TheSettings.SaveAfterClose := True;
      end; {case}

      ReadLn(Source, Bucket);
      case StrToInt(Bucket) of
        0: TheSettings.AutoEnable := False;
        1: TheSettings.AutoEnable := True;
      end; {case}

      ReadLn(Source, Bucket);
      TheSettings.AlarmSound := Bucket;

      ReadLn(Source, Bucket);

      // Reading Alarms...
      while not EOF(Source) do begin
        {-}ReadLn(Source, Bucket);

        {1}ReadLn(Source, Bucket);
        lbAlarms.Items.Add(Bucket);
        Alarms.Add(Bucket);

        {2}ReadLn(Source, Bucket);
        Times.Add(Bucket);

        {3}ReadLn(Source, Bucket);
        Messages.Add(Bucket);
      end; {while}

    except
    end; {try}

    CloseFile(Source);
  end
  else begin
    Application.MessageBox('File "alarms.dat" not found, creating a new one with default settings.', 'Information', MB_ICONINFORMATION);

    AssignFile(Source, DATFile);
    Rewrite(Source);

    // Writing Default Settings...
    WriteLn(Source, '1');
    WriteLn(Source, 'Sounds\ring.wav');
    WriteLn(Source, '-');

    CloseFile(Source);
  end; {if}

  if (lbAlarms.Items.Count > 0) then begin
    lbAlarms.ItemIndex := 0;
    lbAlarmsClick(nil);
  end; {if}

  if (TheSettings.AutoEnable) then
    btnAlarmClick(nil);

  Busy := False;

  Application.OnMinimize := MinimizeToTray;
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.btnAddClick(Sender: TObject);
begin
  with frmAlarms do begin
    Mode := 1;
    Caption := 'New Alarm';
    edAlarm.Text := '';
    edTime.Text := '';
    memMessage.Text := '';
    ShowModal;
  end; {with}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.btnEditClick(Sender: TObject);
begin
  if (lbAlarms.Items.Count = 0) then Exit;

  with frmAlarms do begin
    Mode := 2;
    Caption := 'Edit Alarm';
    edAlarm.Text := Alarms[lbAlarms.ItemIndex];
    edTime.Text := Times[lbAlarms.ItemIndex];
    memMessage.Text := Messages[lbAlarms.ItemIndex];
    ShowModal;
  end; {with}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.btnDelClick(Sender: TObject);
begin
  if (lbAlarms.Items.Count = 0) then Exit;

  if (Application.MessageBox('Are you sure?', 'Question', MB_ICONQUESTION + MB_YESNO) = IDYES) then begin
    Alarms.Delete(lbAlarms.ItemIndex);
    Times.Delete(lbAlarms.ItemIndex);
    Messages.Delete(lbAlarms.ItemIndex);
    lbAlarms.Items.Delete(lbAlarms.ItemIndex);
    if (lbAlarms.Items.Count >= 1) then begin
      lbAlarms.ItemIndex := 0;
      lbAlarmsClick(nil);
    end
    else begin
      edTime.Text := '';
      memMessage.Text := '';
    end; {if}
  end; {if}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.btnSettingsClick(Sender: TObject);
begin
  frmSettings.ShowModal;
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.lbAlarmsClick(Sender: TObject);
begin
  if (lbAlarms.Items.Count = -1) then Exit;

  edTime.Text := Times[lbAlarms.ItemIndex];
  memMessage.Text := Messages[lbAlarms.ItemIndex];
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.lbAlarmsDblClick(Sender: TObject);
begin
  btnEditClick(nil);
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.lbAlarmsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  R: TRect;
begin
  with lbAlarms.Canvas do begin
    Brush.Color := lbAlarms.Color;
    FillRect(Rect);

    R := Rect;
    R.Left := 11;
    DrawText(lbAlarms.Canvas.Handle, PChar(lbAlarms.Items[Index]), Length(lbAlarms.Items[Index]), R, DT_VCENTER);

    if (odSelected in State) then begin
      with Font do begin
        Size := 8;
        Font.Style := [fsBold];
        Color := clRed;
      end; {with}

      R := Rect;
      R.Left := 1;
      R.Right := 10;
      DrawText(lbAlarms.Canvas.Handle, Chr(149), 1, R, DT_VCENTER);

      with Font do begin
        Size := 8;
        Font.Style := [fsBold];
        Color := clNavy;
      end; {with}

      R := Rect;
      R.Left := 11;
      DrawText(lbAlarms.Canvas.Handle, PChar(lbAlarms.Items[Index]), Length(lbAlarms.Items[Index]), R, DT_VCENTER);
    end; {if}

    if (odFocused in State) then DrawFocusRect(Rect);
  end; {with}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Target: TextFile;
  Walk: Integer;
begin
  if (TheSettings.SaveAfterClose) then begin
    AssignFile(Target, DATFile);
    Rewrite(Target);

    // Writing Settings...
    if (TheSettings.SaveAfterClose) then
      WriteLn(Target, '1')
    else
      WriteLn(Target, '0');

    if (TheSettings.AutoEnable) then
      WriteLn(Target, '1')
    else
      WriteLn(Target, '0');

    WriteLn(Target, TheSettings.AlarmSound);

    WriteLn(Target, '-');

    for Walk := 0 to lbAlarms.Items.Count - 1 do begin
      WriteLn(Target, '-');
      WriteLn(Target, Alarms[Walk]);
      WriteLn(Target, Times[Walk]);
      WriteLn(Target, Messages[Walk]);
    end; {for}

    Alarms.Free;
    Times.Free;
    Messages.Free;

    CloseFile(Target);
  end; {if}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.tmrAlarmTimer(Sender: TObject);
var
  i: Integer;
begin
  if (Busy) then Exit;

  DecodeTime(Now, hh, mm, ss, ms);
  T := FormatDateTime('hh:nn', Time);

  for i := 0 to lbAlarms.Items.Count - 1 do begin
    if (T = Times[i]) then begin
      with frmAlarm do begin
        Caption := ('Alarm: ' + Alarms[i]);
        lblAlarm.Caption := Alarms[i];
        lblTime.Caption := Times[i];
        memMessage.Text := Messages[i];
        Busy := True;
        if FileExists(TheSettings.AlarmSound) then begin
          mciSendString('Stop MM', tmp, 0, 0);
          mciSendString('Close MM', tmp, 0, 0);
          mciSendString(PChar('Open ' + TheSettings.AlarmSound + ' Alias MM'), tmp, 0, 0);
          mciSendString('Play MM', tmp, 0, 0);
        end; {if}
        Show;
      end; {with}
    end; {if}
  end; {for}
end;

//=============================================================================
//=============================================================================

procedure TfrmMain.btnAlarmClick(Sender: TObject);
begin
  if (SAlarm) then begin
    SAlarm := False;
    btnAlarm.Down := False;
    tmrAlarm.Enabled := False;
    frmMain.Caption := (App_Name + ' ' + App_Ver + ' - [Status: Disabled]');
  end
  else begin
    SAlarm := True;
    btnAlarm.Down := True;
    tmrAlarm.Enabled := True;
    frmMain.Caption := (App_Name + ' ' + App_Ver + ' - [Status: Enabled]');
  end; {if}
end;

end.