source: cprs/trunk/CPRS-Chart/fDeviceSelect.pas@ 830

Last change on this file since 830 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 4.7 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 if Sender <> frmFrame then
70 begin
71 DefPrt := User.CurrentPrinter;
72 if DefPrt = '' then DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
73 if DefPrt <> '' then
74 begin
75 if (not FWinPrint) then
76 begin
77 if (DefPrt <> 'WIN;Windows Printer') then
78 begin
79 cboDevice.InitLongList(Piece(DefPrt, ';', 2));
80 cboDevice.SelectByID(DefPrt);
81 end
82 else
83 cboDevice.InitLongList('');
84 end
85 else if FWinprint then
86 begin
87 cboDevice.InitLongList(Piece(DefPrt, ';', 2));
88 cboDevice.SelectByID(DefPrt);
89 end;
90 end
91 else
92 begin
93 cboDevice.InitLongList('');
94 end;
95 if ACaption<>'' then frmDeviceSelect.Caption:=ACaption;
96 end
97 else
98 begin
99 frmDeviceSelect.Caption := 'Print Device Selection';
100 cboDevice.InitLongList('');
101 end;
102 ShowModal;
103 Result := ADevice;
104 //Result := Piece(ADevice, ';', 1) + U + Piece(ADevice, U, 2);
105 end;
106 finally
107 frmDeviceSelect.Release;
108 end;
109end;
110
111procedure TfrmDeviceSelect.cboDeviceChange(Sender: TObject);
112begin
113inherited;
114 with cboDevice do if ItemIndex > -1 then
115 begin
116 txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
117 txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
118 end;
119end;
120
121procedure TfrmDeviceSelect.cmdOKClick(Sender: TObject);
122begin
123 inherited;
124 if cboDevice.ItemID = '' then
125 begin
126 InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
127 Exit;
128 end;
129 ADevice := cboDevice.Items[cboDevice.ItemIndex];
130 if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
131 Close;
132end;
133
134procedure TfrmDeviceSelect.cmdCancelClick(Sender: TObject);
135begin
136 inherited;
137 ADevice := '';
138 Close;
139end;
140
141procedure TfrmDeviceSelect.cboDeviceNeedData(Sender: TObject;
142 const StartFrom: String; Direction, InsertAt: Integer);
143begin
144 inherited;
145 cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
146end;
147
148procedure TfrmDeviceSelect.FormClose(Sender: TObject;
149 var Action: TCloseAction);
150begin
151 inherited;
152 SaveUserBounds(Self);
153end;
154
155procedure TfrmDeviceSelect.FormCreate(Sender: TObject);
156begin
157 inherited;
158 ResizeFormToFont(Self);
159 SetFormPosition(Self);
160end;
161
162end.
Note: See TracBrowser for help on using the repository browser.