source: cprs/trunk/CPRS-Chart/fRenewOutMed.pas@ 801

unit fRenewOutMed;

interface

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

type
  TfrmRenewOutMed = class(TForm)
    memOrder: TCaptionMemo;
    pnlButtons: TPanel;
    cmdOK: TButton;
    cmdCancel: TButton;
    pnlMiddle: TPanel;
    cboPickup: TORComboBox;
    lblPickup: TLabel;
    txtRefills: TCaptionEdit;
    lblRefills: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
  private
    OKPressed: Boolean;
  end;

function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
  AnOrder: TOrder): Boolean;

implementation

{$R *.DFM}

const
  TX_ERR_REFILL = 'Refills must be a number from 0 to 11.';
  TC_ERR_REFILL = 'Refills';

function ExecuteRenewOutMed(var Refills: Integer; var Comments, Pickup: string;
  AnOrder: TOrder): Boolean;
var
  frmRenewOutMed: TfrmRenewOutMed;
begin
  Result := False;
  frmRenewOutMed := TfrmRenewOutMed.Create(Application);
  try
    ResizeFormToFont(TForm(frmRenewOutMed));
    frmRenewOutMed.memOrder.SetTextBuf(PChar(AnOrder.Text));
    frmRenewOutMed.txtRefills.Text := IntToStr(Refills);
    frmRenewOutMed.cboPickup.SelectByID(Pickup);
    frmRenewOutMed.ShowModal;
    if frmRenewOutMed.OKPressed then
    begin
      Result := True;
      Refills := StrToIntDef(frmRenewOutMed.txtRefills.Text, Refills);
      Pickup := frmRenewOutMed.cboPickup.ItemID;
    end;
  finally
    frmRenewOutMed.Release;
  end;
end;

procedure TfrmRenewOutMed.FormCreate(Sender: TObject);
begin
  inherited;
  OKPressed := False;
  with cboPickup.Items do
  begin
    Add('W^at Window');
    Add('M^by Mail');
    Add('C^in Clinic');
  end;
end;

procedure TfrmRenewOutMed.cmdOKClick(Sender: TObject);
var
  NumRefills: Integer;
begin
  inherited;
  NumRefills := StrToIntDef(txtRefills.Text, -1);
  if (NumRefills < 0) or (NumRefills > 11) then
  begin
    InfoBox(TX_ERR_REFILL, TC_ERR_REFILL, MB_OK);
    Exit;
  end;
  OKPressed := True;
  Close;
end;

procedure TfrmRenewOutMed.cmdCancelClick(Sender: TObject);
begin
  inherited;
  Close;
end;

end.