TPopupMenu

[edosoft]

Problem: Ich will so was wie das Startmenü machen. Ich habe bei OnPopup eine funktion eingebunden, die alle Dateien/Ordner ausließt und sie in das Popupmenü einfügt. Für Unterordner erstellt das Tool einen Dummy-Eintrag und bei diesem bei OnMeasure wird der Dummy-Eintrag ersetzt durch die jeweiligen Ordnerinhalte usw.

Aber mahcnmal scheißt sich das Tool einfach ab wenn ich ein Untermenü öffne und manchmal sind alle PopupMenü Einträge auf dem Platzt von einem einzigen Eintrag zusammengequetscht. Sie werden dann erst richtig angezeigt wenn ich das Menü erneut ausklappe.

Weiss einer wie ich des machen kann?

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, EDOSoft, ImgList, Menus, ShellAPI;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    ImageList1: TImageList;
    procedure OnMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
      Height: Integer);
    procedure PopupMenu1Popup(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses StrUtils;

{$R *.dfm}

procedure TForm1.OnMeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  Data: TMenuItem;
  Result: TSearchRec;
  I: Integer;
  Item, Item2: TMenuItem;
  sPath: String;
begin
Data:=(Sender as TMenuItem);
Data.OnMeasureItem:=nil;

Form1.Caption:=Data.Caption;
sPath:='c:\windows\startmenü\'+Data.Caption+'\';
I:=FindFirst(sPath+'*.*', faAnyFile, Result);

while I=0 do
  begin
  if(Result.Name<>'.') and (Result.Name<>'..') then
    begin
    Item:=TMenuItem.Create(nil);
    Item.Caption:=ExtractFileTitle(sPath+Result.Name);
    Item2:=TMenuItem.Create(nil);
    Item2.Caption:=Data.Caption+'\'+Result.Name;
    Item2.OnMeasureItem:=OnMeasureItem;
    if LowerCase(ExtractFileExt(Result.Name))='.lnk' then
      Item.ImageIndex:=ImageList1.AddIcon(GetLinkFileData(sPath+Result.Name).SIcon)
    else
      Item.ImageIndex:=ImageList1.AddIcon(GetIcon(sPath+Result.Name, SHGFI_SMALLICON));
    if(Result.Attr and faDirectory)=faDirectory then Item.Add(Item2);
    Data.Parent.Add(Item);
    end;
  I:=FindNext(Result);
  end;
Data.Parent.Delete(0);
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  Result: TSearchRec;
  I: Integer;
  Item, Item2: TMenuItem;
  sPath: String;
begin
PopupMenu1.Items.Clear;
ImageList1.Clear;
sPath:='c:\windows\startmenü\';
I:=FindFirst(sPath+'*.*', faAnyFile, Result);
while I=0 do
  begin
  if(Result.Name<>'.') and (Result.Name<>'..') then
    begin
    Item:=TMenuItem.Create(nil);
    Item.Caption:=ExtractFileTitle(sPath+Result.Name);
    Item2:=TMenuItem.Create(nil);
    Item2.Caption:=Result.Name;
    Item2.OnMeasureItem:=OnMeasureItem;
    if LowerCase(ExtractFileExt(Result.Name))='.lnk' then
      Item.ImageIndex:=ImageList1.AddIcon(GetLinkFileData(sPath+Result.Name).SIcon)
      else
      Item.ImageIndex:=ImageList1.AddIcon(GetIcon(sPath+Result.Name, SHGFI_SMALLICON));
    if(Result.Attr and faDirectory)=faDirectory then Item.Add(Item2);
    PopupMenu1.Items.Add(Item);
    end;
  I:=FindNext(Result);
  end;
end;

end.

[edosoft]

Hat schon einer eine Lösung gefunden?

[Christian Seehase]

Moin Edosoft,

würdest Du es bitte unterlassen Deinen Thread nach so kurzer Zeit zu pushen?
Mindestens einen Tag Geduld solltest Du schon haben.
Danke.