Procedure

GetToolMenu

Module

rMisc

Last Modified

7/15/2014 3:26:44 PM

Scope

Interfaced

Declaration

procedure GetToolMenu;

Called-By Hierarchy


             GetToolMenu
TfrmFrame.SetUserTools┘ 
TfrmFrame.FormCreate┘   

Called-By

Name Declaration Comments
TfrmFrame.SetUserTools procedure SetUserTools; -


Source

88    procedure GetToolMenu;
89    var
90      i, p, LastIdx, count, MenuCount: Integer;
91      id, x: string;
92      LastItem, item: TToolMenuItem;
93      caption, action: string;
94      CurrentMenuID: string;
95      MenuIDs: TStringList;
96    begin
97      if not assigned(uToolMenuItems) then
98        uToolMenuItems := TObjectList.Create
99      else
100       uToolMenuItems.Clear;
101     CallV('ORWU TOOLMENU', [nil]);
102     MenuIDs := TStringList.Create;
103     try
104       for i := 0 to RPCBrokerV.Results.Count - 1 do
105       begin
106         x := Piece(RPCBrokerV.Results[i], U, 1);
107         item := TToolMenuItem.Create;
108         Caption := Piece(x, '=', 1);
109         Action := Copy(x, Pos('=', x) + 1, Length(x));
110         item.Caption2 := Caption;
111         if UpperCase(copy(Action,1,SUBMENU_KEY_LEN)) = SUBMENU_KEY then
112         begin
113           id := UpperCase(Trim(Copy(Action, SUBMENU_KEY_LEN+1, MaxInt)));
114           if (LeftStr(id,1) = SUB_LEFT) and (RightStr(id,1) = SUB_RIGHT) then
115             id := copy(id, 2, length(id)-2);
116           item.MenuID := id;
117           Action := '';
118           if MenuIDs.IndexOf(item.MenuID) < 0 then
119             MenuIDs.Add(item.MenuID)
120           else
121           begin
122             item.SubMenuID := item.MenuID;
123             item.MenuID := '';
124           end;
125         end;
126         if RightStr(Caption, 1) = SUB_RIGHT then
127         begin
128           p := length(Caption) - 2;
129           while (p > 0) and (Caption[p] <> SUB_LEFT) do
130             dec(p);
131           if (p > 0) and (Caption[p] = SUB_LEFT) then
132           begin
133             item.SubMenuID := UpperCase(Trim(copy(Caption,p+1, length(Caption)-1-p)));
134             Caption := copy(Caption,1,p-1);
135           end;
136         end;
137         item.Caption := Caption;
138         item.Action := Action;
139         uToolMenuItems.add(item);
140       end;
141       // see if all child menu items have parents
142       for I := 0 to uToolMenuItems.Count - 1 do
143       begin
144         item := TToolMenuItem(uToolMenuItems[i]);
145         if MenuIDs.IndexOf(item.SubMenuID) < 0 then
146         begin
147           item.SubMenuID := '';
148           item.Caption := item.Caption2;
149         end;
150       end;
151   
152       // see if there are more than MAX_TOOLITEMS in the root menu
153       // if there are, add automatic sub menus
154       LastIdx := (MAX_TOOLITEMS - 1);
155       count := 0;
156       CurrentMenuID := '';
157       i := 0;
158       LastItem := nil;
159       MenuCount := 0;
160       repeat
161         item := TToolMenuItem(uToolMenuItems[i]);
162         if item.SubMenuID = '' then
163         begin
164           item.SubMenuID := CurrentMenuID;
165           inc(count);
166           if Count > MAX_TOOLITEMS then
167           begin
168             item.SubMenuID := '';
169             inc(MenuCount);
170             item := TToolMenuItem.Create;
171             item.Caption := MORE_NAME;
172             item.MenuID := MORE_ID + IntToStr(MenuCount);
173             item.SubMenuID := CurrentMenuID;
174             CurrentMenuID := item.MenuID;
175             LastItem.SubMenuID := CurrentMenuID;
176             uToolMenuItems.Insert(LastIdx, item);
177             inc(LastIdx,MAX_TOOLITEMS);
178             Count := 1;
179           end;
180           LastItem := item;
181         end;
182         inc(i);
183       until i >= uToolMenuItems.Count;
184   
185     finally
186       MenuIDs.Free;
187     end;
188   end;