Re[11]: Как сделать красиво
От: SimplyJoe  
Дата: 13.03.06 00:09
Оценка:
Первое приближение такое:

Задания и менеджер.
unit Tasks;

interface
uses SysUtils, Classes, Contnrs;

type

  ETaskManagerError = class (Exception);

  TTask = class
  private
    FName: string;
    FStartTime: TDateTime;
  protected
    function HasStartTime: Boolean;
  public
    constructor Create (AName: string; AppendStartTime: Boolean = True);
    property Name: string read FName;
    property StartTime: TDateTime read FStartTime;
    function ToString: string;
  end;

  TTaskManager = class
  private
    FList: TObjectList;
    function GetCount: Integer;
    function GetItems(Index: Integer): TTask;
  protected
    procedure Add (ATask: TTask);
  public
    function CreateTask (ATaskName: string; AppendStartTime: Boolean = True): TTask;
    procedure RenameTask (ExistingIndex: Integer; NewName: string);
    function IndexOf (ATaskName: string): Integer;
    constructor Create;
    destructor Destroy; override;
    property Items[Index: Integer]: TTask read GetItems; default;
    property Count: Integer read GetCount;
    procedure Delete (Index: Integer);
  end;

implementation

{ TTask }

constructor TTask.Create(AName: string;
  AppendStartTime: Boolean = True);
begin
  inherited Create();

  FName := AName;

  if AppendStartTime then
    FStartTime := Now();
end;

function TTask.HasStartTime: Boolean;
begin
  Result := FStartTime<>0 
end;


function TTask.ToString: string;
begin
  Result := FName;

  if HasStartTime then
    Result := Format ('%s (%s)',[Result, DateTimeToStr(FStartTime)]);
end;

{ TTaskManager }

procedure TTaskManager.Add(ATask: TTask);
begin
  FList.Add(ATask)
end;

constructor TTaskManager.Create;
begin
  inherited Create();
  FList := TObjectList.Create (True); // owns objects
end;

function TTaskManager.CreateTask(ATaskName: string;
  AppendStartTime: Boolean = True): TTask;
begin
  // проверка пост-условия:
  // в списке не должно уже быть задания с таким именем
  if IndexOf(ATaskName)<>-1 then
    raise ETaskManagerError.Create('Задание с таким именем уже существует');

  Result := TTask.Create(ATaskName, AppendStartTime);
  Add (Result);
end;

procedure TTaskManager.Delete(Index: Integer);
begin
  FList.Delete(Index);
end;

destructor TTaskManager.Destroy;
begin
  FList.Free;
  inherited;
end;

function TTaskManager.GetCount: Integer;
begin
  Result := FList.Count
end;

function TTaskManager.GetItems(Index: Integer): TTask;
begin
  Result := TTask(FList[Index])
end;

function TTaskManager.IndexOf(ATaskName: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  
  for I := 0 to FList.Count - 1 do
    if AnsiCompareText(ATaskName,GetItems(I).Name)=0 then
    begin
      Result := I;
      Break
    end;
end;

procedure TTaskManager.RenameTask(ExistingIndex: Integer; NewName: string);
var
  Tsk: TTask;
begin
  Tsk := GetItems(ExistingIndex);
  // возможно, это не лучший вариант с доступом к приватному полю,
  // но я иногда так делаю
  Tsk.FName := NewName;
end;

end.


Гуи:

unit Unit18;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Tasks, StdCtrls;

type
  TQForm = class(TForm)
    lbToDo: TListBox;
    btnSaveTasks: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    procedure btnSaveTasksClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FTaskManager: TTaskManager;
    FEditBoxes: array of TEdit;
    function AddTask (AName: string): Boolean;
    function AskForRename (Tsk: TTask): Boolean;
    procedure UpdateToDoListBox;
  end;

var
  QForm: TQForm;

implementation

{$R *.dfm}

function TQForm.AddTask(AName: string): Boolean;
var
  Idx: Integer;
begin
  Result := False;

  if Trim(AName)='' then
    Exit;

  Idx := FTaskManager.IndexOf(AName);

  if Idx = -1 then
  begin
    FTaskManager.CreateTask(AName);
    Result := True
  end
  else
    if AskForRename(FTaskManager[Idx]) then
    begin
      FTaskManager.RenameTask(Idx,AName);
      Result := True
    end;
end;

function TQForm.AskForRename(Tsk: TTask): Boolean;
begin
  Result :=
    MessageDlg('Задача "' + Tsk.ToString + '" уже существует. Переназначить?',
    mtWarning,[mbYes,mbNo],-1) = mrYes
end;

///
/// обработчик нажатия на кнопку "Сохранить задания..."
///
procedure TQForm.btnSaveTasksClick(Sender: TObject);
var
  I: Integer;
  TasksChanged: Boolean;
begin
  TasksChanged := False;

  for I := Low(FEditBoxes) to High(FEditBoxes) do
    if AddTask(FEditBoxes[I].Text) then
      TasksChanged := True;

  if TasksChanged then
  begin
    //
    // тут выполняем сортировку и т.п
    // ...

    // обновляем визуальный список
    UpdateToDoListBox;
  end;
end;

procedure TQForm.FormCreate(Sender: TObject);
begin
  FTaskManager := TTaskManager.Create;

  // Честно говоря, не знаю, зачем тебе несколько
  // эдитов, поэтому сделал пока так.
  // В зависимости от задачи (которая мне не известна)
  // способ хранения и доступа к полям ввода может модифицироваться
  SetLength(FEditBoxes,3);
  FEditBoxes[0] := Edit1;
  FEditBoxes[1] := Edit2;
  FEditBoxes[2] := Edit3;
end;

procedure TQForm.FormDestroy(Sender: TObject);
begin
  FTaskManager.Free;
end;

procedure TQForm.UpdateToDoListBox;
var
  I: Integer;
begin
  lbToDo.Items.BeginUpdate;
  try
    lbToDo.Clear;
    for I := 0 to FTaskManager.Count-1 do
      lbToDo.Items.Add(FTaskManager[I].ToString)
  finally
    lbToDo.Items.EndUpdate;
  end;
end;

end.


Гуишную часть можно сделать и по-другому, но я не понял смысл этих нескольких эдитов и переспрашивания пользователя
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.