control.pas

小闹钟程序

      begin
        AMode:=2;
        AMemo:=edt_Hint.Text+'(每天)';
      end;

      if Mode_3.Checked then
      begin
        AMode:=3;
        AMemo:=edt_Hint.Text+'(每'+FormatDateTime('ddd',AWeek.Date)+')';
      end;

      if Mode_4.Checked then
      begin
        AMode:=3;
        AMemo:=edt_Hint.Text+'(每月'+FormatDateTime('dd"日"',ADate.Date)+')';
      end;

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

      SetMemo(AMemo);
      SetMode(AMode);
      SetAction(cmb_Action.ItemIndex);
      if Sound_1.Checked then
        SetSound('1'+ edt_SoundFile.Text);
      if Sound_2.Checked then
        SetSound('2'+ cmb_Sound.Text);
      SetProgram(edt_Program.Text);
      SetDate(ADate.Date);
      SetTime(ATime.Time);
      DecodeDateWeek(AWeek.DateTime,AYear,AWeekOfYear,ADayOfWeek);
      SetWeek(ADayOfWeek);

      TempListItem := GetListItem(self);
      TempListItem.Caption := self.Memo;
      TempListItem.SubItems.Strings[0]:=FormatDateTime('hh "时"mm"分"ss"秒"',self.Time);
      TempListItem.Data := self;
      TempListItem.ImageIndex := 1;
    end;
  end;
end;

{ TControlModule }
procedure TControlModule.AddSystem;
var
    AMemo:String;
    AMode:Integer;
    AAction:Integer;
    ASound:String;
    AYear,AWeekOfYear,ADayOfWeek:Word;
    dlg:TSysEditor;
begin
  dlg:=TSysEditor.Create(self);
  if dlg.ShowModal = mrOk then
  begin
    with dlg do
    begin
      DecodeDateWeek(AWeek.DateTime,AYear,AWeekOfYear,ADayOfWeek);
      if Mode_1.Checked then
      begin
        AMode:=1;
        AMemo:=edt_Hint.Text+'('+FormatDateTime('yyyy "年"MM"月"dd"日"',ADate.Date)+')';
      end;

      if Mode_2.Checked then
      begin
        AMode:=2;
        AMemo:=edt_Hint.Text+'(每天)';
      end;

      if Mode_3.Checked then
      begin
        AMode:=3;
        AMemo:=edt_Hint.Text+'('+FormatDateTime('ddd',AWeek.Date)+')';
      end;

      if Mode_4.Checked then
      begin
        AMode:=3;
        AMemo:=edt_Hint.Text+'(每月'+FormatDateTime('dd"日"',ADate.Date)+')';
      end;

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

      AAction:=cmb_Action.ItemIndex;
      if Sound_1.Checked then
        ASound:='1'+ edt_SoundFile.Text;
      if Sound_2.Checked then
        ASound:='2'+ cmb_Sound.Text;
      AddSystem(AMemo, AMode,AAction,ASound,edt_Program.Text,ADate.Date,ATime.Time,ADayOfWeek);
    end;
  end;
  dlg.Free;
end;

Procedure TControlModule.AddSystem(AMemo : String;
                        AMode:Integer;
                        AAction:Integer;
                        ASound:String;
                        AProgram:String;
                        ADate:TDate;
                        ATime:TTime;
                        AWeek:Integer);
var
  TempCtrlSys : TControlSystem;
begin
  if AMemo = '' then
    Exit;

  TempCtrlSys := TControlSystem.Create;
  TempCtrlSys.FMemo:=AMemo;
  TempCtrlSys.FMode:=AMode;
  TempCtrlSys.FAction:=AAction;
  TempCtrlSys.FSound:=ASound;
  TempCtrlSys.FProgram:=AProgram;
  TempCtrlSys.FDate:=ADate;
  TempCtrlSys.FTime:=ATime;
  TempCtrlSys.FWeek:=AWeek;
  AddSystem(TempCtrlSys);
end;

procedure TControlModule.AddSystem(ASystem: TControlSystem);
var
  TempListItem : TListItem;
begin
  if ASystem = Nil then
    Exit;

  if ASystem.Memo = '' then
    Exit;

  // 重名
  if GetSystem(ASystem.Memo) <> Nil then
    Exit;

  with ControlModule.SysTable  do
  begin
    Last;

    Append;
    FieldByName('提示信息').AsString:=ASystem.Memo;
    FieldByName('闹铃方式').AsInteger:=ASystem.Mode;
    FieldByName('闹铃动作').AsInteger:=ASystem.Action;
    FieldByName('提示声音').AsString:=ASystem.Sound;
    FieldByName('运行程序').AsString:=ASystem.ExeProgram;
    FieldByName('日期').AsDateTime:=ASystem.Date;
    FieldByName('时间').AsDateTime:=ASystem.Time;
    FieldByName('星期').AsInteger:=ASystem.Week;
    Post;

    ASystem.FID := Word(FieldByName('ID').AsInteger);
  end;

  FSysList.Add(ASystem);

  TempListItem := frmAlarmOption.CtrlList.Items.Add;
  TempListItem.Caption := ASystem.Memo;
  TempListItem.SubItems.Add(FormatDateTime('hh "时"mm"分"ss"秒"',ASystem.Time));
  TempListItem.Data := ASystem;
  TempListItem.ImageIndex := 1;
end;

procedure TControlModule.DelSystem(ASystem: TControlSystem);
var
  I,J : Integer;
  RootNode : TTreeNode;
begin
  if ASystem = Nil then
    Exit;

  if ASystem.Memo= '' then
    Exit;

  with ControlModule.SysTable do
  begin
    First;
    while not Eof do
    begin
        if FieldByName('ID').AsInteger=ASystem.ID then
            break;
        Next;
    end;
    Delete;
  end;

  // 内存
  FSysList.Remove(ASystem);

  with frmAlarmOption.CtrlList do
  begin
    // 刷新ListView
      for I := 0 to frmAlarmOption.CtrlList.Items.Count - 1 do
      begin
        if frmAlarmOption.CtrlList.Items[I].Data = ASystem then
        begin
          frmAlarmOption.CtrlList.Items.Delete(I);
          Break;
        end;
      end;
  end;

  ASystem.Free;
end;

procedure TControlModule.DelSystem(Index: Integer);
var
  TempCtrlSys : TControlSystem;
begin
  TempCtrlSys := GetSystem(Index);

  if TempCtrlSys = Nil then
    Exit;

  DelSystem(TempCtrlSys);
end;

procedure TControlModule.DelSystem(SystemName: String);
var
  TempCtrlSys : TControlSystem;
begin
  TempCtrlSys := GetSystem(SystemName);

  if TempCtrlSys = Nil then
    Exit;

  DelSystem(TempCtrlSys);
end;

function TControlModule.GetSystem(Index: Integer): TControlSystem;
begin
  if (Index < 0) or (Index >= FSysList.Count) then
  begin
    Result := Nil;
    Exit;
  end;

  Result := TControlSystem(FSysList[Index]);
end;

function TControlModule.GetSystem(SysName: String): TControlSystem;
var
  I : Integer;
  TempCtrlSys : TControlSystem;
begin
  Result := Nil;

  for I := 0 to FSysList.Count - 1 do
  begin
    TempCtrlSys := TControlSystem(FSysList[I]);

    if TempCtrlSys.Memo = SysName then
    begin
      Result := TempCtrlSys;
      Break;
    end;
  end;
end;

function TControlModule.GetSystemCount: Integer;
begin
  Result := FSysList.Count;
end;

procedure TControlModule.BuildMemTree;
var
  I : Integer;
  TempCtrlSys : TControlSystem;
  TempStr:string;
  Str_Back:String;
  bmp:TBitmap;
  mem:TStream;
  IsTopMost:Boolean;
  str_Font:String;
begin
  with SysTable do
  begin
    First;
    while not Eof do
    begin
      TempCtrlSys := TControlSystem.Create;
      TempCtrlSys.FMode:=FieldByName('闹铃方式').AsInteger;
      TempCtrlSys.FAction:=FieldByName('闹铃动作').AsInteger;
      TempCtrlSys.FMemo := FieldByName('提示信息').AsString;
      TempCtrlSys.FSound:= FieldByName('提示声音').AsString;
      TempCtrlSys.FProgram:= FieldByName('运行程序').AsString;
      TempCtrlSys.FDate:= FieldByName('日期').AsDateTime;
      TempCtrlSys.FTime:= FieldByName('时间').AsDateTime;
      TempCtrlSys.FWeek := FieldByName('星期').AsInteger;
      TempCtrlSys.FID := FieldByName('ID').AsInteger;
      FSysList.Add(TempCtrlSys);
      Next;
    end;
  end;

    with ControlModule.OptionTable do
    begin
       First;
       if RecordCount<1 then
       begin
           Str_Back:='大象';
           IsTopMost:=false;
           str_Font:='宋体';
       end
       else
       begin
           Str_Back:=FieldByName('背景来源').AsString;
           IsTopMost:=FieldByName('总在最前面').AsBoolean;
           str_Font:=FieldByName('字体名称').AsString;
       end;
    end;

    MainWnd.Label1.Font.Name:=str_Font;
    if IsTopMost then
    begin
       SetWindowPos(MainWnd.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    end
    else
    begin
       SetWindowPos(MainWnd.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    end;

    with ControlModule.BackTable do
    begin
       First;
       while not eof do
       begin
          if FieldByName('Name').AsString=Str_Back then
              break;
          Next;
       end;
       bmp:=TBitmap.Create;
       mem:=CreateBlobStream(FieldByName('Data'),bmRead);
       mem.Position:=0;
       bmp.LoadFromStream(mem);
       MainWnd.Image1.Picture.Assign(bmp);
       bmp.Free;
       mem.Free;
    end;
    if Str_Back='大象' then
    begin
       MainWnd.Label1.Left:=107;
       MainWnd.Label1.Top:=5;
    end
    else
    begin
       MainWnd.Label1.Left:=139;  
       MainWnd.Label1.Top:=5;
    end;

    MainWnd.Width:=MainWnd.Image1.Width;
    MainWnd.Height:=MainWnd.Image1.Height;
end;

procedure TControlModule.ControlModuleCreate(Sender: TObject);
begin
  FSysList := TList.Create;
  BuildMemTree;
end;

procedure TControlModule.ControlModuleDestroy(Sender: TObject);
var
  I : Integer;
begin
  for I :=  FSysList.Count - 1 downto 0 do
  begin
    TControlSystem(FSysList[I]).Free;
  end;

  FSysList.Clear;
  FSysList.Free;
end;

end.