Forum > Windows (32/64)
Dialogs and Windows PE
atasoft:
Hi,
I am trying to write a program to select disk drive and path.
I use the dialog TSelectDirectoryDialog. The program works OK on Windows 10/11 but when I run it on Windows PE I get error: Access violation.
I found on the internet another solution using code to open a dialog. It works OK on Windows 10/11 but on Windows PE it shows the dialog with buttons without the drives and paths.
(Lazarus version 2.2.6 FPC Version 3.2.2)
(Project Options: Execution level: required Administrator, Win32 GUI Application
Can any one help me.
Thank you in advance.
Andreas
Code:
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Windows, ShlObj;
type
{ TMainForm }
TMainForm = class(TForm)
btnSelectPath: TButton;
btnSelectPath_Dlg: TButton;
edtPath: TEdit;
lblPath: TLabel;
SelectDirectoryDialog1: TSelectDirectoryDialog;
procedure btnSelectPathClick(Sender: TObject);
procedure btnSelectPath_DlgClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;
var
PathName: array [0..MAX_PATH] of Char;
begin
case uMsg of
BFFM_INITIALIZED: SendMessage(hwnd, BFFM_SETSELECTION, 1, lpData);
BFFM_SELCHANGED:
begin
SHGetPathFromIDList(PItemIDList(lParam), @PathName);
//SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, LPARAM(PathName));
SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, LPARAM);
end;
end;
Result := 0;
end;
procedure TMainForm.btnSelectPathClick(Sender: TObject);
var
bi: TBrowseInfo;
pidl: PItemIDList;
PathName: array [0..MAX_PATH] of Char;
begin
FillChar(bi, SizeOf(TBrowseInfo), 0);
bi.hwndOwner := Self.Handle;
bi.pszDisplayName := @PathName;
bi.lpszTitle := 'Select a folder';
bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
bi.lpfn := @BrowseCallbackProc;
bi.lParam := LPARAM(PChar(edtPath.Text));
pidl := SHBrowseForFolder(bi);
if pidl <> nil then
begin
if SHGetPathFromIDList(pidl, @PathName) then
edtPath.Text := PathName;
//CoTaskMemFree(pidl);
end;
end;
procedure TMainForm.btnSelectPath_DlgClick(Sender: TObject);
var
DirName: String;
begin
SelectDirectoryDialog1.Execute;
DirName:=SelectDirectoryDialog1.FileName;
//SaveDialog1.Execute;
//DirName:=SaveDialog1.FileName;
edtPath.Text:=DirName;
end;
end.
Bart:
As a workaround, you can use old style dialogs (you get the Win9x look for these dialogs then IIRC).
There is a similar issue in the bugtracker, but this concerns Windowqs RE.
As it turns out there the shell isn't available and Vista dilaogs either won't work or give AV's.
On Windows RE, it works well if you compile with -dDisableVistaDialogs.
The XP-style dialogs will be used then.
In the mentioned issue there is also a proposal to implement a fallback for such cases, sou you might try to apply that.
Bart
atasoft:
Thank you very much Bart. TOpenDialog and TSaveDialog is working on Windows PE changing the options to old style dialog. TSelectDirectoryDialog does NOT work.
Solution:
procedure TMainForm.btnSaveDlgClick(Sender: TObject);
var
FileName: String;
sd: TSaveDialog;
begin
sd := TSaveDialog.Create(Self);
sd.Options := [ofOldStyleDialog]; // Set old style dialog to avoid Access Violation under Windows PE
try
if not sd.Execute then Exit; // Access Violation under Windows PE
FileName:=sd.FileName;
edtPath.Text:=FileName;
finally
sd.Free;
end;
end;
KodeZwerg:
--- Quote from: atasoft on March 05, 2024, 08:43:06 am ---The program works OK on Windows 10/11 but when I run it on Windows PE I get error: Access violation.
--- End quote ---
While debugging, on what line the AV happen? I dont got Windows PE but I guess it has to do with Icon reading or cache writing.
atasoft:
--- Quote from: KodeZwerg on March 05, 2024, 02:34:20 pm ---
--- Quote from: atasoft on March 05, 2024, 08:43:06 am ---The program works OK on Windows 10/11 but when I run it on Windows PE I get error: Access violation.
--- End quote ---
While debugging, on what line the AV happen? I dont got Windows PE but I guess it has to do with Icon reading or cache writing.
--- End quote ---
I develop the application on Windows 10 and I just check it on Windows PE therefore I don't know exactly where is the problem.
Navigation
[0] Message Index
[#] Next page