| 1 | unit fOptionsNewList;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Dialogs,
 | 
|---|
| 6 |   Buttons, ComCtrls, ExtCtrls, OrFn, ORCtrls;
 | 
|---|
| 7 | 
 | 
|---|
| 8 | type
 | 
|---|
| 9 |   TfrmOptionsNewList = class(TForm)
 | 
|---|
| 10 |     pnlBottom: TPanel;
 | 
|---|
| 11 |     btnOK: TButton;
 | 
|---|
| 12 |     btnCancel: TButton;
 | 
|---|
| 13 |     txtNewList: TCaptionEdit;
 | 
|---|
| 14 |     lblEnter: TLabel;
 | 
|---|
| 15 |     lblNew: TLabel;
 | 
|---|
| 16 |     procedure btnOKClick(Sender: TObject);
 | 
|---|
| 17 |     procedure txtNewListKeyPress(Sender: TObject; var Key: Char);
 | 
|---|
| 18 |     procedure txtNewListChange(Sender: TObject);
 | 
|---|
| 19 |   private
 | 
|---|
| 20 |     { Private declarations }
 | 
|---|
| 21 |     FNewList: string;
 | 
|---|
| 22 |   public
 | 
|---|
| 23 |     { Public declarations }
 | 
|---|
| 24 |   end;
 | 
|---|
| 25 | 
 | 
|---|
| 26 | procedure DialogOptionsNewList(fontsize: integer; var actiontype: string);
 | 
|---|
| 27 | 
 | 
|---|
| 28 | var
 | 
|---|
| 29 |   frmOptionsNewList: TfrmOptionsNewList;
 | 
|---|
| 30 | 
 | 
|---|
| 31 | implementation
 | 
|---|
| 32 | 
 | 
|---|
| 33 | uses rOptions;
 | 
|---|
| 34 | 
 | 
|---|
| 35 | {$R *.DFM}
 | 
|---|
| 36 | 
 | 
|---|
| 37 | procedure DialogOptionsNewList(fontsize: integer; var actiontype: string);
 | 
|---|
| 38 | // create the form and make it modal, return an action
 | 
|---|
| 39 | var
 | 
|---|
| 40 |   frmOptionsNewList: TfrmOptionsNewList;
 | 
|---|
| 41 | begin
 | 
|---|
| 42 |   frmOptionsNewList := TfrmOptionsNewList.Create(Application);
 | 
|---|
| 43 |   actiontype := '';
 | 
|---|
| 44 |   try
 | 
|---|
| 45 |     with frmOptionsNewList do
 | 
|---|
| 46 |     begin
 | 
|---|
| 47 |       Position := poScreenCenter;
 | 
|---|
| 48 |       ResizeAnchoredFormToFont(frmOptionsNewList);
 | 
|---|
| 49 |       ShowModal;
 | 
|---|
| 50 |       actiontype := FNewList;
 | 
|---|
| 51 |     end;
 | 
|---|
| 52 |   finally
 | 
|---|
| 53 |     frmOptionsNewList.Release;
 | 
|---|
| 54 |   end;
 | 
|---|
| 55 | end;
 | 
|---|
| 56 | 
 | 
|---|
| 57 | procedure TfrmOptionsNewList.btnOKClick(Sender: TObject);
 | 
|---|
| 58 | var
 | 
|---|
| 59 |   ok: boolean;
 | 
|---|
| 60 | begin
 | 
|---|
| 61 |   ok := false;
 | 
|---|
| 62 |   with txtNewList do
 | 
|---|
| 63 |   begin
 | 
|---|
| 64 |     if (length(Text) < 3) or (length(Text) > 30) then
 | 
|---|
| 65 |       showmessage('Enter a valid name.')
 | 
|---|
| 66 |     else if not ContainsAlpha(txtNewList.Text[1]) then
 | 
|---|
| 67 |       showmessage('Enter a valid name.')
 | 
|---|
| 68 |     else
 | 
|---|
| 69 |     begin
 | 
|---|
| 70 |       FNewList := rpcNewList(Text);
 | 
|---|
| 71 |       if Piece(FNewList, '^', 1) = '' then
 | 
|---|
| 72 |         showmessage('Enter a valid name. ' + Piece(FNewList, '^', 2))
 | 
|---|
| 73 |       else
 | 
|---|
| 74 |         ok := true;
 | 
|---|
| 75 |     end;
 | 
|---|
| 76 |     if ok then Close
 | 
|---|
| 77 |     else
 | 
|---|
| 78 |     begin
 | 
|---|
| 79 |       Text := '';
 | 
|---|
| 80 |       SetFocus;
 | 
|---|
| 81 |     end;
 | 
|---|
| 82 |   end;
 | 
|---|
| 83 | end;
 | 
|---|
| 84 | 
 | 
|---|
| 85 | procedure TfrmOptionsNewList.txtNewListKeyPress(Sender: TObject;
 | 
|---|
| 86 |   var Key: Char);
 | 
|---|
| 87 | begin
 | 
|---|
| 88 |   if not (Key in ['A'..'Z', 'a'..'z', '0'..'9', #32, #8]) then
 | 
|---|
| 89 |   begin
 | 
|---|
| 90 |     Key := #0;
 | 
|---|
| 91 |     beep;
 | 
|---|
| 92 |   end;
 | 
|---|
| 93 | end;
 | 
|---|
| 94 | 
 | 
|---|
| 95 | procedure TfrmOptionsNewList.txtNewListChange(Sender: TObject);
 | 
|---|
| 96 | begin
 | 
|---|
| 97 |   btnOK.Enabled := length(txtNewList.Text) > 3;
 | 
|---|
| 98 | end;
 | 
|---|
| 99 | 
 | 
|---|
| 100 | end.
 | 
|---|
| 101 | 
 | 
|---|