diff --git a/.gitattributes b/.gitattributes index 399a812628..31a1e9c2a5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/ide/findreplacedialog.pp b/ide/findreplacedialog.pp index 2637366412..dc7353a1f7 100644 --- a/ide/findreplacedialog.pp +++ b/ide/findreplacedialog.pp @@ -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 diff --git a/lcl/forms.pp b/lcl/forms.pp index 3d3973a7fe..bb114c4c18 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -881,6 +881,9 @@ type FIcon: TIcon; FIdleLockCount: Integer; FFormList: TList; + FLastKeyDownSender: TWinControl; + FLastKeyDownKey: Word; + FLastKeyDownShift: TShiftState; FMainForm : TForm; FMouseControl: TControl; FNavigation: TApplicationNavigationOptions; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index a0a10d972c..2f0c5633d1 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -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 diff --git a/lcl/include/buttons.inc b/lcl/include/buttons.inc index 87963ae529..9457dc192f 100644 --- a/lcl/include/buttons.inc +++ b/lcl/include/buttons.inc @@ -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 diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index f3346b95bb..a7a7f81aa0 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -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 diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 4266aa2d13..b69e09e67b 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -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 diff --git a/lcl/tests/test1_2button.lpi b/lcl/tests/test1_2button.lpi index 5727834479..b75d229152 100644 --- a/lcl/tests/test1_2button.lpi +++ b/lcl/tests/test1_2button.lpi @@ -16,7 +16,7 @@ - + diff --git a/lcl/tests/test1_3label.lpi b/lcl/tests/test1_3label.lpi index 467fb44faa..2ecc7d5366 100644 --- a/lcl/tests/test1_3label.lpi +++ b/lcl/tests/test1_3label.lpi @@ -9,14 +9,14 @@ - + </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"/> diff --git a/lcl/tests/test1_5checkbox.lpi b/lcl/tests/test1_5checkbox.lpi new file mode 100644 index 0000000000..d6f709d231 --- /dev/null +++ b/lcl/tests/test1_5checkbox.lpi @@ -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> diff --git a/lcl/tests/test1_5checkbox.lpr b/lcl/tests/test1_5checkbox.lpr new file mode 100644 index 0000000000..d182f19b32 --- /dev/null +++ b/lcl/tests/test1_5checkbox.lpr @@ -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. + diff --git a/lcl/tests/test2_2labelattributes.lpi b/lcl/tests/test2_2labelattributes.lpi new file mode 100644 index 0000000000..416bee3128 --- /dev/null +++ b/lcl/tests/test2_2labelattributes.lpi @@ -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> diff --git a/lcl/tests/test2_2labelattributes.lpr b/lcl/tests/test2_2labelattributes.lpr new file mode 100644 index 0000000000..79f7143614 --- /dev/null +++ b/lcl/tests/test2_2labelattributes.lpr @@ -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. +