source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fDeviceSelect.pas@ 1727

Last change on this file since 1727 was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch

File size: 4.5 KB
Line 
1unit fDeviceSelect;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, fAutoSz, ORCtrls, ORNet, Mask, ExtCtrls, VA508AccessibilityManager;
8
9type
10 TfrmDeviceSelect = class(TfrmAutoSz)
11 grpDevice: TGroupBox;
12 cboDevice: TORComboBox;
13 pnlBottom: TPanel;
14 cmdOK: TButton;
15 cmdCancel: TButton;
16 chkDefault: TCheckBox;
17 pnlGBBottom: TPanel;
18 lblMargin: TLabel;
19 txtRightMargin: TMaskEdit;
20 lblLength: TLabel;
21 txtPageLength: TMaskEdit;
22 procedure cboDeviceChange(Sender: TObject);
23 procedure cmdOKClick(Sender: TObject);
24 procedure cmdCancelClick(Sender: TObject);
25 procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
26 Direction, InsertAt: Integer);
27 procedure FormClose(Sender: TObject; var Action: TCloseAction);
28 procedure FormCreate(Sender: TObject);
29 private
30 FWinPrint: Boolean;
31 end;
32
33var
34 frmDeviceSelect: TfrmDeviceSelect;
35 ADevice: string;
36
37function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ;
38
39implementation
40
41{$R *.DFM}
42
43uses ORFn, rCore, uCore, rReports, Printers, fFrame, rMisc;
44
45const
46 TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';
47 TX_NODEVICE_CAP = 'Device Not Selected';
48 TX_ERR_CAP = 'Print Error';
49
50function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ;
51{ displays a form that prompts for a device}
52var
53 frmDeviceSelect: TfrmDeviceSelect;
54 DefPrt: string;
55begin
56 frmDeviceSelect := TfrmDeviceSelect.Create(Application);
57 try
58 with frmDeviceSelect do
59 begin
60 FWinPrint := AllowWindowsPrinter;
61 with cboDevice do
62 begin
63 if (FWinPrint) and (Printer.Printers.Count > 0) then
64 begin
65 Items.Add('WIN;Windows Printer^Windows Printer');
66 Items.Add('^--------------------VistA Printers----------------------');
67 end;
68 end;
69
70 DefPrt := User.CurrentPrinter;
71 if DefPrt = '' then DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
72 if DefPrt <> '' then
73 begin
74 if (not FWinPrint) then
75 begin
76 if (DefPrt <> 'WIN;Windows Printer') then
77 begin
78 cboDevice.InitLongList(Piece(DefPrt, ';', 2));
79 cboDevice.SelectByID(DefPrt);
80 end
81 else
82 cboDevice.InitLongList('');
83 end
84 else if FWinprint then
85 begin
86 cboDevice.InitLongList(Piece(DefPrt, ';', 2));
87 cboDevice.SelectByID(DefPrt);
88 end;
89 end
90 else
91 begin
92 cboDevice.InitLongList('');
93 end;
94 if ACaption<>'' then frmDeviceSelect.Caption:=ACaption;
95
96 ShowModal;
97 Result := ADevice;
98 //Result := Piece(ADevice, ';', 1) + U + Piece(ADevice, U, 2);
99 end;
100 finally
101 frmDeviceSelect.Release;
102 end;
103end;
104
105procedure TfrmDeviceSelect.cboDeviceChange(Sender: TObject);
106begin
107inherited;
108 with cboDevice do if ItemIndex > -1 then
109 begin
110 txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
111 txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
112 end;
113end;
114
115procedure TfrmDeviceSelect.cmdOKClick(Sender: TObject);
116begin
117 inherited;
118 if cboDevice.ItemID = '' then
119 begin
120 InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
121 Exit;
122 end;
123 ADevice := cboDevice.Items[cboDevice.ItemIndex];
124 if chkDefault.Checked then begin
125 SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
126 User.CurrentPrinter := cboDevice.ItemID;
127 end;
128 Close;
129end;
130
131procedure TfrmDeviceSelect.cmdCancelClick(Sender: TObject);
132begin
133 inherited;
134 ADevice := User.CurrentPrinter;
135 Close;
136end;
137
138procedure TfrmDeviceSelect.cboDeviceNeedData(Sender: TObject;
139 const StartFrom: String; Direction, InsertAt: Integer);
140begin
141 inherited;
142 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
143end;
144
145procedure TfrmDeviceSelect.FormClose(Sender: TObject;
146 var Action: TCloseAction);
147begin
148 inherited;
149 SaveUserBounds(Self);
150end;
151
152procedure TfrmDeviceSelect.FormCreate(Sender: TObject);
153begin
154 inherited;
155 ResizeFormToFont(Self);
156 SetFormPosition(Self);
157end;
158
159end.
Note: See TracBrowser for help on using the repository browser.