PeterdeB
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(Sende r: 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(pidlSe lected, 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,Canva s,edit.Wid th); { 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.pszDisplayNam e);
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_CURRE NT_USER, PlacesBar,'place0',rdStrin g,edt1.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place1',rdStrin g,edt2.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place2',rdStrin g,edt3.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place3',rdStrin g,edt4.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place4',rdStrin g,edt5.Tex t);
Close;
end;
end;
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(Sende
var
lpbi: TBrowseInfo;
pidlStart: PItemIDList;
Malloc: IMalloc;
sFolder: string;
pidlSelected: PItemIDList;
Edit: TEdit;
begin
SHGetSpecialFolderLocation
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(pidlSe
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,Canva
Malloc.Free(pidlSelected);
end;
if lblWarning.Visible = False then
lblWarning.Visible := True;
if imgWarning.Visible = False
then imgWarning.Visible := True;
FreeMem(lpbi.pszDisplayNam
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
begin
if (mrYes = MessageDlg('Alle wijzigingen worden opgeslagen. Doorgaan?', mtConfirmation, [mbYes, mbNo], 0)) then
begin
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
Close;
end;
end;
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!
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
Let me know if there are q's or problems.
Russell
ASKER
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:=Mini mizeName(V alue, Canvas, FDisplay[Index].Width);
end;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.FormCreate(Sender : TObject);
begin
if FileExists(ExtractFileDir( Applicatio n.Exename) + '\English.ini') then
begin
smlFormLangRes1.LangFileNa me := 'English.ini';
smlMenuLangRes1.LangFileNa me := 'English.ini';
smlMsgLangRes1.LangFileNam e := '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.LangFileNa me := 'Nederlands.ini';
smlMenuLangRes1.LangFileNa me := 'Nederlands.ini';
smlMsgLangRes1.LangFileNam e := '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.Capti on := '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\Window s\CurrentV ersion\Pol icies\Comd lg32\Place sBar';
Reg := TRegistry.Create(KEY_ALL_A CCESS);
Reg.RootKey := HKEY_CURRENT_USER;
if not Reg.KeyExists(PlacesBar)th en
WinExec('Regedt32.exe /s default.reg', SW_HIDE) else
begin
edt1.Text := GetRegistryData(HKEY_CURRE NT_USER,Pl acesBar,'p lace0');
edt2.Text := GetRegistryData(HKEY_CURRE NT_USER,Pl acesBar,'p lace1');
edt3.Text := GetRegistryData(HKEY_CURRE NT_USER,Pl acesBar,'p lace2');
edt4.Text := GetRegistryData(HKEY_CURRE NT_USER,Pl acesBar,'p lace3');
edt5.Text := GetRegistryData(HKEY_CURRE NT_USER,Pl acesBar,'p lace4');
end;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.FormShow(Sender: TObject);
begin
if ShowSplashRegardless then
Sleep(1000);
fSplash.Release;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.ApplicationHint(S ender: TObject);
begin
sbmain.Panels[0].Text := (Application.Hint);
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.ButtonClick(Sende r: 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(pidlSe lected, 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,Canva s,edit.Wid th);
Malloc.Free(pidlSelected);
end;
if lblWarning.Visible = False then
lblWarning.Visible := True;
if imgWarning.Visible = False
then imgWarning.Visible := True;
FreeMem(lpbi.pszDisplayNam e);
Malloc.Free(pidlStart);
end;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.Exit1Click(Sender : TObject);
begin
close;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.About1Click(Sende r: 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_CURRE NT_USER, PlacesBar,'place0',rdStrin g,edt1.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place1',rdStrin g,edt2.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place2',rdStrin g,edt3.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place3',rdStrin g,edt4.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place4',rdStrin g,edt5.Tex t);
Close;
end;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.btnResetClick(Sen der: 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(Send er: TObject);
begin
OpenDialog1.Execute;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.btnHelpClick(Send er: TObject);
begin
if not FileExists(HelpFile) then
MessageDlg('Help bestand niet gevonden!', mtInformation, [mbOK],0)
else
begin
Application.HelpFile := HelpFile;
Application.HelpCommand(HE LP_INDEX, 0);
end;
end;
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
{------------------------- ---------- ---------- ---------- ---------- ---------- ---}
procedure TMainfrm.FormCloseQuery(Se nder: 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(Send er: TObject);
begin
if smlFormLangRes1.LangFileNa me = 'Nederlands.ini' then
begin
smlFormLangRes1.LangFileNa me := 'English.ini';
smlMenuLangRes1.LangFileNa me := 'English.ini';
smlMsgLangRes1.LangFileNam e := '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.LangFileNa me = 'English.ini' then
begin
smlFormLangRes1.LangFileNa me := 'Nederlands.ini';
smlMenuLangRes1.LangFileNa me := 'Nederlands.ini';
smlMsgLangRes1.LangFileNam e := '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_CURRE NT_USER, PlacesBar,'place0',rdStrin g,edt1.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place1',rdStrin g,edt2.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place2',rdStrin g,edt3.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place3',rdStrin g,edt4.Tex t);
SetRegistryData(HKEY_CURRE NT_USER, PlacesBar,'place4',rdStrin g,edt5.Tex t);
end;
procedure TMainfrm.FormDestroy(Sende r: TObject);
begin
//
end;
end.
Let me guess...I have to transform my code quite a bit?
Kind regards,
Paul
Btw off for another coffee :)
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:=Mini
end;
end;
{-------------------------
procedure TMainfrm.FormCreate(Sender
begin
if FileExists(ExtractFileDir(
begin
smlFormLangRes1.LangFileNa
smlMenuLangRes1.LangFileNa
smlMsgLangRes1.LangFileNam
Engels1.Checked := True;
Nederlands1.Checked := False;
HelpFile := ExtractFileDir(Application
AboutFile := ExtractFileDir(Application
end
else
begin
smlFormLangRes1.LangFileNa
smlMenuLangRes1.LangFileNa
smlMsgLangRes1.LangFileNam
Nederlands1.Checked := True;
Engels1.Checked := False;
HelpFile := ExtractFileDir(Application
AboutFile := ExtractFileDir(Application
end;
Application.MainForm.Capti
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\Window
Reg := TRegistry.Create(KEY_ALL_A
Reg.RootKey := HKEY_CURRENT_USER;
if not Reg.KeyExists(PlacesBar)th
WinExec('Regedt32.exe /s default.reg', SW_HIDE) else
begin
edt1.Text := GetRegistryData(HKEY_CURRE
edt2.Text := GetRegistryData(HKEY_CURRE
edt3.Text := GetRegistryData(HKEY_CURRE
edt4.Text := GetRegistryData(HKEY_CURRE
edt5.Text := GetRegistryData(HKEY_CURRE
end;
end;
{-------------------------
procedure TMainfrm.FormShow(Sender: TObject);
begin
if ShowSplashRegardless then
Sleep(1000);
fSplash.Release;
end;
{-------------------------
procedure TMainfrm.ApplicationHint(S
begin
sbmain.Panels[0].Text := (Application.Hint);
end;
{-------------------------
{-------------------------
procedure TMainfrm.ButtonClick(Sende
var
lpbi: TBrowseInfo;
pidlStart: PItemIDList;
Malloc: IMalloc;
sFolder: string;
pidlSelected: PItemIDList;
Edit: TEdit;
begin
SHGetSpecialFolderLocation
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(pidlSe
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,Canva
Malloc.Free(pidlSelected);
end;
if lblWarning.Visible = False then
lblWarning.Visible := True;
if imgWarning.Visible = False
then imgWarning.Visible := True;
FreeMem(lpbi.pszDisplayNam
Malloc.Free(pidlStart);
end;
end;
{-------------------------
procedure TMainfrm.Exit1Click(Sender
begin
close;
end;
{-------------------------
procedure TMainfrm.About1Click(Sende
begin
Aboutbox.ShowModal;
end;
{-------------------------
procedure TMainfrm.btnOKClick(Sender
begin
if (mrYes = MessageDlg('Alle wijzigingen worden opgeslagen. Doorgaan?', mtConfirmation, [mbYes, mbNo], 0)) then
begin
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
Close;
end;
end;
{-------------------------
procedure TMainfrm.btnResetClick(Sen
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)
Close;
end;
end;
{-------------------------
procedure TMainfrm.btnTestClick(Send
begin
OpenDialog1.Execute;
end;
{-------------------------
{-------------------------
procedure TMainfrm.btnHelpClick(Send
begin
if not FileExists(HelpFile) then
MessageDlg('Help bestand niet gevonden!', mtInformation, [mbOK],0)
else
begin
Application.HelpFile := HelpFile;
Application.HelpCommand(HE
end;
end;
{-------------------------
{-------------------------
procedure TMainfrm.FormCloseQuery(Se
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(Send
begin
if smlFormLangRes1.LangFileNa
begin
smlFormLangRes1.LangFileNa
smlMenuLangRes1.LangFileNa
smlMsgLangRes1.LangFileNam
Engels1.Checked := True;
Nederlands1.Checked := False;
HelpFile := ExtractFileDir(Application
end;
end;
procedure TMainfrm.Nederlands1Click(
begin
if smlFormLangRes1.LangFileNa
begin
smlFormLangRes1.LangFileNa
smlMenuLangRes1.LangFileNa
smlMsgLangRes1.LangFileNam
Nederlands1.Checked := True;
Engels1.Checked := False;
HelpFile := ExtractFileDir(Application
end;
end;
procedure TMainfrm.FormClose(Sender:
begin
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
SetRegistryData(HKEY_CURRE
end;
procedure TMainfrm.FormDestroy(Sende
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
ASKER
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 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.T ag);
S := FullString^;
Dispose(FullString);
label1.caption := S;
end;
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.T
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
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
ASKER
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(Sende r: 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.
procedure TMainfrm.FormDestroy(Sende
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...
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).Co ntrol:= 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
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).Co
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
ASKER
Hi PierreC!
Thanks for your reply I can hardly wait to test it! Thanks in advance!
Kind regards,
Paul
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(TDl gForm, 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\Window s\CurrentV ersion\Pol icies\ComD lg32\Place sBar';
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:=CanUpda te;
btnDelete.Enabled:=CanDele te;
// Determine selected radio item
bSpecial:=rbSpecial.Checke d;
// Enabled / disable the controls
txtPath.Enabled:=not(bSpec ial);
btnBrowse.Enabled:=not(bSp ecial);
cboSpecial.Enabled:=bSpeci al;
txtPath.Color:=ENABLED_COL ORS[txtPat h.Enabled] ;
cboSpecial.Color:=ENABLED_ COLORS[cbo Special.En abled];
end;
function TDlgForm.CanDelete: Boolean;
begin
// Determine if we can delete an item
result:=not(lbPlaces.ItemI ndex < 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.Ite mIndex < 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.Ite mIndex < 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:=lbPlaces Click;
rbSpecial.OnClick:=rbSpeci alClick;
rbFolder.OnClick:=rbFolder Click;
end;
procedure TDlgForm.UnbindEvents;
begin
// Unbind the event handlers
lbPlaces.OnClick:=nil;
rbSpecial.OnClick:=nil;
rbFolder.OnClick:=nil;
end;
procedure TDlgForm.ClearRegValues(Ke y: 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_ROO T, 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.I tems.Objec ts[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_ROO T, 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[d wIndex];
// 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_ROO T, 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(@l pszBuffer) ^);
// Add the special folder to the list
lbPlaces.Items.AddObject(S pecialName FromID(dwD isp), Pointer(dwDisp));
end
// Check for string value
else if (dwType = REG_SZ) then
// Add folder name to list
lbPlaces.Items.AddObject(l pszBuffer, 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.BeginUpda te;
// Resource protection
try
// Clear the item list
cboSpecial.Items.Clear;
// Walk the special folder array
for dwIndex:=Low(SPECIAL_FOLDE RS) to High(SPECIAL_FOLDERS) do
begin
// Add the speical folder name and pointer to id
cboSpecial.Items.AddObject (SPECIAL_F OLDERS[dwI ndex].Name , Pointer(SPECIAL_FOLDERS[dw Index].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.Ite ms.Objects [Index]);
// Check ID
if (dwID = 0) then
// Set the path
SetEditPath(lbPlaces.Items [Index])
else
// Select the special path
SelectSpecial(Integer(lbPl aces.Items .Objects[I ndex]));
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(Sen der: TObject);
begin
// Set selected
SetSelected(lbPlaces.ItemI ndex);
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.Coun t) do
begin
// Compare ID values
if (Integer(cboSpecial.Items. Objects[dw Index]) = ID) then
begin
// Found the index
dwItem:=dwIndex;
// Done processing
break;
end;
end;
finally
// Set item index
cboSpecial.ItemIndex:=dwIt em;
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(txt Path.Handl e);
// 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(Se nder: TObject);
begin
// Update control state
UpdateState;
end;
procedure TDlgForm.rbFolderClick(Sen der: TObject);
begin
// Update control state
UpdateState;
end;
procedure TDlgForm.btnAddClick(Sende r: 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.I tems.Objec ts[cboSpec ial.ItemIn dex]);
// Add special item
dwAdd:=lbPlaces.Items.AddO bject(Spec ialNameFro mID(dwID), Pointer(dwID));
end
// Check folder
else if (Length(FCached) > 0) then
// Add folder
dwAdd:=lbPlaces.Items.AddO bject(FCac hed, nil)
finally
// Set selected item
SetSelected(dwAdd);
end;
end;
procedure TDlgForm.btnDeleteClick(Se nder: TObject);
begin
// Resource protection
try
// Delete the selected item
if not(lbPlaces.ItemIndex < 0) then lbPlaces.Items.Delete(lbPl aces.ItemI ndex);
finally
// Select first item
SetSelected(0);
end;
end;
procedure TDlgForm.btnUpdateClick(Se nder: TObject);
var dwIndex: Integer;
dwID: Integer;
begin
// Update the selected item
if not(lbPlaces.ItemIndex < 0) then
begin
// Save index
dwIndex:=lbPlaces.ItemInde x;
// Determine if adding a special item of folder
if (rbSpecial.Checked and not(cboSpecial.ItemIndex < 0)) then
begin
// Get special id
dwID:=Integer(cboSpecial.I tems.Objec ts[cboSpec ial.ItemIn dex]);
// Set special item
lbPlaces.Items[dwIndex]:=S pecialName FromID(dwI D);
lbPlaces.Items.Objects[dwI ndex]:=Poi nter(dwID) ;
end
// Check folder
else if (Length(FCached) > 0) then
begin
// Set folder
lbPlaces.Items[dwIndex]:=F Cached;
lbPlaces.Items.Objects[dwI ndex]:=nil ;
end;
end;
end;
procedure TDlgForm.btnSaveClick(Send er: TObject);
begin
// Write the current settings
SaveRegCurrent;
end;
procedure TDlgForm.btnResetClick(Sen der: TObject);
begin
// Resource protection
try
// Write the defaults
SaveRegDefaults;
finally
// Run the init again
InitDialog;
end;
end;
procedure TDlgForm.btnBrowseClick(Se nder: 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(pvMa lloc)) then
begin
// Resource protection
try
// Make sure pidl is ssigned
if Succeeded(SHGetSpecialFold erLocation (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:=pidlSta rt;
lpBrowse.pszDisplayName:=@ lpszFolder ;
lpBrowse.lpszTitle:=@lpszT itle;
lpBrowse.ulFlags:=BIF_RETU RNONLYFSDI RS or BIF_NEWDIALOGSTYLE;
// Browse for folder
pidlContext:=SHBrowseForFo lder(lpBro wse);
// Check result
if Assigned(pidlContext) then
begin
// Resource protection
try
// Get the path from the pidl
if SHGetPathFromIDList(pidlCo ntext, 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.Ob jects[Inde x]) then
// Set to italic underline
Canvas.Font.Style:=[fsBold , fsUnderline, fsItalic]
else
// Normal text
Canvas.Font.Style:=[fsBold ];
// Get minimized name
szItem:=MinimizeName(lbPla ces.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_FOLDE RS) to High(SPECIAL_FOLDERS) do
begin
// ID compare
if (ID = SPECIAL_FOLDERS[dwIndex].I D) then
begin
// Found the desired name
SetString(result, SPECIAL_FOLDERS[dwIndex].N ame, StrLen(SPECIAL_FOLDERS[dwI ndex].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_ITE M, [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
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(TDl
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\Window
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
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:=CanUpda
btnDelete.Enabled:=CanDele
// Determine selected radio item
bSpecial:=rbSpecial.Checke
// Enabled / disable the controls
txtPath.Enabled:=not(bSpec
btnBrowse.Enabled:=not(bSp
cboSpecial.Enabled:=bSpeci
txtPath.Color:=ENABLED_COL
cboSpecial.Color:=ENABLED_
end;
function TDlgForm.CanDelete: Boolean;
begin
// Determine if we can delete an item
result:=not(lbPlaces.ItemI
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.Ite
// 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.Ite
// 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:=lbPlaces
rbSpecial.OnClick:=rbSpeci
rbFolder.OnClick:=rbFolder
end;
procedure TDlgForm.UnbindEvents;
begin
// Unbind the event handlers
lbPlaces.OnClick:=nil;
rbSpecial.OnClick:=nil;
rbFolder.OnClick:=nil;
end;
procedure TDlgForm.ClearRegValues(Ke
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_ROO
begin
// Resource protection
try
// Clear current values
ClearRegValues(hkPlaces);
// Walk the listbox items
for dwIndex:=0 to Pred(lbPlaces.Items.Count)
begin
// Determine item type
dwDisp:=Integer(lbPlaces.I
// 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_ROO
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[d
// 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_ROO
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,
begin
// Check for DWORD type value
if (dwType = REG_DWORD) then
begin
// Get the integer in the buffer
dwDisp:=Integer(Pointer(@l
// Add the special folder to the list
lbPlaces.Items.AddObject(S
end
// Check for string value
else if (dwType = REG_SZ) then
// Add folder name to list
lbPlaces.Items.AddObject(l
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.BeginUpda
// Resource protection
try
// Clear the item list
cboSpecial.Items.Clear;
// Walk the special folder array
for dwIndex:=Low(SPECIAL_FOLDE
begin
// Add the speical folder name and pointer to id
cboSpecial.Items.AddObject
end;
// Set item index
cboSpecial.ItemIndex:=0;
finally
// Unlock
cboSpecial.Items.EndUpdate
end;
end;
procedure TDlgForm.SetSelected(Index
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.Ite
// Check ID
if (dwID = 0) then
// Set the path
SetEditPath(lbPlaces.Items
else
// Select the special path
SelectSpecial(Integer(lbPl
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(Sen
begin
// Set selected
SetSelected(lbPlaces.ItemI
end;
procedure TDlgForm.SelectSpecial(ID:
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.Coun
begin
// Compare ID values
if (Integer(cboSpecial.Items.
begin
// Found the index
dwItem:=dwIndex;
// Done processing
break;
end;
end;
finally
// Set item index
cboSpecial.ItemIndex:=dwIt
end;
end;
end;
procedure TDlgForm.SetEditPath(Path:
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(txt
// Resource protection
try
// Update the edit control
txtPath.Text:=MinimizeName
finally
// Release the handle
ReleaseDC(txtPath.Handle, lpCanvas.Handle);
end;
finally
// Free the canvas
lpCanvas.Free;
end;
end;
procedure TDlgForm.rbSpecialClick(Se
begin
// Update control state
UpdateState;
end;
procedure TDlgForm.rbFolderClick(Sen
begin
// Update control state
UpdateState;
end;
procedure TDlgForm.btnAddClick(Sende
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.I
// Add special item
dwAdd:=lbPlaces.Items.AddO
end
// Check folder
else if (Length(FCached) > 0) then
// Add folder
dwAdd:=lbPlaces.Items.AddO
finally
// Set selected item
SetSelected(dwAdd);
end;
end;
procedure TDlgForm.btnDeleteClick(Se
begin
// Resource protection
try
// Delete the selected item
if not(lbPlaces.ItemIndex < 0) then lbPlaces.Items.Delete(lbPl
finally
// Select first item
SetSelected(0);
end;
end;
procedure TDlgForm.btnUpdateClick(Se
var dwIndex: Integer;
dwID: Integer;
begin
// Update the selected item
if not(lbPlaces.ItemIndex < 0) then
begin
// Save index
dwIndex:=lbPlaces.ItemInde
// Determine if adding a special item of folder
if (rbSpecial.Checked and not(cboSpecial.ItemIndex < 0)) then
begin
// Get special id
dwID:=Integer(cboSpecial.I
// Set special item
lbPlaces.Items[dwIndex]:=S
lbPlaces.Items.Objects[dwI
end
// Check folder
else if (Length(FCached) > 0) then
begin
// Set folder
lbPlaces.Items[dwIndex]:=F
lbPlaces.Items.Objects[dwI
end;
end;
end;
procedure TDlgForm.btnSaveClick(Send
begin
// Write the current settings
SaveRegCurrent;
end;
procedure TDlgForm.btnResetClick(Sen
begin
// Resource protection
try
// Write the defaults
SaveRegDefaults;
finally
// Run the init again
InitDialog;
end;
end;
procedure TDlgForm.btnBrowseClick(Se
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(pvMa
begin
// Resource protection
try
// Make sure pidl is ssigned
if Succeeded(SHGetSpecialFold
begin
// Resource protection
try
// Clear buffers
ZeroMemory(@lpBrowse, SizeOf(lpBrowse));
ZeroMemory(@lpszFolder, SizeOf(lpszFolder));
// Set params
lpBrowse.hwndOwner:=Handle
lpBrowse.pidlRoot:=pidlSta
lpBrowse.pszDisplayName:=@
lpBrowse.lpszTitle:=@lpszT
lpBrowse.ulFlags:=BIF_RETU
// Browse for folder
pidlContext:=SHBrowseForFo
// Check result
if Assigned(pidlContext) then
begin
// Resource protection
try
// Get the path from the pidl
if SHGetPathFromIDList(pidlCo
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:
begin
// Save curren values
SaveRegCurrent;
end;
procedure TDlgForm.lbPlacesDrawItem(
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.Ob
// Set to italic underline
Canvas.Font.Style:=[fsBold
else
// Normal text
Canvas.Font.Style:=[fsBold
// Get minimized name
szItem:=MinimizeName(lbPla
// 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_FOLDE
begin
// ID compare
if (ID = SPECIAL_FOLDERS[dwIndex].I
begin
// Found the desired name
SetString(result, SPECIAL_FOLDERS[dwIndex].N
// Done processing
break;
end;
end;
finally
// Check result, use formatted special folder result for unknown items
if (Length(result) = 0) then result:=Format(SPECIAL_ITE
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
ASKER
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?
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?
ASKER
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 :-)
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_DESKTOPDIRECT ORY = $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_COMMON X86 = $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;
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_DESKTOPDIRECT
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
CSIDL_PROGRAM_FILES_COMMON
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;
ASKER
Awesome!
Kind regards,
Paul : - )
Kind regards,
Paul : - )
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:=Mini
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
end;
end;
procedure TForm1.FormDestroy(Sender:
begin
// Free the path list
FPaths.Free;
end;
end.