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