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

added navigation key check for up/down already handled

Browse Source 
git-svn-id: trunk@6825 -
This commit is contained in:
mattias 2005-02-21 13:54:26 +00:00
parent b5adb832b3
commit 85765e67ac
13 changed files with 1015 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -1685,8 +1685,12 @@ lcl/tests/test1_3label.lpi svneol=native#text/plain
lcl/tests/test1_3label.lpr svneol=native#text/pascal
lcl/tests/test1_4edit.lpi svneol=native#text/plain
lcl/tests/test1_4edit.lpr svneol=native#text/pascal
lcl/tests/test1_5checkbox.lpi svneol=native#text/plain
lcl/tests/test1_5checkbox.lpr svneol=native#text/pascal
lcl/tests/test2_1buttonnavigation.lpi svneol=native#text/plain
lcl/tests/test2_1buttonnavigation.lpr svneol=native#text/pascal
lcl/tests/test2_2labelattributes.lpi svneol=native#text/plain
lcl/tests/test2_2labelattributes.lpr svneol=native#text/pascal
lcl/textstrings.pas svneol=native#text/pascal
lcl/toolwin.pp svneol=native#text/pascal
lcl/utrace.pp svneol=native#text/pascal

24
ide/findreplacedialog.pp
View File

@ -130,40 +130,42 @@ begin
TextToFindComboBox:=TComboBox.Create(Self);
with TextToFindComboBox do begin
Name:='TextToFindComboBox';
Parent:=Self;
SetBounds(ComboX,y,Parent.ClientWidth-ComboX-x,Height);
SetBounds(ComboX,y,Self.ClientWidth-ComboX-x,Height);
Anchors:= [akLeft, akTop, akRight];
Text:='';
OnKeyDown:=@TextToFindComboBoxKeyDown;
Parent:=Self;
TabOrder:=0;
end;
TextToFindLabel:=TLabel.Create(Self);
with TextToFindLabel do begin
Name:='TextToFindLabel';
Parent:=Self;
SetBounds(x,y+3,ComboX-x,Height);
Caption:=dlgTextToFing;
FocusControl:= TextToFindComboBox;
Parent:=Self;
end;
inc(y,TextToFindComboBox.Height+1);
ReplaceTextComboBox:=TComboBox.Create(Self);
with ReplaceTextComboBox do begin
Name:='ReplaceTextComboBox';
Parent:=Self;
SetBounds(ComboX,y,Parent.ClientWidth-ComboX-x,Height);
SetBounds(ComboX,y,Self.ClientWidth-ComboX-x,Height);
Anchors:= [akLeft, akTop, akRight];
Text:='';
OnKeyDown:=@TextToFindComboBoxKeyDown;
Parent:=Self;
TabOrder:=1;
end;
ReplaceWithLabel:=TLabel.Create(Self);
with ReplaceWithLabel do begin
Name:='ReplaceWithLabel';
Parent:=Self;
SetBounds(x,y+3,ComboX-x,Height);
Caption:=dlgReplaceWith;
FocusControl:= ReplaceTextComboBox;
Parent:=Self;
end;
inc(y,ReplaceTextComboBox.Height+1);
@ -172,10 +174,10 @@ begin
OptionsGroupBox:=TGroupBox.Create(Self);
with OptionsGroupBox do begin
Name:='OptionsGroupBox';
Parent:=Self;
SetBounds(x,y,OptionsGrpW,160);
Caption:=dlgFROpts;
OnResize:=@OptionsGroupBoxResize;
Parent:=Self;
end;
OptionH:=OptionsGroupBox.ClientHeight div 5;
@ -340,19 +342,13 @@ procedure TLazFindReplaceDialog.TextToFindComboBoxKeyDown(
Sender: TObject; var Key:Word; Shift:TShiftState);
var Component: TFindDlgComponent;
begin
//writeln('TLazFindReplaceDialog.TextToFindComboBoxKeyDown Key=',Key,' RETURN=',VK_RETURN,' TAB=',VK_TAB,' DOWN=',VK_DOWN,' UP=',VK_UP);
//debugln('TLazFindReplaceDialog.TextToFindComboBoxKeyDown Key=',Key,' RETURN=',VK_RETURN,' TAB=',VK_TAB,' DOWN=',VK_DOWN,' UP=',VK_UP);
if (Key=VK_RETURN) then begin
OkButtonClick(Sender);
Key:=VK_UNKNOWN;
end else if (Key=VK_ESCAPE) then begin
CancelButtonClick(Sender);
Key:=VK_UNKNOWN;
end else if Key=VK_TAB then begin
if (Sender=TextToFindComboBox) and (ReplaceTextComboBox.Enabled) then
ReplaceTextComboBox.SetFocus;
if Sender=ReplaceTextComboBox then
TextToFindComboBox.SetFocus;
Key:=VK_UNKNOWN;
end else if Assigned(OnKey) then begin
if Sender=TextToFindComboBox then
Component:=fdcText

3
lcl/forms.pp
View File

@ -881,6 +881,9 @@ type
FIcon: TIcon;
FIdleLockCount: Integer;
FFormList: TList;
FLastKeyDownSender: TWinControl;
FLastKeyDownKey: Word;
FLastKeyDownShift: TShiftState;
FMainForm : TForm;
FMouseControl: TControl;
FNavigation: TApplicationNavigationOptions;

24
lcl/include/application.inc
View File

@ -1152,7 +1152,11 @@ begin
AControl:=TWinControl(Sender);
if AControl=nil then ;
//debugln('TApplication.ControlKeyDown A ',DbgSName(AControl));
end;
FLastKeyDownSender:=AControl;
end else
FLastKeyDownSender:=nil;
FLastKeyDownKey:=Key;
FLastKeyDownShift:=Shift;
end;
procedure TApplication.ControlKeyUp(Sender: TObject; var Key: Word;
@ -1161,9 +1165,22 @@ var
AControl: TWinControl;
Form: TCustomForm;
begin
if Key=VK_UNKNOWN then exit;
if Sender is TWinControl then begin
AControl:=TWinControl(Sender);
//debugln('TApplication.ControlKeyUp A ',DbgSName(AControl));
//debugln('TApplication.ControlKeyUp A ',DbgSName(AControl),' Key=',dbgs(Key),' Shift=',dbgs(Shift));
if FLastKeyDownKey=VK_UNKNOWN then begin
// key was already handled in key down
//debugln('TApplication.ControlKeyUp key was handled in key down');
exit;
end;
if (Key<>FLastKeyDownKey) or (Shift<>FLastKeyDownShift)
or (AControl<>FLastKeyDownSender) then begin
// a key up, without key down
//debugln('TApplication.ControlKeyUp key was handled in key down or in key up');
exit;
end;
// handle tab keys
if (Key=VK_Tab) and ((Shift-[ssShift])=[])
@ -1390,6 +1407,9 @@ end;
{ =============================================================================
$Log$
Revision 1.102 2005/02/21 13:54:26 mattias
added navigation key check for up/down already handled
Revision 1.101 2005/02/19 22:48:23 mattias
fixed navigation key handling for TButton

18
lcl/include/buttons.inc
View File

@ -60,24 +60,13 @@ end;
procedure TCustomButton.ControlKeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key=VK_RETURN) and (Shift=[]) then begin
// some interfaces will handle it with an animation
// => let it handle itself
// if it does not handle it, we will do it ourselves afterwards
end else
inherited ControlKeyDown(Key, Shift);
inherited ControlKeyDown(Key, Shift);
end;
procedure TCustomButton.ControlKeyUp(var Key: Word; Shift: TShiftState
);
begin
if (Key=VK_RETURN) and (Shift=[]) then begin
// the interface didn't handle it.
//debugln('TCustomButton.ControlKeyUp User pressed Return on ',DbgSName(Self),' and interface did not handle it');
Key:=VK_UNKNOWN;
Click;
end else
inherited ControlKeyUp(Key, Shift);
inherited ControlKeyUp(Key, Shift);
end;
{------------------------------------------------------------------------------
@ -236,6 +225,9 @@ end;
{ =============================================================================
$Log$
Revision 1.41 2005/02/21 13:54:26 mattias
added navigation key check for up/down already handled
Revision 1.40 2005/02/19 22:48:23 mattias
fixed navigation key handling for TButton

36
lcl/include/wincontrol.inc
View File

@ -1401,10 +1401,7 @@ begin
if OldFocus<>nil then
NewFocus := TopLevel.FindNextControl(OldFocus,ForwardTab,True,False);
//if NewFocus<>nil then
// DebugLn('TControl.PerformTab A ',Name,':',ClassName,' NewFocus=',NewFocus.Name,':',NewFocus.ClassName)
//else
// DebugLn('TControl.PerformTab B ',Name,':',ClassName,' NewFocus=nil');
//DebugLn('TControl.PerformTab A ',DbgSName(Self),' NewFocus=',DbgSName(NewFocus),' OldFocus=',DbgSName(OldFocus));
If (NewFocus = nil) then NewFocus:=FirstFocus;
If NewFocus = OldFocus then begin
@ -1506,11 +1503,14 @@ begin
Result := nil;
List := TList.Create;
GetTabOrderList(List);
//for i:=0 to List.Count-1 do begin
// debugln('TWinControl.FindNextControl TabOrderList ',dbgs(i),' ',DbgSName(TObject(List[i])));
//end;
If List.Count > 0 then begin
J := List.IndexOf(CurrentControl);
if J<0 then exit;
///DebugLn('TWinControl.FindNextControl A ',CurrentControl.Name,' ',dbgs(J),
// ' '+dbgs(GoForward)+','+dbgs(CheckTabStop)+','+dbgs(CheckParent)+','+dbgs(OnlyWinControls));
//DebugLn('TWinControl.FindNextControl A ',DbgSName(CurrentControl),' ',dbgs(J),
// ' GoForward='+dbgs(GoForward)+' CheckTabStop='+dbgs(CheckTabStop)+' CheckParent='+dbgs(CheckParent));
I := J;
Repeat
If GoForward then begin
@ -1525,21 +1525,20 @@ begin
if I=J then exit;
Next := TWinControl(List[I]);
{DebugLn('TWinControl.FindNextControl B ',Next.Name,' ',dbgs(I),
+' ChckTabStop='+dbgs(CheckTabStop)+' TabStop='+dbgs(Next.TabStop)
+' ChckParent='+dbgs(CheckParent)+' Parent=Self='+dbgs(Next.Parent = Self)
+' Enabled='+dbgs(Next.Enabled)+' OnlyWinC='+dbgs(OnlyWinControls)
+' TestTab='+dbgs(((Not CheckTabStop) or Next.TabStop))
+' TestPar='+dbgs(((not CheckParent) or (Next.Parent = Self)))
+' TestEnVi='+dbgs(Next.Enabled and Next.IsVisible)
+' TestWinC='+dbgs((not OnlyWinControls) or (Next is TWinControl))
);}
//DebugLn('TWinControl.FindNextControl B ',Next.Name,' ',dbgs(I),
// +' ChckTabStop='+dbgs(CheckTabStop)+' TabStop='+dbgs(Next.TabStop)
// +' ChckParent='+dbgs(CheckParent)+' Parent=Self='+dbgs(Next.Parent = Self)
// +' Enabled='+dbgs(Next.Enabled)
// +' TestTab='+dbgs(((Not CheckTabStop) or Next.TabStop))
// +' TestPar='+dbgs(((not CheckParent) or (Next.Parent = Self)))
// +' TestEnVi='+dbgs(Next.Enabled and Next.IsVisible)
// );
If (((not CheckTabStop) or Next.TabStop)
and ((not CheckParent) or (Next.Parent = Self)))
and (Next.Enabled and Next.IsVisible) then
Result := Next;
until (Result <> nil);
//DebugLn('TWinControl.FindNextControl END ',Result.Name,':',Result.ClassName,' ',dbgs(I));
//DebugLn('TWinControl.FindNextControl END ',DbgSName(Result),' I=',dbgs(I));
end;
finally
List.Free;
@ -3682,7 +3681,7 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.WMSysKeyUp(var Message: TLMKeyUp);
begin
debugln('TWinControl.WMSysKeyUp ',DbgSName(Self));
//debugln('TWinControl.WMSysKeyUp ',DbgSName(Self));
DoRemainingKeyUp(Message);
end;
@ -4493,6 +4492,9 @@ end;
{ =============================================================================
$Log$
Revision 1.315 2005/02/21 13:54:26 mattias
added navigation key check for up/down already handled
Revision 1.314 2005/02/19 22:48:23 mattias
fixed navigation key handling for TButton

5
lcl/stdctrls.pp
View File

@ -891,6 +891,8 @@ type
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
@ -1218,6 +1220,9 @@ end.
{ =============================================================================
$Log$
Revision 1.194 2005/02/21 13:54:26 mattias
added navigation key check for up/down already handled
Revision 1.193 2005/02/19 18:23:27 mattias
made TListBox.Clear virtual

2
lcl/tests/test1_2button.lpi
View File

@ -16,7 +16,7 @@
</General>
<Units Count="1">
<Unit0>
<CursorPos X="13" Y="18"/>
<CursorPos X="13" Y="21"/>
<EditorIndex Value="0"/>
<Filename Value="test1_2button.lpr"/>
<IsPartOfProject Value="True"/>

7
lcl/tests/test1_3label.lpi
View File

@ -9,14 +9,14 @@
<SaveOnlyProjectUnits Value="True"/>
</Flags>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="2"/>
<ActiveEditorIndexAtStart Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="test1_3label"/>
</General>
<Units Count="1">
<Unit0>
<CursorPos X="16" Y="32"/>
<CursorPos X="10" Y="48"/>
<EditorIndex Value="0"/>
<Filename Value="test1_3label.lpr"/>
<IsPartOfProject Value="True"/>
@ -46,6 +46,9 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="4"/>
<SearchPaths>
<LCLWidgetType Value="gtk2"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>

65
lcl/tests/test1_5checkbox.lpi Normal file
View File

@ -0,0 +1,65 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
<SaveClosedFiles Value="False"/>
<SaveOnlyProjectUnits Value="True"/>
</Flags>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="4"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="test1_5checkbox"/>
</General>
<Units Count="1">
<Unit0>
<CursorPos X="21" Y="145"/>
<EditorIndex Value="0"/>
<Filename Value="test1_5checkbox.lpr"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<TopLine Value="129"/>
<UnitName Value="test1_5checkbox"/>
<UsageCount Value="42"/>
</Unit0>
</Units>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
</ProjectOptions>
<CompilerOptions>
<Version Value="4"/>
<SearchPaths>
<LCLWidgetType Value="gtk2"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

392
lcl/tests/test1_5checkbox.lpr Normal file
View File

@ -0,0 +1,392 @@
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
LCL Test 1_5
Showing a form at 0,0,320,240 with a single TCheckBox at 100,80,75x25
}
program test1_5checkbox;
{$mode objfpc}{$H+}
uses
Interfaces, FPCAdds, LCLProc, LCLType, Classes, Controls, Forms, TypInfo,
LMessages, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
procedure CheckBox1Change(Sender: TObject);
procedure CheckBox1ChangeBounds(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox1Enter(Sender: TObject);
procedure CheckBox1Exit(Sender: TObject);
procedure CheckBox1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
procedure CheckBox1KeyPress(Sender: TObject; var Key: char);
procedure CheckBox1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure CheckBox1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CheckBox1MouseEnter(Sender: TObject);
procedure CheckBox1MouseLeave(Sender: TObject);
procedure CheckBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure CheckBox1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CheckBox1Resize(Sender: TObject);
procedure Form1Activate(Sender: TObject);
procedure Form1ChangeBounds(Sender: TObject);
procedure Form1Click(Sender: TObject);
procedure Form1Close(Sender: TObject; var CloseAction: TCloseAction);
procedure Form1CloseQuery(Sender: TObject; var CanClose: boolean);
procedure Form1Create(Sender: TObject);
procedure Form1Deactivate(Sender: TObject);
procedure Form1Enter(Sender: TObject);
procedure Form1Exit(Sender: TObject);
function Form1Help(Command: Word; Data: Longint; var CallHelp: Boolean
): Boolean;
procedure Form1Hide(Sender: TObject);
procedure Form1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Form1KeyPress(Sender: TObject; var Key: char);
procedure Form1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Form1MouseEnter(Sender: TObject);
procedure Form1MouseLeave(Sender: TObject);
procedure Form1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
);
procedure Form1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Form1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure Form1MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure Form1MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure Form1Paint(Sender: TObject);
procedure Form1Resize(Sender: TObject);
procedure Form1Shortcut(var Msg: TLMKey; var Handled: Boolean);
procedure Form1Show(Sender: TObject);
procedure Form1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure Form1WindowStateChanged(Sender: TObject);
public
constructor Create(TheOwner: TComponent); override;
end;
{ TForm1 }
procedure TForm1.CheckBox1ChangeBounds(Sender: TObject);
begin
debugln('TForm1.CheckBox1ChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
end;
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
debugln('TForm1.CheckBox1Change ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
debugln('TForm1.CheckBox1Click ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1Enter(Sender: TObject);
begin
debugln('TForm1.CheckBox1Enter ',DbgSName(Sender));
end;
procedure TForm1.CheckBox1Exit(Sender: TObject);
begin
debugln('TForm1.CheckBox1Exit ',DbgSName(Sender));
end;
procedure TForm1.CheckBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Debugln('TForm1.CheckBox1KeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
' Shift=',dbgs(Shift),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1KeyPress(Sender: TObject; var Key: char);
begin
debugln('TForm1.CheckBox1KeyPress ',DbgSName(Sender),' Key=',DbgStr(Key),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
Debugln('TForm1.CheckBox1KeyUp ',DbgSName(Sender),' Key=',dbgs(Key),
' Shift=',dbgs(Shift),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.CheckBox1MouseDown ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1MouseEnter(Sender: TObject);
begin
debugln('TForm1.CheckBox1MouseEnter ',DbgSName(Sender),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1MouseLeave(Sender: TObject);
begin
debugln('TForm1.CheckBox1MouseLeave ',DbgSName(Sender));
end;
procedure TForm1.CheckBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
debugln('TForm1.CheckBox1MouseMove ',DbgSName(Sender),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.CheckBox1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.CheckBox1MouseUp ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift),' CheckBox1.Checked=',dbgs(CheckBox1.Checked));
end;
procedure TForm1.CheckBox1Resize(Sender: TObject);
begin ;
debugln('TForm1.CheckBox1Resize ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
end;
procedure TForm1.Form1Activate(Sender: TObject);
begin
debugln('TForm1.Form1Activate ',DbgSName(Sender));
end;
procedure TForm1.Form1ChangeBounds(Sender: TObject);
begin
debugln('TForm1.Form1ChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(BoundsRect));
end;
procedure TForm1.Form1Click(Sender: TObject);
begin
debugln('TForm1.Form1Click ',DbgSName(Sender));
end;
procedure TForm1.Form1Close(Sender: TObject; var CloseAction: TCloseAction);
begin
debugln('TForm1.Form1Close ',DbgSName(Sender),' CloseAction=',
GetEnumName(TypeInfo(TCloseAction),ord(CloseAction)));
end;
procedure TForm1.Form1CloseQuery(Sender: TObject; var CanClose: boolean);
begin
debugln('TForm1.Form1CloseQuery ',DbgSName(Sender),' CanClose',dbgs(CanClose));
end;
procedure TForm1.Form1Create(Sender: TObject);
begin
debugln('TForm1.Form1Create ',DbgSName(Sender));
CheckBox1:=TCheckBox.Create(Self);
with CheckBox1 do begin
Name:='CheckBox1';
SetBounds(100,80,75,25);
Parent:=Self;
OnChangeBounds:=@CheckBox1ChangeBounds;
OnClick:=@CheckBox1Click;
OnChange:=@CheckBox1Change;
OnEnter:=@CheckBox1Enter;
OnExit:=@CheckBox1Exit;
OnKeyDown:=@CheckBox1KeyDown;
OnKeyPress:=@CheckBox1KeyPress;
OnKeyUp:=@CheckBox1KeyUp;
OnMouseDown:=@CheckBox1MouseDown;
OnMouseEnter:=@CheckBox1MouseEnter;
OnMouseLeave:=@CheckBox1MouseLeave;
OnMouseMove:=@CheckBox1MouseMove;
OnMouseUp:=@CheckBox1MouseUp;
OnResize:=@CheckBox1Resize;
end;
end;
procedure TForm1.Form1Deactivate(Sender: TObject);
begin
debugln('TForm1.Form1Deactivate ',DbgSName(Sender));
end;
procedure TForm1.Form1Enter(Sender: TObject);
begin
debugln('TForm1.Form1Enter ',DbgSName(Sender));
end;
procedure TForm1.Form1Exit(Sender: TObject);
begin
debugln('TForm1.Form1Exit ',DbgSName(Sender));
end;
function TForm1.Form1Help(Command: Word; Data: Longint; var CallHelp: Boolean
): Boolean;
begin
debugln('TForm1.Form1Help Command=',dbgs(Command),' Data=',HexStr(Cardinal(Data),8),' CallHelp=',dbgs(CallHelp));
Result:=false;
end;
procedure TForm1.Form1Hide(Sender: TObject);
begin
debugln('TForm1.Form1Hide ',DbgSName(Sender));
end;
procedure TForm1.Form1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
Debugln('TForm1.Form1KeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1KeyPress(Sender: TObject; var Key: char);
begin
debugln('TForm1.Form1KeyPress ',DbgSName(Sender),' Key=',DbgStr(Key));
end;
procedure TForm1.Form1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.Form1MouseDown ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseEnter(Sender: TObject);
begin
debugln('TForm1.Form1MouseEnter ',DbgSName(Sender));
end;
procedure TForm1.Form1MouseLeave(Sender: TObject);
begin
debugln('TForm1.Form1MouseLeave ',DbgSName(Sender));
end;
procedure TForm1.Form1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
debugln('TForm1.Form1MouseMove ',DbgSName(Sender),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.Form1MouseUp ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
debugln('TForm1.Form1MouseWheel ',DbgSName(Sender),
' WheelDelta=',dbgs(WheelDelta),' MousePos=',dbgs(MousePos),
' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
debugln('TForm1.Form1MouseWheelDown ',DbgSName(Sender),
' MousePos=',dbgs(MousePos),
' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
debugln('TForm1.Form1MouseWheelUp ',DbgSName(Sender),
' MousePos=',dbgs(MousePos),
' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1Paint(Sender: TObject);
begin
debugln('TForm1.Form1Paint ',DbgSName(Sender));
end;
procedure TForm1.Form1Resize(Sender: TObject);
begin
debugln('TForm1.Form1Resize ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
end;
procedure TForm1.Form1Shortcut(var Msg: TLMKey; var Handled: Boolean);
begin
debugln('TForm1.Form1Shortcut Msg.CharCode=',dbgs(Msg.CharCode),
' Handled=',dbgs(Handled));
end;
procedure TForm1.Form1Show(Sender: TObject);
begin
debugln('TForm1.Form1Show ',DbgSName(Sender));
end;
procedure TForm1.Form1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
begin
debugln('TForm1.Form1UTF8KeyPress ',DbgSName(Sender),' UTF8Key="',DbgStr(UTF8Key),'"');
end;
procedure TForm1.Form1WindowStateChanged(Sender: TObject);
begin
debugln('TForm1.Form1WindowStateChanged ',DbgSName(Sender),
' State=',GetEnumName(TypeInfo(TWindowState),ord(WindowState)));
end;
constructor TForm1.Create(TheOwner: TComponent);
begin
OnActivate:=@Form1Activate;
OnChangeBounds:=@Form1ChangeBounds;
OnClick:=@Form1Click;
OnClose:=@Form1Close;
OnCloseQuery:=@Form1CloseQuery;
OnCreate:=@Form1Create;
OnDeactivate:=@Form1Deactivate;
OnEnter:=@Form1Enter;
OnExit:=@Form1Exit;
OnHelp:=@Form1Help;
OnHide:=@Form1Hide;
OnKeyDown:=@Form1KeyDown;
OnKeyDown:=@Form1KeyDown;
OnKeyPress:=@Form1KeyPress;
OnMouseDown:=@Form1MouseDown;
OnMouseEnter:=@Form1MouseEnter;
OnMouseLeave:=@Form1MouseLeave;
OnMouseMove:=@Form1MouseMove;
OnMouseUp:=@Form1MouseUp;
OnMouseWheel:=@Form1MouseWheel;
OnMouseWheelDown:=@Form1MouseWheelDown;
OnMouseWheelUp:=@Form1MouseWheelUp;
OnPaint:=@Form1Paint;
OnResize:=@Form1Resize;
OnShortcut:=@Form1Shortcut;
OnShow:=@Form1Show;
OnUTF8KeyPress:=@Form1UTF8KeyPress;
OnWindowStateChanged:=@Form1WindowStateChanged;
inherited Create(TheOwner);
end;
var
Form1: TForm1;
begin
Application.Initialize;
Application.CreateForm(TForm1,Form1);
Application.Run;
end.

65
lcl/tests/test2_2labelattributes.lpi Normal file
View File

@ -0,0 +1,65 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
<SaveClosedFiles Value="False"/>
<SaveOnlyProjectUnits Value="True"/>
</Flags>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="test2_2labelattributes"/>
</General>
<Units Count="1">
<Unit0>
<CursorPos X="1" Y="197"/>
<EditorIndex Value="0"/>
<Filename Value="test2_2labelattributes.lpr"/>
<IsPartOfProject Value="True"/>
<Loaded Value="True"/>
<TopLine Value="174"/>
<UnitName Value="test2_2labelattributes"/>
<UsageCount Value="34"/>
</Unit0>
</Units>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
</ProjectOptions>
<CompilerOptions>
<Version Value="4"/>
<SearchPaths>
<LCLWidgetType Value="gtk2"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

419
lcl/tests/test2_2labelattributes.lpr Normal file
View File

@ -0,0 +1,419 @@
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.LCL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
LCL Test 2_2
Showing a form at 0,0,320,240 with a label and several controls to test the
label properties.
}
program test2_2labelattributes;
{$mode objfpc}{$H+}
uses
Interfaces, Classes, SysUtils, FPCAdds, LCLProc, LCLType, Controls, Forms,
TypInfo, LMessages, StdCtrls, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
WidthRadioGroup: TRadioGroup;
AutoSizeCheckBox: TCheckBox;
procedure AutoSizeCheckBoxClick(Sender: TObject);
procedure Label1ChangeBounds(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Label1DblClick(Sender: TObject);
procedure Label1Enter(Sender: TObject);
procedure Label1Exit(Sender: TObject);
procedure Label1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Label1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label1MouseEnter(Sender: TObject);
procedure Label1MouseLeave(Sender: TObject);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label1Resize(Sender: TObject);
procedure Form1Activate(Sender: TObject);
procedure Form1ChangeBounds(Sender: TObject);
procedure Form1Click(Sender: TObject);
procedure Form1Close(Sender: TObject; var CloseAction: TCloseAction);
procedure Form1CloseQuery(Sender: TObject; var CanClose: boolean);
procedure Form1Create(Sender: TObject);
procedure Form1Deactivate(Sender: TObject);
procedure Form1Enter(Sender: TObject);
procedure Form1Exit(Sender: TObject);
function Form1Help(Command: Word; Data: Longint; var CallHelp: Boolean
): Boolean;
procedure Form1Hide(Sender: TObject);
procedure Form1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Form1KeyPress(Sender: TObject; var Key: char);
procedure Form1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Form1MouseEnter(Sender: TObject);
procedure Form1MouseLeave(Sender: TObject);
procedure Form1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
);
procedure Form1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Form1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure Form1MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure Form1MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure Form1Paint(Sender: TObject);
procedure Form1Resize(Sender: TObject);
procedure Form1Shortcut(var Msg: TLMKey; var Handled: Boolean);
procedure Form1Show(Sender: TObject);
procedure Form1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure Form1WindowStateChanged(Sender: TObject);
procedure WidthRadioGroupClick(Sender: TObject);
public
constructor Create(TheOwner: TComponent); override;
end;
{ TForm1 }
procedure TForm1.Label1ChangeBounds(Sender: TObject);
begin
debugln('TForm1.Label1ChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
end;
procedure TForm1.AutoSizeCheckBoxClick(Sender: TObject);
begin
debugln('TForm1.AutoSizeCheckBoxClick ',DbgSName(Sender),' AutoSizeCheckBox.Checked=',dbgs(AutoSizeCheckBox.Checked));
Label1.AutoSize:=AutoSizeCheckBox.Checked;
AutoSizeCheckBox.Checked:=Label1.AutoSize;
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
debugln('TForm1.Label1Click ',DbgSName(Sender));
end;
procedure TForm1.Label1DblClick(Sender: TObject);
begin
debugln('TForm1.Label1DblClick ',DbgSName(Sender));
end;
procedure TForm1.Label1Enter(Sender: TObject);
begin
debugln('TForm1.Label1Enter ',DbgSName(Sender));
end;
procedure TForm1.Label1Exit(Sender: TObject);
begin
debugln('TForm1.Label1Exit ',DbgSName(Sender));
end;
procedure TForm1.Label1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Debugln('TForm1.Label1KeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
' Shift=',dbgs(Shift));
end;
procedure TForm1.Label1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.Label1MouseDown ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Label1MouseEnter(Sender: TObject);
begin
debugln('TForm1.Label1MouseEnter ',DbgSName(Sender));
end;
procedure TForm1.Label1MouseLeave(Sender: TObject);
begin
debugln('TForm1.Label1MouseLeave ',DbgSName(Sender));
end;
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
debugln('TForm1.Label1MouseMove ',DbgSName(Sender),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Label1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.Label1MouseUp ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Label1Resize(Sender: TObject);
begin ;
debugln('TForm1.Label1Resize ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
end;
procedure TForm1.Form1Activate(Sender: TObject);
begin
debugln('TForm1.Form1Activate ',DbgSName(Sender));
end;
procedure TForm1.Form1ChangeBounds(Sender: TObject);
begin
debugln('TForm1.Form1ChangeBounds ',DbgSName(Sender),' Bounds=',dbgs(BoundsRect));
end;
procedure TForm1.Form1Click(Sender: TObject);
begin
debugln('TForm1.Form1Click ',DbgSName(Sender));
end;
procedure TForm1.Form1Close(Sender: TObject; var CloseAction: TCloseAction);
begin
debugln('TForm1.Form1Close ',DbgSName(Sender),' CloseAction=',
GetEnumName(TypeInfo(TCloseAction),ord(CloseAction)));
end;
procedure TForm1.Form1CloseQuery(Sender: TObject; var CanClose: boolean);
begin
debugln('TForm1.Form1CloseQuery ',DbgSName(Sender),' CanClose',dbgs(CanClose));
end;
procedure TForm1.Form1Create(Sender: TObject);
begin
debugln('TForm1.Form1Create ',DbgSName(Sender));
Label1:=TLabel.Create(Self);
with Label1 do begin
Name:='Label1';
Caption:='This is a &label with a long caption';
SetBounds(10,10,75,25);
Parent:=Self;
OnChangeBounds:=@Label1ChangeBounds;
OnClick:=@Label1Click;
OnDblClick:=@Label1DblClick;
OnEnter:=@Label1Enter;
OnExit:=@Label1Exit;
OnMouseDown:=@Label1MouseDown;
OnMouseEnter:=@Label1MouseEnter;
OnMouseLeave:=@Label1MouseLeave;
OnMouseMove:=@Label1MouseMove;
OnMouseUp:=@Label1MouseUp;
OnResize:=@Label1Resize;
OnKeyDown:=@Label1KeyDown;
end;
WidthRadioGroup:=TRadioGroup.Create(Self);
with WidthRadioGroup do begin
Name:='WidthRadioGroup';
SetBounds(10,100,100,100);
Caption:='Label.Width';
Parent:=Self;
Items.Add('20');
Items.Add('80');
Items.Add('200');
OnClick:=@WidthRadioGroupClick;
end;
AutoSizeCheckBox:=TCheckBox.Create(Self);
with AutoSizeCheckBox do begin
Name:='AutoSizeCheckBox';
SetBounds(120,100,100,25);
Caption:='Label.AutoSize';
Parent:=Self;
Checked:=Label1.AutoSize;
OnClick:=@AutoSizeCheckBoxClick;
end;
end;
procedure TForm1.Form1Deactivate(Sender: TObject);
begin
debugln('TForm1.Form1Deactivate ',DbgSName(Sender));
end;
procedure TForm1.Form1Enter(Sender: TObject);
begin
debugln('TForm1.Form1Enter ',DbgSName(Sender));
end;
procedure TForm1.Form1Exit(Sender: TObject);
begin
debugln('TForm1.Form1Exit ',DbgSName(Sender));
end;
function TForm1.Form1Help(Command: Word; Data: Longint; var CallHelp: Boolean
): Boolean;
begin
debugln('TForm1.Form1Help Command=',dbgs(Command),' Data=',HexStr(Cardinal(Data),8),' CallHelp=',dbgs(CallHelp));
Result:=false;
end;
procedure TForm1.Form1Hide(Sender: TObject);
begin
debugln('TForm1.Form1Hide ',DbgSName(Sender));
end;
procedure TForm1.Form1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
Debugln('TForm1.Form1KeyDown ',DbgSName(Sender),' Key=',dbgs(Key),
' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1KeyPress(Sender: TObject; var Key: char);
begin
debugln('TForm1.Form1KeyPress ',DbgSName(Sender),' Key=',DbgStr(Key));
end;
procedure TForm1.Form1MouseDown(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.Form1MouseDown ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseEnter(Sender: TObject);
begin
debugln('TForm1.Form1MouseEnter ',DbgSName(Sender));
end;
procedure TForm1.Form1MouseLeave(Sender: TObject);
begin
debugln('TForm1.Form1MouseLeave ',DbgSName(Sender));
end;
procedure TForm1.Form1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
debugln('TForm1.Form1MouseMove ',DbgSName(Sender),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
debugln('TForm1.Form1MouseUp ',DbgSName(Sender),
' Button=',GetEnumName(TypeInfo(TMouseButton),ord(Button)),
' X=',dbgs(X),' Y=',dbgs(Y),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
debugln('TForm1.Form1MouseWheel ',DbgSName(Sender),
' WheelDelta=',dbgs(WheelDelta),' MousePos=',dbgs(MousePos),
' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
debugln('TForm1.Form1MouseWheelDown ',DbgSName(Sender),
' MousePos=',dbgs(MousePos),
' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1MouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
debugln('TForm1.Form1MouseWheelUp ',DbgSName(Sender),
' MousePos=',dbgs(MousePos),
' Handled=',dbgs(Handled),' Shift=',dbgs(Shift));
end;
procedure TForm1.Form1Paint(Sender: TObject);
begin
debugln('TForm1.Form1Paint ',DbgSName(Sender));
end;
procedure TForm1.Form1Resize(Sender: TObject);
begin
debugln('TForm1.Form1Resize ',DbgSName(Sender),' Bounds=',dbgs(TControl(Sender).BoundsRect));
end;
procedure TForm1.Form1Shortcut(var Msg: TLMKey; var Handled: Boolean);
begin
debugln('TForm1.Form1Shortcut Msg.CharCode=',dbgs(Msg.CharCode),
' Handled=',dbgs(Handled));
end;
procedure TForm1.Form1Show(Sender: TObject);
begin
debugln('TForm1.Form1Show ',DbgSName(Sender));
end;
procedure TForm1.Form1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
begin
debugln('TForm1.Form1UTF8KeyPress ',DbgSName(Sender),' UTF8Key="',DbgStr(UTF8Key),'"');
end;
procedure TForm1.Form1WindowStateChanged(Sender: TObject);
begin
debugln('TForm1.Form1WindowStateChanged ',DbgSName(Sender),
' State=',GetEnumName(TypeInfo(TWindowState),ord(WindowState)));
end;
procedure TForm1.WidthRadioGroupClick(Sender: TObject);
begin
debugln('TForm1.WidthRadioGroupClick ',DbgSName(Sender),' WidthRadioGroup.ItemIndex=',dbgs(WidthRadioGroup.ItemIndex));
if WidthRadioGroup.ItemIndex>=0 then begin
Label1.Width:=StrToIntDef(WidthRadioGroup.Items[WidthRadioGroup.ItemIndex],
Label1.Width);
end;
end;
constructor TForm1.Create(TheOwner: TComponent);
begin
OnActivate:=@Form1Activate;
OnChangeBounds:=@Form1ChangeBounds;
OnClick:=@Form1Click;
OnClose:=@Form1Close;
OnCloseQuery:=@Form1CloseQuery;
OnCreate:=@Form1Create;
OnDeactivate:=@Form1Deactivate;
OnEnter:=@Form1Enter;
OnExit:=@Form1Exit;
OnHelp:=@Form1Help;
OnHide:=@Form1Hide;
OnKeyDown:=@Form1KeyDown;
OnKeyDown:=@Form1KeyDown;
OnKeyPress:=@Form1KeyPress;
OnMouseDown:=@Form1MouseDown;
OnMouseEnter:=@Form1MouseEnter;
OnMouseLeave:=@Form1MouseLeave;
OnMouseMove:=@Form1MouseMove;
OnMouseUp:=@Form1MouseUp;
OnMouseWheel:=@Form1MouseWheel;
OnMouseWheelDown:=@Form1MouseWheelDown;
OnMouseWheelUp:=@Form1MouseWheelUp;
OnPaint:=@Form1Paint;
OnResize:=@Form1Resize;
OnShortcut:=@Form1Shortcut;
OnShow:=@Form1Show;
OnUTF8KeyPress:=@Form1UTF8KeyPress;
OnWindowStateChanged:=@Form1WindowStateChanged;
inherited Create(TheOwner);
end;
var
Form1: TForm1;
begin
Application.Initialize;
Application.CreateForm(TForm1,Form1);
Application.Run;
end.