[JVCL-Checkins] CVS: dev/restructured/source JvControlPanel.pas,1.2,1.3

[Peter T. <pe...@us...>]

Update of /cvsroot/jvcl/dev/restructured/source
In directory usw-pr-cvs1:/tmp/cvs-serv27893/dev/restructured/source

Modified Files:
	JvControlPanel.pas 
Log Message:
Fixes to the GetNameCPL function that crashes on W2k and XP. Additional code by Remko Bonte.

Index: JvControlPanel.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/restructured/source/JvControlPanel.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** JvControlPanel.pas	26 Jun 2002 23:30:28 -0000	1.2
--- JvControlPanel.pas	30 Jun 2002 13:24:43 -0000	1.3
***************
*** 86,99 ****
  end;
  
  {*******************************************************}
  
  procedure TJvControlPanel.AddToPopup(Item: TMenuItem; Path: string);
  var
    t: TSearchRec;
!   res, i: Integer;
    it: TMenuItem;
    ts: TStringList;
-   st: string;
    w: Word;
  begin
    ts := TStringList.Create;
--- 86,169 ----
  end;
  
+ function GetNameCplW2k(const APath, AName: string; Strings: TStrings): Boolean;
+ var
+   hLib: HMODULE; // Library Handle to *.cpl file
+   hIco: HICON;
+   CplCall: TCPLApplet; // Pointer to CPlApplet() function
+   i: LongInt;
+   tmpCount, Count: LongInt;
+   CPLInfo: TCPLInfo;
+   InfoW: TNewCPLInfoW;
+   InfoA: TNewCPLInfoA;
+   S: WideString;
+ begin
+   Result := False;
+   hLib := SafeLoadLibrary(APath + AName);
+   if hLib = 0 then
+     Exit;
+   tmpCount := Strings.Count;
+   try
+     @CplCall := GetProcAddress(hLib, PChar(RC_CplAddress));
+     if @CplCall = nil then
+       Exit;
+ 
+     CplCall(GetFocus, CPL_INIT, 0, 0); // Init the *.cpl file
+     try
+       Count := CplCall(GetFocus, CPL_GETCOUNT, 0, 0);
+       for i := 0 to Count - 1 do
+       begin
+         FillChar(InfoW, sizeof(InfoW), 0);
+         FillChar(InfoA, sizeof(InfoA), 0);
+         FillChar(CPLInfo, sizeof(CPLInfo), 0);
+         hIco := 0;
+         S := '';
+         CplCall(GetFocus, CPL_NEWINQUIRE, i, LongInt(@InfoW));
+         if InfoW.dwSize = sizeof(InfoW) then
+         begin
+           if i > 0 then
+             hIco := InfoW.hIcon;
+           S := WideString(InfoW.szName);
+         end
+         else
+         begin
+           if InfoW.dwSize = sizeof(InfoA) then
+           begin
+             Move(InfoW, InfoA, sizeof(InfoA));
+             if i > 0 then
+               hIco := InfoA.hIcon;
+             S := string(InfoA.szName);
+           end
+           else
+           begin
+             CplCall(GetFocus, CPL_INQUIRE, i, LongInt(@CPLInfo));
+             LoadStringA(hLib, CPLInfo.idName, InfoA.szName, 32);
+             if i > 0 then
+               hIco := LoadIcon(hLib, MakeIntResource(@CPLInfo.idIcon));
+             S := string(InfoA.szName);
+           end;
+         end;
+         if S <> '' then
+           Strings.AddObject(S + '%' + AName, TObject(hIco));
+       end;
+       Result := tmpCount < Strings.Count;
+     finally
+       CplCall(GetFocus, CPL_EXIT, 0, 0);
+     end;
+   finally
+     FreeLibrary(hLib);
+   end;
+ end;
+ 
  {*******************************************************}
  
+ 
  procedure TJvControlPanel.AddToPopup(Item: TMenuItem; Path: string);
  var
    t: TSearchRec;
!   res: Integer;
    it: TMenuItem;
    ts: TStringList;
    w: Word;
+   b: TBitmap;
  begin
    ts := TStringList.Create;
***************
*** 103,116 ****
      if (t.Name <> '.') and (t.Name <> '..') then
      begin
!       st := GetNameCpl(Path + t.Name);
!       if st = '' then
!       begin
!         st := t.Name;
!         i := Length(st);
!         while (i > 0) and (st[i] <> '.') do
!           Dec(i);
!         st := Copy(st, 1, i - 1);
!       end;
!       ts.Add(st + '%' + t.Name);
      end;
      res := FindNext(t);
--- 173,178 ----
      if (t.Name <> '.') and (t.Name <> '..') then
      begin
!       if not GetNameCplW2k(Path, t.Name, ts) then
!         ts.Add(ChangeFileExt(t.Name, '') + '%' + t.Name);
      end;
      res := FindNext(t);
***************
*** 125,132 ****
      it.OnClick := UrlClick;
      it.Hint := Path + Copy(ts[res], Pos('%', ts[res]) + 1, Length(ts[res]));
-     ;
      w := 0;
!     it.Bitmap.Assign(IconToBitmap(ExtractAssociatedIcon(Application.Handle, PChar(it.Hint), w)));
!     it.Bitmap.TransparentMode := tmAuto;
      item.Add(it);
      Application.ProcessMessages;
--- 187,197 ----
      it.OnClick := UrlClick;
      it.Hint := Path + Copy(ts[res], Pos('%', ts[res]) + 1, Length(ts[res]));
      w := 0;
!     if ts.Objects[res] <> nil then
!       b := IconToBitmap2(integer(ts.Objects[res]), 16, clWhite)
!     else
!       b := IconToBitmap2(ExtractAssociatedIcon(Application.Handle, PChar(it.Hint), w), 16, clWhite);
!     it.Bitmap.Assign(b);
!     b.Free;
      item.Add(it);
      Application.ProcessMessages;