Module

fOptionsReminders

Path

C:\CPRS\CPRS30\Options\fOptionsReminders.pas

Last Modified

7/15/2014 3:26:40 PM

Units Used in Interface

Name Comments
fBase508Form -

Units Used in Implementation

Name Comments
fRemCoverSheet -
rOptions -
rReminders -

Classes

Name Comments
TfrmOptionsReminders -

Procedures

Name Owner Declaration Scope Comments
btnAddClick TfrmOptionsReminders procedure btnAddClick(Sender: TObject); Public/Published -
btnDeleteClick TfrmOptionsReminders procedure btnDeleteClick(Sender: TObject); Public/Published -
btnDownClick TfrmOptionsReminders procedure btnDownClick(Sender: TObject); Public/Published -
btnOKClick TfrmOptionsReminders procedure btnOKClick(Sender: TObject); Public/Published -
btnUpClick TfrmOptionsReminders procedure btnUpClick(Sender: TObject); Public/Published -
CheckEnable TfrmOptionsReminders procedure CheckEnable; Private
Private declarations
allow buttons to be enabled or not depending on selections
DialogOptionsReminders - procedure DialogOptionsReminders(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); Interfaced Create the form and make it modal, return an action
FormCreate TfrmOptionsReminders procedure FormCreate(Sender: TObject); Public/Published -
lstDisplayedChange TfrmOptionsReminders procedure lstDisplayedChange(Sender: TObject); Public/Published -
lstNotDisplayedChange TfrmOptionsReminders procedure lstNotDisplayedChange(Sender: TObject); Public/Published -
MoveSelected TfrmOptionsReminders procedure MoveSelected(aList: TORListBox; items: TStrings); Public/Published -
radSortClick TfrmOptionsReminders procedure radSortClick(Sender: TObject); Public/Published -
SetItem TfrmOptionsReminders procedure SetItem(aList: TORListBox; index: integer); Public/Published -

Functions

Name Owner Declaration Scope Comments
GetFirstSelection TfrmOptionsReminders function GetFirstSelection(aList: TORListBox): integer; Public/Published -

Global Variables

Name Type Declaration Comments
frmOptionsReminders TfrmOptionsReminders frmOptionsReminders: TfrmOptionsReminders; -


Module Source

1     unit fOptionsReminders;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, OrFn, fBase508Form, VA508AccessibilityManager;
8     
9     type
10      TfrmOptionsReminders = class(TfrmBase508Form)
11        pnlBottom: TPanel;
12        btnOK: TButton;
13        btnCancel: TButton;
14        lstDisplayed: TORListBox;
15        lstNotDisplayed: TORListBox;
16        btnUp: TButton;
17        btnDown: TButton;
18        btnDelete: TButton;
19        btnAdd: TButton;
20        lblDisplayed: TLabel;
21        lblNotDisplayed: TLabel;
22        bvlBottom: TBevel;
23        radSort: TRadioGroup;
24        procedure FormCreate(Sender: TObject);
25        procedure lstDisplayedChange(Sender: TObject);
26        procedure lstNotDisplayedChange(Sender: TObject);
27        procedure btnUpClick(Sender: TObject);
28        procedure btnDownClick(Sender: TObject);
29        procedure btnDeleteClick(Sender: TObject);
30        procedure btnAddClick(Sender: TObject);
31        function GetFirstSelection(aList: TORListBox): integer;
32        procedure SetItem(aList: TORListBox; index: integer);
33        procedure MoveSelected(aList: TORListBox; items: TStrings);
34        procedure btnOKClick(Sender: TObject);
35        procedure radSortClick(Sender: TObject);
36      private
37        { Private declarations }
38        procedure CheckEnable;
39      public
40        { Public declarations }
41      end;
42    
43    var
44      frmOptionsReminders: TfrmOptionsReminders;
45    
46    procedure DialogOptionsReminders(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
47    
48    implementation
49    
50    uses rOptions, fRemCoverSheet, rReminders;
51    
52    {$R *.DFM}
53    
54    procedure DialogOptionsReminders(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
55    // create the form and make it modal, return an action
56    var
57      frmOptionsReminders: TfrmOptionsReminders;
58    begin
59      if NewRemCoverSheetListActive then
60        EditCoverSheetReminderList(TRUE)
61      else
62      begin
63        frmOptionsReminders := TfrmOptionsReminders.Create(Application);
64        actiontype := 0;
65        try
66          with frmOptionsReminders do
67          begin
68            if (topvalue < 0) or (leftvalue < 0) then
69              Position := poScreenCenter
70            else
71            begin
72              Position := poDesigned;
73              Top := topvalue;
74              Left := leftvalue;
75            end;
76            ResizeAnchoredFormToFont(frmOptionsReminders);
77            ShowModal;
78            actiontype := btnOK.Tag;
79          end;
80        finally
81          frmOptionsReminders.Release;
82        end;
83      end;
84    end;
85    
86    procedure TfrmOptionsReminders.FormCreate(Sender: TObject);
87    var
88      i: integer;
89      biglist, userlist: TStringList;
90    begin
91      biglist := TStringList.Create;
92      userlist := TStringList.Create;
93      try
94        rpcGetReminders(biglist);
95        for i := 0 to biglist.Count - 1 do
96          if strtointdef(Piece(biglist[i], '^', 2), 0) > 0 then
97            userlist.Add(biglist[i])
98          else
99            lstNotDisplayed.Items.Add(biglist[i]);
100       SortByPiece(userlist, '^', 2);
101       for i := 0 to userlist.Count - 1 do
102         lstDisplayed.Items.Add(userlist[i]);
103     finally
104       biglist.free;
105       userlist.free;
106     end;
107     CheckEnable;
108   end;
109   
110   procedure TfrmOptionsReminders.CheckEnable;
111   // allow buttons to be enabled or not depending on selections
112   begin
113     with lstDisplayed do
114     begin
115       if Items.Count > 0 then
116       begin
117         if SelCount > 0 then
118         begin
119           btnUp.Enabled     := (SelCount > 0)
120                                and (not Selected[0])
121                                and (radSort.ItemIndex = 0);
122           btnDown.Enabled   := (SelCount > 0)
123                                and (not Selected[Items.Count - 1])
124                                and (radSort.ItemIndex = 0);
125           btnDelete.Enabled := true;
126         end
127         else
128         begin
129           btnUp.Enabled     := false;
130           btnDown.Enabled   := false;
131           btnDelete.Enabled := false;
132         end;
133       end
134       else
135       begin
136         btnUp.Enabled     := false;
137         btnDown.Enabled   := false;
138         btnDelete.Enabled := false;
139       end;
140     end;
141     with lstNotDisplayed do
142     begin
143       btnAdd.Enabled := SelCount > 0;
144     end;
145   end;
146   
147   procedure TfrmOptionsReminders.lstDisplayedChange(Sender: TObject);
148   begin
149     CheckEnable;
150   end;
151   
152   procedure TfrmOptionsReminders.lstNotDisplayedChange(Sender: TObject);
153   begin
154     CheckEnable;
155   end;
156   
157   procedure TfrmOptionsReminders.btnUpClick(Sender: TObject);
158   var
159     newindex, i: integer;
160   begin
161     with lstDisplayed do
162     begin
163       i := 0;
164       while i < Items.Count do
165       begin
166         if Selected[i] then
167         begin
168           newindex := i - 1;
169           Items.Move(i, newindex);
170           Selected[newindex] := true;
171         end;
172         inc(i);
173       end;
174     end;
175     lstDisplayedChange(self);
176   end;
177   
178   procedure TfrmOptionsReminders.btnDownClick(Sender: TObject);
179   var
180     newindex, i: integer;
181   begin
182     with lstDisplayed do
183     begin
184       i := Items.Count - 1;
185       while i > -1 do
186       begin
187         if Selected[i] then
188         begin
189           newindex := i + 1;
190           Items.Move(i, newindex);
191           Selected[newindex] := true;
192         end;
193         dec(i);
194       end;
195     end;
196     lstDisplayedChange(self);
197   end;
198   
199   procedure TfrmOptionsReminders.btnDeleteClick(Sender: TObject);
200   var
201     index: integer;
202   begin
203     index := GetFirstSelection(lstDisplayed);
204     MoveSelected(lstDisplayed, lstNotDisplayed.Items);
205     SetItem(lstDisplayed, index);
206     CheckEnable;
207   end;
208   
209   procedure TfrmOptionsReminders.btnAddClick(Sender: TObject);
210   var
211     index: integer;
212   begin
213     index := GetFirstSelection(lstNotDisplayed);
214     MoveSelected(lstNotDisplayed, lstDisplayed.Items);
215     SetItem(lstNotDisplayed, index);
216     if radSort.ItemIndex = 1 then radSortClick(self);
217     CheckEnable;
218   end;
219   
220   function TfrmOptionsReminders.GetFirstSelection(aList: TORListBox): integer;
221   begin
222     for result := 0 to aList.Items.Count - 1 do
223       if aList.Selected[result] then exit;
224     result := LB_ERR;
225   end;
226   
227   procedure TfrmOptionsReminders.SetItem(aList: TORListBox; index: integer);
228   var
229     maxindex: integer;
230   begin
231     with aList do
232     begin
233       SetFocus;
234       maxindex := aList.Items.Count - 1;
235       if Index = LB_ERR then
236         Index := 0
237       else if Index > maxindex then Index := maxindex;
238       Selected[index] := true;
239     end;
240     CheckEnable;  
241   end;
242   
243   procedure TfrmOptionsReminders.MoveSelected(aList: TORListBox; Items: TStrings);
244   var
245     i: integer;
246   begin
247     for i := aList.Items.Count - 1 downto 0 do
248     begin
249       if aList.Selected[i] then
250       begin
251         Items.AddObject(aList.Items[i], aList.Items.Objects[i]);
252         aList.Items.Delete(i);
253       end;
254     end;
255   end;
256   
257   procedure TfrmOptionsReminders.btnOKClick(Sender: TObject);
258   var
259     i: integer;
260     values: string;
261     aList: TStringList;
262   begin
263     aList := TStringList.Create;
264     try
265       with lstDisplayed do
266       for i := 0 to Items.Count - 1 do
267       begin
268         values := inttostr(i + 1) + '^' + Piece(Items[i], '^', 1);
269         aList.Add(values);
270       end;
271       rpcSetReminders(aList);
272     finally
273       aList.free;
274     end;
275   end;
276   
277   procedure TfrmOptionsReminders.radSortClick(Sender: TObject);
278   var
279     i: integer;
280     userlist: TStringList;
281   begin
282     userlist := TStringList.Create;
283     try
284       for i := 0 to lstDisplayed.Items.Count - 1 do
285         userlist.Add(lstDisplayed.Items[i]);
286       case radSort.ItemIndex of
287         0: SortByPiece(userlist, '^', 2);
288         else SortByPiece(userlist, '^', 3);
289       end;
290       lstDisplayed.Items.Clear;
291       for i := 0 to userlist.Count - 1 do
292         lstDisplayed.Items.Add(userlist[i]);
293     finally
294       userlist.free;
295     end;
296     CheckEnable;
297   end;
298   
299   end.

Module Calls (2 levels)


fOptionsReminders
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rOptions
 │ └rCore
 ├fRemCoverSheet
 │ ├fBase508Form...
 │ ├rCore...
 │ ├uCore
 │ ├uPCE
 │ ├rProbs
 │ ├rTIU
 │ ├rReminders
 │ ├uReminders
 │ └fRemCoverPreview
 └rReminders...

Module Called-By (2 levels)


fOptionsReminders
       fOptions┘ 
       fFrame┘