Стартовый пул
This commit is contained in:
@@ -0,0 +1,633 @@
|
||||
{ lrRxControls unit
|
||||
|
||||
Copyright (C) 2005-2017 Lagunov Aleksey alexs@yandex.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 lrRxControls;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, LR_Class, LRDialogControls, Graphics, LResources,
|
||||
rxlookup, DB, rxDateRangeEditUnit;
|
||||
|
||||
type
|
||||
|
||||
{ TlrRxDBLookupComboBox }
|
||||
|
||||
TlrRxDBLookupComboBox = class(TlrVisualControl)
|
||||
private
|
||||
FKeyField:string;
|
||||
FListField:string;
|
||||
FListSource:string;
|
||||
function GetKeyField: string;
|
||||
function GetListField: string;
|
||||
function GetListSource: string;
|
||||
function GetText: string;
|
||||
procedure SetKeyField(AValue: string);
|
||||
procedure SetListField(AValue: string);
|
||||
procedure SetListSource(AValue: string);
|
||||
procedure RxDBLookupComboBox1CloseUp(Sender: TObject; SearchResult:boolean);
|
||||
procedure SetText(AValue: string);
|
||||
protected
|
||||
procedure PaintDesignControl; override;
|
||||
function CreateControl:TControl;override;
|
||||
procedure AfterLoad;override;
|
||||
procedure AfterCreate;override;
|
||||
public
|
||||
constructor Create(AOwnerPage:TfrPage); override;
|
||||
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
published
|
||||
property KeyField:string read GetKeyField write SetKeyField;
|
||||
property ListField:string read GetListField write SetListField;
|
||||
property ListSource:string read GetListSource write SetListSource;
|
||||
property Color;
|
||||
property Enabled;
|
||||
property Text:string read GetText write SetText;
|
||||
property OnClick;
|
||||
end;
|
||||
|
||||
{ TlrRxDateEdit }
|
||||
|
||||
TlrRxDateEdit = class(TlrVisualControl)
|
||||
private
|
||||
function GetDate: TDateTime;
|
||||
procedure SetDate(AValue: TDateTime);
|
||||
protected
|
||||
procedure PaintDesignControl; override;
|
||||
function CreateControl:TControl;override;
|
||||
public
|
||||
constructor Create(AOwnerPage:TfrPage); override;
|
||||
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
published
|
||||
property Color;
|
||||
property Enabled;
|
||||
property Date:TDateTime read GetDate write SetDate;
|
||||
property OnClick;
|
||||
end;
|
||||
|
||||
{ TlrSelectPeriodControl }
|
||||
|
||||
TlrSelectPeriodControl = class(TlrVisualControl)
|
||||
private
|
||||
function GetFlat: Boolean;
|
||||
function GetHalfYear: word;
|
||||
function GetMonth: word;
|
||||
function GetOptions: TRxDateRangeEditOptions;
|
||||
function GetPeriod: TDateTime;
|
||||
function GetPeriodEnd: TDateTime;
|
||||
function GetQuarter: word;
|
||||
function GetYear: word;
|
||||
procedure SetFlat(AValue: Boolean);
|
||||
procedure SetHalfYear(AValue: word);
|
||||
procedure SetMonth(AValue: word);
|
||||
procedure SetOptions(AValue: TRxDateRangeEditOptions);
|
||||
procedure SetPeriod(AValue: TDateTime);
|
||||
procedure SetQuarter(AValue: word);
|
||||
procedure SetYear(AValue: word);
|
||||
protected
|
||||
procedure PaintDesignControl; override;
|
||||
function CreateControl:TControl;override;
|
||||
public
|
||||
constructor Create(AOwnerPage:TfrPage); override;
|
||||
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
published
|
||||
property AutoSize;
|
||||
property Quarter:word read GetQuarter write SetQuarter;
|
||||
property HalfYear:word read GetHalfYear write SetHalfYear;
|
||||
property Flat: Boolean read GetFlat write SetFlat default False;
|
||||
property Year:word read GetYear write SetYear;
|
||||
property Month:word read GetMonth write SetMonth;
|
||||
property Period:TDateTime read GetPeriod write SetPeriod;
|
||||
property PeriodEnd:TDateTime read GetPeriodEnd;
|
||||
property Options:TRxDateRangeEditOptions read GetOptions write SetOptions default [reoMonth];
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses DBPropEdits, LR_DBRel, LR_Utils, PropEdits, rxduallist, rxstrutils, rxtooledit,
|
||||
LCLIntf, LCLType, Forms, LR_DBComponent;
|
||||
|
||||
{$R lrrxdbdialogcontrols_img.res}
|
||||
|
||||
procedure DoRegsiterControl(var cmpBMP:TBitmap; lrClass:TlrVisualControlClass);
|
||||
begin
|
||||
if not assigned(cmpBMP) then
|
||||
begin
|
||||
cmpBMP := TBitmap.Create;
|
||||
cmpBMP.LoadFromResourceName(HInstance, lrClass.ClassName);
|
||||
frRegisterObject(lrClass, cmpBMP, lrClass.ClassName, nil, otlUIControl, nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
lrBMP_LRDBLookupComboBox : TBitmap = nil;
|
||||
lrBMP_LRRxDateEdit : TBitmap = nil;
|
||||
lrBMP_LRSelectPeriod : TBitmap = nil;
|
||||
|
||||
procedure InitLRComp;
|
||||
begin
|
||||
DoRegsiterControl(lrBMP_LRDBLookupComboBox, TlrRxDBLookupComboBox);
|
||||
DoRegsiterControl(lrBMP_LRRxDateEdit, TlrRxDateEdit);
|
||||
DoRegsiterControl(lrBMP_lrSelectPeriod, TlrSelectPeriodControl);
|
||||
end;
|
||||
{
|
||||
var
|
||||
lrBMP_SelectClient:TBitmap = nil;
|
||||
}
|
||||
{ TlrRxDateEdit }
|
||||
|
||||
function TlrRxDateEdit.GetDate: TDateTime;
|
||||
begin
|
||||
Result:=TRxDateEdit(FControl).Date;
|
||||
end;
|
||||
|
||||
procedure TlrRxDateEdit.SetDate(AValue: TDateTime);
|
||||
begin
|
||||
TRxDateEdit(FControl).Date:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrRxDateEdit.PaintDesignControl;
|
||||
var
|
||||
AY, aH:integer;
|
||||
R1:TRect;
|
||||
begin
|
||||
AY:=(DRect.Top + DRect.Bottom) div 2;
|
||||
aH:=Canvas.TextHeight(Text) div 2;
|
||||
Canvas.Frame3d(DRect, 1, bvLowered);
|
||||
Canvas.Brush.Color := FControl.Color;
|
||||
Canvas.FillRect(DRect);
|
||||
Canvas.Font:=FControl.Font;
|
||||
Canvas.TextRect(DRect, DRect.Left + 3, AY - aH, Text);
|
||||
|
||||
R1:=DRect;
|
||||
R1.Left:=R1.Right - 16;
|
||||
DrawFrameControl(Canvas.Handle, R1, DFC_BUTTON, DFCS_BUTTONPUSH);
|
||||
end;
|
||||
|
||||
function TlrRxDateEdit.CreateControl: TControl;
|
||||
begin
|
||||
Result:=TRxDateEdit.Create(nil);
|
||||
end;
|
||||
|
||||
constructor TlrRxDateEdit.Create(AOwnerPage: TfrPage);
|
||||
begin
|
||||
inherited Create(AOwnerPage);
|
||||
BaseName := 'lrRxDateEdit';
|
||||
AutoSize:=true;
|
||||
end;
|
||||
|
||||
procedure TlrRxDateEdit.LoadFromXML(XML: TLrXMLConfig; const Path: String);
|
||||
begin
|
||||
inherited LoadFromXML(XML, Path);
|
||||
end;
|
||||
|
||||
procedure TlrRxDateEdit.SaveToXML(XML: TLrXMLConfig; const Path: String);
|
||||
begin
|
||||
inherited SaveToXML(XML, Path);
|
||||
end;
|
||||
|
||||
{ TlrRxDBLookupComboBox }
|
||||
|
||||
function TlrRxDBLookupComboBox.GetKeyField: string;
|
||||
begin
|
||||
Result:=FKeyField;
|
||||
end;
|
||||
|
||||
function TlrRxDBLookupComboBox.GetListField: string;
|
||||
begin
|
||||
Result:=FListField;
|
||||
end;
|
||||
|
||||
function TlrRxDBLookupComboBox.GetListSource: string;
|
||||
begin
|
||||
Result:=FListSource;
|
||||
end;
|
||||
|
||||
function TlrRxDBLookupComboBox.GetText: string;
|
||||
begin
|
||||
Result:=TRxDBLookupCombo(FControl).Value;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.SetKeyField(AValue: string);
|
||||
begin
|
||||
if FKeyField=AValue then Exit;
|
||||
FKeyField:=AValue;
|
||||
TRxDBLookupCombo(FControl).LookupField:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.SetListField(AValue: string);
|
||||
begin
|
||||
if FListField=AValue then Exit;
|
||||
FListField:=AValue;
|
||||
TRxDBLookupCombo(FControl).LookupDisplay:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.SetListSource(AValue: string);
|
||||
var
|
||||
D:TDataSet;
|
||||
begin
|
||||
if FListSource=AValue then Exit;
|
||||
FListSource:=AValue;
|
||||
|
||||
D:=frFindComponent(nil, AValue) as TDataSet;
|
||||
if Assigned(D) then
|
||||
begin
|
||||
TRxDBLookupCombo(FControl).LookupSource:=frGetDataSource(OwnerForm, D);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.RxDBLookupComboBox1CloseUp(Sender: TObject;
|
||||
SearchResult: boolean);
|
||||
begin
|
||||
{ if Assigned(TDBLookupComboBox(FControl).ListSource) and Assigned(TDBLookupComboBox(FControl).ListSource.DataSet) then
|
||||
TDBLookupComboBox(FControl).ListSource.DataSet.Locate(TDBLookupComboBox(FControl).KeyField, TDBLookupComboBox(FControl).KeyValue, []);
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.SetText(AValue: string);
|
||||
begin
|
||||
TRxDBLookupCombo(FControl).Value:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.PaintDesignControl;
|
||||
var
|
||||
AY, aH:integer;
|
||||
R1:TRect;
|
||||
begin
|
||||
AY:=(DRect.Top + DRect.Bottom) div 2;
|
||||
aH:=Canvas.TextHeight(Name) div 2;
|
||||
Canvas.Frame3d(DRect, 1, bvLowered);
|
||||
Canvas.Brush.Color := FControl.Color;
|
||||
Canvas.FillRect(DRect);
|
||||
Canvas.Font:=FControl.Font;
|
||||
Canvas.TextRect(DRect, DRect.Left + 3, AY - aH, Name);
|
||||
|
||||
R1:=DRect;
|
||||
R1.Left:=R1.Right - 16;
|
||||
DrawFrameControl(Canvas.Handle, R1, DFC_BUTTON, DFCS_BUTTONPUSH);
|
||||
end;
|
||||
|
||||
function TlrRxDBLookupComboBox.CreateControl: TControl;
|
||||
begin
|
||||
Result:=TRxDBLookupCombo.Create(nil);
|
||||
TRxDBLookupCombo(Result).DisplayAllFields:=true;
|
||||
TRxDBLookupCombo(Result).OnClosePopup:=@RxDBLookupComboBox1CloseUp;
|
||||
TRxDBLookupCombo(Result).Style:=rxcsDropDownList;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.AfterLoad;
|
||||
var
|
||||
D:TDataSet;
|
||||
i:integer;
|
||||
begin
|
||||
inherited AfterLoad;
|
||||
|
||||
D:=frFindComponent(nil, FListSource) as TDataSet;
|
||||
if Assigned(D) then
|
||||
begin
|
||||
if Assigned(D.Owner) then
|
||||
begin
|
||||
try
|
||||
TRxDBLookupCombo(FControl).LookupSource:=frGetDataSource(D.Owner, D);
|
||||
finally
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
for i:=0 to OwnerPage.Objects.Count-1 do
|
||||
begin
|
||||
if TfrObject(OwnerPage.Objects[i]) is TLRDataSetControl then
|
||||
begin
|
||||
if TLRDataSetControl(OwnerPage.Objects[i]).DataSet = D then
|
||||
begin
|
||||
TRxDBLookupCombo(FControl).LookupSource:=TLRDataSetControl(OwnerPage.Objects[i]).lrDataSource;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.AfterCreate;
|
||||
begin
|
||||
inherited AfterCreate;
|
||||
TRxDBLookupCombo(FControl).OnChange:=FControl.OnClick;
|
||||
FControl.OnClick:=nil;
|
||||
end;
|
||||
|
||||
constructor TlrRxDBLookupComboBox.Create(AOwnerPage: TfrPage);
|
||||
begin
|
||||
inherited Create(AOwnerPage);
|
||||
BaseName:='lrRxDBLookupComboBox';
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.LoadFromXML(XML: TLrXMLConfig;
|
||||
const Path: String);
|
||||
begin
|
||||
inherited LoadFromXML(XML, Path);
|
||||
KeyField:=XML.GetValue(Path+'KeyField/Value'{%H-}, '');
|
||||
ListField:=XML.GetValue(Path+'ListField/Value'{%H-}, '');
|
||||
FListSource:=XML.GetValue(Path+'ListSource/Value'{%H-}, '');
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.SaveToXML(XML: TLrXMLConfig; const Path: String
|
||||
);
|
||||
begin
|
||||
inherited SaveToXML(XML, Path);
|
||||
XML.SetValue(Path+'KeyField/Value'{%H-}, FKeyField);
|
||||
XML.SetValue(Path+'ListField/Value'{%H-}, FListField);
|
||||
XML.SetValue(Path+'ListSource/Value'{%H-}, FListSource);
|
||||
end;
|
||||
|
||||
procedure TlrRxDBLookupComboBox.Assign(Source: TPersistent);
|
||||
begin
|
||||
inherited Assign(Source);
|
||||
|
||||
if Source is TlrRxDBLookupComboBox then
|
||||
begin
|
||||
KeyField:=TlrRxDBLookupComboBox(Source).KeyField;
|
||||
ListSource:=TlrRxDBLookupComboBox(Source).ListSource;
|
||||
ListField:=TlrRxDBLookupComboBox(Source).ListField;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TlrSelectPeriodControl }
|
||||
|
||||
function TlrSelectPeriodControl.GetFlat: Boolean;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).Flat;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetHalfYear: word;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).HalfYear;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetMonth: word;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).Month;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetOptions: TRxDateRangeEditOptions;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).Options;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetPeriod: TDateTime;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).Period;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetPeriodEnd: TDateTime;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).PeriodEnd;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetQuarter: word;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).Quarter;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.GetYear: word;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit(Control).Year;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetFlat(AValue: Boolean);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).Flat:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetHalfYear(AValue: word);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).HalfYear:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetMonth(AValue: word);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).Month:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetOptions(AValue: TRxDateRangeEditOptions);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).Options:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetPeriod(AValue: TDateTime);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).Period:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetQuarter(AValue: word);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).Quarter:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SetYear(AValue: word);
|
||||
begin
|
||||
TRxDateRangeEdit(Control).Year:=AValue;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.PaintDesignControl;
|
||||
begin
|
||||
inherited PaintDesignControl;
|
||||
end;
|
||||
|
||||
function TlrSelectPeriodControl.CreateControl: TControl;
|
||||
begin
|
||||
Result:=TRxDateRangeEdit.Create(nil);
|
||||
TRxDateRangeEdit(Result).AutoSize:=false;
|
||||
end;
|
||||
|
||||
constructor TlrSelectPeriodControl.Create(AOwnerPage: TfrPage);
|
||||
begin
|
||||
inherited Create(AOwnerPage);
|
||||
BaseName:='lrSelectPeriod';
|
||||
AutoSize:=false;
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.LoadFromXML(XML: TLrXMLConfig;
|
||||
const Path: String);
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
inherited LoadFromXML(XML, Path);
|
||||
Flat:=XML.GetValue(Path+'Flat/Value'{%H-}, false);
|
||||
S:=XML.GetValue(Path+'Options/Value','');
|
||||
if S<>'' then
|
||||
RestoreProperty('Options',S)
|
||||
else
|
||||
Options:=[];
|
||||
end;
|
||||
|
||||
procedure TlrSelectPeriodControl.SaveToXML(XML: TLrXMLConfig; const Path: String
|
||||
);
|
||||
begin
|
||||
inherited SaveToXML(XML, Path);
|
||||
XML.SetValue(Path+'Flat/Value'{%H-}, Flat);
|
||||
XML.SetValue(Path+'Options/Value', GetSaveProperty('Options'));
|
||||
end;
|
||||
|
||||
type
|
||||
{ TlrDBLookupComboBoxListSourceProperty }
|
||||
|
||||
TlrDBLookupComboBoxListSourceProperty = class(TFieldProperty)
|
||||
public
|
||||
procedure FillValues(const Values: TStringList); override;
|
||||
end;
|
||||
|
||||
{ TlrDBLookupComboBoxFiledsProperty }
|
||||
|
||||
TlrDBLookupComboBoxFiledsProperty = class(TFieldProperty)
|
||||
public
|
||||
procedure FillValues(const Values: TStringList); override;
|
||||
end;
|
||||
|
||||
{ TlrLookupDisplayProperty }
|
||||
|
||||
TlrLookupDisplayProperty = class(TlrDBLookupComboBoxFiledsProperty)
|
||||
public
|
||||
function GetAttributes: TPropertyAttributes; override;
|
||||
procedure Edit; override;
|
||||
end;
|
||||
|
||||
{ TlrLookupDisplayProperty }
|
||||
|
||||
function TlrLookupDisplayProperty.GetAttributes: TPropertyAttributes;
|
||||
begin
|
||||
Result:=inherited GetAttributes + [paDialog]
|
||||
end;
|
||||
|
||||
procedure TlrLookupDisplayProperty.Edit;
|
||||
var
|
||||
DualListDialog1: TDualListDialog;
|
||||
Cmp1:TlrRxDBLookupComboBox;
|
||||
|
||||
procedure DoInitFill;
|
||||
var
|
||||
i,j:integer;
|
||||
LookupDisplay:string;
|
||||
begin
|
||||
LookupDisplay:=Cmp1.ListField;
|
||||
|
||||
if LookupDisplay<>'' then
|
||||
begin
|
||||
StrToStrings(LookupDisplay, DualListDialog1.List2, ';');
|
||||
for i:=DualListDialog1.List1.Count-1 downto 0 do
|
||||
begin
|
||||
j:=DualListDialog1.List2.IndexOf(DualListDialog1.List1[i]);
|
||||
if j>=0 then
|
||||
DualListDialog1.List1.Delete(i);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function DoFillDone:string;
|
||||
var
|
||||
i:integer;
|
||||
begin
|
||||
for i:=0 to DualListDialog1.List2.Count-1 do
|
||||
Result:=Result + DualListDialog1.List2[i]+';';
|
||||
if Result<>'' then
|
||||
Result:=Copy(Result, 1, Length(Result)-1);
|
||||
end;
|
||||
|
||||
procedure DoSetCaptions;
|
||||
begin
|
||||
DualListDialog1.Label1Caption:='All fields';
|
||||
DualListDialog1.Label2Caption:='Fields is LookupDisplay';
|
||||
DualListDialog1.Title:='Fill fields in LookupDisplay property';
|
||||
end;
|
||||
|
||||
begin
|
||||
Cmp1:=nil;
|
||||
|
||||
if GetComponent(0) is TlrRxDBLookupComboBox then
|
||||
Cmp1:=TlrRxDBLookupComboBox(GetComponent(0));
|
||||
|
||||
DualListDialog1:=TDualListDialog.Create(Application);
|
||||
try
|
||||
DoSetCaptions;
|
||||
FillValues(DualListDialog1.List1 as TStringList);
|
||||
DoInitFill;
|
||||
if DualListDialog1.Execute then
|
||||
begin
|
||||
if Assigned(Cmp1) then
|
||||
Cmp1.ListField:=DoFillDone
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(DualListDialog1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDBLookupComboBoxFiledsProperty.FillValues(const Values: TStringList
|
||||
);
|
||||
var
|
||||
L:TlrRxDBLookupComboBox;
|
||||
begin
|
||||
if (GetComponent(0) is TlrRxDBLookupComboBox) then
|
||||
begin
|
||||
L:=GetComponent(0) as TlrRxDBLookupComboBox;
|
||||
if Assigned(TRxDBLookupCombo(L.Control).LookupSource) then
|
||||
frGetFieldNames(TfrTDataSet(TRxDBLookupCombo(L.Control).LookupSource.DataSet) , Values);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TlrDBLookupComboBoxListSourceProperty.FillValues(
|
||||
const Values: TStringList);
|
||||
begin
|
||||
if (GetComponent(0) is TlrRxDBLookupComboBox) then
|
||||
frGetComponents(nil, TDataSet, Values, nil);
|
||||
end;
|
||||
|
||||
initialization
|
||||
InitLRComp;
|
||||
|
||||
RegisterPropertyEditor(TypeInfo(string), TlrRxDBLookupComboBox, 'ListSource', TlrDBLookupComboBoxListSourceProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TlrRxDBLookupComboBox, 'KeyField', TlrDBLookupComboBoxFiledsProperty);
|
||||
RegisterPropertyEditor(TypeInfo(string), TlrRxDBLookupComboBox, 'ListField', TlrLookupDisplayProperty);
|
||||
|
||||
finalization
|
||||
if Assigned(lrBMP_LRDBLookupComboBox) then
|
||||
FreeAndNil(lrBMP_LRDBLookupComboBox);
|
||||
|
||||
if Assigned(lrBMP_LRRxDateEdit) then
|
||||
FreeAndNil(lrBMP_LRRxDateEdit);
|
||||
|
||||
if Assigned(lrBMP_LRSelectPeriod) then
|
||||
FreeAndNil(lrBMP_LRSelectPeriod);
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,70 @@
|
||||
object Form3: TForm3
|
||||
Left = 604
|
||||
Height = 442
|
||||
Top = 239
|
||||
Width = 640
|
||||
Caption = 'MDI form # 2'
|
||||
ClientHeight = 442
|
||||
ClientWidth = 640
|
||||
Icon.Data = {
|
||||
7E04000000000100010010100000010020006804000016000000280000001000
|
||||
0000200000000100200000000000000400006400000064000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000000000000000000000000000000000000E2C0AAFFE2C0AAFF000000000000
|
||||
00000000000000000000E2C0AAFFE2C0AAFF0000000000000000000000000000
|
||||
0000000000000000000000000000C8865BFFBE713FFFC58053FF000000000000
|
||||
00000000000000000000CE946EFFBE703EFFC17746FF00000000000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
00000000000000000000D6A586FFC2794AFFCA8A61FF00000000000000000000
|
||||
0000000000000000000000000000D39E7CFFC2794AFFCC9068FF000000000000
|
||||
00000000000000000000C9885EFFC07443FFC27849FF00000000000000000000
|
||||
0000000000000000000000000000C9885EFFC2794AFFC9885EFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000BD6E3BFFBD6E3BFFE2C0AAFF000000000000
|
||||
0000000000000000000000000000D4A17FFFBD6F3CFFBE703DFF000000000000
|
||||
00000000000000000000C68155FFBF7241FFCC8D66FF00000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000
|
||||
}
|
||||
OnClose = FormClose
|
||||
LCLVersion = '1.1'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 50
|
||||
Top = 0
|
||||
Width = 640
|
||||
Align = alTop
|
||||
Caption = 'MDI form # 2'
|
||||
TabOrder = 0
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Left = 0
|
||||
Height = 392
|
||||
Top = 50
|
||||
Width = 640
|
||||
Align = alClient
|
||||
Lines.Strings = (
|
||||
'Memo1'
|
||||
)
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,59 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="rx"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<AddToProjectUsesSection Value="True"/>
|
||||
<Author Value="Michael Van Canneyt, AO ROSNO, Master-Bank"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="rx_laz"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
</CompilerOptions>
|
||||
<Description Value="Delphi VCL Extensions (RX)"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="4">
|
||||
<Item1>
|
||||
<Filename Value="rx_laz/apputils.pp"/>
|
||||
<UnitName Value="AppUtils"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="rx_laz/mrulist.pp"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="MRUList"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="rx_laz/placement.pp"/>
|
||||
<UnitName Value="Placement"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="rx_laz/strholder.pp"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="StrHolder"/>
|
||||
</Item4>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
Reference in New Issue
Block a user