Module

fODChild

Path

C:\CPRS\CPRS30\Orders\fODChild.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fAutoSz -

Classes

Name Comments
TfrmODChild -

Procedures

Name Owner Declaration Scope Comments
btnCancelClick TfrmODChild procedure btnCancelClick(Sender: TObject); Public/Published -
btnOKClick TfrmODChild procedure btnOKClick(Sender: TObject); Public/Published -
FormCreate TfrmODChild procedure FormCreate(Sender: TObject); Public/Published -
lstODComplexDrawItem TfrmODChild procedure lstODComplexDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect; State: TOwnerDrawState); Public/Published -
lstODComplexMeasureItem TfrmODChild procedure lstODComplexMeasureItem(Control: TWinControl; Index: Integer; var TheHeight: Integer); Public/Published -

Functions

Name Owner Declaration Scope Comments
ActionOnComplexOrder - function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string = ''; ShowCancel: boolean = False): boolean; Interfaced -


Module Source

1     unit fODChild;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ExtCtrls, StdCtrls, fAutoSz, ORFn, VA508AccessibilityManager;
8     
9     type
10      TfrmODChild = class(TfrmAutoSz)
11        lblWarning: TLabel;
12        Panel1: TPanel;
13        lstODComplex: TListBox;
14        Panel2: TPanel;
15        btnOK: TButton;
16        btnCancel: TButton;
17        procedure FormCreate(Sender: TObject);
18        procedure lstODComplexDrawItem(Control: TWinControl; Index: Integer;
19          TheRect: TRect; State: TOwnerDrawState);
20        procedure lstODComplexMeasureItem(Control: TWinControl; Index: Integer;
21          var TheHeight: Integer);
22        procedure btnOKClick(Sender: TObject);
23        procedure btnCancelClick(Sender: TObject);
24      private
25        { Private declarations }
26        FCmdOK: boolean;
27      public
28        { Public declarations }
29      end;
30    
31    function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string = ''; ShowCancel: boolean = False): boolean;
32    implementation
33    
34    {$R *.DFM}
35    function ActionOnComplexOrder(AnList: TStringList; CaptionTxt: string; ShowCancel: boolean): boolean;
36    var
37      i: integer;
38      frmODChild: TfrmODChild;
39    begin
40      frmODChild := TfrmODChild.Create(nil);
41      try
42        try
43          ResizeFormToFont(TForm(frmODChild));
44          if Length(CaptionTxt)>0 then
45            frmODChild.lblWarning.Caption := CaptionTxt;
46    
47          for i := 0 to AnList.count - 1 do
48            frmODChild.lstODComplex.Items.Add(AnList[i]);
49    
50          if not ShowCancel then
51          begin
52            frmODChild.btnOK.Visible := False;
53            frmODChild.btnCancel.Caption := 'OK';
54          end;
55    
56          frmODChild.ShowModal;
57          if frmODChild.FCmdOK then Result := True else Result := False;
58        except
59          on e: Exception do
60            Result := False;
61        end;
62      finally
63        frmODChild.Release;
64      end;
65    end;
66    
67    procedure TfrmODChild.FormCreate(Sender: TObject);
68    begin
69      FCmdOK := False;
70    end;
71    
72    procedure TfrmODChild.lstODComplexDrawItem(Control: TWinControl;
73      Index: Integer; TheRect: TRect; State: TOwnerDrawState);
74    var
75      x: string;
76      ARect: TRect;
77      SaveColor: TColor;
78    begin
79      inherited;
80      with lstODComplex do
81      begin
82        ARect := TheRect;
83        ARect.Left := ARect.Left + 2;
84        Canvas.FillRect(ARect);
85        Canvas.Pen.Color := Get508CompliantColor(clSilver);
86        SaveColor := Canvas.Brush.Color;
87        Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
88        Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
89        if Index < Items.Count then
90        begin
91          x := Piece(Items[index],'^',2);
92          DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
93          Canvas.Brush.Color := SaveColor;
94          ARect.Right := ARect.Right + 4;
95        end;
96      end;
97    end;
98    
99    procedure TfrmODChild.lstODComplexMeasureItem(Control: TWinControl;
100     Index: Integer; var TheHeight: Integer);
101   var
102     x :string;
103     tempHeight: integer;
104     R: TRect;
105   begin
106     inherited;
107     tempHeight := 0;
108     TheHeight := MainFontHeight + 2;
109     with lstODComplex do if Index < Items.Count then
110     begin
111       R := ItemRect(Index);
112       R.Left   := 0;
113       R.Right  := R.Right - 4;
114       R.Top    := 0;
115       R.Bottom := 0;
116       x := Piece(Items[index],'^',2);
117       TempHeight := WrappedTextHeightByFont(Canvas, Font, x, R);
118       TempHeight := HigherOf(TempHeight,TheHeight);
119       if TempHeight > 255 then TempHeight := 255;
120       if TempHeight < 13 then TempHeight := 13;
121     end;
122     TheHeight := TempHeight;
123   end;
124   
125   procedure TfrmODChild.btnOKClick(Sender: TObject);
126   begin
127     FCmdOK := True;
128     Close;
129   end;
130   
131   procedure TfrmODChild.btnCancelClick(Sender: TObject);
132   begin
133     FCmdOK := False;
134     Close;
135   end;
136   
137   end.

Module Calls (2 levels)


fODChild
 └fAutoSz
   └fBase508Form

Module Called-By (2 levels)


                    fODChild
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘