paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-13 09:29:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial/visualtest: Fix usage of image directory in macOS.

Browse Source
This commit is contained in:
wp_xyz 2023-01-23 20:00:42 +01:00
parent ebcffd6ca1
commit f26def2c25
3 changed files with 65 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpvectorial/tests/visualtest.lpi
View File

@ -11,6 +11,7 @@
<Title Value="visualtest"/> <Title Value="visualtest"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<Icon Value="0"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>

76
components/fpvectorial/tests/vtmain.lfm
View File

@ -1,33 +1,34 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 324 Left = 324
Height = 717 Height = 700
Top = 125 Top = 125
Width = 905 Width = 900
Caption = 'Visual fpvectorial test' Caption = 'Visual fpvectorial test'
ClientHeight = 717 ClientHeight = 700
ClientWidth = 905 ClientWidth = 900
OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
ShowHint = True ShowHint = True
LCLVersion = '2.3.0.0' LCLVersion = '2.3.0.0'
object GbTree: TGroupBox object GbTree: TGroupBox
Left = 8 Left = 8
Height = 701 Height = 684
Top = 8 Top = 8
Width = 336 Width = 299
Align = alClient Align = alClient
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Test shapes and objects' Caption = 'Test shapes and objects'
ClientHeight = 681 ClientHeight = 664
ClientWidth = 332 ClientWidth = 295
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
object Tree: TTreeView object Tree: TTreeView
Left = 6 Left = 6
Height = 669 Height = 652
Top = 6 Top = 6
Width = 320 Width = 283
Align = alClient Align = alClient
BorderSpacing.Around = 6 BorderSpacing.Around = 6
HideSelection = False HideSelection = False
@ -44,12 +45,12 @@ object MainForm: TMainForm
end end
end end
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 352 Left = 315
Height = 717 Height = 700
Top = 0 Top = 0
Width = 553 Width = 577
HorzScrollBar.Increment = 55 HorzScrollBar.Increment = 56
HorzScrollBar.Page = 553 HorzScrollBar.Page = 564
HorzScrollBar.Smooth = True HorzScrollBar.Smooth = True
HorzScrollBar.Tracking = True HorzScrollBar.Tracking = True
VertScrollBar.Increment = 69 VertScrollBar.Increment = 69
@ -57,23 +58,23 @@ object MainForm: TMainForm
VertScrollBar.Smooth = True VertScrollBar.Smooth = True
VertScrollBar.Tracking = True VertScrollBar.Tracking = True
Align = alRight Align = alRight
BorderSpacing.Right = 8
BorderStyle = bsNone BorderStyle = bsNone
ClientHeight = 717 ClientHeight = 700
ClientWidth = 553 ClientWidth = 577
TabOrder = 1 TabOrder = 1
object AllTestsPanel: TPanel object AllTestsPanel: TPanel
Left = 4 Left = 4
Height = 683 Height = 683
Top = 8 Top = 8
Width = 537 Width = 569
Align = alTop Align = alTop
AutoSize = True AutoSize = True
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 683 ClientHeight = 683
ClientWidth = 537 ClientWidth = 569
TabOrder = 0 TabOrder = 0
object gbRenderTest: TGroupBox object gbRenderTest: TGroupBox
AnchorSideLeft.Control = AllTestsPanel AnchorSideLeft.Control = AllTestsPanel
@ -81,13 +82,13 @@ object MainForm: TMainForm
Left = 0 Left = 0
Height = 284 Height = 284
Top = 0 Top = 0
Width = 256 Width = 288
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Right = 31 BorderSpacing.Right = 31
Caption = 'Render test' Caption = 'Render test'
ClientHeight = 264 ClientHeight = 264
ClientWidth = 252 ClientWidth = 284
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
@ -95,7 +96,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 30 Height = 30
Top = 2 Top = 2
Width = 240 Width = 272
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -109,7 +110,7 @@ object MainForm: TMainForm
Left = 16 Left = 16
Height = 15 Height = 15
Top = 36 Top = 36
Width = 232 Width = 264
Align = alTop Align = alTop
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -123,7 +124,7 @@ object MainForm: TMainForm
Left = 16 Left = 16
Height = 15 Height = 15
Top = 55 Top = 55
Width = 232 Width = 264
Align = alTop Align = alTop
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -137,7 +138,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 15 Height = 15
Top = 74 Top = 74
Width = 240 Width = 272
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -223,7 +224,8 @@ object MainForm: TMainForm
Left = 16 Left = 16
Height = 25 Height = 25
Top = 97 Top = 97
Width = 75 Width = 81
AutoSize = True
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
@ -240,7 +242,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = gbRenderTest AnchorSideBottom.Control = gbRenderTest
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 287 Left = 319
Height = 284 Height = 284
Top = 0 Top = 0
Width = 250 Width = 250
@ -335,13 +337,13 @@ object MainForm: TMainForm
Left = 0 Left = 0
Height = 312 Height = 312
Top = 300 Top = 300
Width = 537 Width = 569
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Read/write test' Caption = 'Read/write test'
ClientHeight = 292 ClientHeight = 292
ClientWidth = 533 ClientWidth = 565
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 2 TabOrder = 2
@ -349,7 +351,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 15 Height = 15
Top = 2 Top = 2
Width = 517 Width = 549
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -363,7 +365,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 45 Height = 45
Top = 72 Top = 72
Width = 517 Width = 549
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -425,7 +427,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 30 Height = 30
Top = 19 Top = 19
Width = 517 Width = 549
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -439,7 +441,7 @@ object MainForm: TMainForm
Left = 8 Left = 8
Height = 15 Height = 15
Top = 53 Top = 53
Width = 521 Width = 553
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -492,7 +494,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = gbReadWriteTest AnchorSideRight.Control = gbReadWriteTest
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 436 Left = 468
Height = 25 Height = 25
Top = 124 Top = 124
Width = 89 Width = 89
@ -564,13 +566,13 @@ object MainForm: TMainForm
Left = 0 Left = 0
Height = 55 Height = 55
Top = 628 Top = 628
Width = 537 Width = 569
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Test results' Caption = 'Test results'
ClientHeight = 35 ClientHeight = 35
ClientWidth = 533 ClientWidth = 565
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 3 TabOrder = 3

35
components/fpvectorial/tests/vtmain.pas
View File

@ -80,6 +80,7 @@ type
procedure BtnSaveAsRefClick(Sender: TObject); procedure BtnSaveAsRefClick(Sender: TObject);
procedure BtnViewImageClick(Sender: TObject); procedure BtnViewImageClick(Sender: TObject);
procedure CbFileFormatChange(Sender: TObject); procedure CbFileFormatChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure PaintBoxPaint(Sender: TObject); procedure PaintBoxPaint(Sender: TObject);
@ -97,8 +98,10 @@ type
FDocFromWMF: array[TRenderCoords] of TvVectorialDocument; FDocFromWMF: array[TRenderCoords] of TvVectorialDocument;
FDocFromSVG: array[TRenderCoords] of TvVectorialDocument; FDocFromSVG: array[TRenderCoords] of TvVectorialDocument;
FLockResults: Integer; FLockResults: Integer;
function GetFileFormat: TvVectorialFormat; function GetFileFormat: TvVectorialFormat;
function GetFileFormatExt: String; function GetFileFormatExt: String;
function GetImagesFolder(AFileType: String = ''): String;
procedure Populate; procedure Populate;
procedure PrepareDoc(var ADoc: TvVectorialDocument; var APage: TvVectorialPage; procedure PrepareDoc(var ADoc: TvVectorialDocument; var APage: TvVectorialPage;
AUseTopLeftCoords: boolean); AUseTopLeftCoords: boolean);
@ -153,8 +156,8 @@ uses
fpvutils, vtprimitives; fpvutils, vtprimitives;
const const
IMG_FOLDER = 'images' + PathDelim; IMG_FOLDER = 'images';
REFIMG_FOLDER = IMG_FOLDER + 'ref' + PathDelim; REF_FOLDER = 'ref';
NOT_SAVED = '(not saved)'; NOT_SAVED = '(not saved)';
FORMAT_SEPARATOR = ';'; FORMAT_SEPARATOR = ';';
@ -222,9 +225,9 @@ begin
png := TPortableNetworkGraphic.Create; png := TPortableNetworkGraphic.Create;
try try
png.Assign(bmp); png.Assign(bmp);
// renderParams := TRenderParams(Tree.Selected.Data); fn := GetImagesFolder(REF_FOLDER);
ForceDirectory(REFIMG_FOLDER); ForceDirectory(fn);
fn := REFIMG_FOLDER + renderParams.RefFile; fn := fn + renderParams.RefFile;
png.SaveToFile(fn); png.SaveToFile(fn);
finally finally
png.Free; png.Free;
@ -250,7 +253,7 @@ begin
fmt := GetFileFormat; fmt := GetFileFormat;
ext := GetFileFormatExt; ext := GetFileFormatExt;
folder := IMG_FOLDER + ext + PathDelim; folder := GetImagesFolder(ext);
ForceDirectory(folder); ForceDirectory(folder);
if FDoc[rcBottomLeftCoords] <> nil then begin if FDoc[rcBottomLeftCoords] <> nil then begin
@ -282,7 +285,7 @@ begin
exit; exit;
ext := GetFileFormatExt; ext := GetFileFormatExt;
folder := IMG_FOLDER + ext + PathDelim; folder := GetImagesFolder(ext);
if Sender = BtnViewBottomLeft then if Sender = BtnViewBottomLeft then
fn := folder + 'bl_' + ChangeFileExt(renderParams.RefFile, '.' + ext) fn := folder + 'bl_' + ChangeFileExt(renderParams.RefFile, '.' + ext)
@ -303,6 +306,11 @@ begin
UpdateTestResults; UpdateTestResults;
end; end;
procedure TMainForm.FormActivate(Sender: TObject);
begin
Scrollbox1.ClientWidth := AllTestsPanel.Width + 2*AllTestsPanel.BorderSpacing.Around;
end;
procedure TMainForm.PrepareDoc(var ADoc: TvVectorialDocument; procedure TMainForm.PrepareDoc(var ADoc: TvVectorialDocument;
var APage: TvVectorialPage; AUseTopLeftCoords: boolean); var APage: TvVectorialPage; AUseTopLeftCoords: boolean);
var var
@ -385,6 +393,13 @@ begin
end; end;
end; end;
function TMainForm.GetImagesFolder(AFileType: String = ''): String;
begin
Result := IncludeTrailingPathDelimiter(Application.Location + IMG_FOLDER);
if AFileType <> '' then
Result := IncludeTrailingPathDelimiter(Result + AFileType);
end;
procedure TMainForm.PaintBoxPaint(Sender: TObject); procedure TMainForm.PaintBoxPaint(Sender: TObject);
var var
doc: TvVectorialDocument; doc: TvVectorialDocument;
@ -1085,7 +1100,7 @@ begin
exit; exit;
end; end;
fn := IncludeTrailingPathDelimiter(REFIMG_FOLDER) + renderParams.RefFile; fn := GetImagesFolder(REF_FOLDER) + renderParams.RefFile;
if FileExists(fn) then begin if FileExists(fn) then begin
RefImage.Picture.LoadFromFile(fn); RefImage.Picture.LoadFromFile(fn);
RefImage.Hint := fn; RefImage.Hint := fn;
@ -1147,7 +1162,7 @@ begin
end; end;
ext := GetFileFormatExt; ext := GetFileFormatExt;
folder := IMG_FOLDER + ext + PathDelim; folder := GetImagesFolder(ext);
fn := folder + 'bl_' + ChangeFileExt(renderParams.RefFile, '.' + ext); fn := folder + 'bl_' + ChangeFileExt(renderParams.RefFile, '.' + ext);
ShowFileImage(fn, false, WRBottomLeftPaintbox); ShowFileImage(fn, false, WRBottomLeftPaintbox);
@ -1222,7 +1237,7 @@ begin
renderParams := TRenderParams(Tree.Selected.Data); renderParams := TRenderParams(Tree.Selected.Data);
if renderParams <> nil then begin if renderParams <> nil then begin
ext := GetFileFormatExt; ext := GetFileFormatExt;
folder := IMG_FOLDER + ext + PathDelim; folder := GetImagesFolder(ext);
fn := folder + 'bl_' + ChangeFileExt(renderParams.RefFile, '.' + ext); fn := folder + 'bl_' + ChangeFileExt(renderParams.RefFile, '.' + ext);
rcOK[rcBottomLeftCoords] := FileExists(fn); rcOK[rcBottomLeftCoords] := FileExists(fn);
fn := folder + 'tl_' + ChangeFileExt(renderParams.RefFile, '.' + ext); fn := folder + 'tl_' + ChangeFileExt(renderParams.RefFile, '.' + ext);