Link to home
Start Free TrialLog in
Avatar of PeterdeB
PeterdeBFlag for Netherlands

asked on

How to get a drop down box in the object inspector? (created a component)

Hi my dear Delphi wizards!

I'm modifying this pas file to get a component which has a dropdonwbox filled with 10 special folders......The folder selected shoudl be passed to the launch funciton.....


// abracadabra

type
  TpdbLnkDlg = class(TComponent)
  private
    FAuthor: string;
    FDirectory: string;
    Function GetAuthor:string;
    procedure SetAuthor(const Value:string);
     Function GetDirectory:string;
    procedure SetDirectory(const Value:string);
  protected
  public
    constructor Create(Aowner: Tcomponent); override;
     destructor Destroy; override;
   published
    function Launch_CreateShortCut_Dialog(Directory: string): Boolean;
     property Creator: string read GetAuthor write SetAuthor;
     property Folder: string read GetDirectory write SetDirectory;
  end;
procedure Register;

implementation
procedure TpdbLnkDlg.SetAuthor(const Value: string);
begin
FAuthor:=FAuthor;
end;

function TpdbLnkDlg.GetAuthor: string;
begin
Result:=FAuthor;
end;

// this is where things get complicated for me >> how to get a dropdownbox and pass the selected folder
// to the Launch function?
procedure TpdbLnkDlg.SetDirectory(const Value: string);
begin
FDirectory:=FDirectory;
end;

function TpdbLnkDlg.GetDirectory: string;
begin
Result:=FDirectory;
end;

function GetSendToFolder: string;
var
  pIDL: pItemIDList;
  Buffer: array[0..MAX_PATH] of char;
  Malloc: IMalloc;
begin
  SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pIDL);
  ShGetPathFromIdList(pIDL, PChar(@Buffer));
  Result := Buffer;
  OLECheck(SHGetMalloc(Malloc));
  if pIDL <> nil then
    Malloc.Free(pIDL);
end;

function TpdbLnkDlg.Launch_CreateShortCut_Dialog(Directory: string): Boolean;
var
  reg: TRegistry;
  cmd: string;
begin
  Result := False;
  reg := TRegistry.Create;
  try
    reg.Rootkey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('.LNK\ShellNew') then
    begin
      cmd := reg.ReadString('Command');
      cmd := StringReplace(cmd, '%1', GetSendToFolder + '\', []);
      Result := True;
      WinExec(PChar(cmd), SW_SHOWNORMAL);
    end
  finally
    reg.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('PDB', [TpdbLnkDlg]);
end;

destructor TPdbLnkDlg.Destroy;
begin
  { ToDo -cCDK: Free allocated memory and created objects here. }
  inherited Destroy;
end;  { Destroy }

constructor TPdbLnkDlg.Create(AOwner: TComponent);
{ Creates an object of type TPdbLnkDlg, and initializes properties. }
begin
  inherited Create(AOwner);
  { Initialize properties with default values: }
   FAuthor := 'Larry Cook'; // Lariekoek grappig he? ;-)
  { ToDo -cCDK: Add your initialization code here. }
end;  { Create }
initialization
finalization
end.

// end of abacadabra

currently it lets me drop a shortcut into the SendTo folder, that is when I pass '' to the launch function. How can I get a dropdonwbox and pass the selected folder to that function?

Thanks in advance!!

Kind regards,

Dweeeeeeeeeep

Ps any other comments and tips on this code are welcome.....'I'm an absolute beginner' ;-)

ASKER CERTIFIED SOLUTION
Avatar of Mike Littlewood
Mike Littlewood
Flag of United Kingdom of Great Britain and Northern Ireland image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of PeterdeB
PeterdeB
Flag of Netherlands image

ASKER

Ofcourse,
//
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs, ShellApi, StdCtrls, Registry, ShlObj, ActiveX, ComObj,
  Menus, ExtCtrls;
//

Kind regards,

Dweeep
Avatar of PeterdeB
PeterdeB
Flag of Netherlands image

ASKER

My attempt >>

//
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs, ShellApi, StdCtrls, Registry, ShlObj, ActiveX, ComObj,
  Menus, ExtCtrls;


type
  TpdbLnkDlg = class(TComponent)
  private
    FAuthor: string;
    FDirectory: string;
    Function GetAuthor:string;
    procedure SetAuthor(const Value:string);
     Function GetDirectory:string;
    procedure SetDirectory(const Value:string);
  protected
     slFoldersList: tStringList;
    Procedure SetslFolders(slFolders: tStringList);
    { Add each of the folder names}
    Procedure pFillSLFoldersList;
  public
    constructor Create(Aowner: Tcomponent); override;
     destructor Destroy; override;
   published
    function Launch_CreateShortCut_Dialog(Directory: string): Boolean;
     property Creator: string read GetAuthor write SetAuthor;
     property Folder: TStringlist read slFoldersList write SetslFolders;
  end;



procedure Register;

implementation
procedure TpdbLnkDlg.SetAuthor(const Value: string);
begin
FAuthor:=FAuthor;
end;

function TpdbLnkDlg.GetAuthor: string;
begin
Result:=FAuthor;
end;


Procedure TpdbLnkDlg.SetslFolders(slFolders: tStringList);
Begin
  slFolders.Text := slFolders.Text;
End;

Procedure TpdbLnkDlg.pFillSLFoldersList;
Const
  FolderNames: Array[0..3] Of String=
  ('c:\temp', 'c:\tmp','c:\tomp', 'c:\tamp');
Var
  iForLoop: Integer;
Begin
  { Clear the StringList }
  slFoldersList.Clear;
  { Add each of the folder names }
  For iForLoop := Low(FolderNames) To High(FolderNames) Do
    slFoldersList.Add(FolderNames[iForLoop]);
 // For iForLoop := 0 To Length(FolderNames) Do Begin
 //   slFoldersList.Add(FolderNames[iForLoop]);
 // End;
End;

procedure TpdbLnkDlg.SetDirectory(const Value: string);
begin
FDirectory:=FDirectory;
end;

function TpdbLnkDlg.GetDirectory: string;
begin
Result:=FDirectory;
end;

function GetSendToFolder: string;
var
  pIDL: pItemIDList;
  Buffer: array[0..MAX_PATH] of char;
  Malloc: IMalloc;
begin
  SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pIDL);
  ShGetPathFromIdList(pIDL, PChar(@Buffer));
  Result := Buffer;
  OLECheck(SHGetMalloc(Malloc));
  if pIDL <> nil then
    Malloc.Free(pIDL);
end;

function TpdbLnkDlg.Launch_CreateShortCut_Dialog(Directory: string): Boolean;
var
  reg: TRegistry;
  cmd: string;
begin
  Result := False;
  reg := TRegistry.Create;
  try
    reg.Rootkey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('.LNK\ShellNew') then
    begin
      cmd := reg.ReadString('Command');
      cmd := StringReplace(cmd, '%1', GetSendToFolder + '\', []);
      Result := True;
      WinExec(PChar(cmd), SW_SHOWNORMAL);
    end
  finally
    reg.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('PDB', [TpdbLnkDlg]);
end;

destructor TPdbLnkDlg.Destroy;
begin
  { ToDo -cCDK: Free allocated memory and created objects here. }
  inherited Destroy;
end;  { Destroy }

constructor TPdbLnkDlg.Create(AOwner: TComponent);
{ Creates an object of type TPdbLnkDlg, and initializes properties. }
begin
  inherited Create(AOwner);
  { Initialize properties with default values: }
   FAuthor := 'Peter de Biel';
  { ToDo -cCDK: Add your initialization code here. }
end;  { Create }
initialization
finalization
end.

//

The outcome > Cannot assign a Nil to a TStringList.......Ofcourse my goal is to use ShGetSpecialFolder (to get the special folders) but without that this is complicated enough for me so taht is why I started with something easier......

Kindest regards,

Dweeeeeeeeeep ;-)

Ps please comment on what you add and say this will help me comprehend things better ;-)
Avatar of PeterdeB
PeterdeB
Flag of Netherlands image

ASKER

My comments > it should not be a TStringList....and it should be initialized....
Avatar of PeterdeB
PeterdeB
Flag of Netherlands image

ASKER

Solved it for the most part that is > obtaining the drop down list >>

//
unit pdbLnkDlg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs, ShellApi, StdCtrls, Registry, ShlObj, ActiveX, ComObj,
  Menus, ExtCtrls;


type
  TFolder = (fSendTo, fDesktop, fQuickLaunch);
  TpdbLnkDlg = class(TComponent)

  private
     FFolder: TFolder;
    FAuthor: string;
    Function GetAuthor:string;
    procedure SetAuthor(const Value:string);
     Function GetFolder:TFolder;
    procedure SetFolder(const Value:TFolder);
  protected
  public
    constructor Create(Aowner: Tcomponent); override;
     destructor Destroy; override;
   published
    function Launch_CreateShortCut_Dialog(Directory: string): Boolean;
     property author: string read GetAuthor write SetAuthor;
     property Folder: TFolder read GetFolder write SetFolder default fSendTo;  { Published }

  end
procedure Register;

implementation

procedure TpdbLnkDlg.SetAuthor(const Value: string);
begin
  if Value <> FAuthor
  then  FAuthor := Value;
end;

function TpdbLnkDlg.GetAuthor: string;
begin
Result:=FAuthor;
end;


{Procedure TpdbLnkDlg.SetslFolders(slFolders: tStringList);
Begin
 // Folder.Text := Folder.Text;
End;  }


procedure TpdbLnkDlg.SetFolder(const Value: TFolder);
Begin
   if Value <> FFolder then
  begin
    FFolder := Value;
end;
end;

function TpdbLnkDlg.GetFolder: TFolder;
begin
   // pFillSLFoldersList;
   //if FFolder <> fSendTo then
   //begin
  Result := FFolder;
end;


function GetSendToFolder: string;
var
  pIDL: pItemIDList;
  Buffer: array[0..MAX_PATH] of char;
  Malloc: IMalloc;
begin
  SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pIDL);
  ShGetPathFromIdList(pIDL, PChar(@Buffer));
  Result := Buffer;
  OLECheck(SHGetMalloc(Malloc));
  if pIDL <> nil then
    Malloc.Free(pIDL);
end;

function GetQLFolder: string;
var
  pIDL: pItemIDList;
  Buffer: array[0..MAX_PATH] of char;
  Malloc: IMalloc;
begin
  SHGetSpecialFolderLocation(0, CSIDL_STARTMENU, pIDL);
  ShGetPathFromIdList(pIDL, PChar(@Buffer));
  Result := Buffer;
  OLECheck(SHGetMalloc(Malloc));
  if pIDL <> nil then
    Malloc.Free(pIDL);
end;

function GetDeskTopFolder: string;
var
  pIDL: pItemIDList;
  Buffer: array[0..MAX_PATH] of char;
  Malloc: IMalloc;
begin
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pIDL);
  ShGetPathFromIdList(pIDL, PChar(@Buffer));
  Result := Buffer;
  OLECheck(SHGetMalloc(Malloc));
  if pIDL <> nil then
    Malloc.Free(pIDL);
end;

function TpdbLnkDlg.Launch_CreateShortCut_Dialog(Directory: string): Boolean;
var
  reg: TRegistry;
  cmd: string;
begin
  Result := False;
  reg := TRegistry.Create;
  try
    reg.Rootkey := HKEY_CLASSES_ROOT;
    if reg.OpenKeyReadOnly('.LNK\ShellNew') then
    begin
      cmd := reg.ReadString('Command');
      case Folder of
      fSendTo: cmd := StringReplace(cmd, '%1', GetSendToFolder + '\', []);
      fDesktop: cmd := StringReplace(cmd, '%1', GetDeskTopFolder + '\', []);
      fQuickLaunch: cmd := StringReplace(cmd, '%1', GetQLFolder + '\', []);
      end;
     // cmd := StringReplace(cmd, '%1', GetSendToFolder + '\', []);
      Result := True;
      WinExec(PChar(cmd), SW_SHOWNORMAL);
    end
  finally
    reg.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('PDB', [TpdbLnkDlg]);
end;

destructor TPdbLnkDlg.Destroy;
begin
  { ToDo -cCDK: Free allocated memory and created objects here. }
  inherited Destroy;
end;  { Destroy }

constructor TPdbLnkDlg.Create(AOwner: TComponent);
{ Creates an object of type TPdbLnkDlg, and initializes properties. }
begin
  inherited Create(AOwner);
  { Initialize properties with default values: }
   FAuthor := 'Peter de Biel';

   //FDirectory := slFoldersList.ValueFromIndex[0];
  // FDirectory := 'c:\temp';

  { ToDo -cCDK: Add your initialization code here. }
end;  { Create }
initialization

finalization
end.

//

I will fire up another question about this issue.

Kind regards,

Dweep