Module

fODValidateAction

Path

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

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fBase508Form -
uConst -
uCore -

Classes

Name Comments
TfrmInvalidActionList -

Procedures

Name Owner Declaration Scope Comments
btnOKClick TfrmInvalidActionList procedure btnOKClick(Sender: TObject); Public/Published -
DisplayOrdersForAction - procedure DisplayOrdersForAction(TheInvalidList: TStringList; TheValidList: TStringList; TheAction: String); Interfaced -
FormCreate TfrmInvalidActionList procedure FormCreate(Sender: TObject); Public/Published -
FormResize TfrmInvalidActionList procedure FormResize(Sender: TObject); Public/Published -
hdrActionSectionResize TfrmInvalidActionList procedure hdrActionSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
lstActDeniedOrdersDrawItem TfrmInvalidActionList procedure lstActDeniedOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect; State: TOwnerDrawState); Public/Published -
lstActDeniedOrdersMeasureItem TfrmInvalidActionList procedure lstActDeniedOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); Public/Published -
lstValidOrdersDrawItem TfrmInvalidActionList procedure lstValidOrdersDrawItem(Control: TWinControl; Index: Integer; TheRect: TRect; State: TOwnerDrawState); Public/Published -
lstValidOrdersMeasureItem TfrmInvalidActionList procedure lstValidOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer); Public/Published -
RedrawActiveList TfrmInvalidActionList procedure RedrawActiveList; Private -


Module Source

1     unit fODValidateAction;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       ORFn, uCore, StdCtrls, CheckLst, ComCtrls,ExtCtrls,uConst, ORCtrls, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmInvalidActionList = class(TfrmBase508Form)
12        pnlTop: TPanel;
13        lstActDeniedOrders: TCaptionListBox;
14        Label1: TLabel;
15        hdrAction: THeaderControl;
16        pnlBottom: TPanel;
17        Label2: TLabel;
18        lstValidOrders: TCaptionListBox;
19        Panel1: TPanel;
20        btnOK: TButton;
21        procedure lstActDeniedOrdersDrawItem(Control: TWinControl;
22          Index: Integer; TheRect: TRect; State: TOwnerDrawState);
23        procedure lstActDeniedOrdersMeasureItem(Control: TWinControl;
24          Index: Integer; var AHeight: Integer);
25        procedure btnOKClick(Sender: TObject);
26        procedure FormCreate(Sender: TObject);
27        procedure hdrActionSectionResize(HeaderControl: THeaderControl;
28          Section: THeaderSection);
29        procedure lstValidOrdersMeasureItem(Control: TWinControl;
30          Index: Integer; var AHeight: Integer);
31        procedure lstValidOrdersDrawItem(Control: TWinControl; Index: Integer;
32          TheRect: TRect; State: TOwnerDrawState);
33        procedure FormResize(Sender: TObject);
34      private
35        { Private declarations }
36        TheInvaList: TStringList;
37        procedure RedrawActiveList;
38      public
39        { Public declarations }
40      end;
41    
42      procedure DisplayOrdersForAction(TheInvalidList: TStringList; TheValidList: TStringList; TheAction: String);
43    
44    implementation
45    
46    uses
47      VA2006Utils;
48    
49    {$R *.DFM}
50    
51    procedure DisplayOrdersForAction(TheInvalidList: TStringList; TheValidList: TStringList; TheAction: String);
52    var
53      frmInvalidActionList: TfrmInvalidActionList;
54      i: integer;
55    begin
56      frmInvalidActionList := TfrmInvalidActionList.Create(Application);
57      frmInvalidActionList.TheInvaList :=TheInvalidList;
58      if TheAction = OA_CHGEVT then
59      begin
60        frmInvalidActionList.Caption  := 'Change Release Event';
61        frmInvalidActionList.Label1.Caption := 'You can not change the release event for the following orders.';
62        frmInvalidActionList.Label2.Caption := 'You can change the release event for the following orders.';
63      end;
64      if TheAction = OA_EDREL then
65      begin
66        frmInvalidActionList.Caption  := 'Release Order(s) To Service';
67        frmInvalidActionList.Label1.Caption := 'You can not release the following orders to service.';
68        frmInvalidActionList.Label2.Caption := 'You can release the following orders to service.';
69      end;
70      for i := 0 to TheInvalidList.Count - 1 do
71      begin
72        frmInvalidActionList.lstActDeniedOrders.Items.Add(Piece(TheInvalidList[i], U, 1) + ' ' + Piece(TheInvalidList[i], U, 2));
73      end;
74      for i := 0 to TheValidList.Count - 1 do
75      begin
76        frmInvalidActionList.lstValidOrders.Items.Add(TheValidList[i]);
77      end;
78      if TheValidList.Count = 0 then
79      begin
80        frmInvalidActionList.lstValidOrders.Visible := False;
81        frmInvalidActionList.pnlBottom.Visible := False;
82        frmInvalidActionList.Height := frmInvalidActionList.Height - frmInvalidActionList.pnlBottom.Height;
83      end;
84      Beep;
85      frmInvalidActionList.ShowModal;
86      frmInvalidActionList.TheInvaList.Free;
87    end;
88    
89    procedure TfrmInvalidActionList.lstActDeniedOrdersDrawItem(
90      Control: TWinControl; Index: Integer; TheRect: TRect;
91      State: TOwnerDrawState);
92    var
93      x,x1,x2: string;
94      ARect: TRect;
95      i,RightSide: integer;
96      SaveColor: TColor;
97    begin
98      inherited;
99      with lstActDeniedOrders do
100     begin
101       ARect := TheRect;
102       Canvas.FillRect(ARect);
103       Canvas.Pen.Color := Get508CompliantColor(clSilver);
104       Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
105       Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
106       RightSide := -2;
107       for i := 0 to 1 do
108       begin
109         RightSide := RightSide + hdrAction.Sections[i].Width;
110         Canvas.MoveTo(RightSide, ARect.Bottom - 1);
111         Canvas.LineTo(RightSide, ARect.Top);
112       end;
113       if Index < Items.Count then
114       begin
115         x1 := FilteredString(Piece(TheInvaList[index],'^',1));
116         x2 := Piece(TheInvaList[index],'^',2);
117         for i := 0 to 1 do
118         begin
119           if i > 0 then ARect.Left := ARect.Right + 2 else ARect.Left := 2;
120           ARect.Right := ARect.Left + hdrAction.Sections[i].Width - 6;
121           SaveColor := Canvas.Brush.Color;
122           if i = 0 then
123             x := x1;
124           if i = 1 then
125             x := x2;
126           DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
127           Canvas.Brush.Color := SaveColor;
128           ARect.Right := ARect.Right + 4;
129         end;
130       end;
131     end;
132   end;
133   
134   procedure TfrmInvalidActionList.lstActDeniedOrdersMeasureItem(
135     Control: TWinControl; Index: Integer; var AHeight: Integer);
136   var
137     x1,x2: string;
138     ARect: TRect;
139     TextHeight, ReasonHeight, NewHeight: Integer;
140   begin
141     inherited;
142     AHeight := MainFontHeight + 2;
143     NewHeight := AHeight;
144     with lstActDeniedOrders do if Index < Items.Count then
145     begin
146       x1 := FilteredString(Piece(TheInvaList[index],'^',1));
147       x2 := Piece(TheInvaList[index],'^',2);
148   
149       ARect := ItemRect(Index);
150       ARect.Right := hdrAction.Sections[0].Width - 6;
151       ARect.Left := 0; ARect.Top := 0; ARect.Bottom := 0;
152       TextHeight := DrawText(Canvas.Handle, PChar(x1), Length(x1), ARect,
153           DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
154   
155       ARect := ItemRect(Index);
156       ARect.Right := hdrAction.Sections[1].Width - 6;
157       ARect.Left := 0; ARect.Top := 0; ARect.Bottom := 0;
158       ReasonHeight := DrawText(Canvas.Handle, PChar(x2), Length(x2), ARect,
159         DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
160       NewHeight := HigherOf(TextHeight, ReasonHeight);
161       if NewHeight > 255 then NewHeight := 255;
162       if NewHeight <  13 then NewHeight := 13;
163     end;
164     AHeight := NewHeight;
165   end;
166   
167   procedure TfrmInvalidActionList.btnOKClick(Sender: TObject);
168   begin
169     Close;
170   end;
171   
172   procedure TfrmInvalidActionList.FormCreate(Sender: TObject);
173   begin
174     FixHeaderControlDelphi2006Bug(hdrAction);
175     TheInvaList := TStringList.Create;
176   end;
177   
178   procedure TfrmInvalidActionList.hdrActionSectionResize(
179     HeaderControl: THeaderControl; Section: THeaderSection);
180   begin
181     inherited;
182     RedrawSuspend(Self.Handle);
183     RedrawActiveList;
184     RedrawActivate(Self.Handle);
185     lstActDeniedOrders.Invalidate;
186   end;
187   
188   procedure TfrmInvalidActionList.RedrawActiveList;
189   var
190     i, SaveTop: Integer;
191   begin
192     with lstActDeniedOrders do
193     begin
194       RedrawSuspend(Handle);
195       SaveTop := TopIndex;
196       Clear;
197       for i := 0 to TheInvaList.Count - 1 do
198         Items.Add(Piece(TheInvaList[i], U, 1) + ' ' + Piece(TheInvaList[i], U, 2));
199       TopIndex := SaveTop;
200       RedrawActivate(Handle);
201     end;
202   end;
203   
204   procedure TfrmInvalidActionList.lstValidOrdersMeasureItem(
205     Control: TWinControl; Index: Integer; var AHeight: Integer);
206   var
207     x: string;
208     ARect: TRect;
209     NewHeight: Integer;
210   begin
211     inherited;
212     AHeight := MainFontHeight + 2;
213     NewHeight := AHeight;
214     with lstValidOrders do if Index < Items.Count then
215     begin
216       x := FilteredString(lstValidOrders.Items[index]);
217       ARect := ItemRect(Index);
218       ARect.Right := hdrAction.Sections[0].Width - 6;
219       ARect.Left := 0; ARect.Top := 0; ARect.Bottom := 0;
220       NewHeight := DrawText(Canvas.Handle, PChar(x), Length(x), ARect,
221           DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK) + 2;
222       if NewHeight > 255 then NewHeight := 255;
223       if NewHeight <  13 then NewHeight := 13;
224     end;
225     AHeight := NewHeight;
226   end;
227   
228   procedure TfrmInvalidActionList.lstValidOrdersDrawItem(
229     Control: TWinControl; Index: Integer; TheRect: TRect;
230     State: TOwnerDrawState);
231   var
232     x: string;
233     ARect: TRect;
234     SaveColor: TColor;
235   begin
236     inherited;
237     with lstValidOrders do
238     begin
239       ARect := TheRect;
240       Canvas.FillRect(ARect);
241       Canvas.Pen.Color := Get508CompliantColor(clSilver);
242       SaveColor := Canvas.Brush.Color;    
243       Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
244       Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
245       if Index < Items.Count then
246       begin
247         x := FilteredString(lstValidOrders.Items[index]);
248         DrawText(Canvas.Handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
249         Canvas.Brush.Color := SaveColor;
250         ARect.Right := ARect.Right + 4;
251       end;
252     end;
253   end;
254   
255   procedure TfrmInvalidActionList.FormResize(Sender: TObject);
256   begin
257     if pnlBottom.Visible then
258       pnlTop.Height := (Height div 5 ) * 2
259   end;
260   
261   end.

Module Calls (2 levels)


fODValidateAction
 ├uConst
 └fBase508Form
   ├uConst
   └uHelpManager

Module Called-By (2 levels)


      fODValidateAction
              fOrders┘ 
            uOrders┤   
            fODBase┤   
             fFrame┤   
              rMisc┤   
            uODBase┤   
              fMeds┤   
          fOrdersDC┤   
          fOrdersCV┤   
            fOMNavA┤   
             fOMSet┤   
 fOrdersEvntRelease┤   
    fODReleaseEvent┤   
         mEvntDelay┤   
          fODActive┤   
        fOrdersCopy┤   
           fMedCopy┤   
fActivateDeactivate┘