| 1 | unit fARTFreeTextMsg; | 
|---|
| 2 |  | 
|---|
| 3 | interface | 
|---|
| 4 |  | 
|---|
| 5 | uses | 
|---|
| 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | 
|---|
| 7 | Dialogs, fAutoSz, StdCtrls, ComCtrls, ORFn, ExtCtrls, ORCtrls; | 
|---|
| 8 |  | 
|---|
| 9 | type | 
|---|
| 10 | TfrmARTFreeTextMsg = class(TfrmAutoSz) | 
|---|
| 11 | pnlText: TORAutoPanel; | 
|---|
| 12 | pnlButton: TORAutoPanel; | 
|---|
| 13 | cmdContinue: TButton; | 
|---|
| 14 | lblText: TLabel; | 
|---|
| 15 | memFreeText: TCaptionRichEdit; | 
|---|
| 16 | lblComments: TOROffsetLabel; | 
|---|
| 17 | procedure cmdContinueClick(Sender: TObject); | 
|---|
| 18 | private | 
|---|
| 19 | FContinue: boolean; | 
|---|
| 20 | public | 
|---|
| 21 | end; | 
|---|
| 22 |  | 
|---|
| 23 | const | 
|---|
| 24 | LABEL_TEXT = 'You may now add any comments you may have to the message that' + CRLF + | 
|---|
| 25 | 'is going to be sent with the request to add this reactant.' + CRLF + CRLF + | 
|---|
| 26 |  | 
|---|
| 27 | 'You may want to add things like sign/symptoms, observed or historical, etc.,' + CRLF + | 
|---|
| 28 | 'that may be useful to the reviewer.' + CRLF + CRLF + | 
|---|
| 29 |  | 
|---|
| 30 | 'Already included are the entry you attempted, the patient you attempted to' + CRLF + | 
|---|
| 31 | 'enter it for, and your name, title, and contact information.'; | 
|---|
| 32 |  | 
|---|
| 33 | var | 
|---|
| 34 | tmpList: TStringList; | 
|---|
| 35 |  | 
|---|
| 36 | procedure GetFreeTextARTComment(var AFreeTextComment: TStringList; var OKtoContinue: boolean); | 
|---|
| 37 |  | 
|---|
| 38 | implementation | 
|---|
| 39 |  | 
|---|
| 40 | {$R *.dfm} | 
|---|
| 41 |  | 
|---|
| 42 | procedure GetFreeTextARTComment(var AFreeTextComment: TStringList; var OKtoContinue: boolean); | 
|---|
| 43 | var | 
|---|
| 44 | frmARTFreeTextMsg: TfrmARTFreeTextMsg; | 
|---|
| 45 | begin | 
|---|
| 46 | frmARTFreeTextMsg := TfrmARTFreeTextMsg.Create(Application); | 
|---|
| 47 | tmpList := TStringList.Create; | 
|---|
| 48 | try | 
|---|
| 49 | with frmARTFreeTextMsg do | 
|---|
| 50 | begin | 
|---|
| 51 | FContinue := OKtoContinue; | 
|---|
| 52 | tmpList.Text := ''; | 
|---|
| 53 | lblText.Caption := LABEL_TEXT; | 
|---|
| 54 | ResizeFormToFont(TForm(frmARTFreeTextMsg)); | 
|---|
| 55 | ActiveControl := memFreeText; | 
|---|
| 56 | frmARTFreeTextMsg.ShowModal; | 
|---|
| 57 | OKtoContinue := FContinue; | 
|---|
| 58 | AFreeTextComment.Assign(tmpList); | 
|---|
| 59 | end; | 
|---|
| 60 | finally | 
|---|
| 61 | tmpList.Free; | 
|---|
| 62 | frmARTFreeTextMsg.Release; | 
|---|
| 63 | end; | 
|---|
| 64 | end; | 
|---|
| 65 |  | 
|---|
| 66 | procedure TfrmARTFreeTextMsg.cmdContinueClick(Sender: TObject); | 
|---|
| 67 | begin | 
|---|
| 68 | inherited; | 
|---|
| 69 | tmpList.Assign(memFreeText.Lines); | 
|---|
| 70 | FContinue := True; | 
|---|
| 71 | Close; | 
|---|
| 72 | end; | 
|---|
| 73 |  | 
|---|
| 74 | end. | 
|---|