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 >
Pascal/Delphi Source File  |  1998-04-13  |  12KB  |  465 lines
  1. (* =========================================================== *(
  2. **  todo\main.pas -- To do list application for Delphi         **
  3. ** ........................................................... **
  4. **  This program uses two list boxes to create to-do and done  **
  5. **  lists with buttons to transfer items.                      **
  6. ** ........................................................... **
  7. **  Copyright (c) 1995,1998 by Tom Swan. All rights reserved.  **
  8. )* =========================================================== *)
  9.  
  10. unit Main;
  11.  
  12. interface
  13.  
  14. uses
  15.   Windows, Classes, Graphics, Forms, Controls, Buttons,
  16.   StdCtrls, Menus, Dialogs, Clipbrd, SysUtils, Printers, About;
  17.  
  18. type
  19.   TMainForm = class(TForm)
  20.     SrcList: TListBox;
  21.     DstList: TListBox;
  22.     SrcLabel: TLabel;
  23.     DstLabel: TLabel;
  24.     IncludeBtn: TSpeedButton;
  25.     IncAllBtn: TSpeedButton;
  26.     ExcludeBtn: TSpeedButton;
  27.     ExAllBtn: TSpeedButton;
  28.     MainMenu1: TMainMenu;
  29.     FileMenu: TMenuItem;
  30.     HelpMenu: TMenuItem;
  31.     FileOpen: TMenuItem;
  32.     FileSave: TMenuItem;
  33.     FileSaveAs: TMenuItem;
  34.     N1: TMenuItem;
  35.     FilePrint: TMenuItem;
  36.     N2: TMenuItem;
  37.     FileExit: TMenuItem;
  38.     HelpAbout: TMenuItem;
  39.     FileOpenDialog: TOpenDialog;
  40.     FileSaveDialog: TSaveDialog;
  41.     CloseBitBtn: TBitBtn;
  42.     FileNew: TMenuItem;
  43.     AddBitBtn: TBitBtn;
  44.     EditBitBtn: TBitBtn;
  45.     DeleteBitBtn: TBitBtn;
  46.     EditMenu: TMenuItem;
  47.     EditUndo: TMenuItem;
  48.     EditDelete: TMenuItem;
  49.     PrintDialog1: TPrintDialog;
  50.     PrinterSetupDialog1: TPrinterSetupDialog;
  51.     FilePrinterSetup: TMenuItem;
  52.     procedure IncludeBtnClick(Sender: TObject);
  53.     procedure ExcludeBtnClick(Sender: TObject);
  54.     procedure IncAllBtnClick(Sender: TObject);
  55.     procedure ExcAllBtnClick(Sender: TObject);
  56.     procedure MoveSelected(List: TCustomListBox; Items: TStrings);
  57.     procedure SetItem(List: TListBox; Index: Integer);
  58.     function GetFirstSelection(List: TCustomListBox): Integer;
  59.     procedure SetButtons;
  60.     procedure FileOpenClick(Sender: TObject);
  61.     procedure FileExitClick(Sender: TObject);
  62.     procedure FileSaveClick(Sender: TObject);
  63.     procedure FormCreate(Sender: TObject);
  64.     procedure FileSaveAsClick(Sender: TObject);
  65.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  66.     procedure FileNewClick(Sender: TObject);
  67.     procedure AddBitBtnClick(Sender: TObject);
  68.     procedure EditBitBtnClick(Sender: TObject);
  69.     procedure DeleteBitBtnClick(Sender: TObject);
  70.     procedure FileMenuClick(Sender: TObject);
  71.     procedure FormDestroy(Sender: TObject);
  72.     procedure EditUndoClick(Sender: TObject);
  73.     procedure EditMenuClick(Sender: TObject);
  74.     procedure HelpAboutClick(Sender: TObject);
  75.     procedure EditDeleteClick(Sender: TObject);
  76.     procedure FilePrintClick(Sender: TObject);
  77.     procedure FilePrinterSetupClick(Sender: TObject);
  78.   private
  79.     { Private declarations }
  80.     TodoFilename: string;   { If Length=0, no name assigned }
  81.     DoneFilename: string;   { Same as Todo but with .Don ext }
  82.     FileDirty: Boolean;     { True if changes not saved }
  83.     UndoList: TStringList;  { List of deleted strings for undo }
  84.     procedure SetCaption;
  85.     procedure EnableMenu;
  86.     procedure ReadFile;
  87.     procedure WriteFile;
  88.     procedure SaveFile;
  89.     procedure SaveAsFile;
  90.     procedure CloseTodoFile;
  91.   public
  92.     { Public declarations }
  93.   end;
  94.  
  95. var
  96.   MainForm: TMainForm;
  97.  
  98. implementation
  99.  
  100. {$R *.DFM}
  101.  
  102. const
  103.   title = 'To Do';
  104.  
  105. {- Private procedures }
  106.  
  107. procedure TMainForm.SetCaption;
  108. begin
  109.   if Length(TodoFilename) = 0 then
  110.     MainForm.Caption := title
  111.   else
  112.     MainForm.Caption := title + ' - ' +
  113.       Lowercase(ExtractFilename(TodoFilename));
  114. end;
  115.  
  116. procedure TMainForm.EnableMenu;
  117. var
  118.   I: Integer;
  119. begin
  120.   with FileMenu do
  121.   begin
  122.     for I := 0 to Count - 1 do        { Enable all File commands }
  123.       Items[I].Enabled := True;
  124.     if not FileDirty then
  125.     begin  {- No edits }
  126.       FileSave.Enabled := False;        { Must use Save as }
  127.       if Length(TodoFilename) = 0 then  { i.e. file not named }
  128.       begin  {- No edits; no name }
  129.         FileSaveAs.Enabled := False;  { Nothing to save }
  130.         FilePrint.Enabled := False;   { Nothing to print }
  131.       end;
  132.     end;
  133.   end;
  134. end;
  135.  
  136. procedure TMainForm.ReadFile;
  137. begin
  138.   SrcList.Items.LoadFromFile(TodoFilename);
  139.   DstList.Items.LoadFromFile(DoneFilename);
  140.   FileDirty := False;
  141. end;
  142.  
  143. procedure TMainForm.WriteFile;
  144. begin
  145.   SrcList.Items.SaveToFile(TodoFilename);
  146.   DstList.Items.SaveToFile(DoneFilename);
  147.   FileDirty := False;
  148. end;
  149.  
  150. procedure TMainForm.SaveAsFile;
  151. begin
  152.   if FileSaveDialog.Execute then
  153.   begin
  154.     TodoFilename := FileSaveDialog.Filename;
  155.     DoneFilename := ChangeFileExt(TodoFilename, '.Don');
  156.     WriteFile;
  157.     SetCaption;
  158.   end;
  159. end;
  160.  
  161. procedure TMainForm.SaveFile;
  162. begin
  163.   if FileDirty then
  164.   begin
  165.     if Length(TodoFilename) = 0 then
  166.       SaveAsFile
  167.     else
  168.       WriteFile;
  169.   end;
  170. end;
  171.  
  172. procedure TMainForm.CloseTodoFile;
  173. var
  174.   Result: Word;   { MessageDlg function return result }
  175. begin
  176.   if FileDirty then
  177.   begin
  178.     Result := MessageDlg('Save changes?',
  179.       mtConfirmation, mbYesNoCancel, 0);
  180.     case Result of
  181.       mrYes:
  182.         SaveFile;
  183.       mrNo:
  184.         FileDirty := False;
  185.     end;
  186.   end;
  187.   if not FileDirty then
  188.   begin
  189.     TodoFilename := '';
  190.     DoneFilename := '';
  191.     FileDirty := False;
  192.     Caption := title;
  193.     SrcList.Items.Clear;
  194.     DstList.Items.Clear;
  195.   end;
  196. end;
  197.  
  198. procedure TMainForm.FormCreate(Sender: TObject);
  199. begin
  200.   TodoFilename := '';   { No file currently open }
  201.   DoneFilename := '';
  202.   FileDirty := False;   { Undefined if file not open }
  203.   Caption := title;
  204.   UndoList := TStringList.Create;
  205. end;
  206.  
  207. procedure TMainForm.IncludeBtnClick(Sender: TObject);
  208. var
  209.   Index: Integer;
  210. begin
  211.   Index := GetFirstSelection(SrcList);
  212.   MoveSelected(SrcList, DstList.Items);
  213.   SetItem(SrcList, Index);
  214.   FileDirty := True;
  215. end;
  216.  
  217. procedure TMainForm.ExcludeBtnClick(Sender: TObject);
  218. var
  219.   Index: Integer;
  220. begin
  221.   Index := GetFirstSelection(DstList);
  222.   MoveSelected(DstList, SrcList.Items);
  223.   SetItem(DstList, Index);
  224.   FileDirty := True;
  225. end;
  226.  
  227. procedure TMainForm.IncAllBtnClick(Sender: TObject);
  228. var
  229.   I: Integer;
  230. begin
  231.   for I := 0 to SrcList.Items.Count - 1 do
  232.     DstList.Items.AddObject(SrcList.Items[I],
  233.       SrcList.Items.Objects[I]);
  234.   SrcList.Items.Clear;
  235.   SetItem(SrcList, 0);
  236.   FileDirty := True;
  237. end;
  238.  
  239. procedure TMainForm.ExcAllBtnClick(Sender: TObject);
  240. var
  241.   I: Integer;
  242. begin
  243.   for I := 0 to DstList.Items.Count - 1 do
  244.     SrcList.Items.AddObject(DstList.Items[I],
  245.     DstList.Items.Objects[I]);
  246.   DstList.Items.Clear;
  247.   SetItem(DstList, 0);
  248.   FileDirty := True;
  249. end;
  250.  
  251. procedure TMainForm.MoveSelected(List: TCustomListBox;
  252.           Items: TStrings);
  253. var
  254.   I: Integer;
  255. begin
  256.   for I := List.Items.Count - 1 downto 0 do
  257.     if List.Selected[I] then
  258.     begin
  259.       Items.AddObject(List.Items[I], List.Items.Objects[I]);
  260.       List.Items.Delete(I);
  261.     end;
  262.   FileDirty := True;
  263. end;
  264.  
  265. procedure TMainForm.SetButtons;
  266. var
  267.   SrcEmpty, DstEmpty: Boolean;
  268. begin
  269.   SrcEmpty := SrcList.Items.Count = 0;
  270.   DstEmpty := DstList.Items.Count = 0;
  271.   IncludeBtn.Enabled := not SrcEmpty;
  272.   IncAllBtn.Enabled := not SrcEmpty;
  273.   ExcludeBtn.Enabled := not DstEmpty;
  274.   ExAllBtn.Enabled := not DstEmpty;
  275. end;
  276.  
  277. function TMainForm.GetFirstSelection(List: TCustomListBox): Integer;
  278. begin
  279.   for Result := 0 to List.Items.Count - 1 do
  280.     if List.Selected[Result] then Exit;
  281.   Result := LB_ERR;
  282. end;
  283.  
  284. procedure TMainForm.SetItem(List: TListBox; Index: Integer);
  285. var
  286.   MaxIndex: Integer;
  287. begin
  288.   with List do
  289.   begin
  290.     SetFocus;
  291.     MaxIndex := List.Items.Count - 1;
  292.     if Index = LB_ERR then Index := 0
  293.     else if Index > MaxIndex then Index := MaxIndex;
  294.     Selected[Index] := True;
  295.   end;
  296.   SetButtons;
  297. end;
  298.  
  299. procedure TMainForm.FileOpenClick(Sender: TObject);
  300. begin
  301.   if FileOpenDialog.Execute then
  302.   begin
  303.     if FileDirty then CloseTodoFile;
  304.     if not FileDirty then
  305.