begin process at 2012 02 11 07:23:50
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Control

 > SELECTDIRECTORY AVEC UNE CHECKBOXE.

SELECTDIRECTORY AVEC UNE CHECKBOXE.


 Information sur la source

Note :
Aucune note
Catégorie :Control Classé sous :pascal, selectdirectory, windows Niveau :Initié Date de création :28/05/2007 Date de mise à jour :28/05/2007 08:39:26 Vu / téléchargé :4 786 / 475

Auteur : ROCABDEL

Ecrire un message privé
Commentaire sur cette source (1)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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.


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

28 mai 2007 08:39:27 :
changement des mots clés.

 Sources du même auteur

Source avec Zip Source avec une capture UN PETIT GÉNÉRATEUR DE FACTURES

 Sources de la même categorie

TFRAME ONSHOW ONHIDE par redtux
Source avec Zip Source avec une capture GESTION DE CASES À COCHER PERSONNALISÉES DANS UN STRINGGRID par Jean_Jean
Source avec Zip UN TASKDIALOG EN TROIS CLICKS par chramade
Source avec Zip Source avec une capture DÉPLACER LES ITEMS D'UNE TLISTVIEW PAR DRAG AND DROP par krzysiu
Source avec Zip Source avec une capture DEPLACER LES ITEMS D'UNE LISTBOX VERS UNE AUTRE PAR DRAG AND... par japee

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture FICHIER DUPLIQUÉ AVEC UNE TABLE DE HACHAGE par jerome1875
Source avec Zip Source avec une capture PALABRE MESSENGER par darrylsite
Source avec Zip Source avec une capture GENERATION ET RECHERCHE DE SORTIE D'UN LABYRINTHE par timmalos
UN SELECTDIRECTORY QUI SE PLACE AU BON ENDROIT par ThWilliam
Source avec Zip Source avec une capture AUTO-COMPLÉTION D'UN CONTRÔLE DE SAISIE par Bacterius

Commentaires et avis

Commentaire de fbaudoux le 03/09/2010 15:03:23

Merci pour ce snippet qi m'évite de devoir chercher à le réaliser tout seul.
J'aimerais aussi pouvoir demander une fenêtre plus grande pour la même boite de dialogue.
Est ce possible ?

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

free pascal sous linux [ par arnohoho ] bonjour tous le monde voila je suis d&#233;cider &#224; d&#233;buter en pascal, avec free pascal pour &#234;tre plus pr&#233;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 [CS]Nouvelle rubrique [Lazarus] [ par devpsp ] Bonjour, Je code en pascal (pascal objet), comme pas mal de monde, je suppose, j'utilise Lazarus (sous linux, existe aussi sous windows). Serait-il po Problèmes avec JvXPButton sous windows Xp [ par badyinfo ] J'utilise dans mon application plusieurs boutons JvXpButton de la librairie JEDI sous delphi 2006. Lorsque j'exécute mon application au début les bout Delphi 7 + DsPack + windows 2008 server R2 STD [ par lilouk ] Bonjour, Je n'arrive pas à compiler DSPACK_D7 et DSPackDesign_D7 sous windows 2008 server R2 STD. Voici le message d'insulte: [Erreur fatale] Impo Interception arret windows [ par dc46 ] Bonjour, J'ai écrit un programme résident en try-icon qui fonctionne parfaitement. Quand l'utilisateur quitte Windows celui-ci refuse de se terminer s Communiquer avec window Live Messenger [ par zakidao ] salut a tout les delphinaute j'ai un problemme sur delphi je veut fair un programme qui se lie a un autre programme Exemple : je veut lié mon prog image dans une base de donnes DBase pour windows [ par boualem5 ] comment enregistrer une image dans une base de donner DBase pour Windows Clavier virtuel [ par gerdenis ] Bonjour Première participation au forum d'un nouveau retraité qui s'initie à la programmation Je réalise en Delphi un clavier virtuel personnalisé d Changer gestionnaire de copie Windows [ par kleinvi ] Salut Svp. Je suis en train de développer un logiciel de copie pour Windows. Je cherche comment substituer le gestionnaire par défaut de Windows par m


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 4,321 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales