1
0

Add statusbar_demo example

This commit is contained in:
Timothy Warren 2021-10-08 17:15:28 -04:00
parent 313cf9f016
commit 307e0427ab
5 changed files with 257 additions and 0 deletions

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="statusbar_demo"/>
<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="statusbar_demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="statusbar_form.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="statusbar_demo"/>
</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 statusbar_demo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, statusbar_form
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Title:='statusbar_demo';
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,105 @@
object Form1: TForm1
Left = 476
Height = 240
Top = 228
Width = 400
Caption = 'StatusBar demonstration'
ClientHeight = 240
ClientWidth = 400
LCLVersion = '2.0.12.0'
object statusbar: TStatusBar
Left = 0
Height = 23
Top = 217
Width = 400
Panels = <
item
Width = 110
end
item
Width = 110
end
item
Width = 90
end
item
Width = 90
end>
SimplePanel = False
end
object Label1: TLabel
Left = 8
Height = 15
Top = 8
Width = 34
Caption = 'Label1'
ParentColor = False
OnMouseMove = MouseMove
end
object CheckBox1: TCheckBox
Left = 312
Height = 19
Top = 8
Width = 79
Caption = 'CheckBox1'
OnMouseMove = MouseMove
TabOrder = 1
end
object ProgressBar1: TProgressBar
Left = 8
Height = 20
Top = 72
Width = 100
OnMouseMove = MouseMove
TabOrder = 2
end
object SpinEdit1: TSpinEdit
Left = 304
Height = 23
Top = 140
Width = 87
OnMouseMove = MouseMove
TabOrder = 3
end
object ButtonPanel1: TButtonPanel
Left = 6
Height = 34
Top = 177
Width = 388
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 4
OnMouseMove = MouseMove
end
object Bevel1: TBevel
Left = 341
Height = 50
Top = 42
Width = 50
OnMouseMove = MouseMove
end
object BitBtn1: TBitBtn
Left = 8
Height = 30
Top = 133
Width = 75
Caption = 'BitBtn1'
OnMouseMove = MouseMove
TabOrder = 5
end
object Edit1: TEdit
Left = 184
Height = 23
Top = 69
Width = 80
OnMouseMove = MouseMove
TabOrder = 6
Text = 'Edit1'
end
end

View File

@ -0,0 +1,51 @@
unit statusbar_form;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
Spin, ButtonPanel, ExtCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
BitBtn1: TBitBtn;
ButtonPanel1: TButtonPanel;
CheckBox1: TCheckBox;
Edit1: TEdit;
Label1: TLabel;
ProgressBar1: TProgressBar;
SpinEdit1: TSpinEdit;
statusbar: TStatusBar;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var ctrl: TControl;
begin
statusBar.Panels[0].Text := Sender.ClassName;
ctrl := TControl(Sender);
statusBar.Panels[1].Text := ctrl.Name;
statusBar.Panels[2].Text := Format('Top: %d', [ctrl.Top]);
statusBar.Panels[3].Text := Format('Left: %d', [ctrl.Left]);
end;
end.