VistA-cprs/CPRS-Chart/fDeviceSelect.pas

unit fDeviceSelect;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, fAutoSz, ORCtrls, ORNet, Mask, ExtCtrls;

type
  TfrmDeviceSelect = class(TfrmAutoSz)
    grpDevice: TGroupBox;
    cboDevice: TORComboBox;
    pnlBottom: TPanel;
    cmdOK: TButton;
    cmdCancel: TButton;
    chkDefault: TCheckBox;
    pnlGBBottom: TPanel;
    lblMargin: TLabel;
    txtRightMargin: TMaskEdit;
    lblLength: TLabel;
    txtPageLength: TMaskEdit;
    procedure cboDeviceChange(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure cboDeviceNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FWinPrint: Boolean;
  end;

var
  frmDeviceSelect: TfrmDeviceSelect;
  ADevice: string;

function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ;

implementation

{$R *.DFM}

uses ORFn, rCore, uCore, rReports, Printers, fFrame, rMisc;

const
  TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';
  TX_NODEVICE_CAP = 'Device Not Selected';
  TX_ERR_CAP = 'Print Error';

function SelectDevice(Sender: TObject; ALocation: integer; AllowWindowsPrinter: boolean; ACaption: String): string ;
{ displays a form that prompts for a device}
var
  frmDeviceSelect: TfrmDeviceSelect;
  DefPrt: string;
begin
  frmDeviceSelect := TfrmDeviceSelect.Create(Application);
  try
    ResizeFormToFont(TForm(frmDeviceSelect));
    with frmDeviceSelect do
      begin
        FWinPrint := AllowWindowsPrinter;
        with cboDevice do
          begin
            if (FWinPrint) and (Printer.Printers.Count > 0) then
              begin
                Items.Add('WIN;Windows Printer^Windows Printer');
                Items.Add('^--------------------VistA Printers----------------------');
              end;
          end;
        if Sender <> frmFrame then
          begin
            DefPrt := User.CurrentPrinter;
            if DefPrt = '' then DefPrt := GetDefaultPrinter(User.Duz, Encounter.Location);
            if DefPrt <> '' then
              begin
                if (not FWinPrint) then
                  begin
                    if (DefPrt <> 'WIN;Windows Printer') then
                      begin
                        cboDevice.InitLongList(Piece(DefPrt, ';', 2));
                        cboDevice.SelectByID(DefPrt);
                      end
                    else
                      cboDevice.InitLongList('');
                  end
                else if FWinprint then
                  begin
                    cboDevice.InitLongList(Piece(DefPrt, ';', 2));
                    cboDevice.SelectByID(DefPrt);
                  end;
                  end
              else
              begin
                cboDevice.InitLongList('');
              end;
           if ACaption<>'' then frmDeviceSelect.Caption:=ACaption;
          end
         else
          begin
            frmDeviceSelect.Caption := 'Print Device Selection';
            cboDevice.InitLongList('');
          end;
        ShowModal;
        Result := ADevice;
        //Result := Piece(ADevice, ';', 1) + U + Piece(ADevice, U, 2);
      end;
  finally
    frmDeviceSelect.Release;
  end;
end;

procedure TfrmDeviceSelect.cboDeviceChange(Sender: TObject);
begin
inherited;
  with cboDevice do if ItemIndex > -1 then
  begin
    txtRightMargin.Text := Piece(Items[ItemIndex], '^', 4);
    txtPageLength.Text := Piece(Items[ItemIndex], '^', 5);
  end;
end;

procedure TfrmDeviceSelect.cmdOKClick(Sender: TObject);
begin
  inherited;
  if cboDevice.ItemID = '' then
  begin
    InfoBox(TX_NODEVICE, TX_NODEVICE_CAP, MB_OK);
    Exit;
  end;
  ADevice := cboDevice.Items[cboDevice.ItemIndex];
  if chkDefault.Checked then SaveDefaultPrinter(Piece(cboDevice.ItemID, ';', 1));
  Close;
end;

procedure TfrmDeviceSelect.cmdCancelClick(Sender: TObject);
begin
  inherited;
  ADevice := '';
  Close;
end;

procedure TfrmDeviceSelect.cboDeviceNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
  inherited;
  cboDevice.ForDataUse(SubsetOfDevices(StartFrom, Direction));
end;

procedure TfrmDeviceSelect.FormShow(Sender: TObject);
begin
  SetFormPosition(Self);
  inherited;
end;

procedure TfrmDeviceSelect.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  SaveUserBounds(Self);
end;

end.