paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 05:16:48 +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> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="9"/> <Version Value="10"/>
<General> <General>
<Flags> <Flags>
<SaveClosedFiles Value="False"/> <SaveClosedFiles Value="False"/>
@ -12,6 +12,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<Title Value="project1"/> <Title Value="project1"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="default" Default="True"/> <Item1 Name="default" Default="True"/>
@ -37,7 +38,6 @@
<Unit0> <Unit0>
<Filename Value="fontenumeration.lpr"/> <Filename Value="fontenumeration.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="fontenumeration"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="mainunit.pas"/> <Filename Value="mainunit.pas"/>
@ -45,18 +45,21 @@
<ComponentName Value="frmMain"/> <ComponentName Value="frmMain"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="mainunit"/>
</Unit1> </Unit1>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<SearchPaths> <Linking>
<Debugging>
</SearchPaths> <UseExternalDbgSyms Value="True"/>
<Other> </Debugging>
<CompilerPath Value="$(CompPath)"/> <Options>
</Other> <Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="2"> <Exceptions Count="2">

2
examples/fontenum/fontenumeration.lpr
View File

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

51
examples/fontenum/mainunit.lfm
View File

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

22
examples/fontenum/mainunit.pas
View File

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