control.pas

小闹钟程序

unit Control;

// 本模块实现内存索引（数据处理）和数据库管理

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, ScktComp, BDE, ComCtrls ,registry,extctrls,math,DateUtils;

type
  TControlSystem = class;

  TControlSystem = class(TObject)
  private
    FMode:Integer;
    FAction :Integer;
    FMemo : String;
    FSound:String;
    FProgram:String;
    FDate:TDate;
    FTime:TTime;
    FWeek:Integer;
    FID : Word;
    procedure SetMode(const Value : Integer);
    procedure SetAction(const Value : Integer);
    procedure SetMemo(const Value: String);
    procedure SetSound(const Value: String);
    procedure SetProgram(const Value: String);
    procedure SetDate(const Value: TDate);
    procedure SetTime(const Value: TTime);
    procedure SetWeek(const Value:Integer);

  public
    Constructor Create;
    Destructor Destroy; override;

    // Property Editor
    Procedure ShowProp;

    // Property
    Property Mode:Integer Read FMode Write SetMode;
    Property Action:Integer Read FAction Write SetAction;
    Property Memo : String Read FMemo Write SetMemo;
    Property Sound : String Read FSound Write SetSound;
    Property ExeProgram : String Read FProgram Write SetProgram;
    Property Date:TDate Read FDate Write SetDate;
    Property Time :TTime Read FTime Write SetTime;
    Property Week:Integer Read FWeek Write SetWeek;
    Property ID : Word Read FID;

  end;

  TControlModule = class(TDataModule)
    SysTable: TTable;
    Session1: TSession;
    BackTable: TTable;
    OptionTable: TTable;
    SoundTable: TTable;
    procedure ControlModuleCreate(Sender: TObject);
    procedure ControlModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    FSysList : TList;
    Procedure BuildMemTree;
  public
    { Public declarations }
    Function GetSystemCount : Integer;
    Function GetSystem(Index : Integer) : TControlSystem; Overload;
    Function GetSystem(SysName : String) : TControlSystem; Overload;
    Procedure AddSystem; Overload;
    Procedure AddSystem(ASystem : TControlSystem); Overload;

    Procedure AddSystem(AMemo : String;
                        AMode:Integer;
                        AAction:Integer;
                        ASound:String;
                        AProgram:String;
                        ADate:TDate;
                        ATime:TTime;
                        AWeek:Integer); Overload;

    Procedure DelSystem(ASystem : TControlSystem); Overload;
    Procedure DelSystem(Index : Integer); Overload;
    Procedure DelSystem(SystemName : String); Overload;
  end;

  Function GetListItem(ASystem : TControlSystem) : TListItem;
var
  ControlModule: TControlModule;

implementation

uses Option,AlarmOption, SysEdit,Clock;

{$R *.DFM}

Function GetListItem(ASystem : TControlSystem) : TListItem;
var
  I : Integer;
begin
  Result := Nil;
  with frmAlarmOption.CtrlList do
  begin
    for I := 0 to Items.Count - 1 do
    begin
      if Items[I].Data = ASystem then
      begin
        Result := Items[I];
        Break;
      end;
    end;
  end;
end;

{ TControlSystem }
procedure TControlSystem.SetMemo(const Value: String);
var
  TempListItem : TListItem;
begin
  if FMemo = Value then
    Exit;
  FMemo := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('提示信息').AsString := Value;
    Post;
  end;

  TempListItem := GetListItem(Self);

  if TempListItem <> Nil then
  begin
    TempListItem.Caption:= FMemo;
  end;
end;

procedure TControlSystem.SetMode(const Value: Integer);
var
  TempListItem : TListItem;
begin
  if FMode = Value then
    Exit;
  FMode := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('闹铃方式').AsInteger := Value;
    Post;
  end;

  TempListItem := GetListItem(Self);

  if TempListItem <> Nil then
  begin
    TempListItem.SubItems.Strings[0] := FormatDateTime('hh "时"mm"分"ss"秒"',self.Time)+IntToStr(FMode);
  end;
end;

procedure TControlSystem.SetAction(const Value: Integer);
var
  TempListItem : TListItem;
begin
  if FAction = Value then
    Exit;
  FAction := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;
    Edit;
    FieldByName('闹铃动作').AsInteger := Value;
    Post;
  end;
end;

procedure TControlSystem.SetDate(const Value: TDate);
var
  TempListItem : TListItem;
begin
  if FDate = Value then
    Exit;
  FDate := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('日期').AsDateTime := Value;
    Post;
  end;
end;

procedure TControlSystem.SetWeek(const Value: Integer);
var
  TempListItem : TListItem;
begin
  if FWeek = Value then
    Exit;
  FWeek := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('星期').AsInteger := Value;
    Post;
  end;
end;


procedure TControlSystem.SetTime(const Value: TTime);
var
  TempListItem : TListItem;
begin
  if FTime = Value then
    Exit;
  FTime := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('时间').AsDateTime := Value;
    Post;
  end;

  TempListItem := GetListItem(Self);
  if TempListItem <> Nil then
  begin
    TempListItem.SubItems.Strings[0] := FormatDateTime('hh "时"mm"分"ss"秒"',self.Time)+IntToStr(FMode);
  end;
end;

procedure TControlSystem.SetProgram(const Value: String);
var
  TempListItem : TListItem;
begin
  if FProgram = Value then
    Exit;
  FProgram := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('运行程序').AsString := Value;
    Post;
  end;
end;

procedure TControlSystem.SetSound(const Value: String);
var
  TempListItem : TListItem;
begin
  if FSound = Value then
    Exit;
  FSound := Value;
  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ID then
            break;
        Next;
    end;

    Edit;
    FieldByName('提示声音').AsString := Value;
    Post;
  end;
end;

constructor TControlSystem.Create;
begin
  inherited Create;
end;

destructor TControlSystem.Destroy;
begin
  Inherited Destroy;
end;

procedure TControlSystem.ShowProp;
var
    AYear,AWeekOfYear,ADayOfWeek: Word;
    AMode:Integer;
    AMemo:String;
    TempListItem:TListItem;
begin
  with SysEditor do
  begin
    if FMode=1 then
        Mode_1.Checked:=True;
    if FMode=2 then
        Mode_2.Checked:=True;
    if FMode=3 then                                   
        Mode_3.Checked:=True;
    if FMode=4 then
        Mode_4.Checked:=True;
    if FMode=5 then
        Mode_5.Checked:=True;
    cmb_Action.ItemIndex:=FAction;

    if Copy(FSound,1,1)='1' then
    begin
      Sound_1.Checked:=True;
      edt_SoundFile.Text:=Copy(FSound,2,Length(FSound)-1);
    end
    else
    begin
      Sound_2.Checked:=True;
      cmb_Sound.Text:=Copy(FSound,2,Length(FSound)-1);
    end;

    edt_Hint.Text:=Copy(FMemo,1,Pos('(',FMemo)-1);
    edt_Program.Text:=FProgram;
    ADate.Date:=Date;
    ATime.Time:=Time;
    DecodeDateWeek(ADate.DateTime,AYear,AWeekOfYear,ADayOfWeek);
    Aweek.DateTime:=EncodeDateWeek(AYear,AWeekOfYear,Week);
  end;

  if SysEditor.ShowModal = mrOk then
  begin
    with SysEditor do
    begin

      if Mode_1.Checked then
      begin
        AMode:=1;
        AMemo:=edt_Hint.Text+'('+FormatDateTime('yyyy "年"MM"月"dd"日"',ADate.Date)+')';
      end;

      if Mode_2.Checked then