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

example: OnShowHint

Browse Source 
git-svn-id: trunk@47919 -
This commit is contained in:
mattias 2015-02-20 15:49:38 +00:00
parent a6d416e72e
commit 3a3f45bd46
7 changed files with 233 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -4702,6 +4702,12 @@ examples/cursors/project1.lpi svneol=native#text/plain
examples/cursors/project1.lpr svneol=native#text/pascal
examples/cursors/unit1.lfm svneol=native#text/plain
examples/cursors/unit1.pas svneol=native#text/pascal
examples/customhint/CustomHint1.ico -text svneol=unset#image/ico
examples/customhint/CustomHint1.lpi svneol=native#text/plain
examples/customhint/CustomHint1.lpr svneol=native#text/plain
examples/customhint/CustomHint1.res -text
examples/customhint/unit1.lfm svneol=native#text/plain
examples/customhint/unit1.pas svneol=native#text/plain
examples/database/dblookup/data/lookerup.dbf -text
examples/database/dblookup/data/lookerup.mbf -text
examples/database/dblookup/data/months.dbf -text

BIN
examples/customhint/CustomHint1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

80
examples/customhint/CustomHint1.lpi Normal file
View File

@ -0,0 +1,80 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<Title Value="CustomHint1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="CustomHint1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CustomHint1"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="CustomHint1"/>
</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>

21
examples/customhint/CustomHint1.lpr Normal file
View File

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

BIN
examples/customhint/CustomHint1.res Normal file
View File

Binary file not shown.

58
examples/customhint/unit1.lfm Normal file
View File

@ -0,0 +1,58 @@
object Form1: TForm1
Left = 408
Height = 246
Top = 286
Width = 443
Caption = 'Form1'
ClientHeight = 246
ClientWidth = 443
OnCreate = FormCreate
LCLVersion = '1.5'
object Button1: TButton
Left = 30
Height = 27
Top = 30
Width = 260
AutoSize = True
Caption = 'Hover mouse over this button to see the hint'
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object HideTimeoutTrackBar: TTrackBar
Left = 30
Height = 44
Top = 90
Width = 170
Max = 4000
PageSize = 1
Position = 500
TabOrder = 1
end
object HideTimeoutLabel: TLabel
Left = 220
Height = 15
Top = 104
Width = 102
Caption = 'HideTimeout in ms'
ParentColor = False
end
object ReshowTimeoutLabel: TLabel
Left = 220
Height = 15
Top = 166
Width = 120
Caption = 'ReshowTimeout in ms'
ParentColor = False
end
object ReshowTimeoutTrackBar: TTrackBar
Left = 30
Height = 44
Top = 150
Width = 170
Max = 2000
PageSize = 1
Position = 1000
TabOrder = 2
end
end

68
examples/customhint/unit1.pas Normal file
View File

@ -0,0 +1,68 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LazLogger, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, ComCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
HideTimeoutLabel: TLabel;
HideTimeoutTrackBar: TTrackBar;
ReshowTimeoutLabel: TLabel;
ReshowTimeoutTrackBar: TTrackBar;
procedure FormCreate(Sender: TObject);
procedure Button1ShowHint(Sender: TObject; HintInfo: PHintInfo);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.OnShowHint:=@Button1ShowHint;
end;
procedure TForm1.Button1ShowHint(Sender: TObject; HintInfo: PHintInfo);
var
Hour: word;
Minute: word;
Second: word;
MilliSecond: word;
begin
DebugLn(['TForm1.Button1ShowHint',
' HintControl=',DbgSName(HintInfo^.HintControl),
' HintWindowClass=',DbgSName(HintInfo^.HintWindowClass),
' HintPos=',dbgs(HintInfo^.HintPos),
' HintMaxWidth=',HintInfo^.HintMaxWidth,
' HintColor=',dbgs(HintInfo^.HintColor),
' CursorRect=',dbgs(HintInfo^.CursorRect),
' CursorPos=',dbgs(HintInfo^.CursorPos),
' ReshowTimeout=',HintInfo^.ReshowTimeout,
' HideTimeout=',HintInfo^.HideTimeout,
' HintStr=',dbgstr(HintInfo^.HintStr),
' HintData=',dbgs(HintInfo^.HintData)
]);
DecodeTime(Now, Hour, Minute, Second, MilliSecond);
HintInfo^.HintStr:=Format('Time: %2D:%2D:%2D.%4D',[Hour, Minute, Second, MilliSecond]);
HintInfo^.HideTimeout:=HideTimeoutTrackBar.Position;
HintInfo^.ReshowTimeout:=ReshowTimeoutTrackBar.Position;
end;
end.