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