[456] | 1 | unit fRenewOutMed;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
[830] | 7 | fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders, Mask, ORCtrls, ExtCtrls, fBase508Form,
|
---|
[1679] | 8 | VA508AccessibilityManager, VA508AccessibilityRouter;
|
---|
[456] | 9 |
|
---|
| 10 | type
|
---|
[830] | 11 | TfrmRenewOutMed = class(TfrmBase508Form)
|
---|
[456] | 12 | memOrder: TCaptionMemo;
|
---|
| 13 | pnlButtons: TPanel;
|
---|
| 14 | cmdOK: TButton;
|
---|
| 15 | cmdCancel: TButton;
|
---|
| 16 | pnlMiddle: TPanel;
|
---|
| 17 | cboPickup: TORComboBox;
|
---|
| 18 | lblPickup: TLabel;
|
---|
| 19 | txtRefills: TCaptionEdit;
|
---|
| 20 | lblRefills: TLabel;
|
---|
[1679] | 21 | VA508ComponentAccessibility1: TVA508ComponentAccessibility;
|
---|
[456] | 22 | procedure FormCreate(Sender: TObject);
|
---|
| 23 | procedure cmdOKClick(Sender: TObject);
|
---|
| 24 | procedure cmdCancelClick(Sender: TObject);
|
---|
[1679] | 25 | procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
|
---|
| 26 | var Text: string);
|
---|
| 27 | procedure FormShow(Sender: TObject);
|
---|
[456] | 28 | private
|
---|
| 29 | OKPressed: Boolean;
|
---|
| 30 | end;
|
---|
| 31 |
|
---|
| 32 | function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
|
---|
| 33 | AnOrder: TOrder): Boolean;
|
---|
| 34 |
|
---|
| 35 | implementation
|
---|
| 36 |
|
---|
| 37 | {$R *.DFM}
|
---|
| 38 |
|
---|
| 39 | const
|
---|
| 40 | TX_ERR_REFILL = 'Refills must be a number from 0 to 11.';
|
---|
| 41 | TC_ERR_REFILL = 'Refills';
|
---|
| 42 |
|
---|
| 43 | function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
|
---|
| 44 | AnOrder: TOrder): Boolean;
|
---|
| 45 | var
|
---|
| 46 | frmRenewOutMed: TfrmRenewOutMed;
|
---|
| 47 | begin
|
---|
| 48 | Result := False;
|
---|
| 49 | frmRenewOutMed := TfrmRenewOutMed.Create(Application);
|
---|
| 50 | try
|
---|
| 51 | ResizeFormToFont(TForm(frmRenewOutMed));
|
---|
| 52 | frmRenewOutMed.memOrder.SetTextBuf(PChar(AnOrder.Text));
|
---|
| 53 | frmRenewOutMed.txtRefills.Text := IntToStr(Refills);
|
---|
| 54 | frmRenewOutMed.cboPickup.SelectByID(Pickup);
|
---|
| 55 | frmRenewOutMed.ShowModal;
|
---|
| 56 | if frmRenewOutMed.OKPressed then
|
---|
| 57 | begin
|
---|
| 58 | Result := True;
|
---|
| 59 | Refills := StrToIntDef(frmRenewOutMed.txtRefills.Text, Refills);
|
---|
| 60 | Pickup := frmRenewOutMed.cboPickup.ItemID;
|
---|
| 61 | end;
|
---|
| 62 | finally
|
---|
| 63 | frmRenewOutMed.Release;
|
---|
| 64 | end;
|
---|
| 65 | end;
|
---|
| 66 |
|
---|
| 67 | procedure TfrmRenewOutMed.FormCreate(Sender: TObject);
|
---|
| 68 | begin
|
---|
| 69 | inherited;
|
---|
| 70 | OKPressed := False;
|
---|
| 71 | with cboPickup.Items do
|
---|
| 72 | begin
|
---|
| 73 | Add('W^at Window');
|
---|
| 74 | Add('M^by Mail');
|
---|
| 75 | Add('C^in Clinic');
|
---|
| 76 | end;
|
---|
| 77 | end;
|
---|
| 78 |
|
---|
[1679] | 79 | procedure TfrmRenewOutMed.FormShow(Sender: TObject);
|
---|
| 80 | begin
|
---|
| 81 | inherited;
|
---|
| 82 | if ScreenReaderSystemActive then
|
---|
| 83 | begin
|
---|
| 84 | memOrder.TabStop := true;
|
---|
| 85 | memOrder.SetFocus;
|
---|
| 86 | end;
|
---|
| 87 | end;
|
---|
| 88 |
|
---|
| 89 | procedure TfrmRenewOutMed.VA508ComponentAccessibility1StateQuery(
|
---|
| 90 | Sender: TObject; var Text: string);
|
---|
| 91 | begin
|
---|
| 92 | inherited;
|
---|
| 93 | Text := memOrder.Text;
|
---|
| 94 | end;
|
---|
| 95 |
|
---|
[456] | 96 | procedure TfrmRenewOutMed.cmdOKClick(Sender: TObject);
|
---|
| 97 | var
|
---|
| 98 | NumRefills: Integer;
|
---|
| 99 | begin
|
---|
| 100 | inherited;
|
---|
| 101 | NumRefills := StrToIntDef(txtRefills.Text, -1);
|
---|
| 102 | if (NumRefills < 0) or (NumRefills > 11) then
|
---|
| 103 | begin
|
---|
| 104 | InfoBox(TX_ERR_REFILL, TC_ERR_REFILL, MB_OK);
|
---|
| 105 | Exit;
|
---|
| 106 | end;
|
---|
| 107 | OKPressed := True;
|
---|
| 108 | Close;
|
---|
| 109 | end;
|
---|
| 110 |
|
---|
| 111 | procedure TfrmRenewOutMed.cmdCancelClick(Sender: TObject);
|
---|
| 112 | begin
|
---|
| 113 | inherited;
|
---|
| 114 | Close;
|
---|
| 115 | end;
|
---|
| 116 |
|
---|
| 117 | end.
|
---|