source: cprs/branches/tmg-cprs/CPRS-Chart/fDeviceSelect.pas@ 568

//kt -- Modified with SourceScanner on 7/15/2007
unit fDeviceSelect;
//kt note: This wasn't in CPRS project.  I added it.
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
    //kt Begin Mod (change Consts to Vars) 7/15/2007
    TX_NODEVICE      : string;  //kt
    TX_NODEVICE_CAP  : string;  //kt
    TX_ERR_CAP       : string;  //kt
    //kt End Mod -------------------
    FWinPrint: Boolean;
    procedure SetupVars;  //kt 7-15-07
  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,
     DKLang; //kt 7-15-07

//const
//TX_NODEVICE = 'A device must be selected to print, or press ''Cancel'' to not print.';  <-- original line.  //kt 7/15/2007
//TX_NODEVICE_CAP = 'Device Not Selected';  <-- original line.  //kt 7/15/2007
//TX_ERR_CAP = 'Print Error';  <-- original line.  //kt 7/15/2007
 
 
procedure TfrmDeviceSelect.SetupVars;
//kt Added entire function to replace constant declarations 7/15/2007
begin
  TX_NODEVICE := DKLangConstW('fDeviceSelect_A_device_must_be_selected_to_print_or_press_Cancel_to_not_print'); 
  TX_NODEVICE_CAP := DKLangConstW('fDeviceSelect_Device_Not_Selected'); 
  TX_ERR_CAP := DKLangConstW('fDeviceSelect_Print_Error'); 
end;
 
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');  <-- original line.  //kt 7/15/2007
                Items.Add('WIN;' + DKLangConstW('fDeviceSelect_Windows_Printer')+'^'+DKLangConstW('fDeviceSelect_Windows_Printer')); //kt added 7/15/2007
//              Items.Add('^--------------------VistA Printers----------------------');  <-- original line.  //kt 7/15/2007
                Items.Add('^'+DKLangConstW('fDeviceSelect_VistA_Printers')); //kt added 7/15/2007
              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  <-- original line.  //kt 7/15/2007
                    if (DefPrt <> DKLangConstW('fDeviceSelect_WINWindows_Printer')) then //kt added 7/15/2007
                      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';  <-- original line.  //kt 7/15/2007
            frmDeviceSelect.Caption := DKLangConstW('fDeviceSelect_Print_Device_Selection'); //kt added 7/15/2007
            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
  SetupVars;  //kt added 7/15/2007 to replace constants with vars.
  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.