home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi 4 Bible
/
Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso
/
source
/
TODO
/
MAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1998-04-13
|
12KB
|
465 lines
(* =========================================================== *(
** todo\main.pas -- To do list application for Delphi **
** ........................................................... **
** This program uses two list boxes to create to-do and done **
** lists with buttons to transfer items. **
** ........................................................... **
** Copyright (c) 1995,1998 by Tom Swan. All rights reserved. **
)* =========================================================== *)
unit Main;
interface
uses
Windows, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, Menus, Dialogs, Clipbrd, SysUtils, Printers, About;
type
TMainForm = class(TForm)
SrcList: TListBox;
DstList: TListBox;
SrcLabel: TLabel;
DstLabel: TLabel;
IncludeBtn: TSpeedButton;
IncAllBtn: TSpeedButton;
ExcludeBtn: TSpeedButton;
ExAllBtn: TSpeedButton;
MainMenu1: TMainMenu;
FileMenu: TMenuItem;
HelpMenu: TMenuItem;
FileOpen: TMenuItem;
FileSave: TMenuItem;
FileSaveAs: TMenuItem;
N1: TMenuItem;
FilePrint: TMenuItem;
N2: TMenuItem;
FileExit: TMenuItem;
HelpAbout: TMenuItem;
FileOpenDialog: TOpenDialog;
FileSaveDialog: TSaveDialog;
CloseBitBtn: TBitBtn;
FileNew: TMenuItem;
AddBitBtn: TBitBtn;
EditBitBtn: TBitBtn;
DeleteBitBtn: TBitBtn;
EditMenu: TMenuItem;
EditUndo: TMenuItem;
EditDelete: TMenuItem;
PrintDialog1: TPrintDialog;
PrinterSetupDialog1: TPrinterSetupDialog;
FilePrinterSetup: TMenuItem;
procedure IncludeBtnClick(Sender: TObject);
procedure ExcludeBtnClick(Sender: TObject);
procedure IncAllBtnClick(Sender: TObject);
procedure ExcAllBtnClick(Sender: TObject);
procedure MoveSelected(List: TCustomListBox; Items: TStrings);
procedure SetItem(List: TListBox; Index: Integer);
function GetFirstSelection(List: TCustomListBox): Integer;
procedure SetButtons;
procedure FileOpenClick(Sender: TObject);
procedure FileExitClick(Sender: TObject);
procedure FileSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FileSaveAsClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FileNewClick(Sender: TObject);
procedure AddBitBtnClick(Sender: TObject);
procedure EditBitBtnClick(Sender: TObject);
procedure DeleteBitBtnClick(Sender: TObject);
procedure FileMenuClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure EditUndoClick(Sender: TObject);
procedure EditMenuClick(Sender: TObject);
procedure HelpAboutClick(Sender: TObject);
procedure EditDeleteClick(Sender: TObject);
procedure FilePrintClick(Sender: TObject);
procedure FilePrinterSetupClick(Sender: TObject);
private
{ Private declarations }
TodoFilename: string; { If Length=0, no name assigned }
DoneFilename: string; { Same as Todo but with .Don ext }
FileDirty: Boolean; { True if changes not saved }
UndoList: TStringList; { List of deleted strings for undo }
procedure SetCaption;
procedure EnableMenu;
procedure ReadFile;
procedure WriteFile;
procedure SaveFile;
procedure SaveAsFile;
procedure CloseTodoFile;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
const
title = 'To Do';
{- Private procedures }
procedure TMainForm.SetCaption;
begin
if Length(TodoFilename) = 0 then
MainForm.Caption := title
else
MainForm.Caption := title + ' - ' +
Lowercase(ExtractFilename(TodoFilename));
end;
procedure TMainForm.EnableMenu;
var
I: Integer;
begin
with FileMenu do
begin
for I := 0 to Count - 1 do { Enable all File commands }
Items[I].Enabled := True;
if not FileDirty then
begin {- No edits }
FileSave.Enabled := False; { Must use Save as }
if Length(TodoFilename) = 0 then { i.e. file not named }
begin {- No edits; no name }
FileSaveAs.Enabled := False; { Nothing to save }
FilePrint.Enabled := False; { Nothing to print }
end;
end;
end;
end;
procedure TMainForm.ReadFile;
begin
SrcList.Items.LoadFromFile(TodoFilename);
DstList.Items.LoadFromFile(DoneFilename);
FileDirty := False;
end;
procedure TMainForm.WriteFile;
begin
SrcList.Items.SaveToFile(TodoFilename);
DstList.Items.SaveToFile(DoneFilename);
FileDirty := False;
end;
procedure TMainForm.SaveAsFile;
begin
if FileSaveDialog.Execute then
begin
TodoFilename := FileSaveDialog.Filename;
DoneFilename := ChangeFileExt(TodoFilename, '.Don');
WriteFile;
SetCaption;
end;
end;
procedure TMainForm.SaveFile;
begin
if FileDirty then
begin
if Length(TodoFilename) = 0 then
SaveAsFile
else
WriteFile;
end;
end;
procedure TMainForm.CloseTodoFile;
var
Result: Word; { MessageDlg function return result }
begin
if FileDirty then
begin
Result := MessageDlg('Save changes?',
mtConfirmation, mbYesNoCancel, 0);
case Result of
mrYes:
SaveFile;
mrNo:
FileDirty := False;
end;
end;
if not FileDirty then
begin
TodoFilename := '';
DoneFilename := '';
FileDirty := False;
Caption := title;
SrcList.Items.Clear;
DstList.Items.Clear;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
TodoFilename := ''; { No file currently open }
DoneFilename := '';
FileDirty := False; { Undefined if file not open }
Caption := title;
UndoList := TStringList.Create;
end;
procedure TMainForm.IncludeBtnClick(Sender: TObject);
var
Index: Integer;
begin
Index := GetFirstSelection(SrcList);
MoveSelected(SrcList, DstList.Items);
SetItem(SrcList, Index);
FileDirty := True;
end;
procedure TMainForm.ExcludeBtnClick(Sender: TObject);
var
Index: Integer;
begin
Index := GetFirstSelection(DstList);
MoveSelected(DstList, SrcList.Items);
SetItem(DstList, Index);
FileDirty := True;
end;
procedure TMainForm.IncAllBtnClick(Sender: TObject);
var
I: Integer;
begin
for I := 0 to SrcList.Items.Count - 1 do
DstList.Items.AddObject(SrcList.Items[I],
SrcList.Items.Objects[I]);
SrcList.Items.Clear;
SetItem(SrcList, 0);
FileDirty := True;
end;
procedure TMainForm.ExcAllBtnClick(Sender: TObject);
var
I: Integer;
begin
for I := 0 to DstList.Items.Count - 1 do
SrcList.Items.AddObject(DstList.Items[I],
DstList.Items.Objects[I]);
DstList.Items.Clear;
SetItem(DstList, 0);
FileDirty := True;
end;
procedure TMainForm.MoveSelected(List: TCustomListBox;
Items: TStrings);
var
I: Integer;
begin
for I := List.Items.Count - 1 downto 0 do
if List.Selected[I] then
begin
Items.AddObject(List.Items[I], List.Items.Objects[I]);
List.Items.Delete(I);
end;
FileDirty := True;
end;
procedure TMainForm.SetButtons;
var
SrcEmpty, DstEmpty: Boolean;
begin
SrcEmpty := SrcList.Items.Count = 0;
DstEmpty := DstList.Items.Count = 0;
IncludeBtn.Enabled := not SrcEmpty;
IncAllBtn.Enabled := not SrcEmpty;
ExcludeBtn.Enabled := not DstEmpty;
ExAllBtn.Enabled := not DstEmpty;
end;
function TMainForm.GetFirstSelection(List: TCustomListBox): Integer;
begin
for Result := 0 to List.Items.Count - 1 do
if List.Selected[Result] then Exit;
Result := LB_ERR;
end;
procedure TMainForm.SetItem(List: TListBox; Index: Integer);
var
MaxIndex: Integer;
begin
with List do
begin
SetFocus;
MaxIndex := List.Items.Count - 1;
if Index = LB_ERR then Index := 0
else if Index > MaxIndex then Index := MaxIndex;
Selected[Index] := True;
end;
SetButtons;
end;
procedure TMainForm.FileOpenClick(Sender: TObject);
begin
if FileOpenDialog.Execute then
begin
if FileDirty then CloseTodoFile;
if not FileDirty then