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

asked on

How to perform magic on this TEdit + TRegistry Issue?

Hi my dear friends!

Here I come...to ask for the impossible!

I have a TEdit, which I fill with the string: 'This line is far too long we should shorten it a bit!'
Now the TEdit is too small to display the entire string, so I use MinimizeName and get something like >
 'This line ...a bit!'

Now I want to have some kind of mechanism which helps me to write and read to and from the registry so the TEdit displays 'This line ...a bit!' while the actual string that is written to the registry is: 'This line is far too long we should shorten it a bit!'
Moreover, when the TEdit reads from the registry it should also read: 'This line is far too long we should shorten it a bit!' but display > 'This line ...a bit!'

Is this abacadabra enough to you wizards? To me it is....if you need more info...please ask. What I'n trying to do here is configure the Open Dialog Places Bar. The 5 shortcuts located on the far left when you open a document in Notepad for example.

Currently my TEdit displays for example:'K:\ 06 xp iso\ 01 xp iso unattended instal'
While the actual contents is: 'K:\ 06 xp iso\ 01 xp iso unattended installs\xp sp2 pro nl 251006 working_iso\xp sp2 pro nl 251006 working.iso'

So I have no idea where it leads to....If I could simply display only the last foldername...it would be great..but then again...how to make sure that the correct path is stored in teh registry and not just simply only the foldername?

Get the idea?

Kind regards,

Paul

Ps workin samples do the trick....heres the code fragment that fills my TEdits with the paths to the folders I want shortcuts to:

procedure TMainfrm.ButtonClick(Sender: TObject);
var
  lpbi: TBrowseInfo;
  pidlStart: PItemIDList;
  Malloc: IMalloc;
  sFolder: string;
  pidlSelected: PItemIDList;
  Edit: TEdit;
begin
  SHGetSpecialFolderLocation(Handle, $11, pidlStart);
  SHGetMalloc(Malloc);
  with lpbi do
  begin
    hwndOwner := Handle;
    pidlRoot := pidlStart;
    GetMem(pszDisplayName, MAX_PATH);
    lpszTitle := PChar('Selecteer folder');
    ulFlags := $00000001;
    lpfn := nil;
  end;
  pidlSelected := SHBrowseForFolder(lpbi);
  if pidlSelected <> nil then
  begin
    if SHGetPathFromIDList(pidlSelected, lpbi.pszDisplayName) then
      sFolder := StrPas(lpbi.pszDisplayName);
    if (Sender is TsuiButton) then
    begin
      Edit := FindComponent('edt' + Copy((Sender as TsuiButton).Name, 4, 255)) as
        TEdit;
        Edit.Text := sFolder;
      Canvas.Font := Edit.Font;
       Edit.Text := MinimizeName(sFolder,Canvas,edit.Width); { this is great! but when this takes effect an invalid folder reference is saved to the registry...obviously. A work aroudn for this???}
      Malloc.Free(pidlSelected);
    end;
    if lblWarning.Visible = False then
 lblWarning.Visible := True;
 if imgWarning.Visible = False
 then imgWarning.Visible := True;
    FreeMem(lpbi.pszDisplayName);
    Malloc.Free(pidlStart);
  end;
end;

This is the code fragment which shows how I write the TEdits content to the registry (all credits go the RLibby for this tremendous piece of code!!)

procedure TMainfrm.btnOKClick(Sender: TObject);
begin
if (mrYes = MessageDlg('Alle wijzigingen worden opgeslagen. Doorgaan?', mtConfirmation, [mbYes, mbNo], 0)) then
begin
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place0',rdString,edt1.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place1',rdString,edt2.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place2',rdString,edt3.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place3',rdString,edt4.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place4',rdString,edt5.Text);
Close;
end;
end;
Avatar of Russell Libby
Russell Libby
Flag of United States of America image


The problem is that when you programatically load the edit field, the edit field does not contain
an actual path; it contains a value that has been formatted to fit within the limits provided. This
is a one way conversion (PATH->DISPLAY STRING) as it is impossible to take the display string and convert it
back to a valid path.

The way to handle this is to store the ACTUAL path value (in a variable, list, etc) and have the edit field display the formatted path. When setting the value from code (as in the button click), then this becomes very easy. The one problem with the current situation though, is if the user is allowed to manually type in / copy / paste, etc a value into the edit field. If the user does this, then you can only assume that the user is entering an absolute value (path), and not a formatted path. Simply put, you are trying to use a control to handle both actual and display values, which is not a good idea. To handle this, you should be setting the edit field to read only.

A simple example would be to create a string list to store the paths. I am posting some example code, all that you would need to do is call SetPath(index of edit) to set the new value, and GetPath(index of edit) to read the actual value (eg, for writing back to registry).

It all comes down to managing the actual path, which must be done when the display value cannot be converted back to the original value

Regards,
Russell

----

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, StdCtrls;

type
  TForm1            = class(TForm)
     Edit1:         TEdit;
     Edit2:         TEdit;
     Edit3:         TEdit;
     procedure      FormCreate(Sender: TObject);
     procedure      FormDestroy(Sender: TObject);
  private
     // Private declarations
     FPaths:        TStringList;
     FDisplay:      Array [0..2] of TEdit;
  public
     // Public declarations
     procedure      SetPath(Index: Integer; Value: String);
     function       GetPath(Index: Integer): String;
  end;

var
  Form1:            TForm1;

implementation
{$R *.DFM}

function TForm1.GetPath(Index: Integer): String;
begin

  // Check index
  if (Index in [0..2]) then
     // Return path value
     result:=FPaths[Index]
  else
     // Clear result
     SetLength(result, 0);

end;

procedure TForm1.SetPath(Index: Integer; Value: String);
begin

  // Check index
  if (Index in [0..2]) then
  begin
     // Set actual path value
     FPaths[Index]:=Value;
     // Change edit display value
     FDisplay[Index].Text:=MinimizeName(Value, Canvas, FDisplay[Index].Width);
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var  dwIndex:       Integer;
begin

  // Set edit fields
  FDisplay[0]:=Edit1;
  FDisplay[1]:=Edit2;
  FDisplay[2]:=Edit3;

  // Create list to hold the 3 paths
  FPaths:=TStringList.Create;

  // Add 3 blank paths
  for dwIndex:=0 to 2 do
  begin
     FPaths.Add('');
     FDisplay[dwIndex].ReadOnly:=True;
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

  // Free the path list
  FPaths.Free;

end;

end.
Avatar of PeterdeB

ASKER

Thanks my friend! Geez you are fast! Btw my TEdits are already readonly...to prevent users from typing and pasting. By using the Browse dialog..only a valid folder can be referenced :)

Kind regards,

Paul

Ps I'm gonna get me some coffee and then jump into this code of yours!
Very welcome Paul... btw. you can use an array of string, stringlist, etc, whatever. But bottom line is you need to track the *actual* path when setting(loading) and read it back when saving.

Let me know if there are q's or problems.

Russell
Russell > I bumped into a problem...the problem of implementing this. This is my code...>

unit unMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SUIForm, ShellApi, ShlObj, ActiveX,
  ComCtrls, SUIStatusBar,SUIButton, Menus, SUIMainMenu, GhostApp, ImgList,
  SUIDlg, SMLMsgLangRes, SMLMenuLangRes, SMLLangRes,
  SMLFormLangRes, GetSetRegData, Registry, FileCtrl, ExtCtrls;

type
  TMainfrm = class(TForm)
    frmMain: TsuiForm;
    lblTip: TLabel;
    sbMain: TsuiStatusBar;
    mnuNL: TsuiMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Help: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    GhostApp1: TGhostApp;
    btnOK: TsuiButton;
    btnReset: TsuiButton;
    pnlMain1: TPanel;
    pnlSub: TPanel;
    imgList: TImageList;
    lblOmschrijving: TLabel;
    msgDlg: TsuiMessageDialog;
    btn1: TsuiButton;
    btn2: TsuiButton;
    btn3: TsuiButton;
    btn4: TsuiButton;
    btn5: TsuiButton;
    ProgramIcon: TImage;
    lblApplication: TLabel;
    btnTest: TsuiButton;
    btnHelp: TsuiButton;
    lblVersion: TLabel;
    btnErase: TsuiButton;
    lblReleased: TLabel;
    lblCopyright: TLabel;
    smlFormLangRes1: TsmlFormLangRes;
    smlMenuLangRes1: TsmlMenuLangRes;
    smlMsgLangRes1: TsmlMsgLangRes;
    miLanguage1: TMenuItem;
    Nederlands1: TMenuItem;
    Engels1: TMenuItem;
    edt1: TEdit;
    edt2: TEdit;
    edt3: TEdit;
    edt4: TEdit;
    edt5: TEdit;
    OpenDialog1: TOpenDialog;
    pnlWarning: TPanel;
    imgWarning: TImage;
    lblWarning: TLabel;

    procedure btnResetClick(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
    procedure ButtonClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure ApplicationHint(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Engels1Click(Sender: TObject);
    procedure Nederlands1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
     FPaths:        TStringList;
     FDisplay:      Array [0..4] of TEdit;
    FShowSplashRegardless: Boolean;
    FHelpFile, FAboutFile: string;
    procedure InitializeForm;
    property ShowSplashRegardless: Boolean read FShowSplashRegardless write
      FShowSplashRegardless;
    property HelpFile: string read FHelpFile write FHelpFile;
    property AboutFile: string read FAboutFile write FAboutFile;
  public
    procedure SetPath(Index: Integer; Value: String);
     function GetPath(Index: Integer): String;
  end;

var
  Mainfrm: TMainfrm;
  PlacesBar: string;
implementation

uses
  Splash, unAbout, unDialog, unStrings;

{$R *.dfm}

function TMainFrm.GetPath(Index: Integer): String;
begin
  // Check index
  if (Index in [0..2]) then
     // Return path value
     result:=FPaths[Index]
  else
     // Clear result
     SetLength(result, 0);
end;

procedure TMainFrm.SetPath(Index: Integer; Value: String);
begin
  // Check index
  if (Index in [0..4]) then
  begin
     // Set actual path value
     FPaths[Index]:=Value;
     // Change edit display value
     FDisplay[Index].Text:=MinimizeName(Value, Canvas, FDisplay[Index].Width);
  end;
end;


{------------------------------------------------------------------------------}
procedure TMainfrm.FormCreate(Sender: TObject);
begin
  if FileExists(ExtractFileDir(Application.Exename) + '\English.ini') then
    begin
        smlFormLangRes1.LangFileName := 'English.ini';
        smlMenuLangRes1.LangFileName := 'English.ini';
        smlMsgLangRes1.LangFileName := 'English.ini';
        Engels1.Checked := True;
        Nederlands1.Checked := False;
        HelpFile := ExtractFileDir(Application.Exename) + '\Help\ODPE_ENG.hlp';
        AboutFile := ExtractFileDir(Application.Exename) + '\Res\About_ENG.rtf'
    end
    else
    begin
        smlFormLangRes1.LangFileName := 'Nederlands.ini';
        smlMenuLangRes1.LangFileName := 'Nederlands.ini';
        smlMsgLangRes1.LangFileName := 'Nederlands.ini';
        Nederlands1.Checked := True;
        Engels1.Checked := False;
        HelpFile := ExtractFileDir(Application.Exename) + '\Help\ODPE_NL.hlp';
        AboutFile := ExtractFileDir(Application.Exename) + '\Res\About_NL.rtf'
    end;
  Application.MainForm.Caption := 'Open Dialog Places Bar Editor';
  lblApplication.Caption := sAppTitle;
  lblVersion.Caption := sVersion;
  lblCopyright.Caption := sCopyright;
  lblReleased.Caption := sReleaseNote;
   with Constraints do
  begin
    MaxWidth := Width;
    MaxHeight := Height;
    MinWidth := Width;
    MinHeight := Height;
  ShowSplashRegardless := True;
  InitializeForm;
end;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.InitializeForm;
var Reg: TRegistry;

begin
  PlacesBar := 'Software\Microsoft\Windows\CurrentVersion\Policies\Comdlg32\PlacesBar';
  Reg := TRegistry.Create(KEY_ALL_ACCESS);
  Reg.RootKey := HKEY_CURRENT_USER;
  if not Reg.KeyExists(PlacesBar)then
  WinExec('Regedt32.exe /s default.reg', SW_HIDE) else
  begin
edt1.Text := GetRegistryData(HKEY_CURRENT_USER,PlacesBar,'place0');
edt2.Text := GetRegistryData(HKEY_CURRENT_USER,PlacesBar,'place1');
edt3.Text := GetRegistryData(HKEY_CURRENT_USER,PlacesBar,'place2');
edt4.Text := GetRegistryData(HKEY_CURRENT_USER,PlacesBar,'place3');
edt5.Text := GetRegistryData(HKEY_CURRENT_USER,PlacesBar,'place4');
end;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.FormShow(Sender: TObject);
begin
  if ShowSplashRegardless then
    Sleep(1000);
  fSplash.Release;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.ApplicationHint(Sender: TObject);
begin
  sbmain.Panels[0].Text := (Application.Hint);
end;
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
procedure TMainfrm.ButtonClick(Sender: TObject);
var
  lpbi: TBrowseInfo;
  pidlStart: PItemIDList;
  Malloc: IMalloc;
  sFolder: string;
  pidlSelected: PItemIDList;
  Edit: TEdit;
begin
  SHGetSpecialFolderLocation(Handle, $11, pidlStart);
  SHGetMalloc(Malloc);
  with lpbi do
  begin
    hwndOwner := Handle;
    pidlRoot := pidlStart;
    GetMem(pszDisplayName, MAX_PATH);
    lpszTitle := PChar('Selecteer folder');
    ulFlags := $00000001;
    lpfn := nil;
  end;
  pidlSelected := SHBrowseForFolder(lpbi);
  if pidlSelected <> nil then
  begin
    if SHGetPathFromIDList(pidlSelected, lpbi.pszDisplayName) then
      sFolder := StrPas(lpbi.pszDisplayName);
    if (Sender is TsuiButton) then
    begin
      Edit := FindComponent('edt' + Copy((Sender as TsuiButton).Name, 4, 255)) as
        TEdit;
        Edit.Text := sFolder;
      Canvas.Font := Edit.Font;
       Edit.Text := MinimizeName(sFolder,Canvas,edit.Width);
      Malloc.Free(pidlSelected);
    end;
    if lblWarning.Visible = False then
 lblWarning.Visible := True;
 if imgWarning.Visible = False
 then imgWarning.Visible := True;
    FreeMem(lpbi.pszDisplayName);
    Malloc.Free(pidlStart);
  end;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.Exit1Click(Sender: TObject);
begin
  close;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.About1Click(Sender: TObject);
begin
  Aboutbox.ShowModal;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.btnOKClick(Sender: TObject);
begin
if (mrYes = MessageDlg('Alle wijzigingen worden opgeslagen. Doorgaan?', mtConfirmation, [mbYes, mbNo], 0)) then
begin
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place0',rdString,edt1.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place1',rdString,edt2.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place2',rdString,edt3.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place3',rdString,edt4.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place4',rdString,edt5.Text);
Close;
end;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.btnResetClick(Sender: TObject);
const
  nicenames: array[1..5] of string = ('Recent', 'Desktop', 'MyDocuments', 'MyComputer',
    'MyNetworkPlaces');
    var i:Integer;
    edit: TEdit;
begin
if (mrYes = MessageDlg('Alle wijzigingen gaan verloren. Doorgaan?', mtConfirmation, [mbYes, mbNo], 0)) then
begin
 i := 1;
 while (i <= 5) do begin
edit :=  FindComponent('edt' + IntToStr(i)) As TEdit;
edit.Text := nicenames[i];
Inc(i);
end;
ShellExecute(0, nil, PChar(Application.ExeName), nil, nil, SW_NORMAL);
 Close;
end;
end;
{------------------------------------------------------------------------------}
procedure TMainfrm.btnTestClick(Sender: TObject);
begin
  OpenDialog1.Execute;
end;
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
procedure TMainfrm.btnHelpClick(Sender: TObject);
begin
  if not FileExists(HelpFile) then
    MessageDlg('Help bestand niet gevonden!', mtInformation, [mbOK],0)
  else
  begin
    Application.HelpFile := HelpFile;
    Application.HelpCommand(HELP_INDEX, 0);
  end;
end;
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
procedure TMainfrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if imgWarning.Visible  then
if (mrNo = MessageDlg('Wilt u het programma afsluiten en de wijzigingen opslaan?', mtConfirmation, [mbYes, mbNo], 0)) then
  begin
    CanClose := False;
end;
end;
{------------------------------------------------------------------------------}

procedure TMainfrm.Engels1Click(Sender: TObject);
begin
if smlFormLangRes1.LangFileName = 'Nederlands.ini' then
    begin
    smlFormLangRes1.LangFileName := 'English.ini';
        smlMenuLangRes1.LangFileName := 'English.ini';
        smlMsgLangRes1.LangFileName := 'English.ini';
        Engels1.Checked := True;
        Nederlands1.Checked := False;
        HelpFile := ExtractFileDir(Application.Exename) + '\Help\ODPE_ENG.hlp';
end;
end;

procedure TMainfrm.Nederlands1Click(Sender: TObject);
begin
 if smlFormLangRes1.LangFileName = 'English.ini' then
    begin
        smlFormLangRes1.LangFileName := 'Nederlands.ini';
        smlMenuLangRes1.LangFileName := 'Nederlands.ini';
        smlMsgLangRes1.LangFileName := 'Nederlands.ini';
        Nederlands1.Checked := True;
        Engels1.Checked := False;
        HelpFile := ExtractFileDir(Application.Exename) + '\Help\ODPE_NL.hlp';
end;
end;

procedure TMainfrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place0',rdString,edt1.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place1',rdString,edt2.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place2',rdString,edt3.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place3',rdString,edt4.Text);
SetRegistryData(HKEY_CURRENT_USER, PlacesBar,'place4',rdString,edt5.Text);
end;

procedure TMainfrm.FormDestroy(Sender: TObject);
begin
 //
end;

end.


Let me guess...I have to transform my code quite a bit?

Kind regards,

Paul

Btw off for another coffee :)
ASKER CERTIFIED SOLUTION
Avatar of Russell Libby
Russell Libby
Flag of United States of America 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
Hi Russell!

I can't get it to work, it either shows up with double values > the first edit and the last edit both show NetHoodPlaces....in some other cases it leaves teh above edit blank.

Kind regards,

Paul

What is currently in the registry values and have you tried clearing the current reg entries and testing again? The best I can do is give you an example that illustrates what needs to be done (as I already have), as I don't have your source, or even all the units to compile what you have listed above.

Russell

Hi Russell,

I could send you the sourcecode but it involves some 3rd party components as well. I check the registry all the time, since I want the app to handle each situation. An example would be good as well. I ll leave it up to you.

Kind regards,

Paul :)
I suppose you could store the full string as well as the shortened string in teh edit component until you need it
var
  FullString: PString;
begin
..
  Edit.Text := MinimizeName(sFolder, Canvas,edit.Width);
  New(FullString);
  FullString^ := sFolder;
  Edit.Tag := integer(FullString);
..
end;

then later on, to access teh full string
var
  FullString: PString;
  S: String;
begin
  FullString:=Pointer(Edit.Tag);
  S := FullString^;
  Dispose(FullString);
  label1.caption := S;
end;
Paul,

I can take a look at it more tomorrow, and put togehter a sample app; but my strong recommendation is for you to take some time and step though / trace the code you have (specifically the loading / saving / assignment / checking the FPaths array / etc). Only by doing that will you

- become familiar with the code
- determine where the bug lies
- help avoid mistakes later on down the line.

Currently, I have no idea where the problem lies, but as far as I can tell (without being able to compile the source), what I gave you should be correct and functional.

Regards,
Russell

Russell > needless to say my friend > I started tracing the inconsistencies right after I found your post. And will continue on doing so. The first thing I stumbled upon was freeing the FPaths array in the destroy event. It did not compile when I used:

procedure TMainfrm.FormDestroy(Sender: TObject);
begin
 FPaths.Free;
end;

And I did not manage to find a workaround for it but instead of returning here I decided to leave it out and see what would happen without it. I figured not freeing the FPaths array left some garbage on my system, but that I did not consider to be too big an issue :) I was already glad my post picked your attention, so I wanted to do my utmost to get this baby running and grab a hold of the logic etc.

So now I'm still in this process and that is right where I should be, this will help me develop my skills, regardless of how long it takes...I will manage to get it done eventually. The main reason I always ask for working samples is to prevent people from replying too much hocus pocus and aba ca da bra :) Things that may seem obvious to you and TheRealLoki (etc etc etc) might take me ages to comprehend if ever. Nevertheless I enjoy programming and do it just for fun. Some years ago I simply installed Delphi and started on the text editor tutorial without any knowledge or education at all....some 4 months later the editor compiled successfully....and another few months later the buttons responded like I intended :)

So far a 'lil background info......back on topic > the support and guidance I get from this place is priceless....tremendous...oustanding....THE NO.1. spot on earth for me....If EE can't handle it...no one can....

Kind regards and thanks for all the efforts so far....TheRealLoki > thank you tooo!!

I will be back!

Kind regards,

Paul :-)

Ps IMPORTANT > Russell > your code did show me it was possible to display the shortened string, while 'working' with the full string. I only failed to make that consistent for all the TEdits. Moreover my problem(s) have something to do with the way I'm trying to make sure all contents of the TEdits is written to the registry, I now realize. I will therefore consider this question to be answered and post yet another one, which starts where this one ends.

To express my appreciation and stimulate your participation, I will therefore reward your efforts alread and name the new topic quite like this one so they will stick together in the EE database so to speak.





My understanding is that you want to change the display of the TEdit but the stored value must still contain the full text. I suggest you create a new edit component and override the painting of it.

An example of what I'm talking about follows. Note I also created a MinimizeStr function to shorten the text as described above (i.e. 'This line ...a bit!'). for example/demo purposes, I just create the edit control at runtime, but you could easily just register it as a new component and use it during design time.

Kind regards
Pierre



PAS File:
==============================================================
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMyEdit = class(TCustomEdit)
    private
      FCanvas: TCanvas;
      procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    protected
      property Canvas: TCanvas read FCanvas;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    Edit2: TMyEdit;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function MinimizeStr(s: String; ACanvas: TCanvas; MaxWidth: integer): string;
var li,ri, tw, MidCharPos: integer;
    sLeft, sRight: string;
begin
  if ACanvas.TextWidth(s) < MaxWidth then
  begin
    result:= s;
    Exit;
  end;

  sLeft:= ''; sRight:= '';
  tw:= 0;//ACanvas.TextWidth(s);
  li:= 1; ri:= length(s);
  if ri > 0 then result:= s[1]+'...';
  while (tw < MaxWidth) AND (li < ri) do
  begin
    sleft:= sLeft+ s[li];
    if (ri > li) then sRight:= s[ri] + sRight;
    Inc(li); Dec(ri);

    tw:= ACanvas.TextWidth(sLeft + '...'+sRight);
    if tw < MaxWidth
      then result:= sLeft + '...'+sRight;
  end;
end;

{ TMyEdit }

constructor TMyEdit.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas:= TControlCanvas.Create;
  TControlCanvas(FCanvas).Control:= self;
end;

destructor TMyEdit.Destroy;
begin
  FCanvas.Free;
  inherited;
end;

procedure TMyEdit.WMPaint(var Message: TWMPaint);
var DisplayText: string;
begin
  inherited;
  DisplayText:= MinimizeStr(Text, Canvas, Width);
  Canvas.TextOut(1,1, DisplayText);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit2:= TMyEdit.Create(self);
  with Edit2 do
  begin
    Top:= 23;
    Left:= 10;
    Text:= 'This text is too long and must be shortened';
    parent:= self;
    Anchors:= Anchors + [akRight];
  end;
end;

end.



DFM File:
==============================================================
object Form1: TForm1
  Left = 192
  Top = 114
  Width = 358
  Height = 178
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 72
    Width = 61
    Height = 13
    Caption = 'Normal TEdit'
  end
  object Label2: TLabel
    Left = 8
    Top = 8
    Width = 39
    Height = 13
    Caption = 'TMyEdit'
  end
  object Edit1: TEdit
    Left = 8
    Top = 88
    Width = 329
    Height = 21
    TabOrder = 0
    Text = 'Just here to allow taking focus away from the above edit control'
  end
end
Hi PierreC!

Thanks for your reply I can hardly wait to test it! Thanks in advance!

Kind regards,

Paul
Paul,

I did not mean for you to close this question...

I only wanted to suggest that you debug the code you had, as we can only do so much without having all the related code. (And coordinating that tends to be sticky.... rule wise, emailing, etc). But offhand, I noticed a few things; eg, you assign nicenames[] (string array) to the edit fields, and those names translate into NOTHING usable. (ie not a path, and not a CSIDL). You also mentioned FPaths.Free, but in the second code I gave you (directly modified from the code you provided), the FPaths was an array of string, and I did not put anything in the form destructor, leading me to believe you were mixing examples, code, etc. You also close / restart the app on resetting of default values, which is really not needed. All of these things leave room for bugs to occur....

At this point all I can do is offer a sample application that performs something similar to what you are trying to do.

- It handles the 5 dialog shortcuts in either DWORD (CSIDL) or as strings. MS has noted that if a REG_SZ string value is written, it should contain the path. If written as DWORD, it should be the CSIDL value of the desired location (common special folder id).
- The listbox shows how to paint one thing, while actually holding another. PierreC's example is also another nice way to do it, but I was trying for a self-contained app that could easily be posted here / tested with.
- It allows for reading, writing, deleting, updating and resetting of the path values, again, either as CSIDL values or as actual paths.
- Allows for calling of InitDialog at any stage; no restart of app required.

And regarding the reg file import. If you want to do it programmatically, you can download the RegTransfer unit from my site to handle this. Hopefully the code below will give you some ideas, and make things a little clearer (or at least give you some commented code to use as a reference).

Regards,
Russell

----

---- Project source ----
program DlgPlace;

uses
  Forms,
  DlgPlaceUnit in 'DlgPlaceUnit.pas' {DlgForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TDlgForm, DlgForm);
  Application.Run;
end.


---- Unit Source ----
unit DlgPlaceUnit;
////////////////////////////////////////////////////////////////////////////////
//
//   Program     :  DlgPlace
//   Author      :  rllibby
//   Date        :  11.09.2006
//   Description :  Example project that allows the user to modify the
//                  5 shortcut places used in the common control dialog. It should
//                  be noted that the Place[0..4] item can either be a DWORD value
//                  containing the CSIDL (special folder ID) or a string value
//                  containing the path to use as the shortcut. This demo program
//                  handles both cases.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, ActiveX, CommDlg, ShlObj;

////////////////////////////////////////////////////////////////////////////////
//   Custom types
////////////////////////////////////////////////////////////////////////////////
type
  TSpecialFolder    =  packed record
     ID:            Integer;
     Name:          PChar;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Constants
////////////////////////////////////////////////////////////////////////////////
const
  BIF_NEWDIALOGSTYLE=  $40;
  BROWSE_TITLE      =  'Select Folder';
  ENABLED_COLORS:   Array [False..True] of TColor    =  (clBtnFace, clWindow);
  OFFSET_TEXT       =  8;
  PLACES_MAX        =  5;
  PLACES_ROOT       =  HKEY_CURRENT_USER;
  PLACES_KEY        =  'Software\Microsoft\Windows\CurrentVersion\Policies\ComDlg32\PlacesBar';
  PLACES_ITEM       =  'Place%d';
  SPECIAL_ITEM      =  'Special Folder(%d)';
  SPECIAL_DEFAULTS: Array [0..4] of Integer          =  (8, 16, 5, 17, 18);
  SPECIAL_FOLDERS:  Array [0..13] of TSpecialFolder  =  (
                                                           (ID: 17; Name: 'My Computer'),
                                                           (ID: 5;  Name: 'My Documents'),
                                                           (ID: 8;  Name: 'My Recent Documents'),
                                                           (ID: 39; Name: 'My Pictures'),
                                                           (ID: 13; Name: 'My Music'),
                                                           (ID: 14; Name: 'My Videos'),
                                                           (ID: 18; Name: 'My Network Places'),
                                                           (ID: 16; Name: 'Desktop'),
                                                           (ID: 19; Name: 'NetHood'),
                                                           (ID: 2;  Name: 'Programs'),
                                                           (ID: 6;  Name: 'Favorites'),
                                                           (ID: 7;  Name: 'Startup'),
                                                           (ID: 9;  Name: 'Send To'),
                                                           (ID: 11; Name: 'Start Menu')
                                                        );

////////////////////////////////////////////////////////////////////////////////
//   TDlgForm
////////////////////////////////////////////////////////////////////////////////
type
  TDlgForm          =  class(TForm)
     lbPlaces:      TListBox;
     gbSelection:   TGroupBox;
     rbSpecial:     TRadioButton;
     cboSpecial:    TComboBox;
     rbFolder:      TRadioButton;
     txtPath:       TEdit;
     btnBrowse:     TButton;
     btnAdd:        TButton;
     btnUpdate:     TButton;
     btnDelete:     TButton;
     btnSave:       TButton;
     btnReset:      TButton;
     procedure      FormCreate(Sender: TObject);
     procedure      lbPlacesClick(Sender: TObject);
     procedure      rbSpecialClick(Sender: TObject);
     procedure      rbFolderClick(Sender: TObject);
     procedure      lbPlacesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
     procedure      btnDeleteClick(Sender: TObject);
     procedure      btnAddClick(Sender: TObject);
     procedure      btnUpdateClick(Sender: TObject);
     procedure      btnBrowseClick(Sender: TObject);
     procedure      btnSaveClick(Sender: TObject);
     procedure      btnResetClick(Sender: TObject);
     procedure      FormClose(Sender: TObject; var Action: TCloseAction);
  private
     // Private declarations
     FCached:       String;
     function       CanAdd: Boolean;
     function       CanDelete: Boolean;
     function       CanUpdate: Boolean;
     procedure      SetEditPath(Path: String);
     procedure      SetSelected(Index: Integer);
     procedure      SelectSpecial(ID: Integer);
  protected
     // Protected declarations
     procedure      BindEvents;
     procedure      ClearRegValues(Key: HKEY);
     procedure      LoadRegValues;
     procedure      LoadSpecialList;
     procedure      SaveRegCurrent;
     procedure      SaveRegDefaults;
     procedure      UpdateState;
     procedure      UnbindEvents;
  public
     // Public declarations
     procedure      InitDialog;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
function   SpecialNameFromID(ID: Integer): String;

////////////////////////////////////////////////////////////////////////////////
//   Globals
////////////////////////////////////////////////////////////////////////////////
var
  DlgForm:          TDlgForm;

implementation
{$R *.DFM}

//// TDlgForm //////////////////////////////////////////////////////////////////
procedure TDlgForm.FormCreate(Sender: TObject);
begin

  // Init the dialog
  InitDialog;

end;

procedure TDlgForm.InitDialog;
begin

  // Resource protection
  try
     // Unbind the event handlers
     UnbindEvents;
     // Resource protection
     try
        // Clear cached path
        SetLength(FCached, 0);
        // Load the special list
        LoadSpecialList;
        // Load the registry settings
        LoadRegValues;
        // Set default radio item
        rbSpecial.Checked:=True;
     finally
        // Bind events
        BindEvents;
     end;
  finally
     // Set selected item
     SetSelected(0);
  end;

end;

procedure TDlgForm.UpdateState;
var  bSpecial:      Boolean;
begin

  // Update the control states
  btnAdd.Enabled:=CanAdd;
  btnUpdate.Enabled:=CanUpdate;
  btnDelete.Enabled:=CanDelete;

  // Determine selected radio item
  bSpecial:=rbSpecial.Checked;

  // Enabled / disable the controls
  txtPath.Enabled:=not(bSpecial);
  btnBrowse.Enabled:=not(bSpecial);
  cboSpecial.Enabled:=bSpecial;
  txtPath.Color:=ENABLED_COLORS[txtPath.Enabled];
  cboSpecial.Color:=ENABLED_COLORS[cboSpecial.Enabled];

end;

function TDlgForm.CanDelete: Boolean;
begin

  // Determine if we can delete an item
  result:=not(lbPlaces.ItemIndex < 0);

end;

function TDlgForm.CanUpdate: Boolean;
begin

  // Determine if we can update the selected item
  if (lbPlaces.ItemIndex < 0) then
     // No item selected for update
     result:=False
  // Check special item
  else if (rbSpecial.Checked) then
     // Make sure an item is selected in the combo
     result:=not(cboSpecial.ItemIndex < 0)
  // Folder item is checked
  else
     // Make sure the cached path is not blank
     result:=(Length(FCached) > 0);

end;

function TDlgForm.CanAdd: Boolean;
begin

  // Determine if we can add an item
  if (lbPlaces.Items.Count >= PLACES_MAX) then
     // Can't add any more items
     result:=False
  // Check special item
  else if (rbSpecial.Checked) then
     // Make sure an item is selected in the combo
     result:=not(cboSpecial.ItemIndex < 0)
  // Folder item is checked
  else
     // Make sure the cached path is not blank
     result:=(Length(FCached) > 0);

end;

procedure TDlgForm.BindEvents;
begin

  // Bind the event handlers
  lbPlaces.OnClick:=lbPlacesClick;
  rbSpecial.OnClick:=rbSpecialClick;
  rbFolder.OnClick:=rbFolderClick;

end;

procedure TDlgForm.UnbindEvents;
begin

  // Unbind the event handlers
  lbPlaces.OnClick:=nil;
  rbSpecial.OnClick:=nil;
  rbFolder.OnClick:=nil;

end;

procedure TDlgForm.ClearRegValues(Key: HKEY);
var  dwIndex:       Integer;
begin

  // Remove the 5 place items
  for dwIndex:=0 to 4 do RegDeleteValue(Key, PChar(Format(PLACES_ITEM, [dwIndex])));

end;

procedure TDlgForm.SaveRegCurrent;
var  lpszBuffer:    Array [0..MAX_PATH] of Char;
     hkPlaces:      HKEY;
     dwDisp:        DWORD;
     dwIndex:       Integer;
begin

  // Attempt to open the registry key
  if (RegCreateKeyEx(PLACES_ROOT, PLACES_KEY, 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hkPlaces, @dwDisp) = ERROR_SUCCESS) then
  begin
     // Resource protection
     try
        // Clear current values
        ClearRegValues(hkPlaces);
        // Walk the listbox items
        for dwIndex:=0 to Pred(lbPlaces.Items.Count) do
        begin
           // Determine item type
           dwDisp:=Integer(lbPlaces.Items.Objects[dwIndex]);
           // Check ID
           if (dwDisp = 0) then
           begin
              // Copy the path
              StrPCopy(@lpszBuffer, lbPlaces.Items[dwIndex]);
              // Write the value
              RegSetValueEx(hkPlaces, PChar(Format(PLACES_ITEM, [dwIndex])), 0, REG_SZ, @lpszBuffer, Succ(StrLen(@lpszBuffer)));
           end
           else
              // Write the special ID value
              RegSetValueEx(hkPlaces, PChar(Format(PLACES_ITEM, [dwIndex])), 0, REG_DWORD, @dwDisp, SizeOf(Integer));
        end;
     finally
        // Close the registry key
        RegCloseKey(hkPlaces);
     end;
  end;

end;

procedure TDlgForm.SaveRegDefaults;
var  hkPlaces:      HKEY;
     dwType:        DWORD;
     dwSize:        DWORD;
     dwDisp:        DWORD;
     dwIndex:       Integer;
begin

  // Attempt to open the registry key
  if (RegCreateKeyEx(PLACES_ROOT, PLACES_KEY, 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hkPlaces, @dwDisp) = ERROR_SUCCESS) then
  begin
     // Resource protection
     try
        // Clear current values
        ClearRegValues(hkPlaces);
        // Walk the 5 places items
        for dwIndex:=0 to 4 do
        begin
           // Set special ID value
           dwDisp:=SPECIAL_DEFAULTS[dwIndex];
           // Write the value
           RegSetValueEx(hkPlaces, PChar(Format(PLACES_ITEM, [dwIndex])), 0, REG_DWORD, @dwDisp, SizeOf(Integer));
        end;
     finally
        // Close the registry key
        RegCloseKey(hkPlaces);
     end;
  end;

end;

procedure TDlgForm.LoadRegValues;
var  lpszBuffer:    Array [0..MAX_PATH] of Char;
     hkPlaces:      HKEY;
     dwType:        DWORD;
     dwSize:        DWORD;
     dwDisp:        DWORD;
     dwIndex:       Integer;
begin

  // Lock the places list
  lbPlaces.Items.BeginUpdate;

  // Resource protection
  try
     // Clear the places list
     lbPlaces.Items.Clear;
     // Attempt to open the registry key
     if (RegCreateKeyEx(PLACES_ROOT, PLACES_KEY, 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, hkPlaces, @dwDisp) = ERROR_SUCCESS) then
     begin
        // Resource protection
        try
           // Walk the 5 places items
           for dwIndex:=0 to 4 do
           begin
              // Set buffer size
              dwSize:=SizeOf(lpszBuffer);
              // Query the value type
              if (RegQueryValueEx(hkPlaces, PChar(Format(PLACES_ITEM, [dwIndex])), nil, @dwType, @lpszBuffer, @dwSize) = ERROR_SUCCESS) then
              begin
                 // Check for DWORD type value
                 if (dwType = REG_DWORD) then
                 begin
                    // Get the integer in the buffer
                    dwDisp:=Integer(Pointer(@lpszBuffer)^);
                    // Add the special folder to the list
                    lbPlaces.Items.AddObject(SpecialNameFromID(dwDisp), Pointer(dwDisp));
                 end
                 // Check for string value
                 else if (dwType = REG_SZ) then
                    // Add folder name to list
                    lbPlaces.Items.AddObject(lpszBuffer, nil);
              end;
           end;
        finally
           // Close the registry key
           RegCloseKey(hkPlaces);
        end;
     end;
  finally
     // Unlock
     lbPlaces.Items.EndUpdate;
  end;

end;

procedure TDlgForm.LoadSpecialList;
var  dwIndex:       Integer;
begin

  // Lock update
  cboSpecial.Items.BeginUpdate;

  // Resource protection
  try
     // Clear the item list
     cboSpecial.Items.Clear;
     // Walk the special folder array
     for dwIndex:=Low(SPECIAL_FOLDERS) to High(SPECIAL_FOLDERS) do
     begin
        // Add the speical folder name and pointer to id
        cboSpecial.Items.AddObject(SPECIAL_FOLDERS[dwIndex].Name, Pointer(SPECIAL_FOLDERS[dwIndex].ID));
     end;
     // Set item index
     cboSpecial.ItemIndex:=0;
  finally
     // Unlock
     cboSpecial.Items.EndUpdate;
  end;

end;

procedure TDlgForm.SetSelected(Index: Integer);
var  dwID:          Integer;
begin

  // Resource protection
  try
     // Unbind events
     UnbindEvents;
     // Resource protection
     try
        // Check index
        if (Index >= 0) and (Index < lbPlaces.Items.Count) then
        begin
           // Set selected index
           lbPlaces.ItemIndex:=Index;
           // Determine item type
           dwID:=Integer(lbPlaces.Items.Objects[Index]);
           // Check ID
           if (dwID = 0) then
              // Set the path
              SetEditPath(lbPlaces.Items[Index])
           else
              // Select the special path
              SelectSpecial(Integer(lbPlaces.Items.Objects[Index]));
        end
        else
        begin
           // No item selected
           SetLength(FCached, 0);
           cboSpecial.ItemIndex:=0;
           rbSpecial.Checked:=True;
        end;
     finally
        // Bind events
        BindEvents;
     end;
  finally
     // Update control state
     UpdateState;
  end;

end;

procedure TDlgForm.lbPlacesClick(Sender: TObject);
begin

  // Set selected
  SetSelected(lbPlaces.ItemIndex);

end;

procedure TDlgForm.SelectSpecial(ID: Integer);
var  dwItem:        Integer;
     dwIndex:       Integer;
begin

  // Check special combo count
  if (cboSpecial.Items.Count > 0) then
  begin
     // Clear the cached path if set
     if rbFolder.Checked then SetEditPath('');
     // Set radio item
     rbSpecial.Checked:=True;
     // Set default index
     dwItem:=0;
     // Resource protection
     try
        // Locate the item index for the combo
        for dwIndex:=0 to Pred(cboSpecial.Items.Count) do
        begin
           // Compare ID values
           if (Integer(cboSpecial.Items.Objects[dwIndex]) = ID) then
           begin
              // Found the index
              dwItem:=dwIndex;
              // Done processing
              break;
           end;
        end;
     finally
        // Set item index
        cboSpecial.ItemIndex:=dwItem;
     end;
  end;

end;

procedure TDlgForm.SetEditPath(Path: String);
var  lpCanvas:      TCanvas;
begin

  // Create canvas
  lpCanvas:=TCanvas.Create;

  // Resource protection
  try
     // Set the cached path
     FCached:=Path;
     // Set radio item
     rbFolder.Checked:=True;
     // Set canvas handle
     lpCanvas.Handle:=GetDC(txtPath.Handle);
     // Resource protection
     try
        // Update the edit control
        txtPath.Text:=MinimizeName(Path, lpCanvas, txtPath.Width - 20);
     finally
        // Release the handle
        ReleaseDC(txtPath.Handle, lpCanvas.Handle);
     end;
  finally
     // Free the canvas
     lpCanvas.Free;
  end;

end;

procedure TDlgForm.rbSpecialClick(Sender: TObject);
begin

  // Update control state
  UpdateState;

end;

procedure TDlgForm.rbFolderClick(Sender: TObject);
begin

  // Update control state
  UpdateState;

end;

procedure TDlgForm.btnAddClick(Sender: TObject);
var  dwAdd:         Integer;
     dwID:          Integer;
begin

  // Set default added item
  dwAdd:=(-1);

  // Resource protection
  try
     // Determine if adding a special item of folder
     if (rbSpecial.Checked and not(cboSpecial.ItemIndex < 0)) then
     begin
        // Get special id
        dwID:=Integer(cboSpecial.Items.Objects[cboSpecial.ItemIndex]);
        // Add special item
        dwAdd:=lbPlaces.Items.AddObject(SpecialNameFromID(dwID), Pointer(dwID));
     end
     // Check folder
     else if (Length(FCached) > 0) then
        // Add folder
        dwAdd:=lbPlaces.Items.AddObject(FCached, nil)
  finally
     // Set selected item
     SetSelected(dwAdd);
  end;

end;

procedure TDlgForm.btnDeleteClick(Sender: TObject);
begin

  // Resource protection
  try
     // Delete the selected item
     if not(lbPlaces.ItemIndex < 0) then lbPlaces.Items.Delete(lbPlaces.ItemIndex);
  finally
     // Select first item
     SetSelected(0);
  end;

end;

procedure TDlgForm.btnUpdateClick(Sender: TObject);
var  dwIndex:       Integer;
     dwID:          Integer;
begin

  // Update the selected item
  if not(lbPlaces.ItemIndex < 0) then
  begin
     // Save index
     dwIndex:=lbPlaces.ItemIndex;
     // Determine if adding a special item of folder
     if (rbSpecial.Checked and not(cboSpecial.ItemIndex < 0)) then
     begin
        // Get special id
        dwID:=Integer(cboSpecial.Items.Objects[cboSpecial.ItemIndex]);
        // Set special item
        lbPlaces.Items[dwIndex]:=SpecialNameFromID(dwID);
        lbPlaces.Items.Objects[dwIndex]:=Pointer(dwID);
     end
     // Check folder
     else if (Length(FCached) > 0) then
     begin
        // Set folder
        lbPlaces.Items[dwIndex]:=FCached;
        lbPlaces.Items.Objects[dwIndex]:=nil;
     end;
  end;

end;

procedure TDlgForm.btnSaveClick(Sender: TObject);
begin

  // Write the current settings
  SaveRegCurrent;

end;

procedure TDlgForm.btnResetClick(Sender: TObject);
begin

  // Resource protection
  try
     // Write the defaults
     SaveRegDefaults;
  finally
     // Run the init again
     InitDialog;
  end;

end;

procedure TDlgForm.btnBrowseClick(Sender: TObject);
var  lpszTitle:     Array [0..512] of Char;
     lpszFolder:    Array [0..MAX_PATH] of Char;
     lpBrowse:      TBrowseInfo;
     pidlContext:   PItemIDList;
     pidlStart:     PItemIDList;
     pvMalloc:      IMalloc;
begin

  // Set title
  StrPCopy(@lpszTitle, BROWSE_TITLE);

  // Get malloc
  if Succeeded(SHGetMalloc(pvMalloc)) then
  begin
     // Resource protection
     try
        // Make sure pidl is ssigned
        if Succeeded(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidlStart)) then
        begin
           // Resource protection
           try
              // Clear buffers
              ZeroMemory(@lpBrowse, SizeOf(lpBrowse));
              ZeroMemory(@lpszFolder, SizeOf(lpszFolder));
              // Set params
              lpBrowse.hwndOwner:=Handle;
              lpBrowse.pidlRoot:=pidlStart;
              lpBrowse.pszDisplayName:=@lpszFolder;
              lpBrowse.lpszTitle:=@lpszTitle;
              lpBrowse.ulFlags:=BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
              // Browse for folder
              pidlContext:=SHBrowseForFolder(lpBrowse);
              // Check result
              if Assigned(pidlContext) then
              begin
                 // Resource protection
                 try
                    // Get the path from the pidl
                    if SHGetPathFromIDList(pidlContext, lpszFolder) then
                    begin
                       // Resource protection
                       try
                          // Set edit path
                          SetEditPath(lpszFolder);
                       finally
                          // Update state
                          UpdateState;
                       end;
                    end;
                 finally
                    // Free the pidl memory
                    pvMalloc.Free(pidlContext);
                 end;
              end;
           finally
              // Free the pidl memory
              pvMalloc.Free(pidlStart);
           end;
        end;
     finally
        // Release malloc interface
        pvMalloc:=nil;
     end;
  end;

end;

procedure TDlgForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin

  // Save curren values
  SaveRegCurrent;

end;

procedure TDlgForm.lbPlacesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var  szItem:        String;
begin

  // Prepare for canvas drawing
  with lbPlaces do
  begin
     // Clear the rect
     Canvas.FillRect(Rect);
     // Offset the text rect
     Inc(Rect.Left, OFFSET_TEXT);
     Dec(Rect.Right, OFFSET_TEXT);
     // Check for special items
     if Assigned(lbPlaces.Items.Objects[Index]) then
        // Set to italic underline
        Canvas.Font.Style:=[fsBold, fsUnderline, fsItalic]
     else
        // Normal text
        Canvas.Font.Style:=[fsBold];
     // Get minimized name
     szItem:=MinimizeName(lbPlaces.Items[Index], Canvas, Rect.Right - Rect.Left);
     // Draw the text
     Canvas.TextOut(Rect.Left, Rect.Top + 2, szItem);
  end;

end;

//// Utility functions /////////////////////////////////////////////////////////
function SpecialNameFromID(ID: Integer): String;
var  dwIndex:       Integer;
begin

  // Set default result
  SetLength(result, 0);

  // Resource protection
  try
     // Walk the special folder array
     for dwIndex:=Low(SPECIAL_FOLDERS) to High(SPECIAL_FOLDERS) do
     begin
        // ID compare
        if (ID = SPECIAL_FOLDERS[dwIndex].ID) then
        begin
           // Found the desired name
           SetString(result, SPECIAL_FOLDERS[dwIndex].Name, StrLen(SPECIAL_FOLDERS[dwIndex].Name));
           // Done processing
           break;
        end;
     end;
  finally
     // Check result, use formatted special folder result for unknown items
     if (Length(result) = 0) then result:=Format(SPECIAL_ITEM, [ID]);
  end;

end;

end.

---- Unit DFM ----
object DlgForm: TDlgForm
  Left = 336
  Top = 350
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = 'Dialog Shortcut Places'
  ClientHeight = 336
  ClientWidth = 576
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  Scaled = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object lbPlaces: TListBox
    Left = 12
    Top = 12
    Width = 465
    Height = 181
    ExtendedSelect = False
    ItemHeight = 18
    Style = lbOwnerDrawFixed
    TabOrder = 0
    OnClick = lbPlacesClick
    OnDrawItem = lbPlacesDrawItem
  end
  object btnAdd: TButton
    Left = 488
    Top = 12
    Width = 77
    Height = 25
    Caption = '&Add'
    TabOrder = 1
    OnClick = btnAddClick
  end
  object gbSelection: TGroupBox
    Left = 12
    Top = 204
    Width = 465
    Height = 117
    Caption = 'Shortcut Location'
    TabOrder = 2
    object cboSpecial: TComboBox
      Left = 136
      Top = 20
      Width = 317
      Height = 21
      Style = csDropDownList
      Font.Charset = ANSI_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = [fsBold]
      ItemHeight = 13
      ParentFont = False
      TabOrder = 0
    end
    object txtPath: TEdit
      Left = 136
      Top = 48
      Width = 317
      Height = 21
      Color = clBtnFace
      Font.Charset = ANSI_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = [fsBold]
      ParentFont = False
      ReadOnly = True
      TabOrder = 1
    end
    object rbSpecial: TRadioButton
      Left = 20
      Top = 24
      Width = 113
      Height = 17
      Caption = 'Special Locations'
      Checked = True
      TabOrder = 2
      TabStop = True
      OnClick = rbSpecialClick
    end
    object rbFolder: TRadioButton
      Left = 20
      Top = 52
      Width = 113
      Height = 17
      Caption = 'Folder'
      TabOrder = 3
      OnClick = rbFolderClick
    end
    object btnBrowse: TButton
      Left = 376
      Top = 76
      Width = 77
      Height = 25
      Caption = '&Browse...'
      TabOrder = 4
      OnClick = btnBrowseClick
    end
  end
  object btnUpdate: TButton
    Left = 488
    Top = 44
    Width = 77
    Height = 25
    Caption = '&Update'
    TabOrder = 3
    OnClick = btnUpdateClick
  end
  object btnDelete: TButton
    Left = 488
    Top = 76
    Width = 77
    Height = 25
    Caption = '&Delete'
    TabOrder = 4
    OnClick = btnDeleteClick
  end
  object btnSave: TButton
    Left = 488
    Top = 108
    Width = 77
    Height = 25
    Caption = '&Save'
    TabOrder = 5
    OnClick = btnSaveClick
  end
  object btnReset: TButton
    Left = 488
    Top = 140
    Width = 77
    Height = 25
    Caption = '&Reset'
    TabOrder = 6
    OnClick = btnResetClick
  end
end
Hi russell,

I didn't close it because of your replies. No not at all, but just like you mentioned my problem(s) involved more than the code you supplied. So therefore I thought it was fair to start another topic here and reward you for your efforts already and in my opinion that was the right thing to do....

Something else...wanna laugh? :)

I just compiled your code...and all..went well...(geez this seems like a deja vu!)....however I did not yet realize you already implemented the display\actual value thing.....as if you would forget about that!

THANKS THANKS!!

Thanks a lot...I already had your regtransfer unit btw!

Kind regards,

Paul
Ps PierreC > are you willing to reply to the other question (part 2) and show me how to create this component you mentioned?
Russell > I sit in front of my computer watching your program run and it makes me smile :)  I failed to get my hands on the My Computer item, but I did notice that when I entered 'MyComputer' in the register, it would give me back the item....a consession...I could very will live with. (I did not have much choice either btw lol)

Kind regards,

Paul :-)
Paul,

Yeah, MS was inconsistent in the handling of the reg values for the comdlg32 handling, and some special text values like "MyComputer" will fly, albeit they really should not. For these values, the CSIDL should be used (and written as the DWORD type)...

this is the list I put together, and believe it is fairly complete:

////////////////////////////////////////////////////////////////////////////////
//   CSIDL constants
////////////////////////////////////////////////////////////////////////////////
const
  CSIDL_DESKTOP                 =  $0000;
  CSIDL_INTERNET                =  $0001;
  CSIDL_PROGRAMS                =  $0002;
  CSIDL_CONTROLS                =  $0003;
  CSIDL_PRINTERS                =  $0004;
  CSIDL_PERSONAL                =  $0005;
  CSIDL_FAVORITES               =  $0006;
  CSIDL_STARTUP                 =  $0007;
  CSIDL_RECENT                  =  $0008;
  CSIDL_SENDTO                  =  $0009;
  CSIDL_BITBUCKET               =  $000A;
  CSIDL_STARTMENU               =  $000B;
  CSIDL_MYDOCUMENTS             =  $000C;
  CSIDL_MYMUSIC                 =  $000D;
  CSIDL_MYVIDEO                 =  $000E;
  CSIDL_DESKTOPDIRECTORY        =  $0010;
  CSIDL_DRIVES                  =  $0011;
  CSIDL_NETWORK                 =  $0012;
  CSIDL_NETHOOD                 =  $0013;
  CSIDL_FONTS                   =  $0014;
  CSIDL_TEMPLATES               =  $0015;
  CSIDL_COMMON_STARTMENU        =  $0016;
  CSIDL_COMMON_PROGRAMS         =  $0017;
  CSIDL_COMMON_STARTUP          =  $0018;
  CSIDL_COMMON_DESKTOPDIRECTORY =  $0019;
  CSIDL_APPDATA                 =  $001A;
  CSIDL_PRINTHOOD               =  $001B;
  CSIDL_LOCAL_APPDATA           =  $001C;
  CSIDL_ALTSTARTUP              =  $001D;
  CSIDL_COMMON_ALTSTARTUP       =  $001E;
  CSIDL_COMMON_FAVORITES        =  $001F;
  CSIDL_INTERNET_CACHE          =  $0020;
  CSIDL_COOKIES                 =  $0021;
  CSIDL_HISTORY                 =  $0022;
  CSIDL_COMMON_APPDATA          =  $0023;
  CSIDL_WINDOWS                 =  $0024;
  CSIDL_SYSTEM                  =  $0025;
  CSIDL_PROGRAM_FILES           =  $0026;
  CSIDL_MYPICTURES              =  $0027;
  CSIDL_PROFILE                 =  $0028;
  CSIDL_SYSTEMX86               =  $0029;
  CSIDL_PROGRAM_FILESX86        =  $002A;
  CSIDL_PROGRAM_FILES_COMMON    =  $002B;
  CSIDL_PROGRAM_FILES_COMMONX86 =  $002C;
  CSIDL_COMMON_TEMPLATES        =  $002D;
  CSIDL_COMMON_DOCUMENTS        =  $002E;
  CSIDL_COMMON_ADMINTOOLS       =  $002F;
  CSIDL_ADMINTOOLS              =  $0030;
  CSIDL_CONNECTIONS             =  $0031;
  CSIDL_COMMON_MUSIC            =  $0035;
  CSIDL_COMMON_PICTURES         =  $0036;
  CSIDL_COMMON_VIDEO            =  $0037;
  CSIDL_RESOURCES               =  $0038;
  CSIDL_RESOURCES_LOCALIZED     =  $0039;
  CSIDL_COMMON_OEM_LINKS        =  $003A;
  CSIDL_CDBURN_AREA             =  $003B;
  CSIDL_COMPUTERSNEARME         =  $003D;
Awesome!

Kind regards,

Paul : - )