problems with KOL Pmenu Submenus

← →
rofl (2005-02-14 03:07) [0]

i have a problem with a popupmenu; i want it to expand like folder structure on hard drive. the function i use works recursive, but suddenly the pointer to parentmenu is $FEEEFEEE and i get an exception when executing pmenu.insert. i am using KOL 2.0

this is my code:

var
popmenu: Pmenu;

function PathMatchSpecA(pszFile, pszSpec: String): Boolean; StdCall; External 'SHLWAPI.DLL';

...

function FileSearch(const sRoot, sFileEXT: String; const strRecursive: Boolean):string;
const vardel = #13#10;
var WFD: TWin32FindData; hFile: THandle;
begin
result := '';
hFile := FindFirstFileA(pchar(sRoot + '*'), WFD);
while FindNextFileA(hFile, WFD) do

if (WFD.dwFileAttributes and 16) = 16 then
begin
if sFileEXT = ' ' then result := result + sRoot + String(WFD.cFileName) + vardel;
(if strRecursive then if Copy(String(WFD.cFileName),1,1) '.' then
FileSearch(sRoot + String(WFD.cFileName) + '\', sFileEXT, True))
end
else if PathMatchSpecA(String(WFD.cFileName), sFileEXT) then
result := result + sRoot + String(WFD.cFileName) + vardel;

FindClose(hFile);
if strRecursive then strSearch := strSearch + Result;
end;

procedure tform1.addSubSubMenu(var parentmenu:pointer;fld:string;posi:integer);
var s : string;
i : integer;
curloc: integer;
opt: TMenuOptions;
t:pmenu;
begin
if (copy(fld,length(fld),1) = '.') or (copy(fld,length(fld)-1,2) = '..') then exit;
if fld[length(fld)] '\' then fld := fld + '\';
inc(nosubmenus);
setlength(submenus,Nosubmenus+1);
if nosubmenus = 2 then exit;
i:=0;
curloc := 0;
// check if subdirs exist;
s := filesearch(fld,' ',false);
// cut away . and .. dirs
while pos('.'#13#10,s) 0 do
s:= copy(s,pos('.'#13#10,s)+3,length(s));
// if subfolders then opt = submenu
if s '' then opt := [moSubMenu]
else
opt := [moDefault];
// if pointer(parentmenu) = pointer(popmenu) then curloc := sublocs+1;
t := parentmenu;
submenus[nosubmenus] := t.Insert(posi,pchar(fld),TOnMenuItem( MakeMethod( nil, @DoPopUpItem )),opt);
// testlist.Add(fld);
while pos(#13#10,s) 0 do
begin
//recursive if more subfolders
addsubsubmenu(pointer(submenus[nosubmenus]),copy(s,1,pos(#13#10,s)-1),i);
s := copy(s,pos(#13#10,s)+2,length(s));
inc(i);
end;
end;

procedure tform1.addNewSubMenu(fld:pchar);
var s : string;
i : integer;
begin
inc(sublocs);
addsubsubmenu(pointer(popmenu),string(fld),sublocs+1);
end;

// START via i.e. addNewSubMenu('c:\windows');

← →
rofl (2005-02-14 03:20) [1]

var submenus: array of pmenu;

← →
rofl (2005-02-14 08:33) [2]

found the bug, the routine tried to add a submenu to MoDefault Menus. o0

problems with KOL Pmenu Submenus Найти похожие ветки