summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/corelib/gdi/gfx_gdi.pas32
-rw-r--r--src/corelib/gdi/gfx_utils_impl.inc35
-rw-r--r--src/corelib/gfx_utils.pas46
-rw-r--r--src/corelib/gfxbase.pas29
-rw-r--r--src/corelib/x11/gfx_utils_impl.inc31
-rw-r--r--src/corelib/x11/gfx_x11.pas43
-rw-r--r--src/gui/gui_dialogs.pas15
-rw-r--r--src/gui/gui_grid.pas2
8 files changed, 150 insertions, 83 deletions
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index e785c1e2..66090c92 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -135,8 +135,6 @@ type
end;
- { TfpgWindowImpl }
-
TfpgWindowImpl = class(TfpgWindowBase)
private
FMouseInWindow: boolean;
@@ -194,6 +192,9 @@ type
procedure DoFlush;
function GetScreenWidth: TfpgCoord; override;
function GetScreenHeight: TfpgCoord; override;
+ function Screen_dpi_x: integer; override;
+ function Screen_dpi_y: integer; override;
+ function Screen_dpi: integer; override;
property Display: HDC read FDisplay;
end;
@@ -207,12 +208,11 @@ type
end;
- { TfpgFileListImpl }
-
TfpgFileListImpl = class(TfpgFileListBase)
procedure PopulateSpecialDirs(const aDirectory: TfpgString); override;
end;
+
implementation
uses
@@ -1015,6 +1015,21 @@ begin
Result := r.Bottom - r.Top;
end;
+function TfpgApplicationImpl.Screen_dpi_x: integer;
+begin
+ Result := 96;
+end;
+
+function TfpgApplicationImpl.Screen_dpi_y: integer;
+begin
+ Result := 96;
+end;
+
+function TfpgApplicationImpl.Screen_dpi: integer;
+begin
+ Result := 96;
+end;
+
{ TfpgWindowImpl }
var
// these are required for Windows MouseEnter & MouseExit detection.
@@ -2013,6 +2028,8 @@ end;
{ TfpgFileListImpl }
procedure TfpgFileListImpl.PopulateSpecialDirs(const aDirectory: TfpgString);
+const
+ MAX_DRIVES = 25;
var
n: integer;
drvs: string;
@@ -2023,15 +2040,12 @@ begin
if Copy(aDirectory, 2, 1) = ':' then
begin
n := 0;
- { TODO: replace 25 with a constant: max nested directories displayed }
- while n <= 25 do
+ while n <= MAX_DRIVES do
begin
drvs := chr(n+ord('A'))+':\';
if Windows.GetDriveType(PChar(drvs)) <> 1 then
begin
- // vvzh: to avoid doubling of drive letters in inherited UpdateDirectory
- if Pos(drvs, aDirectory) <> 1 then
- FSpecialDirs.Add(drvs);
+ FSpecialDirs.Add(drvs);
end;
inc(n);
end;
diff --git a/src/corelib/gdi/gfx_utils_impl.inc b/src/corelib/gdi/gfx_utils_impl.inc
index 2597d977..c8b264e1 100644
--- a/src/corelib/gdi/gfx_utils_impl.inc
+++ b/src/corelib/gdi/gfx_utils_impl.inc
@@ -1,39 +1,14 @@
{%mainunit gfx_utils.pas}
-// GDI specific implementations of RTL wrapper functions
+// GDI specific implementations of encoding functions
-function fpgFindFirst(const Path: TfpgString; Attr: Longint; out
- Rslt: TSearchRec): Longint;
+function fpgToOSEncoding(aString: TfpgString): string;
begin
- Result := FindFirst(Utf8ToAnsi(Path), Attr, Rslt);
- Rslt.Name := AnsiToUtf8(Rslt.Name);
+ Result := Utf8ToAnsi(aString);
end;
-function fpgFindNext(var Rslt: TSearchRec): Longint;
+function fpgFromOSEncoding(aString: string): TfpgString;
begin
- Result := FindNext(Rslt);
- Rslt.Name := AnsiToUtf8(Rslt.Name);
+ Result := AnsiToUtf8(aString);
end;
-function fpgGetCurrentDir: TfpgString;
-begin
- Result := AnsiToUtf8(GetCurrentDir);
-end;
-
-function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
-begin
- Result := SetCurrentDir(Utf8ToAnsi(NewDir));
-end;
-
-function fpgExpandFileName(const FileName: TfpgString): TfpgString;
-begin
- Result := AnsiToUtf8(ExpandFileName(Utf8ToAnsi(FileName)));
-end;
-
-function fpgFileExists(const FileName: TfpgString): Boolean;
-begin
- Result := FileExists(Utf8ToAnsi(FileName));
-end;
-
-
-
diff --git a/src/corelib/gfx_utils.pas b/src/corelib/gfx_utils.pas
index 584c888b..6dfa2d2d 100644
--- a/src/corelib/gfx_utils.pas
+++ b/src/corelib/gfx_utils.pas
@@ -6,11 +6,16 @@ interface
uses
Classes, SysUtils, gfxbase;
-
+
+// Platform specific encoding handling functions
+function fpgToOSEncoding(aString: TfpgString): string;
+function fpgFromOSEncoding(aString: string): TfpgString;
+
// Common functions for all platforms
function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: boolean = true): TfpgString;
-// RTL wrapper filesystem functions with platform specific encodings
+// RTL wrapper filesystem functions with platform independant encoding
+// These functions are common for all platforms and rely on fpgXXXPlatformEncoding
function fpgFindFirst(const Path: TfpgString; Attr: Longint; out Rslt: TSearchRec): Longint;
function fpgFindNext(var Rslt: TSearchRec): Longint;
@@ -34,7 +39,7 @@ function fpgFileExists(const FileName: TfpgString): Boolean;
implementation
-// RTL wrapper filesystem functions with platform specific encodings
+// Platform specific encoding handling functions
{$I gfx_utils_impl.inc}
@@ -59,6 +64,41 @@ begin
result := ALine;
end;
+// RTL wrapper filesystem functions
+
+function fpgFindFirst(const Path: TfpgString; Attr: Longint; out
+ Rslt: TSearchRec): Longint;
+begin
+ Result := FindFirst(fpgToOSEncoding(Path), Attr, Rslt);
+ Rslt.Name := fpgFromOSEncoding(Rslt.Name);
+end;
+
+function fpgFindNext(var Rslt: TSearchRec): Longint;
+begin
+ Result := FindNext(Rslt);
+ Rslt.Name := fpgFromOSEncoding(Rslt.Name);
+end;
+
+function fpgGetCurrentDir: TfpgString;
+begin
+ Result := fpgFromOSEncoding(GetCurrentDir);
+end;
+
+function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
+begin
+ Result := SetCurrentDir(fpgToOSEncoding(NewDir));
+end;
+
+function fpgExpandFileName(const FileName: TfpgString): TfpgString;
+begin
+ Result := fpgFromOSEncoding(ExpandFileName(fpgToOSEncoding(FileName)));
+end;
+
+function fpgFileExists(const FileName: TfpgString): Boolean;
+begin
+ Result := FileExists(fpgToOSEncoding(FileName));
+end;
+
end.
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 0fa7dfeb..fadde046 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -398,6 +398,9 @@ type
procedure CreateForm(AFormClass: TComponentClass; var AForm: TfpgWindowBase);
function GetScreenWidth: TfpgCoord; virtual; abstract;
function GetScreenHeight: TfpgCoord; virtual; abstract;
+ function Screen_dpi_x: integer; virtual; abstract;
+ function Screen_dpi_y: integer; virtual; abstract;
+ function Screen_dpi: integer; virtual; abstract;
property IsInitialized: boolean read FIsInitialized;
property TopModalForm: TfpgWindowBase read GetTopModalForm;
property MainForm: TfpgWindowBase read FMainForm write FMainForm;
@@ -1902,29 +1905,32 @@ end;
procedure TfpgFileListBase.PopulateSpecialDirs(const aDirectory: TfpgString);
{Sets up FSpecialDirs list}
var
- i, n: integer;
- rootadd: integer;
+ i, n, sp: integer;
begin
// find insert position
i := 0;
while (i < FSpecialDirs.Count)
- and (FSpecialDirs.Strings[i][1] <= aDirectory[1]) do
- inc(i);
+ and (FSpecialDirs.Strings[i][1] < aDirectory[1]) do
+ Inc(i);
- n := 1;
- rootadd := 1;
+ sp := Pos(DirectorySeparator, aDirectory) + 1;
+ n := sp;
while n < Length(aDirectory) do
begin
if aDirectory[n] = DirectorySeparator then
begin
- FSpecialDirs.Insert(i, Copy(aDirectory, 1, n-1+rootadd));
- rootadd := 0;
- inc(i);
+ Inc(i);
+ FSpecialDirs.Insert(i, Copy(aDirectory, 1, n-1));
end;
- inc(n);
+ Inc(n);
end;
- FSpecialDirs.Insert(i, ExcludeTrailingPathDelimiter(aDirectory));
+ if (n > sp) then
+ begin
+ Inc(i);
+ FSpecialDirs.Insert(i, ExcludeTrailingPathDelimiter(aDirectory))
+ end;
+
FCurrentSpecialDir := i;
end;
@@ -1959,6 +1965,7 @@ var
SearchRec: TSearchRec;
dir: TfpgString; // to prevent FDirectoryName from having incorrect value
begin
+ writeln(aDirectory);
// default parameter value is current directory
if aDirectory <> '' then
dir := fpgExpandFileName(aDirectory)
diff --git a/src/corelib/x11/gfx_utils_impl.inc b/src/corelib/x11/gfx_utils_impl.inc
index 607579cf..0f341df4 100644
--- a/src/corelib/x11/gfx_utils_impl.inc
+++ b/src/corelib/x11/gfx_utils_impl.inc
@@ -1,36 +1,15 @@
{%mainunit gfx_utils.pas}
-// X11 specific filesystem implementations of RTL wrapper functions
+// X11 specific filesystem implementations of encoding functions
-function fpgFindFirst(const Path: TfpgString; Attr: Longint; out
- Rslt: TSearchRec): Longint;
+function fpgToOSEncoding(aString: TfpgString): string;
begin
- Result := FindFirst(Path, Attr, Rslt);
+ Result := aString;
end;
-function fpgFindNext(var Rslt: TSearchRec): Longint;
+function fpgFromOSEncoding(aString: string): TfpgString;
begin
- Result := FindNext(Rslt);
-end;
-
-function fpgGetCurrentDir: TfpgString;
-begin
- Result := GetCurrentDir;
-end;
-
-function fpgSetCurrentDir(const NewDir: TfpgString): Boolean;
-begin
- Result := SetCurrentDir(NewDir);
-end;
-
-function fpgExpandFileName(const FileName: TfpgString): TfpgString;
-begin
- Result := ExpandFileName(FileName);
-end;
-
-function fpgFileExists(const FileName: TfpgString): Boolean;
-begin
- Result := FileExists(FileName);
+ Result := aString;
end;
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index 60bba3d1..b693b3ce 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -196,6 +196,9 @@ type
procedure DoFlush;
function GetScreenWidth: TfpgCoord; override;
function GetScreenHeight: TfpgCoord; override;
+ function Screen_dpi_x: integer; override;
+ function Screen_dpi_y: integer; override;
+ function Screen_dpi: integer; override;
property Display: PXDisplay read FDisplay;
property RootWindow: TfpgWinHandle read FRootWindow;
end;
@@ -217,12 +220,13 @@ type
procedure PopulateSpecialDirs(const aDirectory: TfpgString); override;
end;
+
implementation
uses
baseunix,
fpgfx,
- gfx_widget, {$Note This dependency to gfx_widget must be removed.}
+ gfx_widget,
gui_form, // remove this!!!!!
cursorfont,
gfx_popupwindow,
@@ -1215,6 +1219,42 @@ begin
Result := wa.Height;
end;
+function TfpgApplicationImpl.Screen_dpi_x: integer;
+var
+ mm: integer;
+begin
+ // 25.4 is millimeters per inch
+ mm := 0;
+ mm := DisplayWidthMM(Display, DefaultScreen);
+ if mm > 0 then
+ Result := Round((GetScreenWidth * 25.4) / mm)
+ else
+ Result := 96; // seems to be a well known default. :-(
+end;
+
+function TfpgApplicationImpl.Screen_dpi_y: integer;
+var
+ mm: integer;
+begin
+ // 25.4 is millimeters per inch
+ mm := 0;
+ mm := DisplayHeightMM(Display, DefaultScreen);
+ if mm > 0 then
+ Result := Round((GetScreenHeight * 25.4) / mm)
+ else
+ Result := Screen_dpi_x; // same as width
+end;
+
+function TfpgApplicationImpl.Screen_dpi: integer;
+begin
+ Result := Screen_dpi_y;
+ {$IFDEF DEBUG}
+ writeln('Display width in mm: ', DisplayWidthMM(Display, DefaultScreen));
+ writeln('Display height in mm: ', DisplayHeightMM(Display, DefaultScreen));
+ writeln('Display dpi: ', Result);
+ {$ENDIF}
+end;
+
{ TfpgWindowImpl }
procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase);
@@ -2116,6 +2156,7 @@ var
ds: string;
begin
FSpecialDirs.Clear;
+ FSpecialDirs.Add(DirectorySeparator); // add root
ds := aDirectory;
if Copy(ds, 1, 1) <> DirectorySeparator then
diff --git a/src/gui/gui_dialogs.pas b/src/gui/gui_dialogs.pas
index 9d8836cc..46c8acd9 100644
--- a/src/gui/gui_dialogs.pas
+++ b/src/gui/gui_dialogs.pas
@@ -1044,8 +1044,11 @@ begin
ActiveWidget := grid;
FileName := '';
- Filter := rsAllFiles + ' (*)|*';
+ SetFilter(rsAllFiles + ' (*)|*');
+ // we don't want chlFilter to call FilterChange
+ chlFilter.OnChange := nil;
chlFilter.FocusItem := 1;
+ chlFilter.OnChange := @FilterChange; // restore event handler
end;
procedure TfpgFileDialog.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
@@ -1202,9 +1205,12 @@ begin
end;
grid.FileList.Sort(soFileName);
-
+
+ // we don't want chlDir to call DirChange while populating items
+ chlDir.OnChange := nil;
chlDir.Items.Assign(grid.FileList.SpecialDirs);
chlDir.FocusItem := grid.FileList.CurrentSpecialDir + 1;
+ chlDir.OnChange := @DirChange; // restore event handler
if fsel <> '' then
SelectFile(fsel)
@@ -1238,10 +1244,11 @@ var
fs: string;
fm: string;
begin
+ // we don't want chlFilter to call FilterChange while populating items
+ chlFilter.OnChange := nil;
s := FFilter;
FFilterList.Clear;
chlFilter.Items.Clear;
-
repeat
fs := '';
fm := '';
@@ -1269,6 +1276,8 @@ begin
FFilterList.Add(fm);
end;
until (fs = '') or (fm = ''); { repeat/until }
+ // restore event handler
+ chlFilter.OnChange := @FilterChange;
end;
function TfpgFileDialog.GetFileFilter: string;
diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas
index 326789e3..90d8d04b 100644
--- a/src/gui/gui_grid.pas
+++ b/src/gui/gui_grid.pas
@@ -67,6 +67,8 @@ type
end;
}
+ { TfpgFileGrid }
+
TfpgFileGrid = class(TfpgCustomGrid)
private
FFileList: TfpgFileList;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-16 22:36:40 +0000