Accueil > > > SELECTDIRECTORY AVEC UNE CHECKBOXE.
SELECTDIRECTORY AVEC UNE CHECKBOXE.
Information sur la source
Description
ce petit code montre comment ajouter une checkbox dans la boite d'ouverture des dossiers "selectDirectory" du genre scruter les sous-dossier afin de permetre à l'utilisateur de choisir entre l'ouverture du dossier sellectioner seulement et ses sous-dossier.
Source
- unit Unit1;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs,ShlObj, ActiveX, CommCtrl, StdCtrls;
-
- type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- private
- { Déclarations privées }
- public
- { Déclarations publiques }
- end;
-
- var
- Form1: TForm1;
- id:integer;
-
- implementation
- {$R *.dfm}
- {MwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMw}
- function NewDlgProc(Wnd:HWND; uMsg:DWORD; wParam:WPARAM; lParam:LPARAM):integer; stdcall;
- begin
- if (uMsg=WM_COMMAND) then
- if (LOWORD(wParam)=id) then
- if (HIWORD(wParam)=BN_CLICKED) then
- begin
- if (IsDlgButtonChecked(Wnd,id)=BST_CHECKED) then MessageBox(Wnd,'Open SubFolders = Yes','',0) else
- MessageBox(Wnd,'Open SubFolders = No','',0)
- end;
- result:=CallWindowProc(Pointer(GetWindowLong(Wnd,GWL_USERDATA)),Wnd,uMsg,wParam,lParam);
- end;
- {*************************************************************************************************}
- function BrowseCallback(Wnd:HWND; uMsg:DWORD; lParam:LPARAM; lpData:LPARAM ):integer; stdcall;
- var
- hwndCheck:HWND;
- begin
- if (uMsg=BFFM_INITIALIZED) then
- begin
- hwndCheck:=CreateWindow('BUTTON','Open SubFolders', BS_AUTOCHECKBOX or WS_CHILD or WS_VISIBLE,10,10,100,20,Wnd,id,hInstance,nil);
- SendMessage(hwndCheck,WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT),1);
- SetWindowLong(Wnd,GWL_USERDATA,SetWindowLong(Wnd, DWL_DLGPROC, Integer(@NewDlgProc)));
- end;
- Result:=0;
- end;
- {MwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMw}
- procedure TForm1.Button1Click(Sender: TObject);
- var
- bi:TBrowseInfo;
- szDir:array[0..MAX_PATH-1] of char;
- pidl:PItemIDList;
- lpMalloc:IMalloc;
- begin
- if SUCCEEDED(SHGetMalloc(lpMalloc)) then
- begin
- ZeroMemory(@bi,sizeof(bi));
- bi.hwndOwner := Handle;
- bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_EDITBOX;
- bi.lpfn := BrowseCallback;
- pidl := SHBrowseForFolder(bi);
- if (pidl<>nil) then
- begin
- if SHGetPathFromIDList(pidl,szDir) then MessageBox(Handle,szDir,'Picked',0);
- lpMalloc.Free(pidl)
- end;
- end;
- end;
-
- end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShlObj, ActiveX, CommCtrl, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
id:integer;
implementation
{$R *.dfm}
{MwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMw}
function NewDlgProc(Wnd:HWND; uMsg:DWORD; wParam:WPARAM; lParam:LPARAM):integer; stdcall;
begin
if (uMsg=WM_COMMAND) then
if (LOWORD(wParam)=id) then
if (HIWORD(wParam)=BN_CLICKED) then
begin
if (IsDlgButtonChecked(Wnd,id)=BST_CHECKED) then MessageBox(Wnd,'Open SubFolders = Yes','',0) else
MessageBox(Wnd,'Open SubFolders = No','',0)
end;
result:=CallWindowProc(Pointer(GetWindowLong(Wnd,GWL_USERDATA)),Wnd,uMsg,wParam,lParam);
end;
{*************************************************************************************************}
function BrowseCallback(Wnd:HWND; uMsg:DWORD; lParam:LPARAM; lpData:LPARAM ):integer; stdcall;
var
hwndCheck:HWND;
begin
if (uMsg=BFFM_INITIALIZED) then
begin
hwndCheck:=CreateWindow('BUTTON','Open SubFolders', BS_AUTOCHECKBOX or WS_CHILD or WS_VISIBLE,10,10,100,20,Wnd,id,hInstance,nil);
SendMessage(hwndCheck,WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT),1);
SetWindowLong(Wnd,GWL_USERDATA,SetWindowLong(Wnd, DWL_DLGPROC, Integer(@NewDlgProc)));
end;
Result:=0;
end;
{MwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMw}
procedure TForm1.Button1Click(Sender: TObject);
var
bi:TBrowseInfo;
szDir:array[0..MAX_PATH-1] of char;
pidl:PItemIDList;
lpMalloc:IMalloc;
begin
if SUCCEEDED(SHGetMalloc(lpMalloc)) then
begin
ZeroMemory(@bi,sizeof(bi));
bi.hwndOwner := Handle;
bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_EDITBOX;
bi.lpfn := BrowseCallback;
pidl := SHBrowseForFolder(bi);
if (pidl<>nil) then
begin
if SHGetPathFromIDList(pidl,szDir) then MessageBox(Handle,szDir,'Picked',0);
lpMalloc.Free(pidl)
end;
end;
end;
end.
Historique
- 28 mai 2007 08:39:27 :
- changement des mots clés.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
free pascal sous linux [ par arnohoho ]
bonjour tous le monde voila je suis décider à débuter en pascal, avec free pascal pour être plus précis mon probleme est l'i
Compatibilité flottants entre Pascal ss windows et Delphi 5 [ par ducatman07 ]
Salut à tous !Je suis tout nouveau sur ce chat et débutant en DELPHI, et j'aurais un petit problème à vous soumettre.J'ai une application qui tourne s
Copier un fichier dans le presse papier windows??? [ par jmp77 ]
Bonjour,Est ce que quelqu un saurait comment copier un fichier autocad(.dwg) dans le presse papier???Merci et bonne prog,JMP.
ValueListEditor et Registre Windows [ par j_hawk ]
Bonjour,J'ai une petite question,Voici ce que je souhaiterais faire, j'aimerais faire apparaître dans un "ValueListEditor" toutes les clefs et valeurs
Avoir mon propre Systray + Bitmap en fond d'un CoolBar [ par RealSnake ]
Bonjour!Voila j'essaie de faire un prog ki va remplacer le bureau de windows (c explorer.exe ki s'en charge). G donc besoin de récupérer tous les icon
Style XP [ par LeGuepard ]
Salut à tous!J'ai parcouru le forum avant de vous écrire, mais je n'ai pas trouvé la réponse à la question suivante!Comment détecter l'affichage de Wi
Différence d'affichage entre systèmes Windows [ par gimbflo2002 ]
Bonjour,j'ai un problème d'affichage et j'espère qu'un spécialiste pourra me dépanner !Voilà, j'ai développé une appli sous delphi sur un système Wind
Media Player Windows Ligne de commande [ par Rowan ]
Bonjour à tous,Est-ce quelqu'un connait les lignes de commandes du MediaPlayer de Windows? Mode plein écran, ouverture, arrêt, fermeture, etc...D'avan
OnClose n'est pas appelé lors de la fermeture de Windows [ par globule ]
Bonjour, J'ai crée un application qui tourne en tache de fond et qui se place en systray à coté de l'horloge.J'ai implementé l?événement FormClose du
cryptage windows [ par ralfspark ]
salut a tous j ai crypte certains fichier dans windows (comme mes photos), et apres reinstalation je ne peut plus les lire, que doit je faire ?merci
|
Derniers Blogs
ZUNE : NOUVELLE VERSION DU ZUNE SOFTWARE - V 4.2ZUNE : NOUVELLE VERSION DU ZUNE SOFTWARE - V 4.2 par ROMELARD Fabrice
Avec la dernière génération du lecteur MP3 de Microsoft, le ZUNE HD, Microsoft a publié une nouvelle version du logiciel pour PC. Ainsi, je me suis décidé à installer celle-ci sur mon Tablet PC ACER, comme toujours le logiciel est donc tél...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice L'INTERFACE NATURELLE DE WINDOWS PHONE 7 SERIESL'INTERFACE NATURELLE DE WINDOWS PHONE 7 SERIES par odewit
La tendance est aux interfaces naturelles (NUI), et le keynote de Bill Buxton au MIX l'a bien souligné.
La charte graphique et ergonomique de Windows Phone 7 a donc été entièrement repensée en vue d'obtenir un maximum d'efficacité sur ce point. En re...
Cliquez pour lire la suite de l'article par odewit COMMENT MAPPER UNE VUE SQL SUR UNE COLLECTION DE COMPLEX TYPE?COMMENT MAPPER UNE VUE SQL SUR UNE COLLECTION DE COMPLEX TYPE? par Matthieu MEZIL
Avec EF, les vues doivent être mappées sur des entity types. Le problème c'est que les entity types doivent avoir une clé. Avec EF, nous avons les complex type qui n'ont pas de clé mais les vues ne peuvent pas être mappées dessus. Avec EF4, il est possibl...
Cliquez pour lire la suite de l'article par Matthieu MEZIL
Forum
RE : DELPHIRE : DELPHI par overtaker
Cliquez pour lire la suite par overtaker RE : DELPHIRE : DELPHI par rt15
Cliquez pour lire la suite par rt15 DELPHIDELPHI par overtaker
Cliquez pour lire la suite par overtaker
Logiciels
Academy System (10.9.4.0)ACADEMY SYSTEM (10.9.4.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Xilisoft Convertisseur Vidéo Ultimate (5.1.39.0305)XILISOFT CONVERTISSEUR VIDéO ULTIMATE (5.1.39.0305)Xilisoft Convertisseur Vidéo Ultimate est un outil puissant de conversion vidéo, facile à utilise... Cliquez pour télécharger Xilisoft Convertisseur Vidéo Ultimate Xilisoft DVD Ripper Ultimate (5.0.64.0304)XILISOFT DVD RIPPER ULTIMATE (5.0.64.0304)Xilisoft DVD Ripper Ultimate est un logiciel excellent pour copier et convertir DVD vers presque ... Cliquez pour télécharger Xilisoft DVD Ripper Ultimate Rigs of Rods (63.3)RIGS OF RODS (63.3)c'est un jeu de multi-simulation camions,autobus voitures, avions, bateaux, hélicoptère avec défo... Cliquez pour télécharger Rigs of Rods
|