1
0
Fork 0

Add two GUI Label examples

This commit is contained in:
Timothy Warren 2021-10-08 16:48:37 -04:00
parent be5d15e988
commit 313cf9f016
10 changed files with 471 additions and 0 deletions

View File

@ -0,0 +1,90 @@
object propertiesForm: TpropertiesForm
Left = 308
Height = 285
Top = 239
Width = 400
Caption = 'TLabel properties demo'
ClientHeight = 285
ClientWidth = 400
OnCreate = FormCreate
LCLVersion = '2.0.12.0'
object rgAlignment: TRadioGroup
Left = 0
Height = 130
Top = 150
Width = 125
AutoFill = True
Caption = 'Alignment'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 110
ClientWidth = 121
ItemIndex = 0
Items.Strings = (
'taLeftJustify'
'taRightJustify'
'taCenter'
)
OnClick = rgAlignmentClick
TabOrder = 0
end
object rgLayout: TRadioGroup
Left = 137
Height = 130
Top = 150
Width = 125
AutoFill = True
Caption = 'Layout'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 110
ClientWidth = 121
ItemIndex = 0
Items.Strings = (
'tlTop'
'tlCenter'
'tlBottom'
)
OnClick = rgLayoutClick
TabOrder = 1
end
object cgFontStyle: TCheckGroup
Left = 274
Height = 130
Top = 150
Width = 125
AutoFill = True
Caption = 'Font.Style'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 110
ClientWidth = 121
Items.Strings = (
'fsBold'
'fsItalic'
'fsUnderline'
'fsStrikeout'
)
OnItemClick = cgFontStyleItemClick
TabOrder = 2
Data = {
0400000002020202
}
end
end

View File

@ -0,0 +1,112 @@
unit label_form;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
const
limit = 3;
cWidth = 100;
cHeight = 35;
type
TLabelGrid = array[0..limit, 0..limit] of TLabel;
{ TpropertiesForm }
TpropertiesForm = class(TForm)
cgFontStyle: TCheckGroup;
rgAlignment: TRadioGroup;
rgLayout: TRadioGroup;
procedure cgFontStyleItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
procedure rgAlignmentClick(Sender: TObject);
procedure rgLayoutClick(Sender: TObject);
private
labelGrid: TLabelGrid;
procedure SetupLabelGrid;
function CreateLabel(aCol, aRow: integer): TLabel;
end;
var
propertiesForm: TpropertiesForm;
implementation
{$R *.lfm}
{ TpropertiesForm }
procedure TpropertiesForm.FormCreate(Sender: TObject);
begin
SetupLabelGrid;
end;
procedure TpropertiesForm.cgFontStyleItemClick(Sender: TObject; Index: integer);
var c, r :integer;
fs: TFontStyle;
begin
fs := TFontStyle(Index);
for c := 0 to limit do
for r := 0 to limit do
if cgFontStyle.Checked[Index]
then labelGrid[c, r].Font.Style := labelGrid[c, r].Font.Style + [fs]
else labelGrid[c, r].Font.Style := labelGrid[c, r].Font.Style - [fs];
end;
procedure TpropertiesForm.rgAlignmentClick(Sender: TObject);
var rg: TRadioGroup;
c, r, idx: integer;
alignment: TAlignment;
begin
rg := TRadioGroup(Sender); // Cast sender object to its concrete type
idx := rg.ItemIndex;
alignment := TAlignment(idx);
for c := 0 to limit do
for r := 0 to limit do
labelGrid[c, r].Alignment := alignment;
end;
procedure TpropertiesForm.rgLayoutClick(Sender: TObject);
var rg: TRadioGroup;
c, r, idx: integer;
layout: TTextLayout;
begin
rg := TRadioGroup(Sender);
idx := rg.ItemIndex;
layout := TTextLayout(idx);
for c := 0 to limit do
for r := 0 to limit do
labelGrid[c, r].Layout := layout;
end;
function TpropertiesForm.CreateLabel(aCol, aRow: integer): TLabel;
var sum: integer;
begin
result := TLabel.Create(Self);
result.Parent := Self;
result.Caption := Format('col: %d, row: %d', [aCol, aRow]);
result.AutoSize := False;
result.SetBounds(aCol * cWidth, aRow * cHeight, cWidth, cHeight);
sum := aCol + aRow;
if (sum = 1) then sum := 4;
result.Color := clInfoBk + sum;
end;
procedure TpropertiesForm.SetupLabelGrid;
var c, r : Integer;
begin
for c := 0 to limit do
for r:= 0 to limit do
begin
labelGrid[c, r] := CreateLabel(c, r);
end;
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,78 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="label_properties"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True/PM"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="label_properties.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="label_form.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="propertiesForm"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="label_properties"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,23 @@
program label_properties;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, label_form
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Title:='label_properties';
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TpropertiesForm, propertiesForm);
Application.Run;
end.

BIN
labels/labels.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

78
labels/labels.lpi Normal file
View File

@ -0,0 +1,78 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="labels"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="labels.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="labels"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

23
labels/labels.lpr Normal file
View File

@ -0,0 +1,23 @@
program labels;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, umain
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Title:='labels';
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

35
labels/umain.lfm Normal file
View File

@ -0,0 +1,35 @@
object Form1: TForm1
Left = 483
Height = 240
Top = 198
Width = 320
Caption = 'Form1'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '2.0.12.0'
object Label1: TLabel
Left = 25
Height = 15
Top = 112
Width = 34
Caption = 'Label1'
FocusControl = Edit1
ParentColor = False
end
object Edit1: TEdit
Left = 100
Height = 23
Top = 108
Width = 80
TabOrder = 1
Text = 'Edit1'
end
object Button1: TButton
Left = 221
Height = 25
Top = 106
Width = 75
Caption = 'Button1'
TabOrder = 0
end
end

32
labels/umain.pas Normal file
View File

@ -0,0 +1,32 @@
unit umain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
end.