paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-23 21:26:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

Examples: Fix demo fontenum ignoring some user input (http://forum.lazarus.freepascal.org/index.php/topic,36839.0.html)

Browse Source 
git-svn-id: trunk@54876 -
This commit is contained in:
wp 2017-05-11 20:33:58 +00:00
parent b8d6c0d8dc
commit 7cc4753676
4 changed files with 65 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
examples/fontenum/fontenumeration.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<Version Value="10"/>
<General>
<Flags>
<SaveClosedFiles Value="False"/>
@ -12,6 +12,7 @@
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
@ -37,7 +38,6 @@
<Unit0>
<Filename Value="fontenumeration.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fontenumeration"/>
</Unit0>
<Unit1>
<Filename Value="mainunit.pas"/>
@ -45,18 +45,21 @@
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainunit"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="2">

2
examples/fontenum/fontenumeration.lpr
View File

@ -7,6 +7,8 @@ uses
Forms
{ add your units here }, mainunit;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfrmMain, frmMain);

51
examples/fontenum/mainunit.lfm
View File

@ -13,52 +13,52 @@ object frmMain: TfrmMain
OnCreate = FormCreate
OnShow = FormShow
ShowHint = True
LCLVersion = '1.1'
LCLVersion = '1.9.0.0'
object Label3: TLabel
Left = 548
Height = 13
Height = 15
Top = 257
Width = 24
Width = 27
Caption = 'Filtro'
ParentColor = False
end
object Label4: TLabel
Left = 216
Height = 13
Height = 15
Top = 16
Width = 62
Width = 67
Caption = 'Face font list'
ParentColor = False
end
object Label5: TLabel
Left = 424
Height = 13
Height = 15
Top = 11
Width = 29
Width = 30
Caption = 'Styles'
ParentColor = False
end
object Sizes: TLabel
Left = 648
Height = 13
Height = 15
Top = 11
Width = 24
Width = 25
Caption = 'Sizes'
ParentColor = False
end
object lblCharset: TLabel
Left = 424
Height = 13
Height = 15
Top = 176
Width = 48
Width = 53
Caption = 'lblCharset'
ParentColor = False
end
object Label6: TLabel
Left = 11
Height = 13
Height = 15
Top = 16
Width = 24
Width = 26
Caption = 'Filter'
ParentColor = False
end
@ -69,14 +69,15 @@ object frmMain: TfrmMain
Width = 200
ItemHeight = 0
OnClick = lbFamilyClick
Options = [lboDrawFocusRect]
TabOrder = 0
end
object cbCharset: TComboBox
Left = 8
Height = 21
Height = 23
Top = 37
Width = 194
ItemHeight = 13
ItemHeight = 15
TabOrder = 1
Text = 'ANSI_CHARSET'
end
@ -97,6 +98,7 @@ object frmMain: TfrmMain
Width = 208
ItemHeight = 0
OnClick = lbStylesClick
Options = [lboDrawFocusRect]
TabOrder = 3
end
object lbSizes: TListBox
@ -106,6 +108,7 @@ object frmMain: TfrmMain
Width = 56
ItemHeight = 0
OnClick = lbSizesClick
Options = [lboDrawFocusRect]
TabOrder = 4
end
object lbCharset: TListBox
@ -115,14 +118,15 @@ object frmMain: TfrmMain
Width = 208
ItemHeight = 0
OnClick = lbCharsetClick
Options = [lboDrawFocusRect]
TabOrder = 5
end
object cbPitch: TComboBox
Left = 8
Height = 21
Height = 23
Top = 61
Width = 194
ItemHeight = 13
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'DEFAULT_PITCH'
@ -145,18 +149,20 @@ object frmMain: TfrmMain
end
object chkStrike: TCheckBox
Left = 591
Height = 17
Height = 19
Top = 312
Width = 61
Width = 67
Caption = 'Strikeout'
OnChange = chkStrikeChange
TabOrder = 8
end
object chkUnderLine: TCheckBox
Left = 592
Height = 17
Height = 19
Top = 336
Width = 66
Width = 74
Caption = 'UnderLine'
OnChange = chkUnderLineChange
TabOrder = 9
end
object Button1: TButton
@ -179,14 +185,13 @@ object frmMain: TfrmMain
DefaultRowHeight = 17
FixedCols = 0
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll]
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goThumbTracking, goSmoothScroll]
TabOrder = 11
ColWidths = (
364
)
end
object FontDialog1: TFontDialog
Title = 'Select a font'
MinFontSize = 0
MaxFontSize = 0
left = 312

22
examples/fontenum/mainunit.pas
View File

@ -35,6 +35,8 @@ type
procedure BtnFontDlgClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure chkStrikeChange(Sender: TObject);
procedure chkUnderLineChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
@ -155,6 +157,16 @@ begin
LoadFontList;
end;
procedure TfrmMain.chkStrikeChange(Sender: TObject);
begin
SelectFont;
end;
procedure TfrmMain.chkUnderLineChange(Sender: TObject);
begin
SelectFont;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
var
Ini: TInifile;
@ -228,11 +240,15 @@ end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
LoadFontlist;
lbCharsetClick(nil);
SelectFont;
end;
procedure TfrmMain.lbFamilyClick(Sender: TObject);
begin
LoadFamilyFonts(-1);
lbCharsetClick(nil);
SelectFont;
end;
procedure TfrmMain.lbCharsetClick(Sender: TObject);
@ -337,6 +353,12 @@ begin
F.Style := [];
if i and 1 <> 0 then F.Style := F.Style + [fsItalic];
if i and 2 <> 0 then F.Style := F.Style + [fsBold];
if chkUnderLine.Checked
then F.Style := F.Style + [fsUnderline]
else F.Style := F.Style - [fsUnderline];
if chkStrike.Checked
then F.Style := F.Style + [fsStrikeOut]
else F.Style := F.Style - [fsStrikeOut];
UpdateFont(F);
SaveSelection;
finally