| 1 | unit fDupPts;
 | 
|---|
| 2 | 
 | 
|---|
| 3 | interface
 | 
|---|
| 4 | 
 | 
|---|
| 5 | uses
 | 
|---|
| 6 |   Windows, Messages, SysUtils, Variants, Classes, Graphics,
 | 
|---|
| 7 |   Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, OrFn;
 | 
|---|
| 8 | 
 | 
|---|
| 9 | type
 | 
|---|
| 10 |   TfrmDupPts = class(TForm)
 | 
|---|
| 11 |     pnlDupPts: TPanel;
 | 
|---|
| 12 |     btnOK: TButton;
 | 
|---|
| 13 |     btnCancel: TButton;
 | 
|---|
| 14 |     pnlSelDupPt: TPanel;
 | 
|---|
| 15 |     lboSelPt: TORListBox;
 | 
|---|
| 16 |     lblDupPts: TLabel;
 | 
|---|
| 17 |     lblSelDupPts: TLabel;
 | 
|---|
| 18 |     procedure btnCancelClick(Sender: TObject);
 | 
|---|
| 19 |     procedure FormCreate(Sender: TObject);
 | 
|---|
| 20 |     procedure btnOKClick(Sender: TObject);
 | 
|---|
| 21 |     procedure FormKeyDown(Sender: TObject; var Key: Word;
 | 
|---|
| 22 |       Shift: TShiftState);
 | 
|---|
| 23 |     procedure lboSelPtDblClick(Sender: TObject);
 | 
|---|
| 24 |   private
 | 
|---|
| 25 |     { Private declarations }
 | 
|---|
| 26 |   public
 | 
|---|
| 27 |     { Public declarations }
 | 
|---|
| 28 |   end;
 | 
|---|
| 29 | 
 | 
|---|
| 30 | var
 | 
|---|
| 31 |   frmDupPts: TfrmDupPts;
 | 
|---|
| 32 | 
 | 
|---|
| 33 | implementation
 | 
|---|
| 34 | 
 | 
|---|
| 35 | {$R *.dfm}
 | 
|---|
| 36 | 
 | 
|---|
| 37 | uses rCore, uCore, fPtSel;
 | 
|---|
| 38 | 
 | 
|---|
| 39 | procedure TfrmDupPts.btnCancelClick(Sender: TObject);
 | 
|---|
| 40 | begin
 | 
|---|
| 41 | 
 | 
|---|
| 42 | close;
 | 
|---|
| 43 | 
 | 
|---|
| 44 | end;
 | 
|---|
| 45 | 
 | 
|---|
| 46 | procedure TfrmDupPts.FormCreate(Sender: TObject);
 | 
|---|
| 47 | var
 | 
|---|
| 48 |   theDups: tStringList;
 | 
|---|
| 49 | begin
 | 
|---|
| 50 |   fPtSel.DupDFN := 'Cancel'; // Pre-set as default.
 | 
|---|
| 51 |   theDups := tStringList.create;
 | 
|---|
| 52 |   theDups.assign(fPtSel.PtStrs);
 | 
|---|
| 53 |   lboSelPt.items.assign(theDups);
 | 
|---|
| 54 |   ResizeAnchoredFormToFont(self);
 | 
|---|
| 55 | end;
 | 
|---|
| 56 | 
 | 
|---|
| 57 | procedure TfrmDupPts.btnOKClick(Sender: TObject);
 | 
|---|
| 58 | begin
 | 
|---|
| 59 | 
 | 
|---|
| 60 | if not (Length(lboSelPt.ItemID) > 0) then  //*DFN*
 | 
|---|
| 61 | begin
 | 
|---|
| 62 |   infoBox('A patient has not been selected.', 'No Patient Selected', MB_OK);
 | 
|---|
| 63 |   exit;
 | 
|---|
| 64 | end;
 | 
|---|
| 65 | 
 | 
|---|
| 66 | fPtSel.DupDFN := lboSelPt.ItemID;  //*DFN*
 | 
|---|
| 67 | close;
 | 
|---|
| 68 | 
 | 
|---|
| 69 | end;
 | 
|---|
| 70 | 
 | 
|---|
| 71 | procedure TfrmDupPts.FormKeyDown(Sender: TObject; var Key: Word;
 | 
|---|
| 72 |   Shift: TShiftState);
 | 
|---|
| 73 | begin
 | 
|---|
| 74 | 
 | 
|---|
| 75 | // Check for "Esc" keypress:
 | 
|---|
| 76 | if (key = 27) then // ESC key.
 | 
|---|
| 77 |   btnCancel.click;
 | 
|---|
| 78 | 
 | 
|---|
| 79 | end;
 | 
|---|
| 80 | 
 | 
|---|
| 81 | procedure TfrmDupPts.lboSelPtDblClick(Sender: TObject);
 | 
|---|
| 82 | begin
 | 
|---|
| 83 |   btnOKClick(btnOK);
 | 
|---|
| 84 | end;
 | 
|---|
| 85 | 
 | 
|---|
| 86 | end.
 | 
|---|