Module

fPCEBaseGrid

Path

C:\CPRS\CPRS30\Encounter\fPCEBaseGrid.pas

Last Modified

7/15/2014 3:26:36 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmPCEBaseGrid);

end.

Units Used in Interface

Name Comments
fPCEBase -
uPCE -

Classes

Name Comments
TfrmPCEBaseGrid -

Procedures

Name Owner Declaration Scope Comments
ClearGrid TfrmPCEBaseGrid procedure ClearGrid; Public -
FormCreate TfrmPCEBaseGrid procedure FormCreate(Sender: TObject); Public/Published -
hcGridSectionResize TfrmPCEBaseGrid procedure hcGridSectionResize(HeaderControl: THeaderControl; Section: THeaderSection); Public/Published -
pnlGridResize TfrmPCEBaseGrid procedure pnlGridResize(Sender: TObject); Public/Published -
RestoreGridSelected TfrmPCEBaseGrid procedure RestoreGridSelected; Protected -
SaveGridSelected TfrmPCEBaseGrid procedure SaveGridSelected; Protected -
SetGridIndex TfrmPCEBaseGrid procedure SetGridIndex(const Value: integer); Private -
SyncGridData TfrmPCEBaseGrid procedure SyncGridData; Public -
SyncGridHeader TfrmPCEBaseGrid procedure SyncGridHeader(FromHeader: boolean); Public -
UpdateControls TfrmPCEBaseGrid procedure UpdateControls; virtual; Protected -

Functions

Name Owner Declaration Scope Comments
GetGridIndex TfrmPCEBaseGrid function GetGridIndex: integer; Private -

Global Variables

Name Type Declaration Comments
frmPCEBaseGrid TfrmPCEBaseGrid frmPCEBaseGrid: TfrmPCEBaseGrid; -

Constants

Name Declaration Scope Comments
JustificationGap 5 Global -


Module Source

1     unit fPCEBaseGrid;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fPCEBase, ComCtrls, StdCtrls, ORCtrls, ExtCtrls, Buttons, ORFn, uPCE,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmPCEBaseGrid = class(TfrmPCEBase)
12        pnlGrid: TPanel;
13        lbGrid: TORListBox;
14        hcGrid: THeaderControl;
15        procedure FormCreate(Sender: TObject);
16        procedure hcGridSectionResize(HeaderControl: THeaderControl;
17          Section: THeaderSection);
18        procedure pnlGridResize(Sender: TObject);
19      private
20        FSel: string;
21        FGridHeaderSyncing: boolean;
22        function GetGridIndex: integer;
23        procedure SetGridIndex(const Value: integer);
24      protected
25        FSectionGap: integer;
26        procedure UpdateControls; virtual;
27        procedure SaveGridSelected;
28        procedure RestoreGridSelected;
29      public
30        procedure SyncGridHeader(FromHeader: boolean);
31        procedure SyncGridData;
32        procedure ClearGrid;
33        property GridIndex: integer read GetGridIndex write SetGridIndex;
34      end;
35    
36    var
37      frmPCEBaseGrid: TfrmPCEBaseGrid;
38    
39    implementation
40    
41    uses
42      VA2006Utils, VA508AccessibilityRouter;
43    
44    {$R *.DFM}
45    
46    const
47      JustificationGap = 5;
48    
49    procedure TfrmPCEBaseGrid.FormCreate(Sender: TObject);
50    begin
51      inherited;
52      FixHeaderControlDelphi2006Bug(hcGrid);
53      FSectionGap := 15;
54      SyncGridHeader(TRUE);
55    end;
56    
57    procedure TfrmPCEBaseGrid.SyncGridHeader(FromHeader: boolean);
58    var
59      i, w, wd, wp, Gap: integer;
60      txt: string;
61    
62    begin
63      if(not FGridHeaderSyncing) then
64      begin
65        Gap := JustificationGap;
66        FGridHeaderSyncing := TRUE;
67        try
68          if(FromHeader) then
69          begin
70            txt := '';
71            w := 0;
72            for i := 0 to hcGrid.Sections.Count-2 do
73            begin
74              if(i > 0) then
75                txt := txt + ',';
76              inc(w,(hcGrid.Sections[i].Width div 2)*2);
77              txt := txt + IntToStr(w + Gap);
78              Gap := 0;
79            end;
80            lbGrid.TabPositions := txt;
81          end
82          else
83          begin
84            txt := lbGrid.TabPositions;
85            wd := 0;
86            for i := 0 to hcGrid.Sections.Count-2 do
87            begin
88              wp := StrToIntDef(Piece(txt,',',i+1),hcGrid.Sections[i].MinWidth);
89              w := wp - wd;
90              hcGrid.Sections[i].Width := w - Gap;
91              Gap := 0;
92              wd := wp;
93            end;
94          end;
95          w := 0;
96          for i := 0 to hcGrid.Sections.Count-2 do
97            inc(w,hcGrid.Sections[i].Width);
98          hcGrid.Sections[hcGrid.Sections.Count-1].Width := pnlGrid.Width - w;
99        finally
100         FGridHeaderSyncing := FALSE;
101       end;
102     end;
103   end;
104   
105   procedure TfrmPCEBaseGrid.hcGridSectionResize(
106     HeaderControl: THeaderControl; Section: THeaderSection);
107   begin
108     inherited;
109     SyncGridHeader(TRUE);
110   end;
111   
112   procedure TfrmPCEBaseGrid.pnlGridResize(Sender: TObject);
113   begin
114     inherited;
115     SyncGridHeader(TRUE);
116   end;
117   
118   procedure TfrmPCEBaseGrid.SyncGridData;
119   var
120     tp, ltp, i, j, tlen: integer;
121     max: array[0..9] of integer; // more than 10 header sections will cause this to explode
122     tmp: string;
123   
124   begin
125     if(lbGrid.Items.Count > 0) then
126     begin
127       for j := 0 to hcGrid.Sections.Count-2 do max[j] := 0;
128       for i := 0 to lbGrid.Items.Count-1 do
129       begin
130         tmp := lbGrid.Items[i];
131         for j := 0 to hcGrid.Sections.Count-2 do
132         begin
133           tlen := Canvas.TextWidth(Piece(tmp,U,j+1)) + FSectionGap;
134           if(max[j] < tlen) then
135             max[j] := tlen;
136         end;
137       end;
138       ltp := 0;
139       tmp := lbGrid.TabPositions;
140       for i := 0 to hcGrid.Sections.Count-2 do
141       begin
142         if(max[i] < hcGrid.Sections[i].MinWidth) then
143           max[i] := hcGrid.Sections[i].MinWidth;
144         tp := StrToIntDef(Piece(tmp,',',i+1),0);
145         tlen := tp - ltp;
146         ltp := tp;
147         if(max[i] < tlen) then
148           max[i] := tlen;
149       end;
150       for i := 1 to hcGrid.Sections.Count-2 do
151         inc(max[i], max[i-1]);
152       tmp := '';
153       for i := 0 to hcGrid.Sections.Count-2 do
154         tmp := tmp + ',' + inttostr(max[i]);
155       delete(tmp,1,1);
156       if(lbGrid.TabPositions <> tmp) then
157       begin
158         SaveGridSelected;
159         lbGrid.TabPositions := tmp;
160         RestoreGridSelected;
161       end;
162       SyncGridHeader(FALSE);
163     end;
164   end;
165   
166   function TfrmPCEBaseGrid.GetGridIndex: integer;
167   var
168     i: integer;
169   
170   begin
171     Result := -1;
172     if(lbGrid.SelCount > 0) then
173     begin
174       for i := 0 to lbGrid.Items.Count-1 do
175         if(lbGrid.Selected[i]) then
176         begin
177           Result := i;
178           exit;
179         end;
180     end;
181   end;
182   
183   procedure TfrmPCEBaseGrid.SetGridIndex(const Value: integer);
184   var
185     i: integer;
186   
187   begin
188     for i := 0 to lbGrid.Items.Count-1 do
189       lbGrid.Selected[i] := (i = Value);
190     UpdateControls;
191   end;
192   
193   procedure TfrmPCEBaseGrid.ClearGrid;
194   var
195     i: integer;
196   
197   begin
198     if lbGrid.SelCount > 0 then
199     begin
200       for i := 0 to lbGrid.Items.Count-1 do
201         lbGrid.Selected[i] := FALSE;
202     end;
203     UpdateControls;
204   end;
205   
206   procedure TfrmPCEBaseGrid.UpdateControls;
207   begin
208   end;
209   
210   procedure TfrmPCEBaseGrid.RestoreGridSelected;
211   var
212     i: integer;
213   
214   begin
215     for i := 0 to lbGrid.Items.Count-1 do
216       lbGrid.Selected[i] := (copy(FSel,i+1,1) = BOOLCHAR[TRUE]);
217   end;
218   
219   procedure TfrmPCEBaseGrid.SaveGridSelected;
220   var
221     i: integer;
222   begin
223     FSel := '';
224     for i := 0 to lbGrid.Items.Count-1 do
225       FSel := FSel + BOOLCHAR[lbGrid.Selected[i]];
226   end;
227   
228   initialization
229     SpecifyFormIsNotADialog(TfrmPCEBaseGrid);
230   
231   end.

Module Calls (2 levels)


fPCEBaseGrid
 └fPCEBase
   ├uConst
   ├fAutoSz
   ├fBase508Form
   └fEncounterFrame

Module Called-By (2 levels)


       fPCEBaseGrid
     fPCEBaseMain┤ 
     fDiagnoses┤ │ 
     fProcedure┤ │ 
  fImmunization┤ │ 
      fSkinTest┤ │ 
     fPatientEd┤ │ 
  fHealthFactor┤ │ 
          fExam┘ │ 
    fProcedure...┤ 
             fGAF┘ 
fEncounterFrame┘