| 1 | unit fProbCmt;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses
 | 
|---|
| 6 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
| 7 |   ORCtrls, StdCtrls, Buttons;
 | 
|---|
| 8 | 
 | 
|---|
| 9 | type
 | 
|---|
| 10 |   TfrmProbCmt = class(TForm)
 | 
|---|
| 11 |     edComment: TCaptionEdit;
 | 
|---|
| 12 |     bbOK: TBitBtn;
 | 
|---|
| 13 |     bbCancel: TBitBtn;
 | 
|---|
| 14 |     lblComment: TOROffsetLabel;
 | 
|---|
| 15 |     procedure bbCancelClick(Sender: TObject);
 | 
|---|
| 16 |     procedure bbOKClick(Sender: TObject);
 | 
|---|
| 17 |   private
 | 
|---|
| 18 |     fCmtResult: string ;
 | 
|---|
| 19 |   end;
 | 
|---|
| 20 | 
 | 
|---|
| 21 | function NewComment: string ;
 | 
|---|
| 22 | function EditComment(OldValue: string): string ;
 | 
|---|
| 23 | 
 | 
|---|
| 24 | 
 | 
|---|
| 25 | var
 | 
|---|
| 26 |   frmProbCmt: TfrmProbCmt;
 | 
|---|
| 27 | 
 | 
|---|
| 28 | implementation
 | 
|---|
| 29 | 
 | 
|---|
| 30 | uses
 | 
|---|
| 31 |     uProbs, ORfn, rCore ;
 | 
|---|
| 32 | 
 | 
|---|
| 33 | const
 | 
|---|
| 34 |   TX_INVALID_CHAR = 'The character "^" cannot be used in a comment';
 | 
|---|
| 35 |   TC_INVALID_CHAR = 'Invalid character';
 | 
|---|
| 36 | 
 | 
|---|
| 37 | {$R *.DFM}
 | 
|---|
| 38 | 
 | 
|---|
| 39 | function NewComment: string ;
 | 
|---|
| 40 | begin
 | 
|---|
| 41 |   frmProbCmt := TfrmProbCmt.Create(Application) ;
 | 
|---|
| 42 |   try
 | 
|---|
| 43 |     ResizeAnchoredFormToFont(frmProbCmt);
 | 
|---|
| 44 |     with frmProbCmt do
 | 
|---|
| 45 |       begin
 | 
|---|
| 46 |         ShowModal;
 | 
|---|
| 47 |         Result := fCmtResult;
 | 
|---|
| 48 |       end;
 | 
|---|
| 49 |   finally
 | 
|---|
| 50 |     frmProbCmt.Free ;
 | 
|---|
| 51 |   end ;
 | 
|---|
| 52 | end ;
 | 
|---|
| 53 | 
 | 
|---|
| 54 | function EditComment(OldValue: string): string ;
 | 
|---|
| 55 | begin
 | 
|---|
| 56 |   frmProbCmt := TfrmProbCmt.Create(Application) ;
 | 
|---|
| 57 |   try
 | 
|---|
| 58 |     with frmProbCmt do
 | 
|---|
| 59 |       begin
 | 
|---|
| 60 |         edComment.Text := Piece(OldValue, U, 2);
 | 
|---|
| 61 |         ShowModal;
 | 
|---|
| 62 |         Result := fCmtResult;
 | 
|---|
| 63 |       end;
 | 
|---|
| 64 |   finally
 | 
|---|
| 65 |     frmProbCmt.Free ;
 | 
|---|
| 66 |   end ;
 | 
|---|
| 67 | end ;
 | 
|---|
| 68 | 
 | 
|---|
| 69 | 
 | 
|---|
| 70 | procedure TfrmProbCmt.bbCancelClick(Sender: TObject);
 | 
|---|
| 71 | begin
 | 
|---|
| 72 |   fCmtResult := '0^Cancelled' ;
 | 
|---|
| 73 | end;
 | 
|---|
| 74 | 
 | 
|---|
| 75 | procedure TfrmProbCmt.bbOKClick(Sender: TObject);
 | 
|---|
| 76 | begin
 | 
|---|
| 77 |   if (edComment.Text <> '') then
 | 
|---|
| 78 |     begin
 | 
|---|
| 79 |       if Pos('^', edComment.Text) > 0 then
 | 
|---|
| 80 |       begin
 | 
|---|
| 81 |         InfoBox(TX_INVALID_CHAR, TC_INVALID_CHAR, MB_ICONERROR);
 | 
|---|
| 82 |         fCmtResult := '';
 | 
|---|
| 83 |         ModalResult := mrNone;
 | 
|---|
| 84 |       end
 | 
|---|
| 85 |       else
 | 
|---|
| 86 |       begin
 | 
|---|
| 87 |         fCmtResult := '1^'+FormatFMDateTime('mmm dd yyyy',FMToday)+'^'+ edComment.Text;
 | 
|---|
| 88 |         ModalResult := mrOK;
 | 
|---|
| 89 |       end;
 | 
|---|
| 90 |     end
 | 
|---|
| 91 |   else
 | 
|---|
| 92 |     begin
 | 
|---|
| 93 |       fCmtResult := '';
 | 
|---|
| 94 |       ModalResult := mrNone;
 | 
|---|
| 95 |     end;
 | 
|---|
| 96 | end;
 | 
|---|
| 97 | 
 | 
|---|
| 98 | end.
 | 
|---|