home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 May / PCP163A.iso / handson / files / copydelp.exe / catadd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-12-22  |  2.6 KB  |  112 lines
  1. unit catadd;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, TD, DBCtrls, Grids, DBGrids, ExtCtrls;
  8.  
  9. type
  10.   TCatAddForm = class(TForm)
  11.     CancelBtn: TButton;
  12.     UseCategoryBtn: TButton;
  13.     Panel1: TPanel;
  14.     DBGrid1: TDBGrid;
  15.     AddCatEdit: TEdit;
  16.     AddBtn: TButton;
  17.     DeleteBtn: TButton;
  18.     procedure CancelBtnClick(Sender: TObject);
  19.     procedure AddBtnClick(Sender: TObject);
  20.     procedure DeleteBtnClick(Sender: TObject);
  21.     procedure UseCategoryBtnClick(Sender: TObject);
  22.     procedure DBGrid1DblClick(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.   public
  26.     { Public declarations }
  27.     procedure Capitalise( var s : string );
  28.     function LowCase( c : char ) : char;
  29.     procedure UseCategory;
  30.   end;
  31.  
  32. var
  33.   CatAddForm: TCatAddForm;
  34.  
  35. implementation
  36.  
  37. {$R *.DFM}
  38. function TCatAddForm.LowCase( c : char ) : char;
  39. begin
  40.   if (c in ['A'..'Z']) then
  41.      Result := Chr(Ord(c) + 32)
  42.   else Result := c;
  43. end;
  44.  
  45. procedure TCatAddForm.Capitalise( var s : string );
  46. var
  47.    i : integer;
  48. begin
  49.   if s <> '' then
  50.   begin
  51.   for i := 1 to Length( s ) do
  52.       s[i] := LowCase(s[i]); // change to LowCase
  53.     s[1] := Upcase(s[1]);
  54.   end;
  55. end;
  56.  
  57. procedure TCatAddForm.CancelBtnClick(Sender: TObject);
  58. begin
  59.   Close;
  60. end;
  61.  
  62. procedure TCatAddForm.AddBtnClick(Sender: TObject);
  63. var
  64.    newcat : string;
  65. begin
  66.   newcat := AddCatEdit.Text;
  67.   if newcat = '' then
  68.      ShowMessage( 'You need to enter a name for the new category!' )
  69.   else
  70.   begin
  71.     Capitalise( newcat );
  72.     if ToDoForm.CategoriesTable.FindKey( [newcat] ) then
  73.        ShowMessage( 'This category already exists!')
  74.     else
  75.     begin
  76.        ToDoForm.CategoriesTable.InsertRecord( [newcat] );
  77.        AddCatEdit.Text := '';
  78.        ToDoForm.CreateTypeComboList; // rebuild ComboBox list of categories
  79.     end;
  80.   end;
  81. end;
  82.  
  83. procedure TCatAddForm.DeleteBtnClick(Sender: TObject);
  84. begin
  85.    if (ToDoForm.CategoriesTable.RecordCount <= 0) then
  86.       ShowMessage('No categories to delete!' )
  87.    else
  88.    begin
  89.       ToDoForm.CategoriesTable.Delete;
  90.       ToDoForm.CreateTypeComboList; // rebuild Type Combo Items list
  91.    end;
  92. end;
  93.  
  94. procedure TCatAddForm.UseCategory;
  95. begin
  96.   if (ToDoForm.CategoriesTable.RecordCount > 0) then
  97.      ModalResult := mrOK
  98.   else ShowMessage( 'You need to add a category!');
  99. end;
  100.  
  101. procedure TCatAddForm.UseCategoryBtnClick(Sender: TObject);
  102. begin
  103.    UseCategory;
  104. end;
  105.  
  106. procedure TCatAddForm.DBGrid1DblClick(Sender: TObject);
  107. begin
  108.   UseCategory;
  109. end;
  110.  
  111. end.
  112.