[459] | 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.
|
---|