|
|
|
| | | | | | | | |  |
| 
| Code source : unité LRJ_WinMenuFolder | |
| |
| | |
|
Description : cette unité contient les objets LRJ_TMenuFolder et LRJ_TItemMenuFolder.
LRJ_TMenuFolder contient les options et propriétés de la liste du répertoire sélectionné
ainsi que la liste des LRJ_TItemMenuFolder du répertoire racine. LRJ_TItemMenuFolder
encapsule les fichiers et dossiers contenus dans l'arborescence du répertoire sélectionné et
peut contenir une liste de LRJ_TItemMenuFolder lorsque LRJ_TItemMenuFolder encapsule un
dossier.
L'unité est livrée avec une application de démonstration (
voir description plus loin
) qui utilise les fonctionnalités des
objets contenus dans l'unité. Les codes de l'application
sont livrés avec l'unité pour illustrer comment utiliser les objets de
cette unité. Les codes de l'application de démonstration sont également
visibles à la fin de cette page comme exemple d'utilisation. L'application de démonstration
utilise l'unité
LRJ_WinBrowseDialog non livrée avec l'application.
L'unité LRJ_WinMenuFolder met en oeuvre les fonctions et interfaces de Windows suivantes :
|
|
IShellFolder
IShellIcon
SHGetFileInfo
et des fonctions et objets importés des unités importées.
|
Déclarations publiques de l'unité
I
Télécharger l'application de démonstration
I
Exemples d'utilisations
Utilise les unités : Windows, Classes, ActiveX, ShlObj, Controls,
ShellAPI, ImgList, Menus, SysUtils,
LRJ_ClassesPlus et
LRJ_ShellUtils.
Version : 1.1 du 10.05.2009
Auteur : Laurent Hède
Copyright : LorenJo
Nombre de lignes : 432
Réalisée sous : Delphi 6
Systèmes compatibles : NT4, 2000, XP, Vista, serveurs
Prix : 98.00 € H.T.
Déclarations publiques de l'unité :
unit LRJ_WinMenuFolder;
interface
uses
Windows,
Classes,
ActiveX,
Controls,
ShellAPI,
ImgList,
ShlObj,
Menus,
SysUtils,
LRJ_ClassesPlus,
LRJ_ShellUtils;
type
LRJ_TMenuFolder = class;
//-----------OBJECT--------------------------
LRJ_TItemMenuFolder = class(TObject)
.................
function Count: integer;
property IconIndex: integer read GetIconIndex;
property FileName: string read GetFileName;
property FullFileName: string read GetFullFileName;
property IfFolder: boolean read GetIfFolder;
property ParentItem: LRJ_TItemMenuFolder read MOParentItem;
end; //-----------FIN--------------------------
LRJ_TOnClickItemMenuFolder = procedure (const sender : LRJ_TItemMenuFolder) of object;
//-----------OBJECT--------------------------
LRJ_TMenuFolder = class(TComponent)
.................
procedure RefreshList;
function Count: integer;
procedure ChargeToMenu(const AMenu: TMenuItem);
property ImageList: TImageList read GetImageList;
property SmallIcon: boolean read GetIfSmallIcon write SetIfSmallIcon;
property OnClick: LRJ_TOnClickItemMenuFolder read MOOnClick write MOOnClick;
property RootFolder: string read MORootFolder write SetRootFolder;
property Items[const Index: integer]: LRJ_TItemMenuFolder read GetItem;
end; //-----------FIN--------------------------
|
Application de démonstration
Pour sélectionner un répertoire racine à monter dans le PopUp menu, cliquez sur "Parcourir"
et sélectionner le répertoire.
Pour que le menu soit constitué de petites ou grandes icônes, cliquez les choix correspondant dans
le groupe "Options".
Pour faire apparaître le PopUp menu, cliquez sur "Show menu".
Exemples d'utilisations
Codes de l'application de démonstration
unit unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, ShellAPI,
LRJ_WinBrowseDialog,
LRJ_WinMenuFolder;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
RadioGroup1: TRadioGroup;
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Button2: TButton;
PopupMenu1: TPopupMenu;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
private
MOMenuFolder: LRJ_TMenuFolder;
procedure OnClickItem(const sender : LRJ_TItemMenuFolder);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{--------------------------------------------------------------}
procedure TForm1.OnClickItem(const sender : LRJ_TItemMenuFolder);
var
zFullName: string;
begin
zFullName := sender.FullFileName;
ShellExecute(0, nil, PChar(zFullName), nil, PChar(ExtractFileDir(zFullName)), SW_SHOWDEFAULT);
end;
{--------------------------------------------------------------}
procedure TForm1.Button2Click(Sender: TObject);
var
zBrowse: LRJ_TBrowseForFolder;
begin
zBrowse := LRJ_TBrowseForFolder.Create;
if zBrowse.Browse then
begin
Edit1.Text := zBrowse.GetSelectFolder;
MOMenuFolder.RootFolder := Edit1.Text;
end;
zBrowse.Free;
end;
{--------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
MOMenuFolder := LRJ_TMenuFolder.Create(self);
MOMenuFolder.OnClick := OnClickItem;
end;
{--------------------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
var
zPoint: TPoint;
begin
zPoint.X := 0;
zPoint.Y := Button1.Height;
zPoint := Button1.ClientToScreen(zPoint);
PopupMenu1.Items.Clear;
MOMenuFolder.RefreshList;
MOMenuFolder.ChargeToMenu(PopupMenu1.Items);
PopupMenu1.Popup(zPoint.X,zPoint.Y);
end;
{--------------------------------------------------------------}
procedure TForm1.FormDestroy(Sender: TObject);
begin
MOMenuFolder.Free;
end;
{--------------------------------------------------------------}
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex = 0 then MOMenuFolder.SmallIcon := true else MOMenuFolder.SmallIcon := false;
end;
{--------------------------------------------------------------}
end.
|
Vous n'avez pas trouvé d'exemple répondant à votre problématique ?
Cliquez sur ce lien.
|
|
|
 | |  |
|
|
