VistA-cprs/CPRS-Chart/Orders/fODChild.pas

138 lines
3.5 KiB
Plaintext

unit fODChild;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, fAutoSZ, ORFn, VA508AccessibilityManager;
type
TfrmODChild = class(TfrmAutoSz)
lblWarning: TLabel;
Panel1: TPanel;
lstODComplex: TListBox;
Panel2: TPanel;
btnOK: TButton;
btnCancel: TButton;
procedure FormCreate(Sender: TObject);
procedure lstODComplexDrawItem(Control: TWinControl; Index: Integer;
TheRect: TRect; State: TOwnerDrawState);
procedure lstODComplexMeasureItem(Control: TWinControl; Index: Integer;
var TheHeight: Integer);
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
private
{ Private declarations }
FCmdOK: boolean;
public
{ Public declarations }
end;
function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string = ''; ShowCancel: boolean = False): boolean;
implementation
{$R *.DFM}
function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string; ShowCancel: boolean): boolean;
var
i: integer;
frmODChild: TfrmODChild;
begin
frmODChild := TfrmODChild.Create(nil);
try
try
ResizeFormToFont(TForm(frmODChild));
if Length(CaptionTxt)>0 then
frmODChild.lblWarning.Caption := CaptionTxt;
for i := 0 to AnList.count - 1 do
frmODChild.lstODComplex.Items.Add(AnList[i]);
if not ShowCancel then
begin
frmODChild.btnOK.Visible := False;
frmODChild.btnCancel.Caption := 'OK';
end;
frmODChild.ShowModal;
if frmODChild.FCmdOK then Result := True else Result := False;
except
on e: Exception do
Result := False;
end;
finally
frmODChild.Release;
end;
end;
procedure TfrmODChild.FormCreate(Sender: TObject);
begin
FCmdOK := False;
end;
procedure TfrmODChild.lstODComplexDrawItem(Control: TWinControl;
Index: Integer; TheRect: TRect; State: TOwnerDrawState);
var
x: string;
ARect: TRect;
SaveColor: TColor;
begin
inherited;
with lstODComplex do
begin
ARect := TheRect;
ARect.Left := ARect.Left + 2;
Canvas.FillRect(ARect);
Canvas.Pen.Color := Get508CompliantColor(clSilver);
SaveColor := Canvas.Brush.Color;
Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
if Index < Items.Count then
begin
x := Piece(Items[index],'^',2);
DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
Canvas.Brush.Color := SaveColor;
ARect.Right := ARect.Right + 4;
end;
end;
end;
procedure TfrmODChild.lstODComplexMeasureItem(Control: TWinControl;
Index: Integer; var TheHeight: Integer);
var
x :string;
tempHeight: integer;
R: TRect;
begin
inherited;
tempHeight := 0;
TheHeight := MainFontHeight + 2;
with lstODComplex do if Index < Items.Count then
begin
R := ItemRect(Index);
R.Left := 0;
R.Right := R.Right - 4;
R.Top := 0;
R.Bottom := 0;
x := Piece(Items[index],'^',2);
TempHeight := WrappedTextHeightByFont(Canvas, Font, x, R);
TempHeight := HigherOf(TempHeight,TheHeight);
if TempHeight > 255 then TempHeight := 255;
if TempHeight < 13 then TempHeight := 13;
end;
TheHeight := TempHeight;
end;
procedure TfrmODChild.btnOKClick(Sender: TObject);
begin
FCmdOK := True;
Close;
end;
procedure TfrmODChild.btnCancelClick(Sender: TObject);
begin
FCmdOK := False;
Close;
end;
end.