?
Solved

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

Posted on 2007-10-18
5
Medium Priority
?
207 Views
Last Modified: 2010-04-05
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' ;-)

0
Comment
Question by:PeterdeB
  • 4
5 Comments
 
LVL 15

Accepted Solution

by:
mikelittlewood earned 2000 total points
ID: 20101865
Do you have the uses section at the top of your unit, half of the variables I dont know where they come from to try and code it.

Thanks
0
 

Author Comment

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

Kind regards,

Dweeep
0
 

Author Comment

by:PeterdeB
ID: 20103608
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 ;-)
0
 

Author Comment

by:PeterdeB
ID: 20114598
My comments > it should not be a TStringList....and it should be initialized....
0
 

Author Comment

by:PeterdeB
ID: 20116495
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
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Are you ready to place your question in front of subject-matter experts for more timely responses? With the release of Priority Question, Premium Members, Team Accounts and Qualified Experts can now identify the emergent level of their issue, signal…
Screencast - Getting to Know the Pipeline
Suggested Courses
Course of the Month15 days, 18 hours left to enroll

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question