You've already forked lazarus-ccr
jvcllaz: Add JvHtControls and JvValidators ported by Michal Gawrycki (issue #0031026). Fixed some Linux-related issued. Clean up of hints and warnings.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5392 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
92
components/jvcllaz/examples/JvHTControls/JvHTCtrlsDemo.lpi
Normal file
92
components/jvcllaz/examples/JvHTControls/JvHTCtrlsDemo.lpi
Normal file
@ -0,0 +1,92 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="10"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="JvHTCtrlsDemo"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<TextName Value="CompanyName.ProductName.AppName"/>
|
||||||
|
<TextDesc Value="Your application description."/>
|
||||||
|
</XPManifest>
|
||||||
|
<Icon Value="0"/>
|
||||||
|
</General>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="4">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="MemDSLaz"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="jvhtcontrolslaz"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item4>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="JvHTCtrlsDemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="unit1.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
<UnitName Value="Unit1"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="..\..\bin\JvHTCtrlsDemo"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<UseExternalDbgSyms Value="True"/>
|
||||||
|
</Debugging>
|
||||||
|
<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
components/jvcllaz/examples/JvHTControls/JvHTCtrlsDemo.lpr
Normal file
21
components/jvcllaz/examples/JvHTControls/JvHTCtrlsDemo.lpr
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
program JvHTCtrlsDemo;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms, memdslaz, Unit1
|
||||||
|
{ you can add units after this };
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
RequireDerivedFormResource:=True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
269
components/jvcllaz/examples/JvHTControls/unit1.lfm
Normal file
269
components/jvcllaz/examples/JvHTControls/unit1.lfm
Normal file
@ -0,0 +1,269 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 256
|
||||||
|
Height = 468
|
||||||
|
Top = 122
|
||||||
|
Width = 582
|
||||||
|
Caption = 'JvHTControls'
|
||||||
|
ClientHeight = 468
|
||||||
|
ClientWidth = 582
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnShow = FormShow
|
||||||
|
LCLVersion = '1.7'
|
||||||
|
object PageControl1: TPageControl
|
||||||
|
Left = 0
|
||||||
|
Height = 422
|
||||||
|
Top = 0
|
||||||
|
Width = 582
|
||||||
|
ActivePage = TabSheet1
|
||||||
|
Align = alClient
|
||||||
|
TabIndex = 0
|
||||||
|
TabOrder = 0
|
||||||
|
object TabSheet1: TTabSheet
|
||||||
|
Caption = 'TJvHTLabel'
|
||||||
|
ClientHeight = 394
|
||||||
|
ClientWidth = 574
|
||||||
|
object JvHTLabel1: TJvHTLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 106
|
||||||
|
Hint = 'HTLabel with:<br>'#13#10'<b>bold</b><br>'#13#10'<i>italic</i><br>'#13#10'<u>underline</u><br>'#13#10'<s>strikeout</s><br>'#13#10'<font color="clRed">c</font><font color="clblue">o</font><font color="clGreen">l</font><font color="clFuchsia">o</font><font color="clMaroon">r</font><br>'#13#10'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
|
||||||
|
Top = 8
|
||||||
|
Width = 120
|
||||||
|
Caption = 'HTLabel with:<br>'#13#10'<b>bold</b><br>'#13#10'<i>italic</i><br>'#13#10'<u>underline</u><br>'#13#10'<s>strikeout</s><br>'#13#10'<font color="clRed">c</font><font color="clblue">o</font><font color="clGreen">l</font><font color="clFuchsia">o</font><font color="clMaroon">r</font><br>'#13#10'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
|
||||||
|
ParentColor = False
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
OnHyperLinkClick = JvHTLabel1HyperLinkClick
|
||||||
|
end
|
||||||
|
object Memo1: TMemo
|
||||||
|
Left = 0
|
||||||
|
Height = 122
|
||||||
|
Hint = '<b>HTML</b><br>'#13#10'<i>Enter HTML content</i>'
|
||||||
|
Top = 272
|
||||||
|
Width = 574
|
||||||
|
Align = alBottom
|
||||||
|
Lines.Strings = (
|
||||||
|
'HTLabel with:<br>'
|
||||||
|
'<b>bold</b><br>'
|
||||||
|
'<i>italic</i><br>'
|
||||||
|
'<u>underline</u><br>'
|
||||||
|
'<s>strikeout</s><br>'
|
||||||
|
'<font color="clRed">c</font><font color="clblue">o</font><font color="clGreen">l</font><font color="clFuchsia">o</font><font color="clMaroon">r</font><br>'
|
||||||
|
'<a href="http://www.freepascal.org/">Links</a> and <a href="custom">custom links</a>'
|
||||||
|
)
|
||||||
|
OnChange = Memo1Change
|
||||||
|
ParentFont = False
|
||||||
|
ParentShowHint = False
|
||||||
|
ScrollBars = ssAutoBoth
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 0
|
||||||
|
WordWrap = False
|
||||||
|
end
|
||||||
|
object Splitter1: TSplitter
|
||||||
|
Cursor = crVSplit
|
||||||
|
Left = 0
|
||||||
|
Height = 5
|
||||||
|
Top = 267
|
||||||
|
Width = 574
|
||||||
|
Align = alBottom
|
||||||
|
ResizeAnchor = akBottom
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object TabSheet2: TTabSheet
|
||||||
|
Caption = 'TJvHTListBox'
|
||||||
|
ClientHeight = 394
|
||||||
|
ClientWidth = 574
|
||||||
|
object JvHTListBox1: TJvHTListBox
|
||||||
|
Left = 0
|
||||||
|
Height = 394
|
||||||
|
Hint = '<b>TJvHTListBox</b><br>'#13#10'<i>ListBox with HT items</i>'
|
||||||
|
Top = 0
|
||||||
|
Width = 152
|
||||||
|
HideSel = False
|
||||||
|
OnHyperLinkClick = JvHTListBox1HyperLinkClick
|
||||||
|
Align = alLeft
|
||||||
|
ColorHighlight = clHighlight
|
||||||
|
ColorHighlightText = clHighlightText
|
||||||
|
ColorDisabledText = clGrayText
|
||||||
|
Items.Strings = (
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
)
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object Splitter2: TSplitter
|
||||||
|
Left = 152
|
||||||
|
Height = 394
|
||||||
|
Top = 0
|
||||||
|
Width = 5
|
||||||
|
end
|
||||||
|
object Memo2: TMemo
|
||||||
|
Left = 160
|
||||||
|
Height = 90
|
||||||
|
Hint = '<b>New item content</b><br><i>Enter new item contnent</i>'
|
||||||
|
Top = 8
|
||||||
|
Width = 406
|
||||||
|
Anchors = [akTop, akLeft, akRight]
|
||||||
|
Lines.Strings = (
|
||||||
|
'new item...'
|
||||||
|
)
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object Button1: TButton
|
||||||
|
Left = 160
|
||||||
|
Height = 25
|
||||||
|
Hint = '<b>Add item</b><br>'#13#10'<i>Add item to ListBox and ComboBox</i>'
|
||||||
|
Top = 112
|
||||||
|
Width = 75
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Add item'
|
||||||
|
OnClick = Button1Click
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object JvHTComboBox1: TJvHTComboBox
|
||||||
|
Left = 160
|
||||||
|
Height = 24
|
||||||
|
Hint = '<b>TJvHTComboBox</b><br>'#13#10'<i>ComboBox with HT items</i>'
|
||||||
|
Top = 160
|
||||||
|
Width = 152
|
||||||
|
HideSel = False
|
||||||
|
ColorHighlight = clHighlight
|
||||||
|
ColorHighlightText = clHighlightText
|
||||||
|
ColorDisabledText = clGrayText
|
||||||
|
Items.Strings = (
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
'<b>Lazarus</b><br><a href="http://www.lazarus-ide.org/">Home page</a> or <a hred="http://forum.lazarus.freepascal.org/">Forum</a>'
|
||||||
|
'<b>Free Pascal</b><br><a href="http://www.freepascal.org/">Home page</a>'
|
||||||
|
'<b>Other...</b><br><i>Other stuff</i> <font color="clred">d-oh!</font>...'
|
||||||
|
)
|
||||||
|
ParentShowHint = False
|
||||||
|
ShowHint = True
|
||||||
|
TabOrder = 4
|
||||||
|
Text = 'JvHTComboBox1'
|
||||||
|
end
|
||||||
|
object Button2: TButton
|
||||||
|
Left = 264
|
||||||
|
Height = 25
|
||||||
|
Top = 112
|
||||||
|
Width = 53
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Clear'
|
||||||
|
OnClick = Button2Click
|
||||||
|
TabOrder = 5
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object TabSheet3: TTabSheet
|
||||||
|
Caption = 'TJvDBHTLabel'
|
||||||
|
ClientHeight = 394
|
||||||
|
ClientWidth = 574
|
||||||
|
object JvDBHTLabel1: TJvDBHTLabel
|
||||||
|
Left = 8
|
||||||
|
Height = 76
|
||||||
|
Top = 8
|
||||||
|
Width = 82
|
||||||
|
DataSource = DataSource1
|
||||||
|
Mask = 'Numeric field: <b><field="Num"></b><br>Field 1: <b><font color="clRed"><field="fld1"></font></b><br><i>Field 2:</i> <b><font color="clGreen"><field="fld2"></font></b><br>And some link: <a href="url"><field="Fld1"></a><br><a href="qwe">#<field="num"></a> - <b><field="fld1"> <field="fld2"></b>'
|
||||||
|
ParentColor = False
|
||||||
|
OnHyperLinkClick = JvDBHTLabel1HyperLinkClick
|
||||||
|
end
|
||||||
|
object DBGrid1: TDBGrid
|
||||||
|
Left = 0
|
||||||
|
Height = 130
|
||||||
|
Top = 264
|
||||||
|
Width = 574
|
||||||
|
Align = alBottom
|
||||||
|
Color = clWindow
|
||||||
|
Columns = <>
|
||||||
|
DataSource = DataSource1
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object Splitter3: TSplitter
|
||||||
|
Cursor = crVSplit
|
||||||
|
Left = 0
|
||||||
|
Height = 5
|
||||||
|
Top = 259
|
||||||
|
Width = 574
|
||||||
|
Align = alBottom
|
||||||
|
ResizeAnchor = akBottom
|
||||||
|
end
|
||||||
|
object Memo3: TMemo
|
||||||
|
Left = 0
|
||||||
|
Height = 99
|
||||||
|
Top = 160
|
||||||
|
Width = 574
|
||||||
|
Align = alBottom
|
||||||
|
Lines.Strings = (
|
||||||
|
'Numeric field: <b><field="Num"></b><br>Field 1: <b><font color="clRed"><field="fld1"></font></b><br><i>Field 2:</i> <b><font color="clGreen"><field="fld2"></font></b><br>And some link: <a href="url"><field="Fld1"></a><br><a href="qwe">#<field="num"></a> - <b><field="fld1"> <field="fld2"></b>'
|
||||||
|
)
|
||||||
|
OnChange = Memo3Change
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object ButtonPanel1: TButtonPanel
|
||||||
|
Left = 6
|
||||||
|
Height = 34
|
||||||
|
Top = 428
|
||||||
|
Width = 570
|
||||||
|
OKButton.Name = 'OKButton'
|
||||||
|
OKButton.DefaultCaption = True
|
||||||
|
HelpButton.Name = 'HelpButton'
|
||||||
|
HelpButton.DefaultCaption = True
|
||||||
|
CloseButton.Name = 'CloseButton'
|
||||||
|
CloseButton.Hint = '<b>Exit</b><br>'#13#10'<i>Exit application</i>'
|
||||||
|
CloseButton.DefaultCaption = True
|
||||||
|
CloseButton.ShowHint = True
|
||||||
|
CancelButton.Name = 'CancelButton'
|
||||||
|
CancelButton.DefaultCaption = True
|
||||||
|
TabOrder = 1
|
||||||
|
ShowButtons = [pbClose]
|
||||||
|
end
|
||||||
|
object MemDataset1: TMemDataset
|
||||||
|
Active = True
|
||||||
|
FieldDefs = <
|
||||||
|
item
|
||||||
|
Name = 'Num'
|
||||||
|
DataType = ftInteger
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Name = 'Fld1'
|
||||||
|
DataType = ftString
|
||||||
|
Size = 20
|
||||||
|
end
|
||||||
|
item
|
||||||
|
Name = 'Fld2'
|
||||||
|
DataType = ftString
|
||||||
|
Size = 20
|
||||||
|
end>
|
||||||
|
left = 384
|
||||||
|
top = 112
|
||||||
|
end
|
||||||
|
object DataSource1: TDataSource
|
||||||
|
DataSet = MemDataset1
|
||||||
|
left = 464
|
||||||
|
top = 112
|
||||||
|
end
|
||||||
|
end
|
||||||
114
components/jvcllaz/examples/JvHTControls/unit1.pas
Normal file
114
components/jvcllaz/examples/JvHTControls/unit1.pas
Normal file
@ -0,0 +1,114 @@
|
|||||||
|
unit Unit1;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
||||||
|
StdCtrls, ButtonPanel, ExtCtrls, DBGrids, JvHtControls, JvHint, JvDBHTLabel,
|
||||||
|
memds, db;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
Button1: TButton;
|
||||||
|
Button2: TButton;
|
||||||
|
ButtonPanel1: TButtonPanel;
|
||||||
|
DataSource1: TDataSource;
|
||||||
|
DBGrid1: TDBGrid;
|
||||||
|
JvDBHTLabel1: TJvDBHTLabel;
|
||||||
|
JvHTComboBox1: TJvHTComboBox;
|
||||||
|
JvHTLabel1: TJvHTLabel;
|
||||||
|
JvHTListBox1: TJvHTListBox;
|
||||||
|
MemDataset1: TMemDataset;
|
||||||
|
Memo1: TMemo;
|
||||||
|
Memo2: TMemo;
|
||||||
|
Memo3: TMemo;
|
||||||
|
PageControl1: TPageControl;
|
||||||
|
Splitter1: TSplitter;
|
||||||
|
Splitter2: TSplitter;
|
||||||
|
Splitter3: TSplitter;
|
||||||
|
TabSheet1: TTabSheet;
|
||||||
|
TabSheet2: TTabSheet;
|
||||||
|
TabSheet3: TTabSheet;
|
||||||
|
procedure Button1Click(Sender: TObject);
|
||||||
|
procedure Button2Click(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
procedure JvDBHTLabel1HyperLinkClick(Sender: TObject; LinkName: string);
|
||||||
|
procedure JvHTLabel1HyperLinkClick(Sender: TObject; LinkName: string);
|
||||||
|
procedure JvHTListBox1HyperLinkClick(Sender: TObject; LinkName: string);
|
||||||
|
procedure Memo1Change(Sender: TObject);
|
||||||
|
procedure Memo3Change(Sender: TObject);
|
||||||
|
private
|
||||||
|
|
||||||
|
public
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.Memo1Change(Sender: TObject);
|
||||||
|
begin
|
||||||
|
JvHTLabel1.Caption := Memo1.Text;
|
||||||
|
JvHTLabel1.Hint := Memo1.Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Memo3Change(Sender: TObject);
|
||||||
|
begin
|
||||||
|
JvDBHTLabel1.Mask := Memo3.Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
RegisterHtHints;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
MemDataset1.AppendRecord([1, 'asdfxc', 'wertfx']);
|
||||||
|
MemDataset1.AppendRecord([2, 'brdrgrsdgx', 'sdfwetrcx']);
|
||||||
|
MemDataset1.AppendRecord([3, 'bhtesdxcv', 'wytsfsv']);
|
||||||
|
MemDataset1.AppendRecord([4, 'sdgrdthc', 'klvbsdfwe85']);
|
||||||
|
MemDataset1.AppendRecord([5, 'trcbxg', 'her4fekg']);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.JvDBHTLabel1HyperLinkClick(Sender: TObject; LinkName: string);
|
||||||
|
begin
|
||||||
|
MessageDlg('TJvDBHTLabel', 'Hyperlink: ' + LinkName, mtInformation, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
JvHTListBox1.Items.Add(Memo2.Text);
|
||||||
|
JvHTComboBox1.Items.Add(Memo2.Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button2Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
JvHTComboBox1.Items.Clear;
|
||||||
|
JvHTListBox1.Items.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.JvHTLabel1HyperLinkClick(Sender: TObject; LinkName: string);
|
||||||
|
begin
|
||||||
|
MessageDlg('TJvHTLabel', 'Hyperlink: ' + LinkName, mtInformation, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.JvHTListBox1HyperLinkClick(Sender: TObject; LinkName: string);
|
||||||
|
begin
|
||||||
|
MessageDlg('JvHTListBox', 'Hyperlink: ' + LinkName, mtInformation, [mbOK], 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
102
components/jvcllaz/examples/JvValidators/JvValidatorsDemo.lpi
Normal file
102
components/jvcllaz/examples/JvValidators/JvValidatorsDemo.lpi
Normal file
@ -0,0 +1,102 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="10"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="JvValidatorsDemo"/>
|
||||||
|
<UseAppBundle Value="False"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<TextName Value="CompanyName.ProductName.AppName"/>
|
||||||
|
<TextDesc Value="Your application description."/>
|
||||||
|
</XPManifest>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="JvValidatorLaz"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="JvValidatorsDemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="MainFrm.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="frmMain"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="..\..\bin\JvValidatorsDemo"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
<ObjectPath Value="..\..\run"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<SyntaxMode Value="Delphi"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<UseExternalDbgSyms Value="True"/>
|
||||||
|
</Debugging>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
@ -0,0 +1,15 @@
|
|||||||
|
program JvValidatorsDemo;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Forms, Interfaces,
|
||||||
|
MainFrm in 'MainFrm.pas' {frmMain};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TfrmMain, frmMain);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
208
components/jvcllaz/examples/JvValidators/MainFrm.lfm
Normal file
208
components/jvcllaz/examples/JvValidators/MainFrm.lfm
Normal file
@ -0,0 +1,208 @@
|
|||||||
|
object frmMain: TfrmMain
|
||||||
|
Left = 306
|
||||||
|
Height = 274
|
||||||
|
Top = 126
|
||||||
|
Width = 619
|
||||||
|
Caption = 'JvValidators demo'
|
||||||
|
ClientHeight = 274
|
||||||
|
ClientWidth = 619
|
||||||
|
Color = clBtnFace
|
||||||
|
Constraints.MinHeight = 270
|
||||||
|
Constraints.MinWidth = 560
|
||||||
|
DefaultMonitor = dmDesktop
|
||||||
|
Font.Color = clWindowText
|
||||||
|
OnCreate = FormCreate
|
||||||
|
Position = poScreenCenter
|
||||||
|
LCLVersion = '1.7'
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 16
|
||||||
|
Width = 167
|
||||||
|
Caption = 'This edit must have a(ny) value:'
|
||||||
|
FocusControl = edRequired
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 64
|
||||||
|
Width = 233
|
||||||
|
Caption = 'This edit must have more than 9 characters:'
|
||||||
|
FocusControl = edRequired10Chars
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 112
|
||||||
|
Width = 228
|
||||||
|
Caption = 'This edit must match the reg. expr."A.B.C.":'
|
||||||
|
FocusControl = edRegExpr
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 160
|
||||||
|
Width = 201
|
||||||
|
Caption = 'The value must be between 0 and 100:'
|
||||||
|
FocusControl = edRange0to100
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label5: TLabel
|
||||||
|
Left = 280
|
||||||
|
Height = 15
|
||||||
|
Top = 16
|
||||||
|
Width = 35
|
||||||
|
Caption = 'Result:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object edRequired: TEdit
|
||||||
|
Left = 16
|
||||||
|
Height = 23
|
||||||
|
Top = 32
|
||||||
|
Width = 240
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object edRequired10Chars: TEdit
|
||||||
|
Left = 16
|
||||||
|
Height = 23
|
||||||
|
Top = 80
|
||||||
|
Width = 240
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object edRegExpr: TEdit
|
||||||
|
Left = 16
|
||||||
|
Height = 23
|
||||||
|
Top = 128
|
||||||
|
Width = 240
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object edRange0to100: TEdit
|
||||||
|
Left = 16
|
||||||
|
Height = 23
|
||||||
|
Top = 176
|
||||||
|
Width = 227
|
||||||
|
TabOrder = 3
|
||||||
|
Text = '-1'
|
||||||
|
end
|
||||||
|
object udRange0to100: TUpDown
|
||||||
|
Left = 243
|
||||||
|
Height = 23
|
||||||
|
Top = 176
|
||||||
|
Width = 15
|
||||||
|
Associate = edRange0to100
|
||||||
|
Max = 200
|
||||||
|
Min = -100
|
||||||
|
Position = -1
|
||||||
|
TabOrder = 4
|
||||||
|
Wrap = False
|
||||||
|
end
|
||||||
|
object btnCheck: TButton
|
||||||
|
Left = 336
|
||||||
|
Height = 25
|
||||||
|
Top = 224
|
||||||
|
Width = 137
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Use OnValidateFailed'
|
||||||
|
OnClick = btnCheckClick
|
||||||
|
TabOrder = 7
|
||||||
|
end
|
||||||
|
object btnProviderCheck: TButton
|
||||||
|
Left = 16
|
||||||
|
Height = 25
|
||||||
|
Top = 224
|
||||||
|
Width = 130
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Use JvErrorIndicator'
|
||||||
|
OnClick = btnProviderCheckClick
|
||||||
|
TabOrder = 5
|
||||||
|
end
|
||||||
|
object reResults: TMemo
|
||||||
|
Cursor = crArrow
|
||||||
|
Left = 280
|
||||||
|
Height = 167
|
||||||
|
Top = 32
|
||||||
|
Width = 326
|
||||||
|
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||||
|
Lines.Strings = (
|
||||||
|
'This is a demo for the JvValidators component as well as the JvErrorProvider and, to some extent, the JvValidationSummary component.'
|
||||||
|
''
|
||||||
|
'By creating and setting up different validators (at run-time in this demo but you can do it at design-time as well), the edit boxes can be checked for validity by a single call to the Validate method. When one of the validators finds that a control doesn''t match the validation criteria, that error can be handled in different ways depending on your needs.'
|
||||||
|
''
|
||||||
|
'One option is to just check the boolean return value from Validate and display a standard message box telling the user that a value didn''t match.'
|
||||||
|
''
|
||||||
|
'You can also handle the OnValidateFailed event of all validators at once (the TJvValidators event) or for each validator separately (the TJvBaseValidator event). Yet another option is to assign a TJvValidationSummary component to the ValidationSummary property of tJvValidators and handle it''s OnChange event.'
|
||||||
|
''
|
||||||
|
'Finally, you can combine the work of the validators with the use of a TJvErrorIndicator.'
|
||||||
|
''
|
||||||
|
'For more info on TJvErrorIndicator, see the demo for that component (also included).'
|
||||||
|
''
|
||||||
|
'By clicking any of the buttons below, you can see how the different methods described work in real-time.'
|
||||||
|
''
|
||||||
|
''
|
||||||
|
)
|
||||||
|
OnEnter = reResultsEnter
|
||||||
|
ParentColor = True
|
||||||
|
ReadOnly = True
|
||||||
|
ScrollBars = ssBoth
|
||||||
|
TabOrder = 8
|
||||||
|
TabStop = False
|
||||||
|
WordWrap = False
|
||||||
|
end
|
||||||
|
object btnValSum: TButton
|
||||||
|
Left = 160
|
||||||
|
Height = 25
|
||||||
|
Top = 224
|
||||||
|
Width = 162
|
||||||
|
Anchors = [akLeft, akBottom]
|
||||||
|
AutoSize = True
|
||||||
|
Caption = 'Use JvValidationSummary'
|
||||||
|
OnClick = btnValSumClick
|
||||||
|
TabOrder = 6
|
||||||
|
end
|
||||||
|
object JvValidators1: TJvValidators
|
||||||
|
OnValidateFailed = JvValidators1ValidateFailed
|
||||||
|
left = 258
|
||||||
|
top = 104
|
||||||
|
object JvRequiredFieldValidator1: TJvRequiredFieldValidator
|
||||||
|
ControlToValidate = edRequired
|
||||||
|
PropertyToValidate = 'Text'
|
||||||
|
ErrorMessage = 'Value in edRequired cannot be empty'
|
||||||
|
AllowBlank = False
|
||||||
|
end
|
||||||
|
object JvCustomValidator1: TJvCustomValidator
|
||||||
|
ControlToValidate = edRequired10Chars
|
||||||
|
PropertyToValidate = 'Text'
|
||||||
|
ErrorMessage = 'Value in "edRequired10Chars" requires at least 10 characters'
|
||||||
|
OnValidate = JvCustomValidator1Validate
|
||||||
|
end
|
||||||
|
object JvRegularExpressionValidator1: TJvRegularExpressionValidator
|
||||||
|
ControlToValidate = edRegExpr
|
||||||
|
PropertyToValidate = 'Text'
|
||||||
|
ErrorMessage = 'Value in "edRegExpr" does not match "A.B.C."'
|
||||||
|
ValidationExpression = '^A.B.C.*'
|
||||||
|
end
|
||||||
|
object JvRangeValidator1: TJvRangeValidator
|
||||||
|
ControlToValidate = udRange0to100
|
||||||
|
PropertyToValidate = 'Position'
|
||||||
|
ErrorMessage = 'Value in "udRange0to100" must be between 0 and 100'
|
||||||
|
MinimumValue = 0
|
||||||
|
MaximumValue = 100
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object JvErrorIndicator1: TJvErrorIndicator
|
||||||
|
ImageIndex = 0
|
||||||
|
DefaultUseAnchors = False
|
||||||
|
left = 296
|
||||||
|
top = 104
|
||||||
|
end
|
||||||
|
object JvValidationSummary1: TJvValidationSummary
|
||||||
|
OnChange = JvValidationSummary1Change
|
||||||
|
left = 328
|
||||||
|
top = 104
|
||||||
|
end
|
||||||
|
end
|
||||||
174
components/jvcllaz/examples/JvValidators/MainFrm.pas
Normal file
174
components/jvcllaz/examples/JvValidators/MainFrm.pas
Normal file
@ -0,0 +1,174 @@
|
|||||||
|
{******************************************************************
|
||||||
|
|
||||||
|
JEDI-VCL Demo
|
||||||
|
|
||||||
|
Copyright (C) 2002 Project JEDI
|
||||||
|
|
||||||
|
Original author:
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the JEDI-JVCL
|
||||||
|
home page, located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
The contents of this file are used with permission, subject to
|
||||||
|
the Mozilla Public License Version 1.1 (the "License"); you may
|
||||||
|
not use this file except in compliance with the License. You may
|
||||||
|
obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1_1Final.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an
|
||||||
|
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||||
|
implied. See the License for the specific language governing
|
||||||
|
rights and limitations under the License.
|
||||||
|
|
||||||
|
******************************************************************}
|
||||||
|
|
||||||
|
unit MainFrm;
|
||||||
|
|
||||||
|
{.$I jvcl.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||||
|
StdCtrls, ComCtrls, JvValidators, JvErrorIndicator;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TfrmMain }
|
||||||
|
|
||||||
|
TfrmMain = class(TForm)
|
||||||
|
Label1: TLabel;
|
||||||
|
edRequired: TEdit;
|
||||||
|
Label2: TLabel;
|
||||||
|
edRequired10Chars: TEdit;
|
||||||
|
Label3: TLabel;
|
||||||
|
edRegExpr: TEdit;
|
||||||
|
Label4: TLabel;
|
||||||
|
edRange0to100: TEdit;
|
||||||
|
udRange0to100: TUpDown;
|
||||||
|
btnCheck: TButton;
|
||||||
|
Label5: TLabel;
|
||||||
|
btnProviderCheck: TButton;
|
||||||
|
reResults: TMemo;
|
||||||
|
btnValSum: TButton;
|
||||||
|
JvValidators1: TJvValidators;
|
||||||
|
JvErrorIndicator1: TJvErrorIndicator;
|
||||||
|
JvValidationSummary1: TJvValidationSummary;
|
||||||
|
JvRequiredFieldValidator1: TJvRequiredFieldValidator;
|
||||||
|
JvCustomValidator1: TJvCustomValidator;
|
||||||
|
JvRegularExpressionValidator1: TJvRegularExpressionValidator;
|
||||||
|
JvRangeValidator1: TJvRangeValidator;
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure btnCheckClick(Sender: TObject);
|
||||||
|
procedure btnProviderCheckClick(Sender: TObject);
|
||||||
|
procedure btnValSumClick(Sender: TObject);
|
||||||
|
procedure reResultsEnter(Sender: TObject);
|
||||||
|
procedure JvCustomValidator1Validate(Sender: TObject;
|
||||||
|
ValueToValidate: Variant; var Valid: Boolean);
|
||||||
|
procedure JvValidators1ValidateFailed(Sender: TObject;
|
||||||
|
BaseValidator: TJvBaseValidator; var Continue: Boolean);
|
||||||
|
procedure JvValidationSummary1Change(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
procedure ProviderErrorValidateFailed(Sender: TObject;
|
||||||
|
BaseValidator: TJvBaseValidator; var Continue: Boolean);
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
frmMain: TfrmMain;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Variants;
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
procedure TfrmMain.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
reResults.WordWrap := true;
|
||||||
|
JvValidators1.ErrorIndicator := JvErrorIndicator1;
|
||||||
|
JvValidators1.ValidationSummary := JvValidationSummary1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.btnCheckClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
reResults.Lines.Clear;
|
||||||
|
reResults.WordWrap := false;
|
||||||
|
JvErrorIndicator1.ClearErrors;
|
||||||
|
JvValidators1.ValidationSummary := nil;
|
||||||
|
JvValidators1.ErrorIndicator := nil;
|
||||||
|
JvValidators1.OnValidateFailed := JvValidators1ValidateFailed;
|
||||||
|
JvValidators1.Validate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.btnProviderCheckClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
reResults.Lines.Clear;
|
||||||
|
reResults.WordWrap := false;
|
||||||
|
// calling BeginUpdate/EndUpdate delays the error reporting until all controls have been validated
|
||||||
|
JvErrorIndicator1.BeginUpdate;
|
||||||
|
try
|
||||||
|
JvErrorIndicator1.ClearErrors;
|
||||||
|
JvValidators1.ValidationSummary := nil;
|
||||||
|
// custom error messages for this type of check
|
||||||
|
JvValidators1.OnValidateFailed := ProviderErrorValidateFailed;
|
||||||
|
JvValidators1.Validate;
|
||||||
|
finally
|
||||||
|
JvErrorIndicator1.EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.btnValSumClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
reResults.Lines.Clear;
|
||||||
|
reResults.WordWrap := false;
|
||||||
|
JvErrorIndicator1.ClearErrors;
|
||||||
|
JvValidators1.OnValidateFailed := nil;
|
||||||
|
JvValidators1.ErrorIndicator := nil;
|
||||||
|
// Setting the ValidationSummary for TJvValidators will delay
|
||||||
|
// triggering the OnChange event until after Validate has completed
|
||||||
|
JvValidationSummary1.Summaries.Clear;
|
||||||
|
JvValidators1.ValidationSummary := JvValidationSummary1;
|
||||||
|
JvValidators1.Validate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.reResultsEnter(Sender: TObject);
|
||||||
|
begin
|
||||||
|
SelectNext(reResults,true,true);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.JvCustomValidator1Validate(Sender: TObject;
|
||||||
|
ValueToValidate: Variant; var Valid: Boolean);
|
||||||
|
begin
|
||||||
|
// custom validation
|
||||||
|
Valid := not VarIsNull(ValueToValidate) and (Length(string(ValueToValidate)) >= 10);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.JvValidators1ValidateFailed(Sender: TObject;
|
||||||
|
BaseValidator: TJvBaseValidator; var Continue: Boolean);
|
||||||
|
begin
|
||||||
|
// using the OnValidateFailed event
|
||||||
|
reResults.Lines.Add(Format('FAILED: %s',[BaseValidator.ErrorMessage]));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TfrmMain.ProviderErrorValidateFailed(Sender: TObject;
|
||||||
|
BaseValidator: TJvBaseValidator; var Continue: Boolean);
|
||||||
|
begin
|
||||||
|
JvErrorIndicator1.Error[BaseValidator.ControlToValidate] := BaseValidator.ErrorMessage;
|
||||||
|
reResults.Lines.Add(Format('PROVIDER: %s',[BaseValidator.ErrorMessage]));
|
||||||
|
end;
|
||||||
|
procedure TfrmMain.JvValidationSummary1Change(Sender: TObject);
|
||||||
|
var i:integer;
|
||||||
|
begin
|
||||||
|
// update all at once
|
||||||
|
reResults.Lines.Text := TJvValidationSummary(Sender).Summaries.Text;
|
||||||
|
for i := 0 to reResults.Lines.Count - 1 do
|
||||||
|
reResults.Lines[i] := 'SUMMARY: ' + reResults.Lines[i];
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@ -1,23 +1,24 @@
|
|||||||
<?xml version="1.0"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<Package Version="2">
|
<Package Version="4">
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<Name Value="JvXPBarLaz"/>
|
<Name Value="JvXPBarLaz"/>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<AddToProjectUsesSection Value="True"/>
|
||||||
<Author Value="Sergio Samayoa"/>
|
<Author Value="Sergio Samayoa"/>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="5"/>
|
<Version Value="11"/>
|
||||||
<PathDelim Value="\"/>
|
<PathDelim Value="\"/>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<IncludeFiles Value="..\resource\"/>
|
<IncludeFiles Value="..\resource"/>
|
||||||
<OtherUnitFiles Value="..\run\"/>
|
<OtherUnitFiles Value="..\run"/>
|
||||||
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<Parsing>
|
||||||
<Generate Value="Faster"/>
|
<SyntaxOptions>
|
||||||
</CodeGeneration>
|
<UseAnsiStrings Value="False"/>
|
||||||
<Other>
|
</SyntaxOptions>
|
||||||
<CompilerPath Value="$(CompPath)"/>
|
</Parsing>
|
||||||
</Other>
|
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Description Value="JvXPBar (JVCL) conversion for Lazarus version 1.0
|
<Description Value="JvXPBar (JVCL) conversion for Lazarus version 1.0
|
||||||
"/>
|
"/>
|
||||||
@ -42,7 +43,6 @@
|
|||||||
<UnitName Value="JvXPBarReg"/>
|
<UnitName Value="JvXPBarReg"/>
|
||||||
</Item4>
|
</Item4>
|
||||||
</Files>
|
</Files>
|
||||||
<Type Value="RunAndDesignTime"/>
|
|
||||||
<RequiredPkgs Count="3">
|
<RequiredPkgs Count="3">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="JvCoreLaz"/>
|
<PackageName Value="JvCoreLaz"/>
|
||||||
@ -56,7 +56,7 @@
|
|||||||
</Item3>
|
</Item3>
|
||||||
</RequiredPkgs>
|
</RequiredPkgs>
|
||||||
<UsageOptions>
|
<UsageOptions>
|
||||||
<UnitPath Value="$(PkgOutDir)\"/>
|
<UnitPath Value="$(PkgOutDir)"/>
|
||||||
</UsageOptions>
|
</UsageOptions>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
|
|||||||
59
components/jvcllaz/packages/jvhtcontrolslaz.lpk
Normal file
59
components/jvcllaz/packages/jvhtcontrolslaz.lpk
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<Package Version="4">
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Name Value="jvhtcontrolslaz"/>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<OtherUnitFiles Value="..\run;..\design"/>
|
||||||
|
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Files Count="5">
|
||||||
|
<Item1>
|
||||||
|
<Filename Value="..\run\JvHtControls.pas"/>
|
||||||
|
<UnitName Value="JvHtControls"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Filename Value="..\run\JvDBHTLabel.pas"/>
|
||||||
|
<UnitName Value="JvDBHTLabel"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Filename Value="..\run\JvHint.pas"/>
|
||||||
|
<UnitName Value="JvHint"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<Filename Value="jvhtcontrolsreg.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="jvhtcontrolsreg"/>
|
||||||
|
</Item4>
|
||||||
|
<Item5>
|
||||||
|
<Filename Value="..\design\JvHTHintForm.pas"/>
|
||||||
|
<UnitName Value="JvHTHintForm"/>
|
||||||
|
</Item5>
|
||||||
|
</Files>
|
||||||
|
<RequiredPkgs Count="3">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="IDEIntf"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="JvCoreLaz"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item3>
|
||||||
|
</RequiredPkgs>
|
||||||
|
<UsageOptions>
|
||||||
|
<UnitPath Value="$(PkgOutDir)"/>
|
||||||
|
</UsageOptions>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<CustomOptions Items="ExternHelp" Version="2">
|
||||||
|
<_ExternHelp Items="Count"/>
|
||||||
|
</CustomOptions>
|
||||||
|
</Package>
|
||||||
|
</CONFIG>
|
||||||
24
components/jvcllaz/packages/jvhtcontrolsreg.pas
Normal file
24
components/jvcllaz/packages/jvhtcontrolsreg.pas
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
unit jvhtcontrolsreg;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R ../resource/JvHTControlsReg.res}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, JvHtControls, JvDBHTLabel, JvHint, JvHTHintForm, PropEdits, Controls;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('JvHTControls', [TJvHTLabel, TJvHTComboBox, TJvHTListBox,
|
||||||
|
TJvDBHTLabel, TJvHint]);
|
||||||
|
RegisterPropertyEditor(TypeInfo(TCaption), TJvHTLabel, 'Caption', TJvHintProperty);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
57
components/jvcllaz/packages/jvvalidatorlaz.lpk
Normal file
57
components/jvcllaz/packages/jvvalidatorlaz.lpk
Normal file
@ -0,0 +1,57 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<Package Version="4">
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Name Value="JvValidatorLaz"/>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="..\resource"/>
|
||||||
|
<OtherUnitFiles Value="..\run;..\design"/>
|
||||||
|
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Files Count="4">
|
||||||
|
<Item1>
|
||||||
|
<Filename Value="..\run\JvErrorIndicator.pas"/>
|
||||||
|
<UnitName Value="JvErrorIndicator"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Filename Value="..\run\JvValidators.pas"/>
|
||||||
|
<UnitName Value="JvValidators"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Filename Value="jvvalidatorreg.pp"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<AddToUsesPkgSection Value="False"/>
|
||||||
|
<UnitName Value="JvValidatorReg"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<Filename Value="..\design\JvValidatorsEditorForm.pas"/>
|
||||||
|
<UnitName Value="JvValidatorsEditorForm"/>
|
||||||
|
</Item4>
|
||||||
|
</Files>
|
||||||
|
<RequiredPkgs Count="3">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="IDEIntf"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="JvCoreLaz"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item3>
|
||||||
|
</RequiredPkgs>
|
||||||
|
<UsageOptions>
|
||||||
|
<UnitPath Value="$(PkgOutDir)"/>
|
||||||
|
</UsageOptions>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<CustomOptions Items="ExternHelp" Version="2">
|
||||||
|
<_ExternHelp Items="Count"/>
|
||||||
|
</CustomOptions>
|
||||||
|
</Package>
|
||||||
|
</CONFIG>
|
||||||
36
components/jvcllaz/packages/jvvalidatorreg.pp
Normal file
36
components/jvcllaz/packages/jvvalidatorreg.pp
Normal file
@ -0,0 +1,36 @@
|
|||||||
|
unit JvValidatorReg;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, LResources, SysUtils, ComponentEditors, PropEdits, ImageListEditor,
|
||||||
|
GraphPropEdits;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R ..\resource\JvValidatorsReg.res}
|
||||||
|
|
||||||
|
uses JvValidators, JvErrorIndicator, JvValidatorsEditorForm;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterComponents('JvValidators', [TJvValidators, TJvValidationSummary, TJvErrorIndicator]);
|
||||||
|
RegisterNoIcon([TJvRequiredFieldValidator, TJvCompareValidator,
|
||||||
|
TJvRangeValidator, TJvRegularExpressionValidator, TJvCustomValidator, TJvControlsCompareValidator]);
|
||||||
|
|
||||||
|
RegisterComponentEditor(TJvValidators, TJvValidatorEditor);
|
||||||
|
RegisterPropertyEditor(TypeInfo(Integer), TJvErrorIndicator, 'ImageIndex', TImageIndexPropertyEditor);
|
||||||
|
// RegisterPropertyEditor(TypeInfo(string), TJvCustomFormatEdit, 'Characters', TJvCharStringProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TJvBaseValidator, 'PropertyToValidate', TJvPropertyValidateProperty);
|
||||||
|
RegisterPropertyEditor(TypeInfo(string), TJvBaseValidator, 'CompareToProperty', TJvPropertyToCompareProperty); end;
|
||||||
|
|
||||||
|
(*
|
||||||
|
initialization
|
||||||
|
{$I JvXPBarLaz.lrs}
|
||||||
|
*)
|
||||||
|
|
||||||
|
end.
|
||||||
268
components/jvcllaz/run/JvDBHTLabel.pas
Normal file
268
components/jvcllaz/run/JvDBHTLabel.pas
Normal file
@ -0,0 +1,268 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
The contents of this file are subject to the Mozilla Public License
|
||||||
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||||
|
with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
The Original Code is: JvDBHTLabel.PAS, released on 2004-02-01.
|
||||||
|
|
||||||
|
The Initial Developers of the Original Code are: Maciej Kaczkowski
|
||||||
|
Copyright (c) 2003 Maciej Kaczkowski
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's
|
||||||
|
JVCL home page, located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
- To display data from a datasource, use the <FIELD="fieldname"> tag in Mask.
|
||||||
|
- You can have more than one FIELD tag in a label, i.e:
|
||||||
|
<b>Name:</b><i><FIELD="contact"></i>, <b>Company:</b><i><FIELD="Company"></i>
|
||||||
|
- The fieldname *must* be double-quoted!
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvDBHTLabel;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
//{.$I jvcl.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, LMessages, DB, DBCtrls, Controls, JvHtControls;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvDBHTLabel = class(TJvCustomHTLabel)
|
||||||
|
private
|
||||||
|
FDataLink: TFieldDataLink;
|
||||||
|
FMask: string;
|
||||||
|
function GetDataSource: TDataSource;
|
||||||
|
procedure SetDataSource(const Value: TDataSource);
|
||||||
|
procedure DataChange(Sender: TObject);
|
||||||
|
procedure SetMask(const Value: string);
|
||||||
|
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
|
||||||
|
protected
|
||||||
|
function GetLabelText: string; override;
|
||||||
|
procedure Loaded; override;
|
||||||
|
procedure Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation); override;
|
||||||
|
//procedure SetAutoSize(Value: Boolean); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure UpdateCaption;
|
||||||
|
published
|
||||||
|
property DataSource: TDataSource read GetDataSource write SetDataSource;
|
||||||
|
property Mask: string read FMask write SetMask;
|
||||||
|
|
||||||
|
property Align;
|
||||||
|
property AutoSize;
|
||||||
|
property Constraints;
|
||||||
|
property Color;
|
||||||
|
property Layout;
|
||||||
|
property DragCursor;
|
||||||
|
property BiDiMode;
|
||||||
|
property DragKind;
|
||||||
|
property ParentBiDiMode;
|
||||||
|
property OnEndDock;
|
||||||
|
property OnStartDock;
|
||||||
|
property DragMode;
|
||||||
|
property Enabled;
|
||||||
|
property FocusControl;
|
||||||
|
property Font;
|
||||||
|
property ParentColor;
|
||||||
|
property ParentFont;
|
||||||
|
property ParentShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property Transparent;
|
||||||
|
property Visible;
|
||||||
|
property OnClick;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnDragDrop;
|
||||||
|
property OnDragOver;
|
||||||
|
property OnEndDrag;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnStartDrag;
|
||||||
|
property OnHyperLinkClick;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils{, dbconst};
|
||||||
|
|
||||||
|
function ReplaceFieldNameTag(Str: string; DataSet: TDataSet): string;
|
||||||
|
var
|
||||||
|
F: TField;
|
||||||
|
const
|
||||||
|
FieldName = 'FIELD'; // non-standard html
|
||||||
|
// FieldStr = '<' + FieldName + '=';
|
||||||
|
FieldLabelName = 'FIELDLABEL';
|
||||||
|
// FieldLabelStr = '<' + FieldLabelName + '=';
|
||||||
|
|
||||||
|
function ExtractPropertyValue(Tag, PropName: string): string;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
PropName := UpperCase(PropName);
|
||||||
|
if Pos(PropName, UpperCase(Tag)) > 0 then
|
||||||
|
begin
|
||||||
|
Result := Copy(Tag, Pos(PropName, UpperCase(Tag))+Length(PropName), Length(Tag));
|
||||||
|
Result := Copy(Result, Pos('"', Result)+1, Length(Result));
|
||||||
|
Result := Copy(Result, 1, Pos('"', Result)-1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExtractProperty(AStr: string; const PropName: string): string;
|
||||||
|
var
|
||||||
|
J: Integer;
|
||||||
|
I: Integer;
|
||||||
|
A, FieldName, Text: string;
|
||||||
|
PropStr: string;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
PropStr := '<'+PropName+'=';
|
||||||
|
I := Pos(PropStr, UpperCase(AStr));
|
||||||
|
while I > 0 do
|
||||||
|
begin
|
||||||
|
Result := Result + Copy(AStr, 1, I - 1);
|
||||||
|
A := Copy(AStr, I, Length(AStr));
|
||||||
|
J := Pos('>', A);
|
||||||
|
if J > 0 then
|
||||||
|
Delete(AStr, 1, I + J - 1)
|
||||||
|
else
|
||||||
|
AStr := '';
|
||||||
|
FieldName := ExtractPropertyValue(A, PropStr);
|
||||||
|
if Assigned(DataSet) and DataSet.Active then
|
||||||
|
begin
|
||||||
|
F := DataSet.FindField(FieldName);
|
||||||
|
if F <> nil then
|
||||||
|
begin
|
||||||
|
if PropName = FieldLabelName then
|
||||||
|
Text := F.DisplayLabel
|
||||||
|
else
|
||||||
|
Text := F.DisplayText;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Text := Format('(%s)', [FieldName]);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Text := Format('(%s)', [FieldName]);
|
||||||
|
Result := Result + Text;
|
||||||
|
I := Pos(PropStr, UpperCase(AStr));
|
||||||
|
end;
|
||||||
|
Result := Result + AStr;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := ExtractProperty(Str, FieldLabelName);
|
||||||
|
Result := ExtractProperty(Result, FieldName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvDBHTLabel } =======================================================
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.CMGetDataLink(var Message: TLMessage);
|
||||||
|
begin
|
||||||
|
Message.Result := PtrInt(FDataLink);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TJvDBHTLabel.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FDataLink := TFieldDataLink.Create;
|
||||||
|
with FDataLink do
|
||||||
|
begin
|
||||||
|
Control := Self;
|
||||||
|
OnDataChange := @DataChange;
|
||||||
|
OnEditingChange := @DataChange;
|
||||||
|
OnUpdateData := @DataChange;
|
||||||
|
OnActiveChange := @DataChange;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvDBHTLabel.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FDataLink);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.UpdateCaption;
|
||||||
|
begin
|
||||||
|
if Assigned(FDataLink) and Assigned(FDataLink.DataSet) then
|
||||||
|
Caption := ReplaceFieldNameTag(FMask, FDataLink.DataSet)
|
||||||
|
else
|
||||||
|
Caption := ReplaceFieldNameTag(Mask, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvDBHTLabel.GetDataSource: TDataSource;
|
||||||
|
begin
|
||||||
|
Result := FDataLink.DataSource;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvDBHTLabel.GetLabelText: string;
|
||||||
|
begin
|
||||||
|
if csPaintCopy in ControlState then
|
||||||
|
begin
|
||||||
|
if (Assigned(FDataLink) and Assigned(FDataLink.DataSet)) then
|
||||||
|
Result := ReplaceFieldNameTag(FMask, FDataLink.DataSet)
|
||||||
|
else
|
||||||
|
Result := ReplaceFieldNameTag(Mask, nil);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Result := Caption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.Loaded;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if (csDesigning in ComponentState) then DataChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.Notification(AComponent: TComponent; Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
if (Operation = opRemove) and (FDataLink <> nil) and
|
||||||
|
(AComponent = DataSource) then
|
||||||
|
DataSource := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//procedure TJvDBHTLabel.SetAutoSize(Value: Boolean);
|
||||||
|
//begin
|
||||||
|
// if AutoSize <> Value then
|
||||||
|
// begin
|
||||||
|
// if Value and FDataLink.DataSourceFixed then DatabaseError('SDataSourceFixed');
|
||||||
|
// inherited;
|
||||||
|
// end;
|
||||||
|
//end;
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.SetDataSource(const Value: TDataSource);
|
||||||
|
begin
|
||||||
|
FDataLink.DataSource := Value;
|
||||||
|
UpdateCaption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.DataChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
UpdateCaption;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvDBHTLabel.SetMask(const Value: string);
|
||||||
|
begin
|
||||||
|
if FMask <> Value then
|
||||||
|
begin
|
||||||
|
FMask := Value;
|
||||||
|
UpdateCaption;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
878
components/jvcllaz/run/JvErrorIndicator.pas
Normal file
878
components/jvcllaz/run/JvErrorIndicator.pas
Normal file
@ -0,0 +1,878 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
The contents of this file are subject to the Mozilla Public License
|
||||||
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||||
|
with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
The Original Code is: JvErrorIndicator.pas, released on 2002-11-16.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Peter Thörnqvist <peter3 at sourceforge dot net>.
|
||||||
|
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist .
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
* Setting AutoScroll to True for a form and displaying error icons beyond the form's right
|
||||||
|
edge can make the form's scrollbars "jump up and down"
|
||||||
|
* Resizing components while displaying error images, doesn't move the error image smoothly
|
||||||
|
(this is caused by the image being moved only when the BlinkThread triggers)
|
||||||
|
|
||||||
|
Description:
|
||||||
|
A component patterned on the ErrorProvider in .NET:
|
||||||
|
"Provides a user interface for indicating that a control
|
||||||
|
on a form has an error associated with it."
|
||||||
|
To set the error, use the Error property: an empty error string, removes the error image
|
||||||
|
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvErrorIndicator;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, Graphics, Controls, ImgList;
|
||||||
|
|
||||||
|
type
|
||||||
|
IJvErrorIndicatorClient = interface;
|
||||||
|
|
||||||
|
// IJvErrorIndicator is implemented by the TJvErrorIndicator
|
||||||
|
IJvErrorIndicator = interface
|
||||||
|
['{5BCB5404-9C17-4CC6-96EC-46567CA19A12}']
|
||||||
|
procedure BeginUpdate;
|
||||||
|
procedure EndUpdate;
|
||||||
|
procedure SetError(AControl: TControl; const AErrorMessage: WideString);
|
||||||
|
procedure SetClientError(const AClient: IJvErrorIndicatorClient);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// IJvErrorIndicatorClient should be implemented by controls that wants to be able
|
||||||
|
// to update the error indicator through it's own properties
|
||||||
|
IJvErrorIndicatorClient = interface
|
||||||
|
['{9871F250-631E-4119-B073-71B28711C9B8}']
|
||||||
|
procedure SetErrorIndicator(const Value: IJvErrorIndicator);
|
||||||
|
function GetErrorIndicator: IJvErrorIndicator;
|
||||||
|
function GetControl: TControl;
|
||||||
|
procedure SetErrorMessage(const Value: WideString);
|
||||||
|
function GetErrorMessage: WideString;
|
||||||
|
|
||||||
|
property ErrorIndicator: IJvErrorIndicator read GetErrorIndicator write SetErrorIndicator;
|
||||||
|
property ErrorMessage: WideString read GetErrorMessage write SetErrorMessage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvErrorBlinkStyle = (ebsAlwaysBlink, ebsBlinkIfDifferentError, ebsNeverBlink);
|
||||||
|
TJvErrorImageAlignment = (eiaBottomLeft, eiaBottomRight, eiaMiddleLeft, eiaMiddleRight,
|
||||||
|
eiaTopLeft, eiaTopRight);
|
||||||
|
|
||||||
|
{ TJvErrorControl }
|
||||||
|
|
||||||
|
TJvErrorControl = class(TGraphicControl)
|
||||||
|
private
|
||||||
|
FImageList: TCustomImageList;
|
||||||
|
FImageIndex: Integer;
|
||||||
|
FImagePadding: Integer;
|
||||||
|
FControl: TControl;
|
||||||
|
FImageAlignment: TJvErrorImageAlignment;
|
||||||
|
FBlinkCount: Integer;
|
||||||
|
FUseAnchors: Boolean;
|
||||||
|
procedure SetError(const Value: string);
|
||||||
|
function GetError: string;
|
||||||
|
procedure SetImageIndex(const Value: Integer);
|
||||||
|
procedure SetImageList(const Value: TCustomImageList);
|
||||||
|
procedure SetControl(const Value: TControl);
|
||||||
|
procedure SetUseAnchors(AValue: Boolean);
|
||||||
|
protected
|
||||||
|
procedure Paint; override;
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
procedure UpdateAnchors;
|
||||||
|
public
|
||||||
|
function CalcBoundsRect: TRect;
|
||||||
|
property Images: TCustomImageList read FImageList write SetImageList;
|
||||||
|
property ImageIndex: Integer read FImageIndex write SetImageIndex;
|
||||||
|
property Control: TControl read FControl write SetControl;
|
||||||
|
property Error: string read GetError write SetError;
|
||||||
|
property BlinkCount: Integer read FBlinkCount write FBlinkCount;
|
||||||
|
property ImageAlignment: TJvErrorImageAlignment read FImageAlignment write FImageAlignment;
|
||||||
|
property ImagePadding: Integer read FImagePadding write FImagePadding;
|
||||||
|
property UseAnchors: Boolean read FUseAnchors write SetUseAnchors;
|
||||||
|
|
||||||
|
procedure DrawImage(Erase: Boolean);
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
property ShowHint default True;
|
||||||
|
property Width default 16;
|
||||||
|
property Height default 16;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TJvErrorIndicator }
|
||||||
|
|
||||||
|
TJvErrorIndicator = class(TComponent, IUnknown, IJvErrorIndicator)
|
||||||
|
private
|
||||||
|
FDefaultUseAnchors: Boolean;
|
||||||
|
FUpdateCount: Integer;
|
||||||
|
FControls: TList;
|
||||||
|
FBlinkRate: Integer;
|
||||||
|
FImageList: TCustomImageList;
|
||||||
|
FBlinkThread: TThread;
|
||||||
|
FBlinkStyle: TJvErrorBlinkStyle;
|
||||||
|
FChangeLink: TChangeLink;
|
||||||
|
FImageIndex: Integer;
|
||||||
|
FDefaultImage: TImageList;
|
||||||
|
function GetError(AControl: TControl): string;
|
||||||
|
function GetImageAlignment(AControl: TControl): TJvErrorImageAlignment;
|
||||||
|
function GetImagePadding(AControl: TControl): Integer;
|
||||||
|
function GetUseAnchors(AControl: TControl): Boolean;
|
||||||
|
procedure SetBlinkRate(const Value: Integer);
|
||||||
|
procedure SetBlinkStyle(const Value: TJvErrorBlinkStyle);
|
||||||
|
procedure SetError(AControl: TControl; const Value: string);
|
||||||
|
procedure SetImageList(const Value: TCustomImageList);
|
||||||
|
procedure SetImageAlignment(AControl: TControl; const Value: TJvErrorImageAlignment);
|
||||||
|
procedure SetImagePadding(AControl: TControl; const Value: Integer);
|
||||||
|
procedure SetImageIndex(const Value: Integer);
|
||||||
|
procedure DoChangeLinkChange(Sender: TObject);
|
||||||
|
procedure DoBlink(Sender: TObject; Erase: Boolean);
|
||||||
|
procedure SetUseAnchors(AControl: TControl; AValue: Boolean);
|
||||||
|
procedure StopThread;
|
||||||
|
procedure StartThread;
|
||||||
|
function GetControl(Index: Integer): TJvErrorControl;
|
||||||
|
function GetCount: Integer;
|
||||||
|
protected
|
||||||
|
{ IJvErrorIndicator }
|
||||||
|
procedure IJvErrorIndicator.SetError = IndicatorSetError;
|
||||||
|
procedure IndicatorSetError(AControl: TControl; const ErrorMessage: WideString);
|
||||||
|
procedure SetClientError(const AClient: IJvErrorIndicatorClient);
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
function IndexOf(AControl: TControl): Integer;
|
||||||
|
function Add(AControl: TControl): Integer;
|
||||||
|
procedure UpdateControls;
|
||||||
|
procedure Delete(Index: Integer);
|
||||||
|
property Controls[Index: Integer]: TJvErrorControl read GetControl;
|
||||||
|
property Count: Integer read GetCount;
|
||||||
|
public
|
||||||
|
constructor Create(AComponent: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
// Call ClearErrors to remove all error images with one call
|
||||||
|
// After a call to ClearErrors, the internal error image list is emptied
|
||||||
|
// Calling ClearErrors is the same as setting Error[nil] := '' but is slightly faster
|
||||||
|
procedure ClearErrors;
|
||||||
|
// The BeginUpdate method suspends the blinking thread until the EndUpdate method is called.
|
||||||
|
procedure BeginUpdate;
|
||||||
|
// EndUpdate re-enables the blinking thread that was turned off with the BeginUpdate method.
|
||||||
|
procedure EndUpdate;
|
||||||
|
// Gets or sets the error message associated with a control
|
||||||
|
// Setting the error message to an empty string removes the error image
|
||||||
|
// (this is the only way to remove an error image for a single control)
|
||||||
|
// Use Error[nil] := 'SomeValue'; to assign the error message 'SomeValue' to all controls
|
||||||
|
// Using Error[nil] := ''; is equivalent to calling ClearErrors but ClearErrors is faster
|
||||||
|
property Error[AControl: TControl]: string read GetError write SetError;
|
||||||
|
// Gets or sets a value indicating where the error image should be placed in relation to the control.
|
||||||
|
// The location can be further modified by assigning a non-zero value to ImagePadding
|
||||||
|
// Possible values:
|
||||||
|
// eiaBottomLeft - display the error image on the controls left side aligned to the bottom edge of the control
|
||||||
|
// eiaBottomRight - display the error image on the controls right side aligned to the bottom edge of the control
|
||||||
|
// eiaMiddleLeft - display the error image on the controls left side aligned to the middle of the control
|
||||||
|
// eiaMiddleRight - display the error image on the controls right side aligned to the middle of the control
|
||||||
|
// eiaTopLeft - display the error image on the controlsleft side aligned to the top edge of the control
|
||||||
|
// eiaTopRight - display the error image on the controls right side aligned to the top edge of the control
|
||||||
|
// Use AControl = nil to set the same Alignment for all controls
|
||||||
|
property ImageAlignment[AControl: TControl]: TJvErrorImageAlignment read GetImageAlignment write SetImageAlignment;
|
||||||
|
// Gets or sets the amount of extra space to leave between the specified control and the error image.
|
||||||
|
// Use AControl = nil to set the same padding for all controls.
|
||||||
|
property ImagePadding[AControl: TControl]: Integer read GetImagePadding write SetImagePadding;
|
||||||
|
//
|
||||||
|
property UseAnchors[AControl: TControl]: Boolean read GetUseAnchors write SetUseAnchors;
|
||||||
|
published
|
||||||
|
// The rate at which the error image should flash. The rate is expressed in milliseconds. The default is 250 milliseconds.
|
||||||
|
// A value of zero sets BlinkStyle to ebsNeverBlink.
|
||||||
|
property BlinkRate: Integer read FBlinkRate write SetBlinkRate default 250;
|
||||||
|
// The error Image flashes in the manner specified by the assigned BlinkStyle when an error occurs.
|
||||||
|
// Possible values:
|
||||||
|
// ebsBlinkIfDifferentError - blink if the new error message differs from the previous
|
||||||
|
// ebsAlwaysBlink - always blink when the error message changes, even if it's the same message
|
||||||
|
// ebsNeverBlink - never bink, just display the error image and the description
|
||||||
|
// Setting the BlinkRate to zero sets the BlinkStyle to ebsNeverBlink.
|
||||||
|
// The default is ebsBlinkIfDifferentError
|
||||||
|
property BlinkStyle: TJvErrorBlinkStyle read FBlinkStyle write SetBlinkStyle default ebsBlinkIfDifferentError;
|
||||||
|
// Gets or sets the ImageList where to retrieve an image to display next to a control when an error description
|
||||||
|
// string has been set for the control.
|
||||||
|
// This property is used in conjunction with ImageIndex to select the image to display
|
||||||
|
// If either is nil, invalid or out of range, no error image is displayed
|
||||||
|
property Images: TCustomImageList read FImageList write SetImageList;
|
||||||
|
// Gets or sets the ImageIndex in ImageList to use when displaying an image next to a control
|
||||||
|
property ImageIndex: Integer read FImageIndex write SetImageIndex;
|
||||||
|
property DefaultUseAnchors: Boolean read FDefaultUseAnchors write FDefaultUseAnchors;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
//CommCtrl,
|
||||||
|
LCLProc,
|
||||||
|
SysUtils,
|
||||||
|
JvResources, JvJVCLUtils;
|
||||||
|
|
||||||
|
{$R ..\resource\JvErrorIndicator.res}
|
||||||
|
|
||||||
|
const
|
||||||
|
cDefBlinkCount = 5;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvBlinkThreadEvent = procedure(Sender: TObject; Erase: Boolean) of object;
|
||||||
|
|
||||||
|
TJvBlinkThread = class(TThread)
|
||||||
|
private
|
||||||
|
FBlinkRate: Integer;
|
||||||
|
FErase: Boolean;
|
||||||
|
FOnBlink: TJvBlinkThreadEvent;
|
||||||
|
procedure Blink;
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
constructor Create(BlinkRate: Integer; AOnBlink: TJvBlinkThreadEvent);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvErrorIndicator } ==================================================
|
||||||
|
|
||||||
|
constructor TJvErrorIndicator.Create(AComponent: TComponent);
|
||||||
|
|
||||||
|
begin
|
||||||
|
inherited Create(AComponent);
|
||||||
|
FDefaultImage := TImageList.CreateSize(16, 16);
|
||||||
|
FDefaultImage.AddResourceName(HINSTANCE, 'XJVERRORINDICATORICON');
|
||||||
|
//ImageList_AddIcon(FDefaultImage.Handle,
|
||||||
|
// LoadImage(HInstance, PChar('XJVERRORINDICATORICON'), IMAGE_ICON, 16, 16, 0));
|
||||||
|
FBlinkStyle := ebsBlinkIfDifferentError;
|
||||||
|
FBlinkRate := 250;
|
||||||
|
FControls := TList.Create;
|
||||||
|
FChangeLink := TChangeLink.Create;
|
||||||
|
FChangeLink.OnChange := @DoChangeLinkChange;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvErrorIndicator.Destroy;
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
ClearErrors;
|
||||||
|
FControls.Free;
|
||||||
|
FChangeLink.Free;
|
||||||
|
FDefaultImage.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.Add(AControl: TControl): Integer;
|
||||||
|
var
|
||||||
|
Ci: TJvErrorControl;
|
||||||
|
begin
|
||||||
|
Result := IndexOf(AControl);
|
||||||
|
if (Result < 0) and (AControl <> nil) then
|
||||||
|
begin
|
||||||
|
Ci := TJvErrorControl.Create(Self);
|
||||||
|
Ci.Control := AControl;
|
||||||
|
Ci.UseAnchors := DefaultUseAnchors;
|
||||||
|
// Ci.Name := Ci.Control.Name + '_ErrorControl';
|
||||||
|
Result := FControls.Add(Ci);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.Delete(Index: Integer);
|
||||||
|
begin
|
||||||
|
Controls[Index].Free; // removes itself from FControls[]
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.GetError(AControl: TControl): string;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
I := IndexOf(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Result := Controls[I].Error
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEControlNotFoundInGetError);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.GetImageAlignment(AControl: TControl): TJvErrorImageAlignment;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
I := IndexOf(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Result := Controls[I].ImageAlignment
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEControlNotFoundInGetImageAlignment);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.GetImagePadding(AControl: TControl): Integer;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
I := IndexOf(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Result := Controls[I].ImagePadding
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEControlNotFoundInGetImagePadding);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.GetUseAnchors(AControl: TControl): Boolean;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
I := IndexOf(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Result := Controls[I].UseAnchors
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEControlNotFoundInGetUseAnhors);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.IndexOf(AControl: TControl): Integer;
|
||||||
|
begin
|
||||||
|
if AControl <> nil then
|
||||||
|
for Result := 0 to Count - 1 do
|
||||||
|
if Controls[Result].Control = AControl then
|
||||||
|
Exit;
|
||||||
|
Result := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if Operation = opRemove then
|
||||||
|
begin
|
||||||
|
if AComponent is TControl then
|
||||||
|
I := IndexOf(TControl(AComponent))
|
||||||
|
else
|
||||||
|
I := -1;
|
||||||
|
if I > -1 then
|
||||||
|
Delete(I);
|
||||||
|
if AComponent = Images then
|
||||||
|
Images := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetBlinkRate(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FBlinkRate <> Value then
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
FBlinkRate := Value;
|
||||||
|
if FBlinkRate <= 0 then
|
||||||
|
begin
|
||||||
|
FBlinkRate := 0;
|
||||||
|
FBlinkStyle := ebsNeverBlink;
|
||||||
|
end;
|
||||||
|
UpdateControls;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetBlinkStyle(const Value: TJvErrorBlinkStyle);
|
||||||
|
begin
|
||||||
|
if FBlinkStyle <> Value then
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
FBlinkStyle := Value;
|
||||||
|
UpdateControls;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetError(AControl: TControl;
|
||||||
|
const Value: string);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
Ei: TJvErrorControl;
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
if AControl = nil then
|
||||||
|
begin
|
||||||
|
if Value = '' then
|
||||||
|
ClearErrors
|
||||||
|
else
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
Ei := Controls[I];
|
||||||
|
if ((Ei.Error <> Value) and (BlinkStyle = ebsBlinkIfDifferentError)) or (BlinkStyle = ebsAlwaysBlink) then
|
||||||
|
Ei.BlinkCount := cDefBlinkCount
|
||||||
|
else
|
||||||
|
if BlinkStyle = ebsNeverBlink then
|
||||||
|
Ei.BlinkCount := 0;
|
||||||
|
Ei.Error := Value;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
I := Add(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
begin
|
||||||
|
if Value = '' then
|
||||||
|
Delete(I)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Ei := Controls[I];
|
||||||
|
if ((Ei.Error <> Value) and (BlinkStyle = ebsBlinkIfDifferentError)) or
|
||||||
|
(BlinkStyle = ebsAlwaysBlink) then
|
||||||
|
begin
|
||||||
|
Ei.Error := Value;
|
||||||
|
Ei.BlinkCount := cDefBlinkCount;
|
||||||
|
Ei.Visible := (csDesigning in ComponentState);
|
||||||
|
if (FUpdateCount = 0) and (FBlinkThread = nil) then
|
||||||
|
StartThread;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if BlinkStyle = ebsNeverBlink then
|
||||||
|
begin
|
||||||
|
Ei.BlinkCount := 0;
|
||||||
|
Ei.Error := Value;
|
||||||
|
Ei.Visible := (Value <> '');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
UpdateControls;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEUnableToAddControlInSetError);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetImageAlignment(AControl: TControl;
|
||||||
|
const Value: TJvErrorImageAlignment);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
if AControl = nil then
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
Controls[I].ImageAlignment := Value
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
I := Add(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Controls[I].ImageAlignment := Value
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEUnableToAddControlInSetImageAlignme);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetImagePadding(AControl: TControl;
|
||||||
|
const Value: Integer);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
if AControl = nil then
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
Controls[I].ImagePadding := Value
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
I := Add(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Controls[I].ImagePadding := Value
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEUnableToAddControlInSetImagePadding);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.UpdateControls;
|
||||||
|
var
|
||||||
|
I, J: Integer;
|
||||||
|
IL: TCustomImageList;
|
||||||
|
begin
|
||||||
|
if Images <> nil then
|
||||||
|
begin
|
||||||
|
IL := Images;
|
||||||
|
J := ImageIndex;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
IL := FDefaultImage;
|
||||||
|
J := 0;
|
||||||
|
end;
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
Controls[I].Images := IL;
|
||||||
|
Controls[I].ImageIndex := J;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetImageList(const Value: TCustomImageList);
|
||||||
|
begin
|
||||||
|
if FImageList <> Value then
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
ReplaceImageListReference(Self, Value, FImageList, FChangeLink);
|
||||||
|
UpdateControls;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetImageIndex(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FImageIndex <> Value then
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
FImageIndex := Value;
|
||||||
|
UpdateControls;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.DoChangeLinkChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
UpdateControls;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.ClearErrors;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
StopThread;
|
||||||
|
for I := Count - 1 downto 0 do
|
||||||
|
Controls[I].Free;
|
||||||
|
FControls.Clear;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.BeginUpdate;
|
||||||
|
{var
|
||||||
|
I: Integer;}
|
||||||
|
begin
|
||||||
|
Inc(FUpdateCount);
|
||||||
|
StopThread;
|
||||||
|
// ahuser: The following code produces flicker
|
||||||
|
{for I := 0 to Count - 1 do
|
||||||
|
Controls[I].Visible := False;}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.EndUpdate;
|
||||||
|
begin
|
||||||
|
if FUpdateCount > 0 then
|
||||||
|
begin
|
||||||
|
Dec(FUpdateCount);
|
||||||
|
if FUpdateCount = 0 then
|
||||||
|
begin
|
||||||
|
UpdateControls;
|
||||||
|
StartThread;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.StartThread;
|
||||||
|
begin
|
||||||
|
if BlinkStyle <> ebsNeverBlink then
|
||||||
|
FBlinkThread := TJvBlinkThread.Create(BlinkRate, @DoBlink);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.StopThread;
|
||||||
|
begin
|
||||||
|
if FBlinkThread <> nil then
|
||||||
|
try
|
||||||
|
FBlinkThread.Terminate;
|
||||||
|
FBlinkThread.WaitFor;
|
||||||
|
finally
|
||||||
|
FreeAndNil(FBlinkThread);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.DoBlink(Sender: TObject; Erase: Boolean);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
Controls[I].DrawImage(Erase);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetUseAnchors(AControl: TControl; AValue: Boolean);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
if AControl = nil then
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
Controls[I].UseAnchors := AValue
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
I := Add(AControl);
|
||||||
|
if I > -1 then
|
||||||
|
Controls[I].UseAnchors := AValue
|
||||||
|
else
|
||||||
|
raise Exception.Create(RsEUnableToAddControlInSetImagePadding);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.GetControl(Index: Integer): TJvErrorControl;
|
||||||
|
begin
|
||||||
|
Result := TJvErrorControl(FControls[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorIndicator.GetCount: Integer;
|
||||||
|
begin
|
||||||
|
Result := FControls.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.SetClientError(const AClient: IJvErrorIndicatorClient);
|
||||||
|
begin
|
||||||
|
if AClient <> nil then
|
||||||
|
SetError(AClient.GetControl, UTF8Encode(AClient.ErrorMessage));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorIndicator.IndicatorSetError(AControl: TControl;
|
||||||
|
const ErrorMessage: WideString);
|
||||||
|
begin
|
||||||
|
SetError(AControl, UTF8Encode(ErrorMessage));
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvErrorControl } ====================================================
|
||||||
|
|
||||||
|
constructor TJvErrorControl.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FImageAlignment := eiaMiddleRight;
|
||||||
|
ShowHint := True;
|
||||||
|
Visible := False;
|
||||||
|
Width := 16;
|
||||||
|
Height := 16;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvErrorControl.Destroy;
|
||||||
|
begin
|
||||||
|
TJvErrorIndicator(Owner).FControls.Extract(Self);
|
||||||
|
Control := nil;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.DrawImage(Erase: Boolean);
|
||||||
|
begin
|
||||||
|
if not Assigned(Control) or not Assigned(Control.Parent) or not Assigned(Images) then
|
||||||
|
Exit;
|
||||||
|
Visible := (Error <> '') and (not Erase or (BlinkCount < 2));
|
||||||
|
if not Visible and (BlinkCount > 1) then
|
||||||
|
Dec(FBlinkCount);
|
||||||
|
if Visible then
|
||||||
|
if UseAnchors then
|
||||||
|
UpdateAnchors
|
||||||
|
else
|
||||||
|
BoundsRect := CalcBoundsRect;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorControl.CalcBoundsRect: TRect;
|
||||||
|
begin
|
||||||
|
if (Control = nil) or (Images = nil) then
|
||||||
|
Result := Rect(0, 0, 0, 0)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
case ImageAlignment of
|
||||||
|
eiaBottomLeft:
|
||||||
|
begin
|
||||||
|
// must qualify Result fully since Delphi confuses the TRect with the controls Top/Left properties
|
||||||
|
Result.Right := Control.Left - 1;
|
||||||
|
Result.Left := Result.Right - Images.Width;
|
||||||
|
Result.Bottom := Control.Top + Control.Height;
|
||||||
|
Result.Top := Result.Bottom - Images.Height;
|
||||||
|
OffsetRect(Result, -ImagePadding, 0);
|
||||||
|
end;
|
||||||
|
eiaBottomRight:
|
||||||
|
begin
|
||||||
|
Result.Left := Control.Left + Control.Width + 1;
|
||||||
|
Result.Right := Result.Left + Images.Width;
|
||||||
|
Result.Bottom := Control.Top + Control.Height;
|
||||||
|
Result.Top := Result.Bottom - Images.Height;
|
||||||
|
OffsetRect(Result, ImagePadding, 0);
|
||||||
|
end;
|
||||||
|
eiaMiddleLeft:
|
||||||
|
begin
|
||||||
|
Result.Right := Control.Left - 1;
|
||||||
|
Result.Left := Result.Right - Images.Width;
|
||||||
|
Result.Top := Control.Top + (Control.Height - Images.Height) div 2;
|
||||||
|
Result.Bottom := Result.Top + Images.Height;
|
||||||
|
OffsetRect(Result, -ImagePadding, 0);
|
||||||
|
end;
|
||||||
|
eiaMiddleRight:
|
||||||
|
begin
|
||||||
|
Result.Left := Control.Left + Control.Width + 1;
|
||||||
|
Result.Right := Result.Left + Images.Width;
|
||||||
|
Result.Top := Control.Top + (Control.Height - Images.Height) div 2;
|
||||||
|
Result.Bottom := Result.Top + Images.Height;
|
||||||
|
OffsetRect(Result, ImagePadding, 0);
|
||||||
|
end;
|
||||||
|
eiaTopLeft:
|
||||||
|
begin
|
||||||
|
Result.Right := Control.Left - 1;
|
||||||
|
Result.Left := Result.Right - Images.Width;
|
||||||
|
Result.Top := Control.Top;
|
||||||
|
Result.Bottom := Result.Top + Control.Height;
|
||||||
|
OffsetRect(Result, -ImagePadding, 0);
|
||||||
|
end;
|
||||||
|
eiaTopRight:
|
||||||
|
begin
|
||||||
|
Result.Left := Control.Left + Control.Width + 1;
|
||||||
|
Result.Right := Result.Left + Images.Width;
|
||||||
|
Result.Top := Control.Top;
|
||||||
|
Result.Bottom := Result.Top + Images.Height;
|
||||||
|
OffsetRect(Result, ImagePadding, 0);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.Paint;
|
||||||
|
begin
|
||||||
|
// inherited Paint;
|
||||||
|
if (Images <> nil) and Visible then
|
||||||
|
Images.Draw(Canvas, 0, 0, ImageIndex, dsTransparent, itImage);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.SetError(const Value: string);
|
||||||
|
begin
|
||||||
|
Hint := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvErrorControl.GetError: string;
|
||||||
|
begin
|
||||||
|
Result := Hint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.SetImageIndex(const Value: Integer);
|
||||||
|
begin
|
||||||
|
if FImageIndex <> Value then
|
||||||
|
begin
|
||||||
|
FImageIndex := Value;
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.SetImageList(const Value: TCustomImageList);
|
||||||
|
begin
|
||||||
|
if ReplaceComponentReference(Self, Value, TComponent(FImageList)) then
|
||||||
|
begin
|
||||||
|
if FImageList <> nil then
|
||||||
|
if UseAnchors then
|
||||||
|
UpdateAnchors
|
||||||
|
else
|
||||||
|
BoundsRect := CalcBoundsRect
|
||||||
|
else
|
||||||
|
SetBounds(Left, Top, 16, 16);
|
||||||
|
// Invalidate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.SetControl(const Value: TControl);
|
||||||
|
begin
|
||||||
|
if FControl <> Value then
|
||||||
|
begin
|
||||||
|
ReplaceComponentReference(Self, Value, TComponent(FControl));
|
||||||
|
if FControl <> nil then
|
||||||
|
Parent := FControl.Parent
|
||||||
|
else
|
||||||
|
Parent := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.SetUseAnchors(AValue: Boolean);
|
||||||
|
begin
|
||||||
|
if FUseAnchors = AValue then Exit;
|
||||||
|
FUseAnchors := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if (Operation = opRemove) then
|
||||||
|
if (AComponent = Control) then
|
||||||
|
Control := nil
|
||||||
|
else if (AComponent = FImageList) then
|
||||||
|
FImageList := nil
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvErrorControl.UpdateAnchors;
|
||||||
|
begin
|
||||||
|
if (Control = nil) or (Images = nil) then
|
||||||
|
begin
|
||||||
|
SetBounds(0, 0, 0, 0);
|
||||||
|
Exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
AnchorSide[akLeft].Control := nil;
|
||||||
|
AnchorSide[akTop].Control := nil;
|
||||||
|
AnchorSide[akBottom].Control := nil;
|
||||||
|
AnchorSide[akRight].Control := nil;
|
||||||
|
SetBounds(0, 0, Images.Width, Images.Height);
|
||||||
|
case ImageAlignment of
|
||||||
|
eiaBottomLeft:
|
||||||
|
begin
|
||||||
|
AnchorSideLeft.Control := Control;
|
||||||
|
AnchorSideLeft.Side := asrLeft;
|
||||||
|
AnchorSideTop.Control := Control;
|
||||||
|
AnchorSideTop.Side := asrBottom;
|
||||||
|
end;
|
||||||
|
eiaBottomRight:
|
||||||
|
begin
|
||||||
|
AnchorSideRight.Control := Control;
|
||||||
|
AnchorSideRight.Side := asrRight;
|
||||||
|
AnchorSideTop.Control := Control;
|
||||||
|
AnchorSideTop.Side := asrBottom;
|
||||||
|
end;
|
||||||
|
eiaMiddleLeft:
|
||||||
|
begin
|
||||||
|
AnchorVerticalCenterTo(Control);
|
||||||
|
AnchorSideRight.Control := Control;
|
||||||
|
AnchorSideRight.Side := asrLeft;
|
||||||
|
end;
|
||||||
|
eiaMiddleRight:
|
||||||
|
begin
|
||||||
|
AnchorVerticalCenterTo(Control);
|
||||||
|
AnchorSideLeft.Control := Control;
|
||||||
|
AnchorSideLeft.Side := asrRight;
|
||||||
|
end;
|
||||||
|
eiaTopLeft:
|
||||||
|
begin
|
||||||
|
AnchorSideLeft.Control := Control;
|
||||||
|
AnchorSideLeft.Side := asrLeft;
|
||||||
|
AnchorSideBottom.Control := Control;
|
||||||
|
AnchorSideBottom.Side := asrTop;
|
||||||
|
end;
|
||||||
|
eiaTopRight:
|
||||||
|
begin
|
||||||
|
AnchorSideRight.Control := Control;
|
||||||
|
AnchorSideRight.Side := asrRight;
|
||||||
|
AnchorSideBottom.Control := Control;
|
||||||
|
AnchorSideBottom.Side := asrTop;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvBlinkThread } =====================================================
|
||||||
|
|
||||||
|
constructor TJvBlinkThread.Create(BlinkRate: Integer; AOnBlink: TJvBlinkThreadEvent);
|
||||||
|
begin
|
||||||
|
inherited Create(False);
|
||||||
|
FBlinkRate := BlinkRate;
|
||||||
|
FErase := False;
|
||||||
|
FOnBlink := AOnBlink;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBlinkThread.Blink;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnBlink) then
|
||||||
|
FOnBlink(Self, FErase);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBlinkThread.Execute;
|
||||||
|
begin
|
||||||
|
//NameThread(ThreadName);
|
||||||
|
FErase := False;
|
||||||
|
while not Terminated and not Suspended do
|
||||||
|
begin
|
||||||
|
Sleep(FBlinkRate);
|
||||||
|
Synchronize(@Blink);
|
||||||
|
if FBlinkRate = 0 then
|
||||||
|
Exit;
|
||||||
|
FErase := not FErase;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@ -52,6 +52,13 @@ type
|
|||||||
dcNative); // if dcNative is in the set the native allowed keys are used and GetDlgCode is ignored
|
dcNative); // if dcNative is in the set the native allowed keys are used and GetDlgCode is ignored
|
||||||
TDlgCodes = set of TDlgCode;
|
TDlgCodes = set of TDlgCode;
|
||||||
|
|
||||||
|
{$IFDEF WINDOWS}
|
||||||
|
TSmallPoint = Types.TSmallPoint;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
TSmallPoint = Classes.TSmallPoint;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
(******************** NOT CONVERTED
|
(******************** NOT CONVERTED
|
||||||
const
|
const
|
||||||
dcWantMessage = dcWantAllKeys;
|
dcWantMessage = dcWantAllKeys;
|
||||||
@ -134,7 +141,8 @@ procedure HandleDotNetHighlighting(Control: TWinControl; const Msg: TLMessage;
|
|||||||
MouseOver: Boolean; Color: TColor);
|
MouseOver: Boolean; Color: TColor);
|
||||||
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: PtrInt): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||||
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
function CreateWMMessage(Msg: Integer; WParam: PtrInt; LParam: TControl): TLMessage; overload; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||||
function SmallPointToLong(const Pt: TSmallPoint): Longint; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
//function SmallPointToLong(const Pt: Classes.TSmallPoint): Longint; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||||
|
function SmallPointToLong(const Pt: TSmallPoint): LongInt; {$IFDEF SUPPORTS_INLINE} inline {$ENDIF}
|
||||||
function ShiftStateToKeyData(Shift: TShiftState): Longint;
|
function ShiftStateToKeyData(Shift: TShiftState): Longint;
|
||||||
|
|
||||||
//******************** NOT CONVERTED
|
//******************** NOT CONVERTED
|
||||||
@ -370,7 +378,8 @@ begin
|
|||||||
Self.Msg.Result := 0;
|
Self.Msg.Result := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function SmallPointToLong(const Pt: TSmallPoint): Longint;
|
function SmallPointToLong(const Pt: TSmallPoint): LongInt;
|
||||||
|
//function SmallPointToLong(const Pt: Classes.TSmallPoint): Longint;
|
||||||
begin
|
begin
|
||||||
Result := Longint(Pt);
|
Result := Longint(Pt);
|
||||||
end;
|
end;
|
||||||
|
|||||||
264
components/jvcllaz/run/JvHint.pas
Normal file
264
components/jvcllaz/run/JvHint.pas
Normal file
@ -0,0 +1,264 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
The contents of this file are subject to the Mozilla Public License
|
||||||
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||||
|
with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
The Original Code is: JvHint.PAS, released on 2002-07-04.
|
||||||
|
|
||||||
|
The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
|
||||||
|
Copyright (c) 1999, 2002 Andrei Prygounkov
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
component : TJvHint
|
||||||
|
description : Custom activated hint
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvHint;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
//{.$I jvcl.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes,
|
||||||
|
Controls, Forms, ExtCtrls,
|
||||||
|
JvHtControls, JvTypes;
|
||||||
|
|
||||||
|
type
|
||||||
|
TJvHintWindow = class(THintWindow)
|
||||||
|
public
|
||||||
|
property Caption;
|
||||||
|
end;
|
||||||
|
TJvHintWindowClass = class of TJvHintWindow;
|
||||||
|
|
||||||
|
TJvHintState = (tmBeginShow, tmShowing, tmStopped);
|
||||||
|
|
||||||
|
TJvHint = class(TComponent)
|
||||||
|
private
|
||||||
|
FAutoHide: Boolean;
|
||||||
|
protected
|
||||||
|
// (rom) definitely needs cleanup here bad structuring
|
||||||
|
R: TRect;
|
||||||
|
Area: TRect;
|
||||||
|
State: TJvHintState;
|
||||||
|
Txt: THintString;
|
||||||
|
HintWindow: TJvHintWindow;
|
||||||
|
TimerHint: TTimer;
|
||||||
|
FDelay: Integer;
|
||||||
|
procedure TimerHintTimer(Sender: TObject);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure ActivateHint(AArea: TRect; ATxt: THintString);
|
||||||
|
procedure ActivateHintAt(AArea: TRect; ATxt: THintString; ScreenPos: TPoint);
|
||||||
|
procedure CancelHint;
|
||||||
|
published
|
||||||
|
property AutoHide: Boolean read FAutoHide write FAutoHide default True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvHTHintWindow = class(THintWindow)
|
||||||
|
private
|
||||||
|
HtLabel: TJvHTLabel;
|
||||||
|
protected
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
function CalcHintRect({%H-}MaxWidth: Integer;
|
||||||
|
const AHint: THintString; AData: Pointer): TRect; override;
|
||||||
|
procedure Paint; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterHtHints;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
Math, LCLIntf, LCLType,
|
||||||
|
JvResources;
|
||||||
|
|
||||||
|
//=== { TJvHint } ============================================================
|
||||||
|
|
||||||
|
constructor TJvHint.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
TimerHint := TTimer.Create(Self);
|
||||||
|
TimerHint.Enabled := False;
|
||||||
|
TimerHint.Interval := 50;
|
||||||
|
TimerHint.OnTimer := @TimerHintTimer;
|
||||||
|
HintWindow := TJvHintWindowClass.Create(Self);
|
||||||
|
ShowWindow(HintWindow.Handle, SW_HIDE);
|
||||||
|
FAutoHide := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvHint.Destroy;
|
||||||
|
begin
|
||||||
|
TimerHint.Free;
|
||||||
|
HintWindow.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvHint.ActivateHint(AArea: TRect; ATxt: THintString);
|
||||||
|
var
|
||||||
|
P: TPoint = (X:0; y:0); // silence the compiler...
|
||||||
|
begin
|
||||||
|
GetCursorPos(P);
|
||||||
|
Inc(P.Y, 20);
|
||||||
|
ActivateHintAt(AArea, ATxt, P);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvHint.ActivateHintAt(AArea: TRect; ATxt: THintString; ScreenPos: TPoint);
|
||||||
|
var
|
||||||
|
P: TPoint = (X: 0; Y: 0); // silence the compiler
|
||||||
|
begin
|
||||||
|
Area := AArea;
|
||||||
|
if ATxt = '' then
|
||||||
|
begin
|
||||||
|
CancelHint;
|
||||||
|
Exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Txt := ATxt;
|
||||||
|
GetCursorPos(P);
|
||||||
|
if not PtInRect(Area, P) then
|
||||||
|
begin
|
||||||
|
if IsWindowVisible(HintWindow.Handle) then
|
||||||
|
ShowWindow(HintWindow.Handle, SW_HIDE);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if HintWindow.Caption <> Txt then
|
||||||
|
begin
|
||||||
|
R := HintWindow.CalcHintRect(Screen.Width, Txt, nil);
|
||||||
|
R.Top := ScreenPos.Y;
|
||||||
|
R.Left := ScreenPos.X;
|
||||||
|
Inc(R.Bottom, R.Top);
|
||||||
|
Inc(R.Right, R.Left);
|
||||||
|
State := tmBeginShow;
|
||||||
|
TimerHint.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvHint.TimerHintTimer(Sender: TObject);
|
||||||
|
var
|
||||||
|
P: TPoint = (X: 0; Y: 0); // silence the compiler
|
||||||
|
bPoint, bDelay: Boolean;
|
||||||
|
Delay: Integer;
|
||||||
|
HintPause: Integer;
|
||||||
|
begin
|
||||||
|
HintWindow.Color := Application.HintColor;
|
||||||
|
Delay := FDelay * Integer(TimerHint.Interval);
|
||||||
|
case State of
|
||||||
|
tmBeginShow:
|
||||||
|
begin
|
||||||
|
GetCursorPos(P);
|
||||||
|
bPoint := not PtInRect(Area, P);
|
||||||
|
if bPoint then
|
||||||
|
begin
|
||||||
|
State := tmStopped;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if IsWindowVisible(HintWindow.Handle) then
|
||||||
|
HintPause := Application.HintShortPause
|
||||||
|
else
|
||||||
|
HintPause := Application.HintPause;
|
||||||
|
if Delay >= HintPause then
|
||||||
|
begin
|
||||||
|
HintWindow.ActivateHint(R, Txt);
|
||||||
|
FDelay := 0;
|
||||||
|
State := tmShowing;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Inc(FDelay);
|
||||||
|
end;
|
||||||
|
tmShowing:
|
||||||
|
begin
|
||||||
|
GetCursorPos(P);
|
||||||
|
bDelay := FAutoHide and (Delay > Application.HintHidePause);
|
||||||
|
bPoint := not PtInRect(Area, P);
|
||||||
|
if bPoint or bDelay then
|
||||||
|
begin
|
||||||
|
if IsWindowVisible(HintWindow.Handle) then
|
||||||
|
ShowWindow(HintWindow.Handle, SW_HIDE);
|
||||||
|
FDelay := 0;
|
||||||
|
if bPoint then
|
||||||
|
HintWindow.Caption := RsHintCaption;
|
||||||
|
State := tmStopped;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Inc(FDelay);
|
||||||
|
end;
|
||||||
|
tmStopped:
|
||||||
|
begin
|
||||||
|
FDelay := 0;
|
||||||
|
GetCursorPos(P);
|
||||||
|
bPoint := not PtInRect(Area, P);
|
||||||
|
if IsWindowVisible(HintWindow.Handle) then
|
||||||
|
ShowWindow(HintWindow.Handle, SW_HIDE);
|
||||||
|
if bPoint then
|
||||||
|
begin
|
||||||
|
HintWindow.Caption := RsHintCaption;
|
||||||
|
TimerHint.Enabled := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvHint.CancelHint;
|
||||||
|
begin
|
||||||
|
if IsWindowVisible(HintWindow.Handle) then
|
||||||
|
ShowWindow(HintWindow.Handle, SW_HIDE);
|
||||||
|
HintWindow.Caption := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvHTHintWindow } ====================================================
|
||||||
|
|
||||||
|
constructor TJvHTHintWindow.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
HtLabel := TJvHTLabel.Create(Self);
|
||||||
|
HtLabel.Parent := Self;
|
||||||
|
HtLabel.SetBounds(2, 2, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvHTHintWindow.Paint;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvHTHintWindow.CalcHintRect(MaxWidth: Integer;
|
||||||
|
const AHint: THintString; AData: Pointer): TRect;
|
||||||
|
begin
|
||||||
|
HtLabel.Caption := AHint;
|
||||||
|
Result := Bounds(0, 0, HtLabel.Width + 6, HtLabel.Height + 2);
|
||||||
|
if Application.HintHidePause > 0 then
|
||||||
|
Application.HintHidePause :=
|
||||||
|
Max(2500, // default
|
||||||
|
Length(ItemHtPlain(AHint)) *
|
||||||
|
(1000 div 20)); // 20 symbols per second
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterHtHints;
|
||||||
|
begin
|
||||||
|
if Application.ShowHint then
|
||||||
|
begin
|
||||||
|
Application.ShowHint := False;
|
||||||
|
HintWindowClass := TJvHTHintWindow;
|
||||||
|
Application.ShowHint := True;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
HintWindowClass := TJvHTHintWindow;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
1061
components/jvcllaz/run/JvHtControls.pas
Normal file
1061
components/jvcllaz/run/JvHtControls.pas
Normal file
File diff suppressed because it is too large
Load Diff
@ -32,7 +32,7 @@ unit JvJVCLUtils;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
uses
|
uses
|
||||||
Classes, Graphics, JvTypes;
|
Classes, Graphics, JvTypes, ImgList, LCLType, Types;
|
||||||
|
|
||||||
(******************** NOT CONVERTED
|
(******************** NOT CONVERTED
|
||||||
// Transform an icon to a bitmap
|
// Transform an icon to a bitmap
|
||||||
@ -670,9 +670,11 @@ procedure UpdateTrackFont(TrackFont, Font: TFont; TrackOptions: TJvTrackFontOpti
|
|||||||
// used for checkboxes and radiobuttons.
|
// used for checkboxes and radiobuttons.
|
||||||
// Originally from Mike Lischke
|
// Originally from Mike Lischke
|
||||||
function GetDefaultCheckBoxSize: TSize;
|
function GetDefaultCheckBoxSize: TSize;
|
||||||
|
********************)
|
||||||
|
|
||||||
function CanvasMaxTextHeight(Canvas: TCanvas): Integer;
|
function CanvasMaxTextHeight(Canvas: TCanvas): Integer;
|
||||||
|
|
||||||
|
(*******************
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
// AllocateHWndEx works like Classes.AllocateHWnd but does not use any virtual memory pages
|
// AllocateHWndEx works like Classes.AllocateHWnd but does not use any virtual memory pages
|
||||||
function AllocateHWndEx(Method: TWndMethod; const AClassName: string = ''): THandle;
|
function AllocateHWndEx(Method: TWndMethod; const AClassName: string = ''): THandle;
|
||||||
@ -703,21 +705,35 @@ function StripAllFromResult(const Value: TModalResult): TModalResult;
|
|||||||
function SelectColorByLuminance(AColor, DarkColor, BrightColor: TColor): TColor;
|
function SelectColorByLuminance(AColor, DarkColor, BrightColor: TColor): TColor;
|
||||||
|
|
||||||
// (peter3) implementation moved from JvHTControls.
|
// (peter3) implementation moved from JvHTControls.
|
||||||
|
************)
|
||||||
|
|
||||||
type
|
type
|
||||||
TJvHTMLCalcType = (htmlShow, htmlCalcWidth, htmlCalcHeight);
|
TJvHTMLCalcType = (htmlShow, htmlCalcWidth, htmlCalcHeight, htmlHyperLink);
|
||||||
|
|
||||||
procedure HTMLDrawTextEx(Canvas: TCanvas; Rect: TRect;
|
procedure HTMLDrawTextEx(Canvas: TCanvas; Rect: TRect;
|
||||||
const State: TOwnerDrawState; const Text: string; var Width: Integer;
|
const State: TOwnerDrawState; const Text: string; out Width: Integer;
|
||||||
CalcType: TJvHTMLCalcType; MouseX, MouseY: Integer; var MouseOnLink: Boolean;
|
CalcType: TJvHTMLCalcType; MouseX, MouseY: Integer; out MouseOnLink: Boolean;
|
||||||
var LinkName: string; Scale: Integer = 100);
|
var LinkName: string; SuperSubScriptRatio: Double; Scale: Integer = 100); overload;
|
||||||
function HTMLDrawText(Canvas: TCanvas; Rect: TRect;
|
procedure HTMLDrawTextEx2(Canvas: TCanvas; Rect: TRect;
|
||||||
const State: TOwnerDrawState; const Text: string; Scale: Integer = 100): string;
|
const State: TOwnerDrawState; const Text: string; out Width, Height: Integer;
|
||||||
function HTMLTextWidth(Canvas: TCanvas; Rect: TRect;
|
CalcType: TJvHTMLCalcType; MouseX, MouseY: Integer; out MouseOnLink: Boolean;
|
||||||
const State: TOwnerDrawState; const Text: string; Scale: Integer = 100): Integer;
|
var LinkName: string; SuperSubScriptRatio: Double; Scale: Integer = 100); overload;
|
||||||
|
procedure HTMLDrawText(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double;
|
||||||
|
Scale: Integer = 100);
|
||||||
|
procedure HTMLDrawTextHL(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; MouseX, MouseY: Integer;
|
||||||
|
SuperSubScriptRatio: Double; Scale: Integer = 100);
|
||||||
function HTMLPlainText(const Text: string): string;
|
function HTMLPlainText(const Text: string): string;
|
||||||
function HTMLTextHeight(Canvas: TCanvas; const Text: string; Scale: Integer = 100): Integer;
|
function HTMLTextExtent(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): TSize;
|
||||||
|
function HTMLTextWidth(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
|
||||||
|
function HTMLTextHeight(Canvas: TCanvas; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
|
||||||
function HTMLPrepareText(const Text: string): string;
|
function HTMLPrepareText(const Text: string): string;
|
||||||
|
|
||||||
|
(*************
|
||||||
|
|
||||||
// This type is used to allow an easy migration from a TBitmap property to a
|
// This type is used to allow an easy migration from a TBitmap property to a
|
||||||
// TPicture property. It is, for instance, used in TJvXPButton so that users
|
// TPicture property. It is, for instance, used in TJvXPButton so that users
|
||||||
// migrating to the JVCL can still open their applications and benefit
|
// migrating to the JVCL can still open their applications and benefit
|
||||||
@ -809,10 +825,15 @@ function GetGraphicObject(AStream: TStream): TGraphic; overload;
|
|||||||
function GetGraphicObject(AStream: TStream; ASender: TObject; AOnProc: TJvGetGraphicClassEvent): TGraphic; overload;
|
function GetGraphicObject(AStream: TStream; ASender: TObject; AOnProc: TJvGetGraphicClassEvent): TGraphic; overload;
|
||||||
********************)
|
********************)
|
||||||
|
|
||||||
|
function ReplaceComponentReference(This, NewReference: TComponent; var VarReference: TComponent): Boolean;
|
||||||
|
function ReplaceImageListReference(This: TComponent; NewReference: TCustomImageList;
|
||||||
|
var VarReference: TCustomImageList; ChangeLink: TChangeLink): Boolean;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
(********************
|
|
||||||
uses
|
uses
|
||||||
|
sysutils, LCLIntf, math;
|
||||||
|
(********************
|
||||||
SysConst,
|
SysConst,
|
||||||
Consts,
|
Consts,
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
@ -6398,15 +6419,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
*****************)
|
||||||
|
|
||||||
function CanvasMaxTextHeight(Canvas: TCanvas): Integer;
|
function CanvasMaxTextHeight(Canvas: TCanvas): Integer;
|
||||||
var
|
var
|
||||||
tt: TTextMetric;
|
tt: TTextMetric;
|
||||||
begin
|
begin
|
||||||
// (ahuser) Qt returns different values for TextHeight('Ay') and TextHeigth(#1..#255)
|
// (ahuser) Qt returns different values for TextHeight('Ay') and TextHeigth(#1..#255)
|
||||||
GetTextMetrics(Canvas.Handle, tt);
|
GetTextMetrics(Canvas.Handle, tt{%H-});
|
||||||
Result := tt.tmHeight;
|
Result := tt.tmHeight;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
(****************
|
||||||
{$IFDEF MSWINDOWS}
|
{$IFDEF MSWINDOWS}
|
||||||
|
|
||||||
//=== AllocateHWndEx =========================================================
|
//=== AllocateHWndEx =========================================================
|
||||||
@ -6977,6 +7001,7 @@ begin
|
|||||||
else
|
else
|
||||||
Result := BrightColor;
|
Result := BrightColor;
|
||||||
end;
|
end;
|
||||||
|
***********)
|
||||||
|
|
||||||
const
|
const
|
||||||
cBR = '<BR>';
|
cBR = '<BR>';
|
||||||
@ -6996,19 +7021,18 @@ const
|
|||||||
// moved from JvHTControls and renamed
|
// moved from JvHTControls and renamed
|
||||||
function HTMLPrepareText(const Text: string): string;
|
function HTMLPrepareText(const Text: string): string;
|
||||||
type
|
type
|
||||||
THtmlCode = packed record
|
THtmlCode = record
|
||||||
Html: string[10];
|
Html: string;
|
||||||
Text: Char;
|
Text: UTF8String;
|
||||||
end;
|
end;
|
||||||
const
|
const
|
||||||
Conversions: array [0..6] of THtmlCode =
|
Conversions: array [0..6] of THtmlCode = (
|
||||||
(
|
|
||||||
(Html: '&'; Text: '&'),
|
(Html: '&'; Text: '&'),
|
||||||
(Html: '"'; Text: '"'),
|
(Html: '"'; Text: '"'),
|
||||||
(Html: '®'; Text: '�'),
|
(Html: '®'; Text: #$C2#$AE),
|
||||||
(Html: '©'; Text: '�'),
|
(Html: '©'; Text: #$C2#$A9),
|
||||||
(Html: '™'; Text: '�'),
|
(Html: '™'; Text: #$E2#$84#$A2),
|
||||||
(Html: '€'; Text: '�'),
|
(Html: '€'; Text: #$E2#$82#$AC),
|
||||||
(Html: ' '; Text: ' ')
|
(Html: ' '; Text: ' ')
|
||||||
);
|
);
|
||||||
var
|
var
|
||||||
@ -7016,8 +7040,7 @@ var
|
|||||||
begin
|
begin
|
||||||
Result := Text;
|
Result := Text;
|
||||||
for I := Low(Conversions) to High(Conversions) do
|
for I := Low(Conversions) to High(Conversions) do
|
||||||
with Conversions[I] do
|
Result := StringReplace(Result, Conversions[I].Html, Utf8ToAnsi(Conversions[I].Text), [rfReplaceAll, rfIgnoreCase]);
|
||||||
Result := StringReplace(Result, Html, Text, [rfReplaceAll, rfIgnoreCase]);
|
|
||||||
Result := StringReplace(Result, sLineBreak, '', [rfReplaceAll, rfIgnoreCase]); // only <BR> can be new line
|
Result := StringReplace(Result, sLineBreak, '', [rfReplaceAll, rfIgnoreCase]); // only <BR> can be new line
|
||||||
Result := StringReplace(Result, cBR, sLineBreak, [rfReplaceAll, rfIgnoreCase]);
|
Result := StringReplace(Result, cBR, sLineBreak, [rfReplaceAll, rfIgnoreCase]);
|
||||||
Result := StringReplace(Result, cHR, cHR + sLineBreak, [rfReplaceAll, rfIgnoreCase]); // fixed <HR><BR>
|
Result := StringReplace(Result, cHR, cHR + sLineBreak, [rfReplaceAll, rfIgnoreCase]); // fixed <HR><BR>
|
||||||
@ -7056,10 +7079,30 @@ begin
|
|||||||
Delete(Result, 1, Pos(cTagEnd, Result));
|
Delete(Result, 1, Pos(cTagEnd, Result));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// wp: Made Width and MouseOnLink out parameters (were "var" in the original)
|
||||||
|
// to silence the compiler
|
||||||
procedure HTMLDrawTextEx(Canvas: TCanvas; Rect: TRect;
|
procedure HTMLDrawTextEx(Canvas: TCanvas; Rect: TRect;
|
||||||
const State: TOwnerDrawState; const Text: string; var Width: Integer;
|
const State: TOwnerDrawState; const Text: string; out Width: Integer;
|
||||||
CalcType: TJvHTMLCalcType; MouseX, MouseY: Integer; var MouseOnLink: Boolean;
|
CalcType: TJvHTMLCalcType; MouseX, MouseY: Integer; out MouseOnLink: Boolean;
|
||||||
var LinkName: string; Scale: Integer = 100);
|
var LinkName: string; SuperSubScriptRatio: Double; Scale: Integer);
|
||||||
|
var
|
||||||
|
H: Integer;
|
||||||
|
begin
|
||||||
|
HTMLDrawTextEx2(Canvas, Rect, State, Text, Width, H, CalcType, MouseX, MouseY, MouseOnLink,
|
||||||
|
LinkName, SuperSubScriptRatio, Scale);
|
||||||
|
if CalcType = htmlCalcHeight then
|
||||||
|
Width := H;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TScriptPosition = (spNormal, spSuperscript, spSubscript);
|
||||||
|
|
||||||
|
// wp: Make Width, Height and MouseOnLink "out" parameters
|
||||||
|
// (they were "var" in the original) to silence the compiler
|
||||||
|
procedure HTMLDrawTextEx2(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; out Width, Height: Integer;
|
||||||
|
CalcType: TJvHTMLCalcType; MouseX, MouseY: Integer; out MouseOnLink: Boolean;
|
||||||
|
var LinkName: string; SuperSubScriptRatio: Double; Scale: Integer);
|
||||||
const
|
const
|
||||||
DefaultLeft = 0; // (ahuser) was 2
|
DefaultLeft = 0; // (ahuser) was 2
|
||||||
var
|
var
|
||||||
@ -7082,6 +7125,7 @@ var
|
|||||||
RemFontColor,
|
RemFontColor,
|
||||||
RemBrushColor: TColor;
|
RemBrushColor: TColor;
|
||||||
RemFontSize: Integer;
|
RemFontSize: Integer;
|
||||||
|
ScriptPosition: TScriptPosition;
|
||||||
|
|
||||||
function ExtractPropertyValue(const Tag: string; PropName: string): string;
|
function ExtractPropertyValue(const Tag: string; PropName: string): string;
|
||||||
var
|
var
|
||||||
@ -7129,9 +7173,9 @@ var
|
|||||||
begin
|
begin
|
||||||
case Alignment of
|
case Alignment of
|
||||||
taRightJustify:
|
taRightJustify:
|
||||||
Result := (Rect.Right {- Rect.Left}) - HTMLTextWidth(Canvas, Rect, State, Str, Scale);
|
Result := (Rect.Right - Rect.Left) - HTMLTextWidth(Canvas, Rect, State, Str, Scale);
|
||||||
taCenter:
|
taCenter:
|
||||||
Result := (Rect.Right {- Rect.Left} - HTMLTextWidth(Canvas, Rect, State, Str)) div 2;
|
Result := DefaultLeft + ((Rect.Right - Rect.Left) - HTMLTextWidth(Canvas, Rect, State, Str, SuperSubScriptRatio)) div 2;
|
||||||
else
|
else
|
||||||
Result := DefaultLeft;
|
Result := DefaultLeft;
|
||||||
end;
|
end;
|
||||||
@ -7143,13 +7187,23 @@ var
|
|||||||
var
|
var
|
||||||
Width, Height: Integer;
|
Width, Height: Integer;
|
||||||
R: TRect;
|
R: TRect;
|
||||||
|
OriginalFontSize: Integer;
|
||||||
begin
|
begin
|
||||||
R := Rect;
|
R := Rect;
|
||||||
Inc(R.Left, CurLeft);
|
Inc(R.Left, CurLeft);
|
||||||
if Assigned(Canvas) then
|
if Assigned(Canvas) then
|
||||||
begin
|
begin
|
||||||
|
OriginalFontSize := Canvas.Font.Size;
|
||||||
|
try
|
||||||
|
if ScriptPosition <> spNormal then
|
||||||
|
Canvas.Font.Size := Round(Canvas.Font.Size * SuperSubScriptRatio);
|
||||||
|
|
||||||
Width := Canvas.TextWidth(M);
|
Width := Canvas.TextWidth(M);
|
||||||
Height := CanvasMaxTextHeight(Canvas);
|
Height := CanvasMaxTextHeight(Canvas);
|
||||||
|
|
||||||
|
if ScriptPosition = spSubscript then
|
||||||
|
R.Top := R.Bottom - Height - 1;
|
||||||
|
|
||||||
if IsLink and not MouseOnLink then
|
if IsLink and not MouseOnLink then
|
||||||
if (MouseY >= R.Top) and (MouseY <= R.Top + Height) and
|
if (MouseY >= R.Top) and (MouseY <= R.Top + Height) and
|
||||||
(MouseX >= R.Left) and (MouseX <= R.Left + Width) and
|
(MouseX >= R.Left) and (MouseX <= R.Left + Width) and
|
||||||
@ -7166,6 +7220,9 @@ var
|
|||||||
Canvas.TextOut(R.Left, R.Top, M);
|
Canvas.TextOut(R.Left, R.Top, M);
|
||||||
end;
|
end;
|
||||||
CurLeft := CurLeft + Width;
|
CurLeft := CurLeft + Width;
|
||||||
|
finally
|
||||||
|
Canvas.Font.Size := OriginalFontSize;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -7197,20 +7254,21 @@ begin
|
|||||||
OldFontColor := Canvas.Font.Color;
|
OldFontColor := Canvas.Font.Color;
|
||||||
OldBrushColor := Canvas.Brush.Color;
|
OldBrushColor := Canvas.Brush.Color;
|
||||||
OldBrushStyle := Canvas.Brush.Style;
|
OldBrushStyle := Canvas.Brush.Style;
|
||||||
OldAlignment := Alignment;
|
// OldAlignment := Alignment;
|
||||||
RemFontColor := Canvas.Font.Color;
|
RemFontColor := Canvas.Font.Color;
|
||||||
RemBrushColor := Canvas.Brush.Color;
|
RemBrushColor := Canvas.Brush.Color;
|
||||||
RemFontSize := Canvas.Font.size;
|
RemFontSize := Canvas.Font.size;
|
||||||
end;
|
end;
|
||||||
|
vStr := TStringList.Create;
|
||||||
try
|
try
|
||||||
Alignment := taLeftJustify;
|
Alignment := taLeftJustify;
|
||||||
IsLink := False;
|
IsLink := False;
|
||||||
MouseOnLink := False;
|
MouseOnLink := False;
|
||||||
vText := Text;
|
vText := Text;
|
||||||
vStr := TStringList.Create;
|
vStr.Text := vText;
|
||||||
vStr.Text := HTMLPrepareText(vText);
|
|
||||||
LinkName := '';
|
LinkName := '';
|
||||||
TempLink := '';
|
TempLink := '';
|
||||||
|
ScriptPosition := spNormal;
|
||||||
|
|
||||||
Selected := (odSelected in State) or (odDisabled in State);
|
Selected := (odSelected in State) or (odDisabled in State);
|
||||||
Trans := (Canvas.Brush.Style = bsClear) and not selected;
|
Trans := (Canvas.Brush.Style = bsClear) and not selected;
|
||||||
@ -7221,15 +7279,16 @@ begin
|
|||||||
vM := '';
|
vM := '';
|
||||||
for vCount := 0 to vStr.Count - 1 do
|
for vCount := 0 to vStr.Count - 1 do
|
||||||
begin
|
begin
|
||||||
vText := vStr[vCount];
|
vText := HTMLPrepareText(vStr[vCount]);
|
||||||
CurLeft := CalcPos(vText);
|
CurLeft := CalcPos(vText);
|
||||||
while Length(vText) > 0 do
|
while vText <> '' do
|
||||||
begin
|
begin
|
||||||
vM := HTMLBeforeTag(vText, True);
|
vM := HTMLBeforeTag(vText, True);
|
||||||
vM := StringReplace(vM, '<', cLT, [rfReplaceAll, rfIgnoreCase]); // <--+ this must be here
|
vM := StringReplace(vM, '<', cLT, [rfReplaceAll, rfIgnoreCase]); // <--+ this must be here
|
||||||
vM := StringReplace(vM, '>', cGT, [rfReplaceAll, rfIgnoreCase]); // <--/
|
vM := StringReplace(vM, '>', cGT, [rfReplaceAll, rfIgnoreCase]); // <--/
|
||||||
if GetChar(vText, 1) = cTagBegin then
|
if GetChar(vText, 1) = cTagBegin then
|
||||||
begin
|
begin
|
||||||
|
if vM <> '' then
|
||||||
Draw(vM);
|
Draw(vM);
|
||||||
if Pos(cTagEnd, vText) = 0 then
|
if Pos(cTagEnd, vText) = 0 then
|
||||||
Insert(cTagEnd, vText, 2);
|
Insert(cTagEnd, vText, 2);
|
||||||
@ -7248,7 +7307,10 @@ begin
|
|||||||
'U':
|
'U':
|
||||||
Style(fsUnderline, False);
|
Style(fsUnderline, False);
|
||||||
'S':
|
'S':
|
||||||
|
begin
|
||||||
|
ScriptPosition := spNormal;
|
||||||
Style(fsStrikeOut, False);
|
Style(fsStrikeOut, False);
|
||||||
|
end;
|
||||||
'F':
|
'F':
|
||||||
begin
|
begin
|
||||||
if not Selected then // restore old colors
|
if not Selected then // restore old colors
|
||||||
@ -7277,7 +7339,7 @@ begin
|
|||||||
else
|
else
|
||||||
Alignment := taLeftJustify;
|
Alignment := taLeftJustify;
|
||||||
CurLeft := DefaultLeft;
|
CurLeft := DefaultLeft;
|
||||||
if CalcType = htmlShow then
|
if CalcType in [htmlShow, htmlHyperLink] then
|
||||||
CurLeft := CalcPos(vText);
|
CurLeft := CalcPos(vText);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -7308,7 +7370,21 @@ begin
|
|||||||
'U':
|
'U':
|
||||||
Style(fsUnderline, True);
|
Style(fsUnderline, True);
|
||||||
'S':
|
'S':
|
||||||
|
begin
|
||||||
|
if GetChar(vText, 4, True) = 'P' then
|
||||||
|
begin
|
||||||
|
ScriptPosition := spSuperscript;
|
||||||
|
end
|
||||||
|
else if GetChar(vText, 4, True) = 'B' then
|
||||||
|
begin
|
||||||
|
ScriptPosition := spSubscript;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ScriptPosition := spNormal;
|
||||||
Style(fsStrikeOut, True);
|
Style(fsStrikeOut, True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
'H':
|
'H':
|
||||||
if (GetChar(vText, 3, True) = 'R') and Assigned(Canvas) then // HR
|
if (GetChar(vText, 3, True) = 'R') and Assigned(Canvas) then // HR
|
||||||
begin
|
begin
|
||||||
@ -7329,7 +7405,7 @@ begin
|
|||||||
NewLine(HTMLDeleteTag(vText) <> '');
|
NewLine(HTMLDeleteTag(vText) <> '');
|
||||||
end;
|
end;
|
||||||
'F':
|
'F':
|
||||||
if (Pos(cTagEnd, vText) > 0) and (not Selected) and Assigned(Canvas) {and (CalcType = htmlShow)} then // F from FONT
|
if (Pos(cTagEnd, vText) > 0) and (not Selected) and Assigned(Canvas) {and (CalcType in [htmlShow, htmlHyperLink])} then // F from FONT
|
||||||
begin
|
begin
|
||||||
TagPrp := UpperCase(Copy(vText, 2, Pos(cTagEnd, vText) - 2));
|
TagPrp := UpperCase(Copy(vText, 2, Pos(cTagEnd, vText) - 2));
|
||||||
RemFontColor := Canvas.Font.Color;
|
RemFontColor := Canvas.Font.Color;
|
||||||
@ -7358,7 +7434,7 @@ begin
|
|||||||
if Pos('SIZE', TagPrp) > 0 then
|
if Pos('SIZE', TagPrp) > 0 then
|
||||||
begin
|
begin
|
||||||
Prp := ExtractPropertyValue(TagPrp, 'SIZE');
|
Prp := ExtractPropertyValue(TagPrp, 'SIZE');
|
||||||
Canvas.Font.Size := StrToIntDef(Prp,2) * Canvas.Font.Size div 2;
|
Canvas.Font.Size := StrToIntDef(Prp,2){ * Canvas.Font.Size div 2};
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -7367,6 +7443,7 @@ begin
|
|||||||
vM := '';
|
vM := '';
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
if vM <> '' then
|
||||||
Draw(vM);
|
Draw(vM);
|
||||||
NewLine;
|
NewLine;
|
||||||
vM := '';
|
vM := '';
|
||||||
@ -7385,20 +7462,33 @@ begin
|
|||||||
FreeAndNil(vStr);
|
FreeAndNil(vStr);
|
||||||
FreeAndNil(OldFont);
|
FreeAndNil(OldFont);
|
||||||
end;
|
end;
|
||||||
if CalcType = htmlCalcHeight then
|
|
||||||
Width := Rect.Top + CanvasMaxTextHeight(Canvas)
|
|
||||||
else
|
|
||||||
Width := Max(Width, CurLeft - DefaultLeft);
|
Width := Max(Width, CurLeft - DefaultLeft);
|
||||||
|
Height := Rect.Top + CanvasMaxTextHeight(Canvas);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function HTMLDrawText(Canvas: TCanvas; Rect: TRect;
|
// wp: I made this a procedure - it was a function in the original with the
|
||||||
const State: TOwnerDrawState; const Text: string; Scale: Integer = 100): string;
|
// result being unassigned.
|
||||||
|
procedure HTMLDrawText(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double; Scale: Integer);
|
||||||
var
|
var
|
||||||
W: Integer;
|
W: Integer;
|
||||||
S: Boolean;
|
S: Boolean;
|
||||||
St: string;
|
St: string;
|
||||||
begin
|
begin
|
||||||
HTMLDrawTextEx(Canvas, Rect, State, Text, W, htmlShow, 0, 0, S, St, Scale);
|
HTMLDrawTextEx(Canvas, Rect, State, Text, W, htmlShow, 0, 0, S, St, SuperSubScriptRatio, Scale);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// wp: I made this a procedure - it was a function in the original with the
|
||||||
|
// result being unassigned.
|
||||||
|
procedure HTMLDrawTextHL(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; MouseX, MouseY: Integer;
|
||||||
|
SuperSubScriptRatio: Double; Scale: Integer);
|
||||||
|
var
|
||||||
|
W: Integer;
|
||||||
|
S: Boolean;
|
||||||
|
St: string;
|
||||||
|
begin
|
||||||
|
HTMLDrawTextEx(Canvas, Rect, State, Text, W, htmlShow, MouseX, MouseY, S, St, SuperSubScriptRatio, Scale);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function HTMLPlainText(const Text: string): string;
|
function HTMLPlainText(const Text: string): string;
|
||||||
@ -7418,28 +7508,41 @@ begin
|
|||||||
Result := Result + S;
|
Result := Result + S;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function HTMLTextWidth(Canvas: TCanvas; Rect: TRect;
|
function HTMLTextExtent(Canvas: TCanvas; Rect: TRect;
|
||||||
const State: TOwnerDrawState; const Text: string; Scale: Integer = 100): Integer;
|
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): TSize;
|
||||||
var
|
var
|
||||||
S: Boolean;
|
S: Boolean;
|
||||||
St: string;
|
St: string;
|
||||||
begin
|
begin
|
||||||
HTMLDrawTextEx(Canvas, Rect, State, Text, Result, htmlCalcWidth, 0, 0, S, St);
|
HTMLDrawTextEx2(Canvas, Rect, State, Text, Result.cx, Result.cy, htmlCalcWidth, 0, 0, S, St, SuperSubScriptRatio, Scale);
|
||||||
|
if Result.cy = 0 then
|
||||||
|
Result.cy := CanvasMaxTextHeight(Canvas);
|
||||||
|
Inc(Result.cy);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function HTMLTextHeight(Canvas: TCanvas; const Text: string; Scale: Integer = 100): Integer;
|
function HTMLTextWidth(Canvas: TCanvas; Rect: TRect;
|
||||||
|
const State: TOwnerDrawState; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
|
||||||
|
var
|
||||||
|
S: Boolean;
|
||||||
|
St: string;
|
||||||
|
begin
|
||||||
|
HTMLDrawTextEx(Canvas, Rect, State, Text, Result, htmlCalcWidth, 0, 0, S, St, SuperSubScriptRatio, Scale);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function HTMLTextHeight(Canvas: TCanvas; const Text: string; SuperSubScriptRatio: Double; Scale: Integer = 100): Integer;
|
||||||
var
|
var
|
||||||
S: Boolean;
|
S: Boolean;
|
||||||
St: string;
|
St: string;
|
||||||
R: TRect;
|
R: TRect;
|
||||||
begin
|
begin
|
||||||
R := Rect(0, 0, 0, 0);
|
R := Rect(0, 0, 0, 0);
|
||||||
HTMLDrawTextEx(Canvas, R, [], Text, Result, htmlCalcHeight, 0, 0, S, St, Scale);
|
HTMLDrawTextEx(Canvas, R, [], Text, Result, htmlCalcHeight, 0, 0, S, St, SuperSubScriptRatio, Scale);
|
||||||
if Result = 0 then
|
if Result = 0 then
|
||||||
Result := CanvasMaxTextHeight(Canvas);
|
Result := CanvasMaxTextHeight(Canvas);
|
||||||
Inc(Result);
|
Inc(Result);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
(*************
|
||||||
{ TJvPicture }
|
{ TJvPicture }
|
||||||
procedure TJvPicture.ReadBitmapData(Stream: TStream);
|
procedure TJvPicture.ReadBitmapData(Stream: TStream);
|
||||||
var
|
var
|
||||||
@ -7682,6 +7785,43 @@ begin
|
|||||||
Result := nil;
|
Result := nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
******************)
|
||||||
|
|
||||||
|
function ReplaceComponentReference(This, NewReference: TComponent; var VarReference: TComponent): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (VarReference <> NewReference) and Assigned(This);
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
if Assigned(VarReference) then
|
||||||
|
VarReference.RemoveFreeNotification(This);
|
||||||
|
VarReference := NewReference;
|
||||||
|
if Assigned(VarReference) then
|
||||||
|
VarReference.FreeNotification(This);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ReplaceImageListReference(This: TComponent; NewReference: TCustomImageList;
|
||||||
|
var VarReference: TCustomImageList; ChangeLink: TChangeLink): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (VarReference <> NewReference) and Assigned(This);
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
if Assigned(VarReference) then
|
||||||
|
begin
|
||||||
|
VarReference.RemoveFreeNotification(This);
|
||||||
|
VarReference.UnRegisterChanges(ChangeLink);
|
||||||
|
end;
|
||||||
|
VarReference := NewReference;
|
||||||
|
if Assigned(VarReference) then
|
||||||
|
begin
|
||||||
|
VarReference.RegisterChanges(ChangeLink);
|
||||||
|
VarReference.FreeNotification(This);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(************
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
InitScreenCursors;
|
InitScreenCursors;
|
||||||
|
|
||||||
|
|||||||
2366
components/jvcllaz/run/JvResources.pas
Normal file
2366
components/jvcllaz/run/JvResources.pas
Normal file
File diff suppressed because it is too large
Load Diff
@ -61,10 +61,10 @@ type
|
|||||||
Result: Longint;
|
Result: Longint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
(********************
|
|
||||||
THintString = string;
|
THintString = string;
|
||||||
THintStringList = TStringList;
|
THintStringList = TStringList;
|
||||||
|
|
||||||
|
(********************
|
||||||
{ JvExVCL classes }
|
{ JvExVCL classes }
|
||||||
TInputKey = (ikAll, ikArrows, ikChars, ikButton, ikTabs, ikEdit, ikNative{, ikNav, ikEsc});
|
TInputKey = (ikAll, ikArrows, ikChars, ikButton, ikTabs, ikEdit, ikNative{, ikNav, ikEsc});
|
||||||
TInputKeys = set of TInputKey;
|
TInputKeys = set of TInputKey;
|
||||||
|
|||||||
993
components/jvcllaz/run/JvValidators.pas
Normal file
993
components/jvcllaz/run/JvValidators.pas
Normal file
@ -0,0 +1,993 @@
|
|||||||
|
{-----------------------------------------------------------------------------
|
||||||
|
The contents of this file are subject to the Mozilla Public License
|
||||||
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||||
|
with the License. You may obtain a copy of the License at
|
||||||
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||||
|
|
||||||
|
Software distributed under the License is distributed on an "AS IS" basis,
|
||||||
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||||
|
the specific language governing rights and limitations under the License.
|
||||||
|
|
||||||
|
The Original Code is: JvValidators.PAS, released on 2003-01-01.
|
||||||
|
|
||||||
|
The Initial Developer of the Original Code is Peter Th�rnqvist [peter3 at sourceforge dot net] .
|
||||||
|
Portions created by Peter Th�rnqvist are Copyright (C) 2003 Peter Th�rnqvist.
|
||||||
|
All Rights Reserved.
|
||||||
|
|
||||||
|
Contributor(s):
|
||||||
|
|
||||||
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||||
|
located at http://jvcl.delphi-jedi.org
|
||||||
|
|
||||||
|
Known Issues:
|
||||||
|
-----------------------------------------------------------------------------}
|
||||||
|
// $Id$
|
||||||
|
|
||||||
|
unit JvValidators;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
// NB: this is here so a user can disable DB support if he wants to
|
||||||
|
// NB2: this need not be defined in the design package because GetDataLink is
|
||||||
|
// defined differently depending on this define
|
||||||
|
{$DEFINE JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
DB,
|
||||||
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
SysUtils, Classes, Controls, Forms, {JvComponentBase,} JvErrorIndicator;
|
||||||
|
|
||||||
|
type
|
||||||
|
EValidatorError = class(Exception);
|
||||||
|
|
||||||
|
// Implemented by classes that can return the value to validate against.
|
||||||
|
// The validator classes first check if the ControlToValidate supports this interface
|
||||||
|
// and if it does, uses the value returned from GetValidationPropertyValue instead of
|
||||||
|
// extracting it from RTTI (using ControlToValidate and PropertyToValidate)
|
||||||
|
// The good thing about implementing this interface is that the value to validate do
|
||||||
|
// not need to be a published property but can be anything, even a calculated value
|
||||||
|
IJvValidationProperty = interface
|
||||||
|
['{564FD9F5-BE57-4559-A6AF-B0624C956E50}']
|
||||||
|
function GetValidationPropertyValue: Variant;
|
||||||
|
function GetValidationPropertyName: WideString;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IJvValidationSummary = interface
|
||||||
|
['{F2E4F4E5-E831-4514-93C9-0E2ACA941DCF}']
|
||||||
|
procedure BeginUpdate;
|
||||||
|
procedure EndUpdate;
|
||||||
|
procedure AddError(const ErrorMessage: string);
|
||||||
|
procedure RemoveError(const ErrorMessage: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvBaseValidator = class;
|
||||||
|
TJvValidators = class;
|
||||||
|
TJvBaseValidatorClass = class of TJvBaseValidator;
|
||||||
|
|
||||||
|
TJvBaseValidator = class(TComponent)
|
||||||
|
private
|
||||||
|
FEnabled: Boolean;
|
||||||
|
FValid: Boolean;
|
||||||
|
FPropertyToValidate: string;
|
||||||
|
FErrorMessage: string;
|
||||||
|
FGroupName: string;
|
||||||
|
FControlToValidate: TControl;
|
||||||
|
FErrorControl: TControl;
|
||||||
|
FValidator: TJvValidators;
|
||||||
|
FOnValidateFailed: TNotifyEvent;
|
||||||
|
|
||||||
|
procedure SetControlToValidate(Value: TControl);
|
||||||
|
procedure SetErrorControl(Value: TControl);
|
||||||
|
protected
|
||||||
|
function GetValidationPropertyValue: Variant; virtual;
|
||||||
|
procedure SetValid(const Value: Boolean); virtual;
|
||||||
|
function GetValid: Boolean; virtual;
|
||||||
|
procedure DoValidateFailed; dynamic;
|
||||||
|
procedure Validate; virtual; abstract;
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
procedure SetParentComponent(Value: TComponent); override;
|
||||||
|
procedure ReadState(Reader: TReader); override;
|
||||||
|
|
||||||
|
// get the number of registered base validator classes
|
||||||
|
class function BaseValidatorsCount: Integer;
|
||||||
|
// get info on a registered class
|
||||||
|
class procedure GetBaseValidatorInfo(Index: Integer; var DisplayName: string;
|
||||||
|
var ABaseValidatorClass: TJvBaseValidatorClass);
|
||||||
|
|
||||||
|
public
|
||||||
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
// return a TDataLink if the control is a DB control or nil if is not
|
||||||
|
function GetDataLink(AControl:TControl):TDataLink;virtual;
|
||||||
|
{$ELSE}
|
||||||
|
function GetDataLink(AControl:TControl):TObject;virtual;
|
||||||
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
// register a new base validator class. DisplayName is used by the design-time editor.
|
||||||
|
// A class with an empty DisplayName will not sshow up in the editor
|
||||||
|
class procedure RegisterBaseValidator(const DisplayName: string; AValidatorClass: TJvBaseValidatorClass);
|
||||||
|
class procedure UnregisterBaseValidator(AValidatorClass: TJvBaseValidatorClass);
|
||||||
|
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
function GetParentComponent: TComponent; override;
|
||||||
|
function HasParent: Boolean; override;
|
||||||
|
property Value: Variant read GetValidationPropertyValue;
|
||||||
|
published
|
||||||
|
property Valid: Boolean read GetValid write SetValid default true;
|
||||||
|
// the control that is used to align the error indicator (nil means that the ControlToValidate should be used)
|
||||||
|
property ErrorControl: TControl read FErrorControl write SetErrorControl;
|
||||||
|
// the control to validate
|
||||||
|
property ControlToValidate: TControl read FControlToValidate write SetControlToValidate;
|
||||||
|
// the property in ControlToValidate to validate against
|
||||||
|
property PropertyToValidate: string read FPropertyToValidate write FPropertyToValidate;
|
||||||
|
// make this validator a part of a group so it can be validated separately using Validate(GroupName)
|
||||||
|
property GroupName:string read FGroupName write FGroupName;
|
||||||
|
property Enabled: Boolean read FEnabled write FEnabled default true;
|
||||||
|
// the message to display in case of error
|
||||||
|
property ErrorMessage: string read FErrorMessage write FErrorMessage;
|
||||||
|
// triggered when Valid is set to False
|
||||||
|
property OnValidateFailed: TNotifyEvent read FOnValidateFailed write FOnValidateFailed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvRequiredFieldValidator = class(TJvBaseValidator)
|
||||||
|
private
|
||||||
|
FAllowBlank: Boolean;
|
||||||
|
protected
|
||||||
|
procedure Validate; override;
|
||||||
|
published
|
||||||
|
property AllowBlank: Boolean read FAllowBlank write FAllowBlank default true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvValidateCompareOperator = (vcoLessThan, vcoLessOrEqual, vcoEqual, vcoGreaterOrEqual, vcoGreaterThan, vcoNotEqual);
|
||||||
|
|
||||||
|
TJvCompareValidator = class(TJvBaseValidator)
|
||||||
|
private
|
||||||
|
FValueToCompare: Variant;
|
||||||
|
FOperator: TJvValidateCompareOperator;
|
||||||
|
protected
|
||||||
|
procedure Validate; override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
published
|
||||||
|
property ValueToCompare: Variant read FValueToCompare write FValueToCompare;
|
||||||
|
property CmpOperator: TJvValidateCompareOperator read FOperator write FOperator default vcoEqual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvRangeValidator = class(TJvBaseValidator)
|
||||||
|
private
|
||||||
|
FMinimumValue: Variant;
|
||||||
|
FMaximumValue: Variant;
|
||||||
|
protected
|
||||||
|
procedure Validate; override;
|
||||||
|
published
|
||||||
|
property MinimumValue: Variant read FMinimumValue write FMinimumValue;
|
||||||
|
property MaximumValue: Variant read FMaximumValue write FMaximumValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvRegularExpressionValidator = class(TJvBaseValidator)
|
||||||
|
private
|
||||||
|
FValidationExpression: string;
|
||||||
|
protected
|
||||||
|
procedure Validate; override;
|
||||||
|
published
|
||||||
|
property ValidationExpression: string read FValidationExpression write FValidationExpression;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvCustomValidateEvent = procedure(Sender: TObject; ValueToValidate: Variant; var Valid: Boolean) of object;
|
||||||
|
|
||||||
|
TJvCustomValidator = class(TJvBaseValidator)
|
||||||
|
private
|
||||||
|
FOnValidate: TJvCustomValidateEvent;
|
||||||
|
protected
|
||||||
|
function DoValidate: Boolean; virtual;
|
||||||
|
procedure Validate; override;
|
||||||
|
published
|
||||||
|
property OnValidate: TJvCustomValidateEvent read FOnValidate write FOnValidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// compares the properties of two controls
|
||||||
|
// if CompareToControl implements the IJvValidationProperty interface, the value
|
||||||
|
// to compare is taken from GetValidationPropertyValue, otherwise RTTI is used to get the
|
||||||
|
// property value
|
||||||
|
TJvControlsCompareValidator = class(TJvBaseValidator)
|
||||||
|
private
|
||||||
|
FCompareToControl: TControl;
|
||||||
|
FCompareToProperty: string;
|
||||||
|
FOperator: TJvValidateCompareOperator;
|
||||||
|
FAllowNull: Boolean;
|
||||||
|
procedure SetCompareToControl(const AValue: TControl);
|
||||||
|
protected
|
||||||
|
procedure Validate; override;
|
||||||
|
function GetPropertyValueToCompare: Variant;
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
|
||||||
|
published
|
||||||
|
property CompareToControl: TControl read FCompareToControl write SetCompareToControl;
|
||||||
|
property CompareToProperty: string read FCompareToProperty write FCompareToProperty;
|
||||||
|
property CmpOperator: TJvValidateCompareOperator read FOperator write FOperator default vcoEqual;
|
||||||
|
property AllowNull: Boolean read FAllowNull write FAllowNull default True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvValidateFailEvent = procedure(Sender: TObject; BaseValidator: TJvBaseValidator; var Continue: Boolean) of object;
|
||||||
|
|
||||||
|
TJvValidators = class(TComponent)
|
||||||
|
private
|
||||||
|
FOnValidateFailed: TJvValidateFailEvent;
|
||||||
|
FItems: TList;
|
||||||
|
FValidationSummary: IJvValidationSummary;
|
||||||
|
FErrorIndicator: IJvErrorIndicator;
|
||||||
|
procedure SetValidationSummary(const Value: IJvValidationSummary);
|
||||||
|
procedure SetErrorIndicator(const Value: IJvErrorIndicator);
|
||||||
|
function GetCount: Integer;
|
||||||
|
function GetItem(Index: Integer): TJvBaseValidator;
|
||||||
|
protected
|
||||||
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||||
|
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
|
||||||
|
function DoValidateFailed(const ABaseValidator: TJvBaseValidator): Boolean; dynamic;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Insert(AValidator: TJvBaseValidator);
|
||||||
|
procedure Remove(AValidator: TJvBaseValidator);
|
||||||
|
procedure Exchange(Index1, Index2: Integer);
|
||||||
|
function Validate: Boolean; overload;
|
||||||
|
function Validate(const GroupName:string): Boolean; overload;
|
||||||
|
property Items[Index: Integer]: TJvBaseValidator read GetItem; default;
|
||||||
|
property Count: Integer read GetCount;
|
||||||
|
published
|
||||||
|
property ValidationSummary: IJvValidationSummary read FValidationSummary write SetValidationSummary;
|
||||||
|
property ErrorIndicator: IJvErrorIndicator read FErrorIndicator write SetErrorIndicator;
|
||||||
|
property OnValidateFailed: TJvValidateFailEvent read FOnValidateFailed write FOnValidateFailed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJvValidationSummary = class(TComponent, IUnknown, IJvValidationSummary)
|
||||||
|
private
|
||||||
|
FUpdateCount: Integer;
|
||||||
|
FPendingUpdates: Integer;
|
||||||
|
FSummaries: TStringList;
|
||||||
|
FOnChange: TNotifyEvent;
|
||||||
|
FOnRemoveError: TNotifyEvent;
|
||||||
|
FOnAddError: TNotifyEvent;
|
||||||
|
function GetSummaries: TStrings;
|
||||||
|
protected
|
||||||
|
{ IJvValidationSummary }
|
||||||
|
procedure AddError(const ErrorMessage: string);
|
||||||
|
procedure RemoveError(const ErrorMessage: string);
|
||||||
|
procedure BeginUpdate;
|
||||||
|
procedure EndUpdate;
|
||||||
|
|
||||||
|
procedure Change; virtual;
|
||||||
|
public
|
||||||
|
destructor Destroy; override;
|
||||||
|
property Summaries: TStrings read GetSummaries;
|
||||||
|
published
|
||||||
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||||
|
property OnAddError: TNotifyEvent read FOnAddError write FOnAddError;
|
||||||
|
property OnRemoveError: TNotifyEvent read FOnRemoveError write FOnRemoveError;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
cValidatorsDBValue = '(DBValue)';
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
DBCtrls,
|
||||||
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
Masks,
|
||||||
|
Variants,
|
||||||
|
TypInfo,
|
||||||
|
// JclUnicode, // for reg exp support
|
||||||
|
{JvTypes,} JvResources, JvJVCLUtils;
|
||||||
|
|
||||||
|
var
|
||||||
|
GlobalValidatorsList: TStringList = nil;
|
||||||
|
|
||||||
|
procedure RegisterBaseValidators; forward;
|
||||||
|
|
||||||
|
function ValidatorsList: TStringList;
|
||||||
|
begin
|
||||||
|
if not Assigned(GlobalValidatorsList) then
|
||||||
|
begin
|
||||||
|
GlobalValidatorsList := TStringList.Create;
|
||||||
|
// register
|
||||||
|
//RegisterBaseValidators; is registered in initialization
|
||||||
|
end;
|
||||||
|
Result := GlobalValidatorsList;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Debug(const Msg: string); overload;
|
||||||
|
begin
|
||||||
|
// Application.MessageBox(PChar(Msg),PChar('Debug'),MB_OK or MB_TASKMODAL)
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Debug(const Msg: string; const Fmt: array of const); overload;
|
||||||
|
begin
|
||||||
|
Debug(Format(Msg, Fmt));
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ComponentName(Comp: TComponent): string;
|
||||||
|
begin
|
||||||
|
if Comp = nil then
|
||||||
|
Result := 'nil'
|
||||||
|
else
|
||||||
|
if Comp.Name <> '' then
|
||||||
|
Result := Comp.Name
|
||||||
|
else
|
||||||
|
Result := Comp.ClassName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvBaseValidator } ===================================================
|
||||||
|
|
||||||
|
constructor TJvBaseValidator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FValid := True;
|
||||||
|
FEnabled := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvBaseValidator.Destroy;
|
||||||
|
begin
|
||||||
|
Debug('TJvBaseValidator.Destroy: FValidator is %s', [ComponentName(FValidator)]);
|
||||||
|
ErrorControl := nil;
|
||||||
|
ControlToValidate := nil;
|
||||||
|
if FValidator <> nil then
|
||||||
|
begin
|
||||||
|
FValidator.Remove(Self);
|
||||||
|
FValidator := nil;
|
||||||
|
end;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TJvBaseValidator.RegisterBaseValidator(const DisplayName: string; AValidatorClass:
|
||||||
|
TJvBaseValidatorClass);
|
||||||
|
begin
|
||||||
|
if ValidatorsList.IndexOfObject(TObject(Pointer(AValidatorClass))) < 0 then
|
||||||
|
begin
|
||||||
|
Classes.RegisterClass(TPersistentClass(AValidatorClass));
|
||||||
|
ValidatorsList.AddObject(DisplayName, TObject(Pointer(AValidatorClass)));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TJvBaseValidator.UnregisterBaseValidator(AValidatorClass: TJvBaseValidatorClass);
|
||||||
|
var
|
||||||
|
ClassIndex: Integer;
|
||||||
|
begin
|
||||||
|
ClassIndex := ValidatorsList.IndexOfObject(TObject(Pointer(AValidatorClass)));
|
||||||
|
if ClassIndex >= 0 then
|
||||||
|
begin
|
||||||
|
Classes.UnregisterClass(TPersistentClass(AValidatorClass));
|
||||||
|
ValidatorsList.Delete(ClassIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TJvBaseValidator.BaseValidatorsCount: Integer;
|
||||||
|
begin
|
||||||
|
Result := ValidatorsList.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class procedure TJvBaseValidator.GetBaseValidatorInfo(Index: Integer;
|
||||||
|
var DisplayName: string; var ABaseValidatorClass: TJvBaseValidatorClass);
|
||||||
|
begin
|
||||||
|
if (Index < 0) or (Index >= ValidatorsList.Count) then
|
||||||
|
raise Exception.CreateFmt(RsEInvalidIndexd, [Index]);
|
||||||
|
DisplayName := ValidatorsList[Index];
|
||||||
|
ABaseValidatorClass := TJvBaseValidatorClass(ValidatorsList.Objects[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvBaseValidator.GetValid: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FValid;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvBaseValidator.GetParentComponent: TComponent;
|
||||||
|
begin
|
||||||
|
Debug('TJvBaseValidator.GetParentComponent: Parent is %s', [ComponentName(FValidator)]);
|
||||||
|
Result := FValidator;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvBaseValidator.GetValidationPropertyValue: Variant;
|
||||||
|
var
|
||||||
|
ValProp: IJvValidationProperty;
|
||||||
|
PropInfo: PPropInfo;
|
||||||
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
DataLink:TDataLink;
|
||||||
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
begin
|
||||||
|
Result := Null;
|
||||||
|
if FControlToValidate <> nil then
|
||||||
|
begin
|
||||||
|
if Supports(FControlToValidate, IJvValidationProperty, ValProp) then
|
||||||
|
Result := ValProp.GetValidationPropertyValue
|
||||||
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
else if AnsiSameText(FPropertyToValidate,cValidatorsDBValue) then
|
||||||
|
begin
|
||||||
|
DataLink := GetDataLink(FControlToValidate);
|
||||||
|
if (DataLink is TFieldDataLink) and (TFieldDataLink(DataLink).Field <> nil) then
|
||||||
|
Result := TFieldDataLink(DataLink).Field.DisplayText;
|
||||||
|
end
|
||||||
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
else if FPropertyToValidate <> '' then
|
||||||
|
begin
|
||||||
|
PropInfo := GetPropInfo(FControlToValidate, FPropertyToValidate);
|
||||||
|
if (PropInfo <> nil) and (PropInfo^.GetProc <> nil) then
|
||||||
|
begin
|
||||||
|
Result := GetPropValue(FControlToValidate, FPropertyToValidate, False);
|
||||||
|
if (PropInfo^.PropType = TypeInfo(TDateTime)) or
|
||||||
|
(PropInfo^.PropType = TypeInfo(TDate)) or
|
||||||
|
(PropInfo^.PropType = TypeInfo(TTime)) then
|
||||||
|
Result := VarAsType(Result, varDate);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvBaseValidator.HasParent: Boolean;
|
||||||
|
begin
|
||||||
|
Debug('TJvBaseValidator.HasParent');
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if Operation = opRemove then
|
||||||
|
begin
|
||||||
|
if AComponent = ControlToValidate then
|
||||||
|
ControlToValidate := nil;
|
||||||
|
if AComponent = ErrorControl then
|
||||||
|
ErrorControl := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.SetValid(const Value: Boolean);
|
||||||
|
begin
|
||||||
|
FValid := Value;
|
||||||
|
if not FValid then
|
||||||
|
DoValidateFailed;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.SetControlToValidate(Value: TControl);
|
||||||
|
var
|
||||||
|
Obj: IJvValidationProperty;
|
||||||
|
begin
|
||||||
|
if ReplaceComponentReference(Self, Value, TComponent(FControlToValidate)) then
|
||||||
|
if FControlToValidate <> nil then
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
begin
|
||||||
|
if Supports(FControlToValidate, IJvValidationProperty, Obj) then
|
||||||
|
PropertyToValidate := UTF8Encode(Obj.GetValidationPropertyName)
|
||||||
|
else
|
||||||
|
PropertyToValidate := '';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.SetErrorControl(Value: TControl);
|
||||||
|
begin
|
||||||
|
ReplaceComponentReference(Self, Value, TComponent(FErrorControl));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.SetParentComponent(Value: TComponent);
|
||||||
|
begin
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
begin
|
||||||
|
Debug('TJvBaseValidator.SetParentComponent: Parent is %s, changing to %s',
|
||||||
|
[ComponentName(FValidator), ComponentName(Value)]);
|
||||||
|
if FValidator <> nil then
|
||||||
|
begin
|
||||||
|
Debug('FValidator.Remove');
|
||||||
|
FValidator.Remove(Self);
|
||||||
|
end;
|
||||||
|
if (Value <> nil) and (Value is TJvValidators) then
|
||||||
|
begin
|
||||||
|
Debug('FValidator.Insert');
|
||||||
|
TJvValidators(Value).Insert(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.ReadState(Reader: TReader);
|
||||||
|
begin
|
||||||
|
inherited ReadState(Reader);
|
||||||
|
Debug('TJvBaseValidator.ReadState: Reader.Parent is %s', [ComponentName(Reader.Parent)]);
|
||||||
|
if Reader.Parent is TJvValidators then
|
||||||
|
begin
|
||||||
|
if FValidator <> nil then
|
||||||
|
FValidator.Remove(Self);
|
||||||
|
FValidator := TJvValidators(Reader.Parent);
|
||||||
|
FValidator.Insert(Self);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvBaseValidator.DoValidateFailed;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnValidateFailed) then
|
||||||
|
FOnValidateFailed(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
function TJvBaseValidator.GetDataLink(AControl:TControl): TDataLink;
|
||||||
|
begin
|
||||||
|
if AControl <> nil then
|
||||||
|
Result := TDataLink(AControl.Perform(CM_GETDATALINK, 0, 0))
|
||||||
|
else
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
{$ELSE}
|
||||||
|
function TJvBaseValidator.GetDataLink(AControl:TControl):TObject;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
end;
|
||||||
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
||||||
|
|
||||||
|
|
||||||
|
//=== { TJvRequiredFieldValidator } ==========================================
|
||||||
|
|
||||||
|
procedure TJvRequiredFieldValidator.Validate;
|
||||||
|
var
|
||||||
|
R: Variant;
|
||||||
|
begin
|
||||||
|
R := GetValidationPropertyValue;
|
||||||
|
case VarType(R) of
|
||||||
|
varDate:
|
||||||
|
Valid := VarCompareValue(R, 0) <> vrEqual; // zero is the invalid value for dates
|
||||||
|
varSmallint,
|
||||||
|
varInteger,
|
||||||
|
varSingle,
|
||||||
|
varDouble,
|
||||||
|
varCurrency,
|
||||||
|
varBoolean,
|
||||||
|
varByte:
|
||||||
|
; // nothing to do because all values are valid
|
||||||
|
else
|
||||||
|
if FAllowBlank then
|
||||||
|
Valid := VarCompareValue(R, '') <> vrEqual
|
||||||
|
else
|
||||||
|
Valid := Trim(VarToStr(R)) <> '';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvCustomValidator } =================================================
|
||||||
|
|
||||||
|
function TJvCustomValidator.DoValidate: Boolean;
|
||||||
|
begin
|
||||||
|
Result := Valid;
|
||||||
|
if Assigned(FOnValidate) then
|
||||||
|
FOnValidate(Self, GetValidationPropertyValue, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvCustomValidator.Validate;
|
||||||
|
begin
|
||||||
|
Valid := DoValidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvRegularExpressionValidator } ======================================
|
||||||
|
|
||||||
|
function MatchesMask(const Filename, Mask: string{;
|
||||||
|
const SearchFlags: TSearchFlags = [sfCaseSensitive]}): Boolean;
|
||||||
|
{var
|
||||||
|
URE: TURESearch;
|
||||||
|
SL: TWideStringList;}
|
||||||
|
begin
|
||||||
|
Result := Masks.MatchesMask(Filename, Mask);
|
||||||
|
(*
|
||||||
|
// use the regexp engine in JclUnicode
|
||||||
|
SL := TWideStringList.Create;
|
||||||
|
try
|
||||||
|
URE := TURESearch.Create(SL);
|
||||||
|
try
|
||||||
|
URE.FindPrepare(Mask, SearchFlags);
|
||||||
|
// this could be overkill for long strings and many matches,
|
||||||
|
// but it's a lot simpler than calling FindFirst...
|
||||||
|
Result := URE.FindAll(Filename);
|
||||||
|
finally
|
||||||
|
URE.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
SL.Free;
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvRegularExpressionValidator.Validate;
|
||||||
|
var
|
||||||
|
R: string;
|
||||||
|
begin
|
||||||
|
R := VarToStr(GetValidationPropertyValue);
|
||||||
|
Valid := (R = ValidationExpression) or MatchesMask(R, ValidationExpression);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvCompareValidator } ================================================
|
||||||
|
|
||||||
|
constructor TJvCompareValidator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FOperator := vcoEqual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvCompareValidator.Validate;
|
||||||
|
var
|
||||||
|
VR: TVariantRelationship;
|
||||||
|
begin
|
||||||
|
VR := VarCompareValue(GetValidationPropertyValue, ValueToCompare);
|
||||||
|
case CmpOperator of
|
||||||
|
vcoLessThan:
|
||||||
|
Valid := VR = vrLessThan;
|
||||||
|
vcoLessOrEqual:
|
||||||
|
Valid := (VR = vrLessThan) or (VR = vrEqual);
|
||||||
|
vcoEqual:
|
||||||
|
Valid := (VR = vrEqual);
|
||||||
|
vcoGreaterOrEqual:
|
||||||
|
Valid := (VR = vrGreaterThan) or (VR = vrEqual);
|
||||||
|
vcoGreaterThan:
|
||||||
|
Valid := (VR = vrGreaterThan);
|
||||||
|
vcoNotEqual:
|
||||||
|
Valid := VR <> vrEqual;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvRangeValidator } ==================================================
|
||||||
|
|
||||||
|
procedure TJvRangeValidator.Validate;
|
||||||
|
var
|
||||||
|
VR: TVariantRelationship;
|
||||||
|
begin
|
||||||
|
VR := VarCompareValue(GetValidationPropertyValue, MinimumValue);
|
||||||
|
Valid := (VR = vrGreaterThan) or (VR = vrEqual);
|
||||||
|
if Valid then
|
||||||
|
begin
|
||||||
|
VR := VarCompareValue(GetValidationPropertyValue, MaximumValue);
|
||||||
|
Valid := (VR = vrLessThan) or (VR = vrEqual);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvControlsCompareValidator } ========================================
|
||||||
|
|
||||||
|
constructor TJvControlsCompareValidator.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FAllowNull := True;
|
||||||
|
FOperator := vcoEqual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvControlsCompareValidator.GetPropertyValueToCompare: Variant;
|
||||||
|
var
|
||||||
|
ValProp: IJvValidationProperty;
|
||||||
|
PropInfo: PPropInfo;
|
||||||
|
begin
|
||||||
|
Result := Null;
|
||||||
|
if FCompareToControl <> nil then
|
||||||
|
begin
|
||||||
|
if Supports(FCompareToControl, IJvValidationProperty, ValProp) then
|
||||||
|
Result := ValProp.GetValidationPropertyValue
|
||||||
|
else
|
||||||
|
if FCompareToProperty <> '' then
|
||||||
|
begin
|
||||||
|
PropInfo := GetPropInfo(FCompareToControl, FCompareToProperty);
|
||||||
|
if (PropInfo <> nil) and (PropInfo^.GetProc <> nil) then
|
||||||
|
Result := GetPropValue(FCompareToControl, FCompareToProperty, False);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvControlsCompareValidator.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if (Operation = opRemove) and (AComponent = CompareToControl) then
|
||||||
|
CompareToControl := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvControlsCompareValidator.SetCompareToControl(const AValue: TControl);
|
||||||
|
var
|
||||||
|
Obj: IJvValidationProperty;
|
||||||
|
begin
|
||||||
|
if ReplaceComponentReference(Self, AValue, TComponent(FCompareToControl)) then
|
||||||
|
if FCompareToControl <> nil then
|
||||||
|
begin
|
||||||
|
if not (csLoading in ComponentState) then
|
||||||
|
begin
|
||||||
|
if Supports(FCompareToControl, IJvValidationProperty, Obj) then
|
||||||
|
CompareToProperty := UTF8Encode(Obj.GetValidationPropertyName)
|
||||||
|
else
|
||||||
|
CompareToProperty := '';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvControlsCompareValidator.Validate;
|
||||||
|
var
|
||||||
|
Val1, Val2: Variant;
|
||||||
|
VR: TVariantRelationship;
|
||||||
|
begin
|
||||||
|
Val1 := GetValidationPropertyValue;
|
||||||
|
Val2 := GetPropertyValueToCompare;
|
||||||
|
if not AllowNull and
|
||||||
|
((TVarData(Val1).VType in [varEmpty, varNull]) or (TVarData(Val2).VType in [varEmpty, varNull])) then
|
||||||
|
begin
|
||||||
|
Valid := False;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
VR := VarCompareValue(Val1, Val2);
|
||||||
|
case CmpOperator of
|
||||||
|
vcoLessThan:
|
||||||
|
Valid := VR = vrLessThan;
|
||||||
|
vcoLessOrEqual:
|
||||||
|
Valid := (VR = vrLessThan) or (VR = vrEqual);
|
||||||
|
vcoEqual:
|
||||||
|
Valid := (VR = vrEqual);
|
||||||
|
vcoGreaterOrEqual:
|
||||||
|
Valid := (VR = vrGreaterThan) or (VR = vrEqual);
|
||||||
|
vcoGreaterThan:
|
||||||
|
Valid := (VR = vrGreaterThan);
|
||||||
|
vcoNotEqual:
|
||||||
|
Valid := (VR <> vrEqual);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvValidators } ======================================================
|
||||||
|
|
||||||
|
constructor TJvValidators.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FItems := TList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TJvValidators.Destroy;
|
||||||
|
var
|
||||||
|
V: TJvBaseValidator;
|
||||||
|
begin
|
||||||
|
Debug('TJvValidators.Destroy: Count is %d', [FItems.Count]);
|
||||||
|
while FItems.Count > 0 do
|
||||||
|
begin
|
||||||
|
V := TJvBaseValidator(FItems.Last);
|
||||||
|
V.FValidator := nil;
|
||||||
|
V.Free;
|
||||||
|
FItems.Delete(FItems.Count - 1);
|
||||||
|
end;
|
||||||
|
FItems.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvValidators.DoValidateFailed(const ABaseValidator: TJvBaseValidator): Boolean;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
if Assigned(FOnValidateFailed) then
|
||||||
|
FOnValidateFailed(Self, ABaseValidator, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvValidators.Validate(const GroupName:string): Boolean;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
Controls: TList;
|
||||||
|
ErrCtrl: TControl;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
if ValidationSummary <> nil then
|
||||||
|
FValidationSummary.BeginUpdate;
|
||||||
|
try
|
||||||
|
Controls := TList.Create;
|
||||||
|
if FErrorIndicator <> nil then
|
||||||
|
FErrorIndicator.BeginUpdate;
|
||||||
|
try
|
||||||
|
{ Get all controls that should be validated }
|
||||||
|
if FErrorIndicator <> nil then
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
ErrCtrl := Items[i].ErrorControl;
|
||||||
|
if ErrCtrl = nil then
|
||||||
|
ErrCtrl := Items[i].ControlToValidate;
|
||||||
|
if ErrCtrl <> nil then
|
||||||
|
if Controls.IndexOf(ErrCtrl) = -1 then
|
||||||
|
Controls.Add(ErrCtrl);
|
||||||
|
end;
|
||||||
|
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
if Items[I].Enabled and ((Items[I].GroupName = '') or AnsiSameText(GroupName, Items[I].GroupName)) then
|
||||||
|
begin
|
||||||
|
Items[I].Validate;
|
||||||
|
if not Items[I].Valid then
|
||||||
|
begin
|
||||||
|
if (Items[I].ErrorMessage <> '') and (Items[I].ControlToValidate <> nil) then
|
||||||
|
begin
|
||||||
|
ErrCtrl := Items[I].ErrorControl;
|
||||||
|
if ErrCtrl = nil then
|
||||||
|
ErrCtrl := Items[i].ControlToValidate;
|
||||||
|
|
||||||
|
if ValidationSummary <> nil then
|
||||||
|
FValidationSummary.AddError(Items[I].ErrorMessage);
|
||||||
|
if ErrorIndicator <> nil then
|
||||||
|
FErrorIndicator.SetError(ErrCtrl, UTF8Decode(Items[I].ErrorMessage));
|
||||||
|
if FErrorIndicator <> nil then
|
||||||
|
Controls.Remove(ErrCtrl); { control is not valid }
|
||||||
|
end;
|
||||||
|
Result := False;
|
||||||
|
if not DoValidateFailed(Items[I]) then
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{ Clear ErrorIndicators for controls that are valid }
|
||||||
|
if FErrorIndicator <> nil then
|
||||||
|
for I := 0 to Controls.Count - 1 do
|
||||||
|
FErrorIndicator.SetError(TControl(Controls[I]), ''); // clear error indicator
|
||||||
|
finally
|
||||||
|
if FErrorIndicator <> nil then
|
||||||
|
FErrorIndicator.EndUpdate;
|
||||||
|
Controls.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
if ValidationSummary <> nil then
|
||||||
|
FValidationSummary.EndUpdate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvValidators.Validate: Boolean;
|
||||||
|
begin
|
||||||
|
Result := Validate('');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.Notification(AComponent: TComponent;
|
||||||
|
Operation: TOperation);
|
||||||
|
begin
|
||||||
|
inherited Notification(AComponent, Operation);
|
||||||
|
if Operation = opRemove then
|
||||||
|
begin
|
||||||
|
if Assigned(ValidationSummary) and AComponent.IsImplementorOf(ValidationSummary) then
|
||||||
|
ValidationSummary := nil;
|
||||||
|
if Assigned(ErrorIndicator) and AComponent.IsImplementorOf(ErrorIndicator) then
|
||||||
|
ErrorIndicator := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.GetChildren(Proc: TGetChildProc; Root: TComponent);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
Debug('TJvValidators.GetChildren: Count is %d, Root is %s', [Count, ComponentName(Root)]);
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
Proc(Items[I]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.SetValidationSummary(const Value: IJvValidationSummary);
|
||||||
|
begin
|
||||||
|
ReferenceInterface(FValidationSummary, opRemove);
|
||||||
|
FValidationSummary := Value;
|
||||||
|
ReferenceInterface(FValidationSummary, opInsert);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.Insert(AValidator: TJvBaseValidator);
|
||||||
|
begin
|
||||||
|
Debug('TJvValidators.Insert: inserting %s', [ComponentName(AValidator)]);
|
||||||
|
Assert(AValidator <> nil, RsEInsertNilValidator);
|
||||||
|
AValidator.FValidator := Self;
|
||||||
|
if FItems.IndexOf(AValidator) < 0 then
|
||||||
|
FItems.Add(AValidator);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.Remove(AValidator: TJvBaseValidator);
|
||||||
|
begin
|
||||||
|
Debug('TJvValidators.Remove: removing %s', [ComponentName(AValidator)]);
|
||||||
|
Assert(AValidator <> nil, RsERemoveNilValidator);
|
||||||
|
Assert(AValidator.FValidator = Self, RsEValidatorNotChild);
|
||||||
|
AValidator.FValidator := nil;
|
||||||
|
FItems.Remove(AValidator);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvValidators.GetCount: Integer;
|
||||||
|
begin
|
||||||
|
Result := FItems.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvValidators.GetItem(Index: Integer): TJvBaseValidator;
|
||||||
|
begin
|
||||||
|
Result := TJvBaseValidator(FItems[Index]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.Exchange(Index1, Index2: Integer);
|
||||||
|
begin
|
||||||
|
FItems.Exchange(Index1, Index2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidators.SetErrorIndicator(const Value: IJvErrorIndicator);
|
||||||
|
begin
|
||||||
|
ReferenceInterface(FErrorIndicator, opRemove);
|
||||||
|
FErrorIndicator := Value;
|
||||||
|
ReferenceInterface(FErrorIndicator, opInsert);
|
||||||
|
end;
|
||||||
|
|
||||||
|
//=== { TJvValidationSummary } ===============================================
|
||||||
|
|
||||||
|
destructor TJvValidationSummary.Destroy;
|
||||||
|
begin
|
||||||
|
FSummaries.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidationSummary.AddError(const ErrorMessage: string);
|
||||||
|
begin
|
||||||
|
if Summaries.IndexOf(ErrorMessage) < 0 then
|
||||||
|
begin
|
||||||
|
Summaries.Add(ErrorMessage);
|
||||||
|
if (FUpdateCount = 0) and Assigned(FOnAddError) then
|
||||||
|
FOnAddError(Self);
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidationSummary.RemoveError(const ErrorMessage: string);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
I := Summaries.IndexOf(ErrorMessage);
|
||||||
|
if I > -1 then
|
||||||
|
begin
|
||||||
|
Summaries.Delete(I);
|
||||||
|
if (FUpdateCount = 0) and Assigned(FOnRemoveError) then
|
||||||
|
FOnRemoveError(Self);
|
||||||
|
Change;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TJvValidationSummary.GetSummaries: TStrings;
|
||||||
|
begin
|
||||||
|
if FSummaries = nil then
|
||||||
|
FSummaries := TStringList.Create;
|
||||||
|
Result := FSummaries;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidationSummary.Change;
|
||||||
|
begin
|
||||||
|
if FUpdateCount <> 0 then
|
||||||
|
begin
|
||||||
|
Inc(FPendingUpdates);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if Assigned(FOnChange) then
|
||||||
|
FOnChange(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidationSummary.BeginUpdate;
|
||||||
|
begin
|
||||||
|
Inc(FUpdateCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TJvValidationSummary.EndUpdate;
|
||||||
|
begin
|
||||||
|
Dec(FUpdateCount);
|
||||||
|
if FUpdateCount < 0 then
|
||||||
|
FUpdateCount := 0;
|
||||||
|
if (FUpdateCount = 0) and (FPendingUpdates > 0) then
|
||||||
|
begin
|
||||||
|
Change;
|
||||||
|
FPendingUpdates := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterBaseValidators;
|
||||||
|
begin
|
||||||
|
TJvBaseValidator.RegisterBaseValidator('Required Field Validator', TJvRequiredFieldValidator);
|
||||||
|
TJvBaseValidator.RegisterBaseValidator('Compare Validator', TJvCompareValidator);
|
||||||
|
TJvBaseValidator.RegisterBaseValidator('Range Validator', TJvRangeValidator);
|
||||||
|
TJvBaseValidator.RegisterBaseValidator('Regular Expression Validator', TJvRegularExpressionValidator);
|
||||||
|
TJvBaseValidator.RegisterBaseValidator('Custom Validator', TJvCustomValidator);
|
||||||
|
TJvBaseValidator.RegisterBaseValidator('Controls Compare Validator', TJvControlsCompareValidator);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
// (p3) do NOT touch! This is required to make the registration work on formulars!!!
|
||||||
|
RegisterBaseValidators;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
FreeAndNil(GlobalValidatorsList);
|
||||||
|
|
||||||
|
end.
|
||||||
Reference in New Issue
Block a user