Tree - bw/todolist - Cool Bug Repo

bw / todolist

Files

Blob Blame Raw
unit main;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, DateUtils, Forms, Controls, Graphics, ExtCtrls, StdCtrls;

type

  PTodoHistoryItem = ^TTodoHistoryItem;
  TTodoHistoryItem = record
    date          : TDate;
    done          : Boolean;
    doneByOthers  : Boolean;
  end;

  PTodoItem = ^TTodoItem;
  TTodoItem = record
    id            : Integer;
    name          : string;
    repeatDays    : Integer;
    daysSinceDone : Integer;
    done          : Boolean;
    doneByOthers  : Boolean;
    cancelled     : Boolean;
    planned       : Boolean;
    notPlanned    : Boolean;
    history       : array of TTodoHistoryItem;
    panel         : TPanel;
    updating      : Boolean;
  end;

  PTodoList = ^TTodoList;
  TTodoList = record
    filename      : string;
    name          : string;
    nextId        : Integer;
    date          : TDate;
    items         : array of TTodoItem;
  end;

  { TfrmMain }

  TfrmMain = class(TForm)
    bAdd: TButton;
    bNextDay: TButton;
    cbPlanned: TCheckBox;
    lDate: TLabel;
    sbTodo: TScrollBox;
    procedure bAddClick(Sender: TObject);
    procedure bNextDayClick(Sender: TObject);
    procedure cbPlannedChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure OnChangeItem(Sender: TObject);
    procedure UpdateItem(var item: TTodoItem);
    procedure ClearTodoList();
    procedure RebuildTodoList();
  private
  public
  end;
var
  frmMain: TfrmMain;
  todoList: TTodoList;

implementation

{$R *.lfm}


function BoolToInt(b: Boolean): Integer;
begin
  if b then Result := 1 else Result := 0;
end;


function DateToInt(date: TDate): Integer;
var
   y, m, d: Word;
begin
  DecodeDate(date, y, m, d);
  Result := y*10000 + m*100 + d;
end;


function IntToDate(i: Integer): TDate;
begin
  Result := EncodeDate(i div 10000, (i div 100) mod 100, i mod 100);
end;


function RoundDate(date: TDate): TDate;
begin
  Result := IntToDate( DateToInt(date) );
end;


function isPlanned(var item: TTodoItem): Boolean;
begin
  Result := item.planned or ((item.daysSinceDone >= item.repeatDays) and not item.notPlanned);
end;


function isDone(var item: TTodoItem): Boolean;
begin
  Result := item.done or item.doneByOthers;
end;


function isNeedToDo(var item: TTodoItem): Boolean;
begin
  Result := isPlanned(item) and (not item.cancelled) and not isDone(item);
end;


procedure ClearTodoList(var list: TTodoList);
begin
  list.filename := '';
  list.name := '';
  list.nextId := 0;
  setLength(list.items, 0);
end;


function SaveTodoList(var list: TTodoList; filename: string): Boolean;
var
  i: Integer;
  f: textfile;
begin
  Result := False;

  AssignFile(f, filename);
  Rewrite(f);
  Writeln(f, 2); // version
  Writeln(f, list.name);
  Writeln(f, list.nextId);
  Writeln(f, DateToInt(list.date));
  Writeln(f, Length(list.items));
  for i := 0 to Length(list.items)-1 do begin
    Writeln(f, list.items[i].id);
    Writeln(f, list.items[i].name);
    Writeln(f,
      list.items[i].repeatDays, ' ',
      list.items[i].daysSinceDone, ' ',
      BoolToInt(list.items[i].done), ' ',
      BoolToInt(list.items[i].doneByOthers), ' ',
      BoolToInt(list.items[i].cancelled), ' ',
      BoolToInt(list.items[i].planned), ' ',
      BoolToInt(list.items[i].notPlanned) );
  end;
  CloseFile(f);

  Result := True;
end;


function SaveTodoListEx(var list: TTodoList): Boolean;
var
  i: Integer;
  fo, fn: string;
begin
  Result := False;
  if FileExists(list.filename) then begin
    for i := 0 to 1000 do begin
      fo := list.filename + '.old.' + IntToStr(i);
      if FileExists(fo) then fo := '' else break;
    end;
    for i := 0 to 1000 do begin
      fn := list.filename + '.new.' + IntToStr(i);
      if FileExists(fn) then fn := '' else break;
    end;
    if (fo = '') or (fn = '') then Exit;

    if not SaveTodoList(list, fn) then begin
      DeleteFile(fn);
      Exit;
    end;

    if not RenameFile(list.filename, fo) then begin
      DeleteFile(fn);
      Exit;
    end;

    if not RenameFile(fn, list.filename) then begin
      RenameFile(fo, list.filename);
      DeleteFile(fn);
      Exit;
    end;

    DeleteFile(fn);
    DeleteFile(fo);
  end else
  if not SaveTodoList(list, list.filename) then begin
    DeleteFile(list.filename);
    Exit;
  end;
  Result := True;
end;


function LoadTodoList(var list: TTodoList; filename: string): Boolean;
var
  i, version, count: Integer;
  i0, i1, i2, i3, i4: Integer;
  f: textfile;
begin
  clearTodoList(list);
  list.filename := filename;

  Result := False;
  if not FileExists(filename) then Exit;

  AssignFile(f, filename);
  Reset(f);
  Readln(f, version);
  Readln(f, list.name);
  Readln(f, list.nextId);
  Readln(f, i0);
  list.date := IntToDate(i0);
  Readln(f, count);
  setLength(list.items, count);
  for i := 0 to count-1 do begin
    Readln(f, list.items[i].id);
    Readln(f, list.items[i].name);
    if version <= 1 then begin
      Readln(f,
        list.items[i].repeatDays,
        list.items[i].daysSinceDone,
        i0, i1, i2, i3 );
      list.items[i].done         := i0 <> 0;
      list.items[i].doneByOthers := i1 <> 0;
      list.items[i].cancelled    := i3 <> 0;
      list.items[i].planned      := i2 <> 0;
      list.items[i].notPlanned   := False;
    end else begin
      Readln(f,
        list.items[i].repeatDays,
        list.items[i].daysSinceDone,
        i0, i1, i2, i3, i4 );
      list.items[i].done         := i0 <> 0;
      list.items[i].doneByOthers := i1 <> 0;
      list.items[i].cancelled    := i2 <> 0;
      list.items[i].planned      := i3 <> 0;
      list.items[i].notPlanned   := i4 <> 0;
    end;
  end;
  CloseFile(f);
  Result := True;
end;


procedure SetTodoListDate(var list: TTodoList; date: TDate);
var
  i, d: Integer;
begin
  date := RoundDate(date);
  d := DaysBetween(date, list.date);
  if (date < list.date) and (d > 0) then d := -d;
  list.date := date;
  if d = 0 then Exit;
  for i := 0 to Length(list.items)-1 do begin
    Inc(list.items[i].daysSinceDone, d);
    if d < 0 then begin
      if list.items[i].daysSinceDone < 1 then
         list.items[i].daysSinceDone := 1;
    end else begin
      if isDone(list.items[i]) then begin
        list.items[i].daysSinceDone := d;
        list.items[i].planned := False;
      end;
      list.items[i].done := False;
      list.items[i].doneByOthers := False;
      list.items[i].cancelled := False;
      list.items[i].notPlanned := False;
    end
  end
end;


procedure AddTodoItem(var list: TTodoList);
var
  i: Integer;
begin
  i := Length(list.items);
  SetLength(list.items, i + 1);
  list.items[i].id := list.nextId;
  list.items[i].repeatDays := 1;
  list.items[i].daysSinceDone := 1;
  Inc(list.nextId);
end;


procedure RemoveTodoItem(var list: TTodoList; i: Integer);
var
  j: Integer;
begin
  if (i < 0) or (i >= Length(list.items)) then Exit;
  for j := i+1 to Length(list.items)-1 do
    list.items[j-1] := list.items[j];
  SetLength(list.items, Length(list.items) - 1);
end;


procedure InsertTodoItem(var list: TTodoList; i: Integer; item: TTodoItem);
var
  j: Integer;
begin
  if i < 0 then i := 0;
  if i > Length(list.items) then i := Length(list.items);
  SetLength(list.items, Length(list.items) + 1);
  for j := Length(list.items)-1 downto i+1 do
    list.items[j] := list.items[j-1];
  list.items[i] := item;
end;


procedure TfrmMain.bAddClick(Sender: TObject);
begin
  AddTodoItem(todoList);
  RebuildTodoList();
end;

procedure TfrmMain.bNextDayClick(Sender: TObject);
begin
  SetTodoListDate(todoList, IncDay(todoList.date));
  RebuildTodoList();
end;

procedure TfrmMain.cbPlannedChange(Sender: TObject);
begin
  RebuildTodoList();
end;

procedure TfrmMain.FormActivate(Sender: TObject);
begin
  if todoList.filename <> '' then Exit;
  LoadTodoList(todoList, 'todo.list');
  SetTodoListDate(todoList, Date);
  RebuildTodoList();
end;


procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  SaveTodoListEx(todoList);
  CloseAction := caFree;
end;


procedure TfrmMain.OnChangeItem(Sender: TObject);
var
  p: TPanel;
  i: Integer;
  n: string;
  item: TTodoItem;

  function ParseInt(s: string): Integer;
  begin
    Result := StrToInt(s);
    if Result < 1 then Result := 1;
  end;

begin
  p := TPanel(TControl(Sender).Parent);
  i := p.Tag;

  n := TControl(Sender).Name;
  if n = 'delete' then begin
    RemoveTodoItem(todoList, i);
    RebuildTodoList();
  end else
  if n = 'up' then begin
    item := todoList.items[i];
    RemoveTodoItem(todoList, i);
    InsertTodoItem(todoList, i-1, item);
    RebuildTodoList();
  end else
  if n = 'down' then begin
    item := todoList.items[i];
    RemoveTodoItem(todoList, i);
    InsertTodoItem(todoList, i+1, item);
    RebuildTodoList();
  end else begin
    with todoList.items[i] do begin
      if updating then Exit;
      name          := TEdit( p.FindChildControl('name') ).Text;
      repeatDays    := ParseInt(TEdit( p.FindChildControl('repeatDays')    ).Text);
      daysSinceDone := ParseInt(TEdit( p.FindChildControl('daysSinceDone') ).Text);
      done          := TCheckBox( p.FindChildControl('done')         ).Checked;
      doneByOthers  := TCheckBox( p.FindChildControl('doneByOthers') ).Checked;
      cancelled     := TCheckBox( p.FindChildControl('cancelled')    ).Checked;
      planned       := TCheckBox( p.FindChildControl('planned')      ).Checked;
      notPlanned    := TCheckBox( p.FindChildControl('notPlanned')   ).Checked;
    end;
    UpdateItem(todoList.items[i]);
  end;

  SaveTodoListEx(todoList);
end;


procedure TfrmMain.UpdateItem(var item: TTodoItem);
begin
  item.updating := True;
  with item.panel do begin
    if item.cancelled then
      item.panel.Font.StrikeThrough := True
    else
      item.panel.Font.StrikeThrough := False;

    if isNeedToDo(item) then
      item.panel.Font.Color := clDefault
    else
      item.panel.Font.Color := clGrayText;

    TCheckBox( FindChildControl('done')         ).Checked := item.done;
    TCheckBox( FindChildControl('doneByOthers') ).Checked := item.doneByOthers;
    TCheckBox( FindChildControl('cancelled')    ).Checked := item.cancelled;
    TCheckBox( FindChildControl('planned')      ).Checked := item.planned;
    TCheckBox( FindChildControl('notPlanned')   ).Checked := item.notPlanned;
    TEdit( FindChildControl('daysSinceDone') ).Text := IntToStr(item.daysSinceDone);
    TEdit( FindChildControl('repeatDays')    ).Text := IntToStr(item.repeatDays);
    TEdit( FindChildControl('name')          ).Text := item.name;
  end;
  item.updating := False;
end;


procedure TfrmMain.ClearTodoList();
var
  i: Integer;
begin
  while sbTodo.ControlCount > 0 do
    sbTodo.Controls[0].Destroy();
  for i := 0 to Length(todoList.items)-1 do
    todoList.items[i].panel := nil;
  sbTodo.UpdateScrollbars;
end;


procedure TfrmMain.RebuildTodoList();
const
  b = 0;
  bb = 2;
  sb = 16;
var
  i, j, h, t, l, ll, r: Integer;
  scroll: Integer;
  plannedOnly: Boolean;
  p: TPanel;

  function createCheckBox(name, title: string): TCheckBox;
  begin
    Result := TCheckBox.Create(p);
    Result.Name := name;
    Result.Caption := '';
    Result.Hint := title;
    Result.ShowHint := True;
    Result.Top := bb;
    Result.Left := l;
    Result.OnChange := @OnChangeItem;
    p.InsertControl(Result);
    Inc(l, Result.Width);
  end;

  function createButton(name, title: string): TButton;
  begin
    Result := TButton.Create(p);
    Result.Name := name;
    Result.Caption := title;
    Result.ParentFont := True;
    Result.Top := bb;
    Result.Left := r - Result.Width;
    Result.Anchors := [akTop, akRight];
    Result.OnClick := @OnChangeItem;
    p.InsertControl(Result);
    r := Result.Left;
  end;

  function createSquareButton(name, title: string): TButton;
  begin
    Result := createButton(name, title);
    Result.Left := Result.Left + Result.Width - Result.Height;
    Result.Width := Result.Height;
    r := Result.Left;
  end;

  function createEdit(name, title: string): TEdit;
  begin
    Result := TEdit.Create(p);
    Result.Name := name;
    Result.Hint := Title;
    Result.ShowHint := True;
    Result.AutoSize := False;
    Result.BorderStyle := bsNone;
    Result.ParentFont := True;
    Result.ParentColor := True;
    Result.Width := Result.Height*2;
    Result.NumbersOnly := True;
    Result.Top := bb;
    Result.Left := r - Result.Width;
    Result.Anchors := [akTop, akRight];
    Result.OnEditingDone := @OnChangeItem;
    p.InsertControl(Result);
    r := Result.Left;
  end;

  function createNameEdit(name, title: string): TEdit;
  begin
    Result := createEdit(name, title);
    Result.NumbersOnly := False;
    Result.Left := l;
    Result.Width := Result.Width + r - l;
    Result.Anchors := [akLeft, akTop, akRight];
  end;

begin
  scroll := sbTodo.VertScrollBar.Position;
  plannedOnly := cbPlanned.Checked;

  ClearTodoList();

  lDate.Caption := FormatDateTime('YYYY-MM-DD', todoList.date);

  t := b;
  for i := 0 to Length(todoList.items)-1 do begin
    if plannedOnly and not isPlanned(todoList.items[i]) then
      Continue;

    p := TPanel.Create(sbTodo);
    p.Tag := i;
    p.Left := b;
    p.Width := sbTodo.Width - b*2 - sb;
    p.Top := t;
    p.Anchors := [akLeft, akTop, akRight];
    p.ParentFont := False;
    sbTodo.InsertControl(p);

    l := bb;

    createCheckBox('done', 'Done');
    createCheckBox('doneByOthers', 'Done by others');
    createCheckBox('cancelled', 'Cancelled');
    ll := l;
    Inc(l, bb);
    Inc(l, bb);
    Inc(l, bb);
    createCheckBox('planned', 'Planned manually').Visible := not plannedOnly;
    createCheckBox('notPlanned', 'Remove from plan manually').Visible := not plannedOnly;
    if plannedOnly then l := ll;
    Inc(l, bb);

    r := p.ClientWidth - bb;

    createButton('delete', 'delete');
    Dec(r, bb);
    createSquareButton('down', '+');
    createSquareButton('up', '-');
    Dec(r, bb);

    createEdit('daysSinceDone', 'Days since last done');
    Dec(r, bb);
    createEdit('repeatDays', 'Repeat every N days');
    Dec(r, bb);
    createNameEdit('name', 'Task name');

    h := 0;
    for j := 0 to p.ControlCount-1 do
      if h < p.Controls[j].Top + p.Controls[j].Height then
        h := p.Controls[j].Top + p.Controls[j].Height;
    p.Height := h + bb;
    Inc(t, p.Height + b);

    todoList.items[i].panel := p;
    UpdateItem(todoList.items[i]);
  end;
  sbTodo.UpdateScrollbars;

  sbTodo.ScrollBy(0, -scroll);
end;


end.
bw / todolist

Source Code

Files
