pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fix datemask in rxdbgrid, new component rxCloseFormValidator

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2071 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2011-10-13 15:45:13 +00:00
parent 19359ddf86
commit 695b270396
16 changed files with 547 additions and 162 deletions
Download Patch File Download Diff File Expand all files Collapse all files

143
components/rx/Demos/PhoneBookDemo/PhoneBookDemo.lpi
View File

@@ -1,24 +1,26 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<ResourceType Value="res"/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<VersionInfo>
<UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/>
<Language Value=""/>
<CharSet Value=""/>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
@@ -38,24 +40,27 @@
</Item1>
<Item2>
<PackageName Value="DBFLaz"/>
<MinVersion Minor="1" Release="1" Valid="True"/>
<MinVersion Minor="1" Valid="True" Release="1"/>
</Item2>
<Item3>
<PackageName Value="rxnew"/>
<MinVersion Major="1" Minor="1" Release="4" Build="93" Valid="True"/>
<MinVersion Build="93" Major="1" Minor="1" Valid="True" Release="4"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="5">
<Units Count="4">
<Unit0>
<Filename Value="PhoneBookDemo.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="PhoneBookDemo"/>
<CursorPos X="13" Y="11"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<UsageCount Value="20"/>
<CursorPos X="13" Y="11"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="pbmainunit.pas"/>
@@ -63,9 +68,14 @@
<ComponentName Value="pbMainForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="pbMainUnit"/>
<CursorPos X="11" Y="9"/>
<TopLine Value="1"/>
<UsageCount Value="20"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="16"/>
<CursorPos X="43" Y="32"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
@@ -73,99 +83,22 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="pbMainUnit"/>
<CursorPos X="5" Y="9"/>
<TopLine Value="1"/>
<CursorPos X="5" Y="9"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="usr\local\share\lazarus\components\rxnew\rxdbgrid.pas"/>
<UnitName Value="rxdbgrid"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<ComponentName Value="pbMainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="pbMainUnit"/>
<CursorPos X="1" Y="48"/>
<TopLine Value="19"/>
<EditorIndex Value="0"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
</Units>
<JumpHistory Count="16" HistoryIndex="15">
<Position1>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="52" Column="1" TopLine="26"/>
</Position1>
<Position2>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="53" Column="1" TopLine="26"/>
</Position2>
<Position3>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="54" Column="1" TopLine="26"/>
</Position3>
<Position4>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="55" Column="1" TopLine="26"/>
</Position4>
<Position5>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="52" Column="1" TopLine="26"/>
</Position5>
<Position6>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="53" Column="1" TopLine="26"/>
</Position6>
<Position7>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="54" Column="1" TopLine="26"/>
</Position7>
<Position8>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="55" Column="1" TopLine="26"/>
</Position8>
<Position9>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="54" Column="1" TopLine="25"/>
</Position9>
<Position10>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="53" Column="1" TopLine="24"/>
</Position10>
<Position11>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="52" Column="1" TopLine="23"/>
</Position11>
<Position12>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="51" Column="1" TopLine="22"/>
</Position12>
<Position13>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="50" Column="1" TopLine="21"/>
</Position13>
<Position14>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="49" Column="1" TopLine="20"/>
</Position14>
<Position15>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="48" Column="1" TopLine="19"/>
</Position15>
<Position16>
<Filename Value="\usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Caret Line="49" Column="1" TopLine="19"/>
</Position16>
</JumpHistory>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="10"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="PhoneBookDemo"/>
@@ -173,7 +106,16 @@
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<DebugInfoType Value="dsAuto"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
@@ -185,23 +127,28 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="4">
<BreakPoints Count="3">
<Item1>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsGlobal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="..\..\rxlookup.pas"/>
<Line Value="1013"/>
</Item1>
<Item2>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsGlobal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="..\..\rxpopupunit.pas"/>
<Line Value="267"/>
</Item2>
<Item3>
<Kind Value="bpkSource"/>
<WatchScope Value="wpsGlobal"/>
<WatchKind Value="wpkWrite"/>
<Source Value="usr\local\share\lazarus\components\rxnew\Demos\PhoneBookDemo\pbmainunit.pas"/>
<Line Value="51"/>
</Item3>
<Item4>
<Source Value="pbmainunit.pas"/>
<Line Value="51"/>
</Item4>
</BreakPoints>
<Watches Count="1">
<Item1>

58
components/rx/Demos/PhoneBookDemo/pbmainunit.lfm
View File

@@ -12,30 +12,31 @@ object pbMainForm: TpbMainForm
Menu = MainMenu1
OnCreate = FormCreate
Position = poDesktopCenter
LCLVersion = '0.9.29'
LCLVersion = '0.9.31'
object ToolPanel1: TToolPanel
Left = 0
Height = 23
Height = 31
Top = 0
Width = 849
Items = <>
Options = []
ButtonAllign = tbaNone
Align = alTop
AutoSize = True
BorderWidth = 4
TabOrder = 0
end
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 396
Top = 23
Height = 392
Top = 31
Width = 849
TitleButtons = False
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Caption = 'PATRONYMIC'
Title.PrefixOption = poNone
Title.Orientation = toHorizontal
Width = 190
FieldName = 'PATRONYMIC'
@@ -47,6 +48,8 @@ object pbMainForm: TpbMainForm
end
item
Title.Alignment = taCenter
Title.Caption = 'NAME'
Title.PrefixOption = poNone
Title.Orientation = toHorizontal
Width = 150
FieldName = 'NAME'
@@ -58,6 +61,8 @@ object pbMainForm: TpbMainForm
end
item
Title.Alignment = taCenter
Title.Caption = 'SURNAME'
Title.PrefixOption = poNone
Title.Orientation = toHorizontal
Width = 150
FieldName = 'SURNAME'
@@ -69,6 +74,8 @@ object pbMainForm: TpbMainForm
end
item
Title.Alignment = taCenter
Title.Caption = 'PHONE'
Title.PrefixOption = poNone
Title.Orientation = toHorizontal
Width = 130
FieldName = 'PHONE'
@@ -80,6 +87,8 @@ object pbMainForm: TpbMainForm
end
item
Title.Alignment = taCenter
Title.Caption = 'ICQ'
Title.PrefixOption = poNone
Title.Orientation = toHorizontal
FieldName = 'ICQ'
Filter.Font.Style = [fsItalic]
@@ -90,6 +99,8 @@ object pbMainForm: TpbMainForm
end
item
Title.Alignment = taCenter
Title.Caption = 'MEMO'
Title.PrefixOption = poNone
Title.Orientation = toHorizontal
FieldName = 'MEMO'
Filter.Font.Style = [fsItalic]
@@ -98,9 +109,42 @@ object pbMainForm: TpbMainForm
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end>
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind]
FooterColor = clYellow
Align = alClient
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
@@ -111,8 +155,8 @@ object pbMainForm: TpbMainForm
end
object StatusBar1: TStatusBar
Left = 0
Height = 25
Top = 419
Height = 21
Top = 423
Width = 849
Panels = <>
end

16
components/rx/curredit.pas
View File

@@ -36,7 +36,7 @@ unit curredit;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, {StdCtrls,}
LMessages, MaskEdit;
type
@@ -203,7 +203,7 @@ type
end;
implementation
uses rxstrutils, Math, tooledit;
uses {rxstrutils, } strutils, Math, tooledit;
function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
var
@@ -419,14 +419,14 @@ end;
function TCustomNumEdit.TextToValText(const AValue: string): string;
begin
Result := DelRSpace(AValue);
Result := Trim(AValue);
if DecimalSeparator <> ThousandSeparator then begin
Result := DelChars(Result, ThousandSeparator);
end;
if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
Result := ReplaceStr(Result, '.', DecimalSeparator);
Result := StringReplace(Result, '.', DecimalSeparator, [rfReplaceAll]);
if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
Result := ReplaceStr(Result, ',', DecimalSeparator);
Result := StringReplace(Result, ',', DecimalSeparator, [rfReplaceAll]);
if Result = '' then Result := '0'
else if Result = '-' then Result := '-0';
end;
@@ -449,7 +449,7 @@ begin
end;
end;
if RaiseOnError and (Result <> NewValue) then
raise ERangeError.CreateFmt(ReplaceStr('SOutOfRange %d %d %d %d', '%d', '%.*f'),
raise ERangeError.CreateFmt(StringReplace('SOutOfRange %d %d %d %d', '%d', '%.*f', [rfReplaceAll]),
[DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
end;
end;
@@ -607,7 +607,7 @@ var
begin
EditFormat := '0';
if FDecimalPlaces > 0 then
EditFormat := EditFormat + '.' + MakeStr('#', FDecimalPlaces);
EditFormat := EditFormat + '.' + DupeString('#', FDecimalPlaces);
if (FValue = 0.0) and FZeroEmpty then
EditText := ''
else
@@ -690,7 +690,7 @@ var
I: Integer;
C: Char;
begin
Result := ',0.' + MakeStr('0', CurrencyDecimals);
Result := ',0.' + DupeString('0', CurrencyDecimals);
CurrStr := '';
for I := 1 to Length(CurrencyString) do
begin

8
components/rx/docs/WhatsNew.rus.txt
View File

@@ -70,8 +70,14 @@
+ Улучшено отображение редактора полей типа TDateTime/TDate в RxDBGrid
+ У TRxCollumn компоненты TRxDBGrid для стиля cbsPickList добавлено свойство DirectInput.
Если оно установлено в false - значения поля можно выбрать только из выпадающего списка
+ Добавлены 2 комопненты - TRxRadioGroup и TRxDBRadioGroup. В отличии от стнадартных позваляют выборочно запрещать некоторые RadioButton-ы на
+ Добавлены 2 комопненты - TRxRadioGroup и TRxDBRadioGroup. В отличии от стнадартных позволяют выборочно запрещать некоторые RadioButton-ы на
компоненте через свойство ItemEnabled.
+ Новая компонента - TRxCloseFormValidator. Предназначена для размещения на диалоговых модальных окнах, при закрытии такого окна
проверяет на обязательную заполненность списка полей ввода, перечисленных в свойстве Items.
+ В модуле rxStrUtils большая часть функция помечена как устаревшая - они дублируют функционал из модуля StrUtils. В дальнешем они
будут удалены в целях уменьшения кол-ва кода.
+ У RxDBGrid-а при вводе даты подставляется маска ввода
22.05.2008 - версия 2.0.0.136 (svn revision 100)
+ У объекта TRxCustomDBLookupCombo введён контроль на CircularDataLink
+ У объекта TRxCustomDBLookupCombo ускорена отрисовка данных

2
components/rx/folderlister.pas
View File

@@ -79,7 +79,7 @@ type
end;
implementation
uses RxStrUtils, RxAppUtils;
uses {RxStrUtils, }strutils, RxAppUtils;
function MenuItemStr(S:string):string;
var

2
components/rx/pickdate.pas
View File

@@ -262,7 +262,7 @@ const
implementation
uses Messages, RXCtrls, rxconst, ToolEdit, vclutils, math, LCLStrConsts,
rxstrutils, LResources;
{rxstrutils,} LResources;
const
SBtnGlyphs: array[0..3] of PChar = ('PREV2', 'PREV1', 'NEXT1', 'NEXT2');

9
components/rx/registerrxtools.pas
View File

@@ -41,7 +41,7 @@ uses
procedure Register;
implementation
uses RxSystemServices, RxLogin, RxVersInfo;
uses RxSystemServices, RxLogin, RxVersInfo, RxCloseFormValidator;
const
sRxToolsPage = 'RX Tools';
@@ -60,11 +60,18 @@ begin
RegisterComponents(sRxToolsPage, [TRxVersionInfo]);
end;
procedure RegisterCloseFormValidator;
begin
RegisterComponents('RX Tools',[TRxCloseFormValidator]);
end;
procedure Register;
begin
RegisterUnit('RxLogin', @RegisterRxLogin);
RegisterUnit('RxVersInfo', @RegisterRxVersInfo);
RegisterUnit('RxSystemServices', @RegisterRxSystemServices);
RegisterUnit('RxCloseFormValidator', @RegisterCloseFormValidator);
end;
end.

2
components/rx/rxclock.pas
View File

@@ -34,7 +34,7 @@ unit rxclock;
interface
{$I rx.inc}
uses LCLType, LMessages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
uses LCLType, LMessages, SysUtils, Classes, Graphics, Controls, Forms, {StdCtrls,}
ExtCtrls, Menus, messages;
type

375
components/rx/rxcloseformvalidator.pas Normal file
View File

@@ -0,0 +1,375 @@
{ RxCloseFormValidator unit
Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru and Lazarus team
original conception from rx library for Delphi (c)
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit RxCloseFormValidator;
{$I rx.inc}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DB;
const
{ TODO : В дальнейшем эти константы оформить в виде ресурсов и вынести в соответсвующий модуль }
sCloseValidError = 'Ошибка. Не все требуемые поля заполнены!';
sReqValue = 'Поле %s. Требуется значение';
type
{ TValidateItem }
TValidateItem = class(TCollectionItem)
private
FControl: TWinControl;
FEnabled: boolean;
FFieldCaption: string;
procedure SetControl(AValue: TWinControl);
procedure SetEnabled(AValue: boolean);
procedure SetFieldCaption(AValue: string);
function DBComponentField:TField;
protected
function GetDisplayName: string; override;
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
function CheckClose:boolean;
function ErrorMessage:string;
procedure SetFocus;
published
property Control:TWinControl read FControl write SetControl;
property Enabled:boolean read FEnabled write SetEnabled default true;
property FieldCaption:string read FFieldCaption write SetFieldCaption;
end;
{ TValidateItems }
TValidateItems = class(TCollection)
private
function GetItems(Index: Integer): TValidateItem;
procedure SetItems(Index: Integer; AValue: TValidateItem);
public
constructor Create;
property Items[Index: Integer]: TValidateItem read GetItems write SetItems; default;
end;
{ TRxCloseFormValidator }
TRxCloseFormValidator = class(TComponent)
private
FErrorMsgCaption: string;
FOnCloseQuery : TCloseQueryEvent;
FItems:TValidateItems;
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
function CheckCloseForm:boolean;
function GetItems: TValidateItems;
procedure SetCloseQueryHandler;
procedure SetItems(AValue: TValidateItems);
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ErrorMsgCaption:string read FErrorMsgCaption write FErrorMsgCaption;
property Items:TValidateItems read GetItems write SetItems;
end;
implementation
uses LCLType, StdCtrls, DbCtrls, typinfo, ComCtrls, ExtCtrls;
{ TValidateItems }
function TValidateItems.GetItems(Index: Integer): TValidateItem;
begin
result := TValidateItem( inherited Items[Index] );
end;
procedure TValidateItems.SetItems(Index: Integer; AValue: TValidateItem);
begin
Items[Index].Assign( AValue );
end;
constructor TValidateItems.Create;
begin
inherited Create(TValidateItem);
end;
{ TValidateItem }
procedure TValidateItem.SetControl(AValue: TWinControl);
var
i:integer;
OwnForm, P:TComponent;
F:TField;
begin
if FControl=AValue then Exit;
FControl:=AValue;
if Assigned(FControl) and (FFieldCaption = '') then
begin
//Установим название поля по текст компоненты
if FControl is TCustomRadioGroup then
FFieldCaption:=TCustomRadioGroup(FControl).Caption
else
if FControl is TCustomCheckBox then
FFieldCaption:=TCustomCheckBox(FControl).Caption
else
if Assigned(FControl.Owner) then
begin
OwnForm:=FControl.Owner;
//Попробуем найти название поле - по тексту метки, которая связана с данным полем
for i:=0 to OwnForm.ComponentCount-1 do
begin
P:=OwnForm.Components[i];
if P is TLabel then
if TLabel(P).FocusControl = FControl then
begin
FFieldCaption:=TLabel(P).Caption;
break;
end;
end;
end;
if FFieldCaption = '' then
begin
F:=DBComponentField;
if Assigned(F) then
FFieldCaption:=F.DisplayLabel;
end;
end
end;
procedure TValidateItem.SetEnabled(AValue: boolean);
begin
if FEnabled=AValue then Exit;
FEnabled:=AValue;
end;
procedure TValidateItem.SetFieldCaption(AValue: string);
begin
if FFieldCaption=AValue then Exit;
FFieldCaption:=AValue;
end;
function TValidateItem.DBComponentField: TField;
var
P:TObject;
PI1, PI2:PPropInfo;
FiName:string;
DS:TDataSet;
begin
Result:=nil;
if not Assigned(FControl) then exit;
//Сначала проверим - вдруги это завязки на работу с БД
PI1:=GetPropInfo(Control, 'DataSource');
PI2:=GetPropInfo(Control, 'DataField');
if Assigned(PI1) and Assigned(PI2) then
begin
//Точно - БД
P:=GetObjectProp(Control, 'DataSource');
FiName:=GetPropValue(Control, 'DataField');
if Assigned(P) and (FiName<>'') then
begin
DS:=(P as TDataSource).DataSet;
if Assigned(DS) then
Result:=DS.FieldByName(FiName);
end;
end
end;
function TValidateItem.GetDisplayName: string;
begin
if Assigned(FControl) then
begin
if FEnabled then
Result:=FControl.Name + ' - validate'
else
Result:=FControl.Name + ' - disabled'
end
else
Result:=inherited GetDisplayName;
end;
constructor TValidateItem.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FEnabled:=true;
end;
destructor TValidateItem.Destroy;
begin
inherited Destroy;
end;
function TValidateItem.CheckClose: boolean;
var
P:TObject;
PI1, PI2:PPropInfo;
FiName:string;
DS:TDataSet;
begin
Result:=true;
if not Assigned(FControl) then exit;
//Сначала проверим - вдруги это завязки на работу с БД
PI1:=GetPropInfo(Control, 'DataSource');
PI2:=GetPropInfo(Control, 'DataField');
if Assigned(PI1) and Assigned(PI2) then
begin
//Точно - БД
//Проверка выполняется если только указан источник данных и поле в нём
P:=GetObjectProp(Control, 'DataSource');
FiName:=GetPropValue(Control, 'DataField');
if Assigned(P) and (FiName<>'') then
begin
DS:=(P as TDataSource).DataSet;
if Assigned(DS) then
Result:=not DS.FieldByName(FiName).IsNull;
end;
end
else
if Control is TCustomEdit then
Result:=TCustomEdit(Control).Text<>'';
end;
function TValidateItem.ErrorMessage: string;
begin
Result:=Format(sReqValue, [FFieldCaption]);
end;
procedure TValidateItem.SetFocus;
var
P:TWinControl;
begin
if FControl is TWinControl then
begin
P:=TWinControl(FControl).Parent;
//Необходимо обработать случай нахождения компоненты на PageControl-e
while Assigned(P) and not (P is TCustomForm) do
begin
if P is TTabSheet then
TTabSheet(P).PageControl.ActivePage:=TTabSheet(P);
P:=P.Parent;
end;
TWinControl(FControl).SetFocus;
end;
end;
{ TRxCloseFormValidator }
procedure TRxCloseFormValidator.FormCloseQuery(Sender: TObject;
var CanClose: boolean);
begin
if Sender is TCustomForm then
begin
if TForm(Sender).ModalResult = mrOk then
begin
CanClose:=CheckCloseForm;
if CanClose and Assigned(FOnCloseQuery) then
FOnCloseQuery(Sender, CanClose);
end;
end;
end;
function TRxCloseFormValidator.CheckCloseForm: boolean;
var
i:integer;
begin
Result:=false;
for i:=0 to FItems.Count-1 do
begin
if FItems[i].Enabled and (not FItems[i].CheckClose) then
begin
FItems[i].SetFocus;
Application.MessageBox(PChar(FItems[i].ErrorMessage), PChar(FErrorMsgCaption), MB_OK + MB_ICONERROR);
exit;
end;
end;
Result:=true;
end;
function TRxCloseFormValidator.GetItems: TValidateItems;
begin
Result:=FItems;
end;
procedure TRxCloseFormValidator.SetCloseQueryHandler;
begin
if (csDesigning in ComponentState) or (not Assigned(Owner)) then exit;
if Owner is TCustomForm then
begin
FOnCloseQuery:=TForm(Owner).OnCloseQuery;
TForm(Owner).OnCloseQuery:=@FormCloseQuery;
end;
end;
procedure TRxCloseFormValidator.SetItems(AValue: TValidateItems);
begin
FItems.Assign(AValue);
end;
procedure TRxCloseFormValidator.Notification(AComponent: TComponent;
Operation: TOperation);
var
i:integer;
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
for i:=0 to FItems.Count - 1 do
if FItems[i].Control = AComponent then
FItems[i].Control := nil;
end;
end;
procedure TRxCloseFormValidator.Loaded;
begin
inherited Loaded;
SetCloseQueryHandler;
end;
constructor TRxCloseFormValidator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FErrorMsgCaption:=sCloseValidError;
FItems:=TValidateItems.Create;
end;
destructor TRxCloseFormValidator.Destroy;
begin
FreeAndNil(FItems);
inherited Destroy;
end;
end.

1
components/rx/rxdbgrid.pas
View File

@@ -848,6 +848,7 @@ constructor TRxDBGridDateEditor.Create(Aowner: TComponent);
begin
inherited Create(Aowner);
AutoSize := false;
UpdateMask;
end;
{procedure TRxDBGridDateEditor.SetBounds(aLeft, aTop, aWidth, aHeight: integer);

6
components/rx/rxlookup.pas
View File

@@ -37,7 +37,7 @@ interface
uses
LCLType, LCLProc, LCLIntf, Classes, SysUtils, LResources, Forms, types,
Controls, Graphics, Dialogs, DB, EditBtn, DBGrids, StdCtrls, Buttons,
Controls, Graphics, Dialogs, DB, EditBtn, DBGrids, {StdCtrls,} Buttons,
LMessages, DbCtrls, GraphType, dbutils, RxDbGrid, rxpopupunit, Themes;
const
@@ -469,9 +469,9 @@ begin
end;
procedure TRxCustomDBLookupEdit.ShowList;
var
{var
i,W:integer;
GC:TColumn;
GC:TColumn;}
begin
if FLookupDataLink.Active and not PopupVisible then
begin

6
components/rx/rxnew.lpk
View File

@@ -34,7 +34,7 @@ translate to Lazarus by alexs in 2005 - 2009
<License Value="free ware
"/>
<Version Build="105" Major="2" Minor="1" Release="2"/>
<Files Count="59">
<Files Count="60">
<Item1>
<Filename Value="autopanel.pas"/>
<UnitName Value="AutoPanel"/>
@@ -274,6 +274,10 @@ translate to Lazarus by alexs in 2005 - 2009
<Filename Value="vclutils.pas"/>
<UnitName Value="vclutils"/>
</Item59>
<Item60>
<Filename Value="rxcloseformvalidator.pas"/>
<UnitName Value="RxCloseFormValidator"/>
</Item60>
</Files>
<LazDoc Paths="docs\;\usr\local\share\lazarus\components\rxnew\docs\"/>
<i18n>

3
components/rx/rxnew.pas
View File

@@ -16,7 +16,8 @@ uses
rxdconst, rxdice, rxFileUtils, rxfilterby, rxiconv, rxlogin, rxlookup,
rxmemds, rxpopupunit, rxsortmemds, rxspin, rxstrutils, rxswitch,
RxSystemServices, rxtbrsetup, RxTimeEdit, rxtoolbar, RxVersInfo,
RxViewsPanel, rxxpman, seldsfrm, tooledit, vclutils, LazarusPackageIntf;
RxViewsPanel, rxxpman, seldsfrm, tooledit, vclutils, RxCloseFormValidator,
LazarusPackageIntf;
implementation

72
components/rx/rxstrutils.pas
View File

@@ -59,7 +59,7 @@ function OemToAnsiStr(const OemStr: string): string;
{ OemToAnsiStr translates a string from the OEM character set into the
Windows character set. }
function IsEmptyStr(const S: string; const EmptyChars: TCharSet): Boolean;
function IsEmptyStr(const S: string; const EmptyChars: TCharSet): Boolean; deprecated; //use this function from fcl strutils
{ EmptyStr returns true if the given string contains only character
from the EmptyChars. }
@@ -67,10 +67,10 @@ function ReplaceStr(const S, Srch, Replace: string): string;
{ Returns string with every occurrence of Srch string replaced with
Replace string. }
function DelSpace(const S: string): string;
function DelSpace(const S: string): string; deprecated; //use this function from fcl strutils
{ DelSpace return a string with all white spaces removed. }
function DelChars(const S: string; Chr: Char): string;
function DelChars(const S: string; Chr: Char): string; deprecated; //use this function from fcl strutils
{ DelChars return a string with all Chr characters removed. }
function DelBSpace(const S: string): string;
@@ -82,24 +82,24 @@ function DelESpace(const S: string): string;
function DelRSpace(const S: string): string;
{ DelRSpace trims leading and trailing spaces from the given string. }
function DelSpace1(const S: string): string;
function DelSpace1(const S: string): string; deprecated; //use this function from fcl strutils
{ DelSpace1 return a string with all non-single white spaces removed. }
function Tab2Space(const S: string; Numb: Byte): string;
function Tab2Space(const S: string; Numb: Byte): string; deprecated; //use this function from fcl strutils
{ Tab2Space converts any tabulation character in the given string to the
Numb spaces characters. }
function NPos(const C: string; S: string; N: Integer): Integer;
function NPos(const C: string; S: string; N: Integer): Integer; deprecated; //use this function from fcl strutils
{ NPos searches for a N-th position of substring C in a given string. }
function MakeStr(C: Char; N: Integer): string;
function MS(C: Char; N: Integer): string;
{ MakeStr return a string of length N filled with character C. }
function AddChar(C: Char; const S: string; N: Integer): string;
function AddChar(C: Char; const S: string; N: Integer): string; deprecated; //use this function from fcl strutils
{ AddChar return a string left-padded to length N with characters C. }
function AddCharR(C: Char; const S: string; N: Integer): string;
function AddCharR(C: Char; const S: string; N: Integer): string; deprecated; //use this function from fcl strutils
{ AddCharR return a string right-padded to length N with characters C. }
function LeftStr(const S: string; N: Integer): string;
@@ -120,48 +120,48 @@ function CompText(const S1, S2: string): Integer;
{ CompText compares S1 to S2, without case-sensitivity. The return value
is the same as for CompStr. }
function Copy2Symb(const S: string; Symb: Char): string;
function Copy2Symb(const S: string; Symb: Char): string; deprecated; //use this function from fcl strutils
{ Copy2Symb returns a substring of a string S from begining to first
character Symb. }
function Copy2SymbDel(var S: string; Symb: Char): string;
function Copy2SymbDel(var S: string; Symb: Char): string; deprecated; //use this function from fcl strutils
{ Copy2SymbDel returns a substring of a string S from begining to first
character Symb and removes this substring from S. }
function Copy2Space(const S: string): string;
function Copy2Space(const S: string): string; deprecated; //use this function from fcl strutils
{ Copy2Symb returns a substring of a string S from begining to first
white space. }
function Copy2SpaceDel(var S: string): string;
function Copy2SpaceDel(var S: string): string; deprecated; //use this function from fcl strutils
{ Copy2SpaceDel returns a substring of a string S from begining to first
white space and removes this substring from S. }
function AnsiProperCase(const S: string; const WordDelims: TCharSet): string;
function AnsiProperCase(const S: string; const WordDelims: TCharSet): string; deprecated; //use this function from fcl strutils
{ Returns string, with the first letter of each word in uppercase,
all other letters in lowercase. Words are delimited by WordDelims. }
function WordCount(const S: string; const WordDelims: TCharSet): Integer;
function WordCount(const S: string; const WordDelims: TCharSet): Integer; deprecated; //use this function from fcl strutils
{ WordCount given a set of word delimiters, returns number of words in S. }
function WordPosition(const N: Integer; const S: string;
const WordDelims: TCharSet): Integer;
const WordDelims: TCharSet): Integer; deprecated; //use this function from fcl strutils
{ Given a set of word delimiters, returns start position of N'th word in S. }
function ExtractWord(N: Integer; const S: string;
const WordDelims: TCharSet): string;
const WordDelims: TCharSet): string; deprecated; //use this function from fcl strutils
function ExtractWordPos(N: Integer; const S: string;
const WordDelims: TCharSet; var Pos: Integer): string;
const WordDelims: TCharSet; var Pos: Integer): string; deprecated; //use this function from fcl strutils
function ExtractDelimited(N: Integer; const S: string;
const Delims: TCharSet): string;
const Delims: TCharSet): string; deprecated; //use this function from fcl strutils
{ ExtractWord, ExtractWordPos and ExtractDelimited given a set of word
delimiters, return the N'th word in S. }
function ExtractSubstr(const S: string; var Pos: Integer;
const Delims: TCharSet): string;
const Delims: TCharSet): string; deprecated; //use this function from fcl strutils
{ ExtractSubstr given a set of word delimiters, returns the substring from S,
that started from position Pos. }
function IsWordPresent(const W, S: string; const WordDelims: TCharSet): Boolean;
function IsWordPresent(const W, S: string; const WordDelims: TCharSet): Boolean; deprecated; //use this function from fcl strutils
{ IsWordPresent given a set of word delimiters, returns True if word W is
present in string S. }
@@ -174,17 +174,17 @@ function ExtractQuotedString(const S: string; Quote: Char): string;
end of a quoted string, and reduces pairs of Quote characters within
the quoted string to a single character. }
function FindPart(const HelpWilds, InputStr: string): Integer;
function FindPart(const HelpWilds, InputStr: string): Integer; deprecated; //use this function from fcl strutils
{ FindPart compares a string with '?' and another, returns the position of
HelpWilds in InputStr. }
function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean; deprecated; //use this function from fcl strutils
{ IsWild compares InputString with WildCard string and returns True
if corresponds. }
function XorString(const Key, Src: ShortString): ShortString;
function XorEncode(const Key, Source: string): string;
function XorDecode(const Key, Source: string): string;
function XorString(const Key, Src: ShortString): ShortString; deprecated; //use this function from fcl strutils
function XorEncode(const Key, Source: string): string; deprecated; //use this function from fcl strutils
function XorDecode(const Key, Source: string): string; deprecated; //use this function from fcl strutils
//by alexs
function StrToHexText(S:string):string;
@@ -196,40 +196,40 @@ function HexTextToStr(S:string):string;
function FindCmdLineSwitch(const Switch: string; SwitchChars: TCharSet;
IgnoreCase: Boolean): Boolean;
{$ENDIF}
function GetCmdLineArg(const Switch: string; SwitchChars: TCharSet): string;
function GetCmdLineArg(const Switch: string; SwitchChars: TCharSet): string; deprecated; //use this function from fcl strutils
{ ** Numeric string handling routines ** }
function Numb2USA(const S: string): string;
function Numb2USA(const S: string): string; deprecated; //use this function from fcl strutils
{ Numb2USA converts numeric string S to USA-format. }
function Dec2Hex(N: Longint; A: Byte): string;
function D2H(N: Longint; A: Byte): string;
function Dec2Hex(N: Longint; A: Byte): string; deprecated; //use this function from fcl strutils
function D2H(N: Longint; A: Byte): string; deprecated; //use this function from fcl strutils
{ Dec2Hex converts the given value to a hexadecimal string representation
with the minimum number of digits (A) specified. }
function Hex2Dec(const S: string): Longint;
function H2D(const S: string): Longint;
function Hex2Dec(const S: string): Longint; deprecated; //use this function from fcl strutils
function H2D(const S: string): Longint; deprecated; //use this function from fcl strutils
{ Hex2Dec converts the given hexadecimal string to the corresponding integer
value. }
function Dec2Numb(N: Longint; A, B: Byte): string;
function Dec2Numb(N: Longint; A, B: Byte): string; deprecated; //use this function from fcl strutils
{ Dec2Numb converts the given value to a string representation with the
base equal to B and with the minimum number of digits (A) specified. }
function Numb2Dec(S: string; B: Byte): Longint;
function Numb2Dec(S: string; B: Byte): Longint; deprecated; //use this function from fcl strutils
{ Numb2Dec converts the given B-based numeric string to the corresponding
integer value. }
function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
function IntToBin(Value: Longint; Digits, Spaces: Integer): string; deprecated; //use this function from fcl strutils
{ IntToBin converts the given value to a binary string representation
with the minimum number of digits specified. }
function IntToRoman(Value: Longint): string;
function IntToRoman(Value: Longint): string; deprecated; //use this function from fcl strutils
{ IntToRoman converts the given value to a roman numeric string
representation. }
function RomanToInt(const S: string): Longint;
function RomanToInt(const S: string): Longint; deprecated; //use this function from fcl strutils
{ RomanToInt converts the given string to an integer value. If the string
doesn't contain a valid roman numeric value, the 0 value is returned. }

2
components/rx/rxswitch.pas
View File

@@ -36,7 +36,7 @@ unit rxswitch;
interface
uses SysUtils, LCLType, LCLProc, LCLIntf, LMessages, Classes, Graphics,
Controls, Forms, StdCtrls, ExtCtrls, Menus;
Controls, Forms, {StdCtrls,} ExtCtrls, Menus;
type

4
components/rx/tooledit.pas
View File

@@ -425,7 +425,7 @@ begin
if AValue <> FCalendarStyle then
begin
FCalendarStyle:=AValue;
{ case AValue of
(* case AValue of
csPopup:
begin
if FPopup = nil then
@@ -441,7 +441,7 @@ begin
FPopup.Free;
FPopup := nil;
end;
end;}
end;*)
end;
end;