|
|
|
| | | | | | | | |  |
| 
| Code source : unité LRJ_WinFavorisWeb | |
| |
| | |
|
Description : cette unité contient les objets LRJ_TFavoriInternetList et LRJ_TFavoriInternetItem.
LRJ_TFavoriInternetList contient les options et propriétés de la liste des favoris Internet importés
de Windows ainsi que la liste des LRJ_TFavoriInternetItem du répertoire racine. LRJ_TFavoriInternetItem
encapsule les fichiers et dossiers contenus dans l'arborescence des favoris Internet et
peut contenir une liste de LRJ_TFavoriInternetItem lorsque LRJ_TFavoriInternetItem 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'unité LRJ_WinFavorisWeb 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, SysUtils, Controls,
Registry, ShellAPI, ImgList, Menus,
LRJ_ClassesPlus,
LRJ_WindowsPlus,
LRJ_ShellUtils et
LRJ_WinInternetShortcut.
Version : 1.1 du 10.05.2009
Auteur : Laurent Hède
Copyright : LorenJo
Nombre de lignes : 533
Réalisée sous : Delphi 6
Systèmes compatibles : NT4, 2000, XP, Vista, serveurs
Prix : 123.00 € H.T.
Déclarations publiques de l'unité :
unit LRJ_WinFavorisWeb;
interface
uses
Windows,
Classes,
ActiveX,
ShlObj,
SysUtils,
Controls,
Registry,
ShellAPI,
ImgList,
Menus,
LRJ_ClassesPlus,
LRJ_WindowsPlus,
LRJ_ShellUtils,
LRJ_WinInternetShortcut;
..................
type
LRJ_TFavoriInternetList = class;
//-----------OBJECT--------------------------
LRJ_TFavoriInternetItem = class(TObject)
..................
function Count: integer;
function IsFolder: boolean;
property URL: string read GetURL;
property FileName: string read GetFileName;
property DisplayName: string read GetDisplayName;
property IconIndex: integer read GetIconIndex;
property Items[const Index: integer]: LRJ_TFavoriInternetItem read GetItem;
end; //-----------FIN--------------------------
LRJ_TOnClickFavoriInternetItem = procedure (sender : LRJ_TFavoriInternetItem) of object;
//-----------OBJECT--------------------------
LRJ_TFavoriInternetList = class(TComponent)
..................
function Count: integer;
procedure ChargeToMenu(const AMenu: TMenuItem);
property DisplayName: string read GetDisplayName;
property PathDirectory: string read GetPathDirectory;
property ChannelShortcutDisplayName: string read GetChannelShortcutName;
property InternetShortcutDisplayName: string read GetInternetShortcutName;
property ImageList: TImageList read GetImageList;
property SmallIcon: boolean read GetIfSmallIcon write SetIfSmallIcon;
property IncludeChannel: boolean read MOIncludeChannel write MOIncludeChannel;
property OnClick: LRJ_TOnClickFavoriInternetItem read MOOnClick write MOOnClick;
property Items[const Index: integer]: LRJ_TFavoriInternetItem read GetItem;
end; //-----------FIN--------------------------
|
Application de démonstration
L'application de démonstration charge à l'ouverture le nom standard du répertoire des favoris Internet
ainsi que le répertoire où se situe les favoris Internet.
Les options permettent de choisir si les icônes du menu seront petites ou grandes et
si le menu inclus ou non les canaux TV Internet.
Pour faire apparaître le 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, Menus, StdCtrls, Spin, ExtCtrls, ShellAPI,
LRJ_WinFavorisWeb;
type
TForm1 = class(TForm)
Button1: TButton;
GroupBox1: TGroupBox;
RadioGroup1: TRadioGroup;
Label2: TLabel;
Edit1: TEdit;
Label3: TLabel;
Edit2: TEdit;
PopupMenu1: TPopupMenu;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
private
MOFavorisInternet: LRJ_TFavoriInternetList;
procedure OnClickItem(sender : LRJ_TFavoriInternetItem);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{--------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
MOFavorisInternet := LRJ_TFavoriInternetList.Create(self);
MOFavorisInternet.OnClick := OnClickItem;
Edit1.Text := MOFavorisInternet.PathDirectory;
Edit2.Text := MOFavorisInternet.DisplayName;
end;
{--------------------------------------------------------------}
procedure TForm1.FormDestroy(Sender: TObject);
begin
MOFavorisInternet.Free;
end;
{--------------------------------------------------------------}
procedure TForm1.OnClickItem(sender : LRJ_TFavoriInternetItem);
var
zFullName: string;
begin
zFullName := sender.URL;
ShellExecute(0, nil, PChar(zFullName), nil, nil , SW_SHOWDEFAULT);
end;
{--------------------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
var
zPoint: TPoint;
begin
zPoint.X := 0;
zPoint.Y := Button1.Height;
zPoint := Button1.ClientToScreen(zPoint);
PopupMenu1.Items.Clear;
MOFavorisInternet.RefreshList;
MOFavorisInternet.ChargeToMenu(PopupMenu1.Items);
PopupMenu1.Popup(zPoint.X,zPoint.Y);
end;
{--------------------------------------------------------------}
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
MOFavorisInternet.IncludeChannel := CheckBox1.Checked;
end;
{--------------------------------------------------------------}
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex = 0 then
MOFavorisInternet.SmallIcon := true
else
MOFavorisInternet.SmallIcon := False;
end;
{--------------------------------------------------------------}
end.
|
Vous n'avez pas trouvé d'exemple répondant à votre problématique ?
Cliquez sur ce lien.
|
|
|
 | |  |
|
|
