I have a TListView and a TObjectList. I bind TFoo.value to Item.Caption.
I write a procedure "AfterScroll" with a showmessage inside. I connect the procedure on TBindSourceAdapter.AfterScroll.
I run this program and I have just one showmessage.
If I replace TListView by TStringGrid, I have the showmessage on each lines.
type
TFoo = class
private
FValue: string;
public
constructor create(sValue: string);
property Value: string read FValue write FValue;
end;
TForm5 = class(TForm)
PrototypeBindSource1: TPrototypeBindSource;
StringGrid1: TStringGrid;
BindingsList1: TBindingsList;
LinkGridToDataSourcePrototypeBindSource1: TLinkGridToDataSource;
ListView1: TListView;
LinkFillControlToField1: TLinkFillControlToField;
procedure PrototypeBindSource1CreateAdapter(Sender: TObject; var ABindSourceAdapter: TBindSourceAdapter);
private
{ Déclarations privées }
ListFoo: TObjectList<TFoo>;
procedure AfterScrool(Adapter: TBindSourceAdapter);
public
{ Déclarations publiques }
constructor create(AOwner: TComponent); override;
end;
var
Form5: TForm5;
implementation
{$R *.fmx}
{ TForm5 }
procedure TForm5.AfterScrool(Adapter: TBindSourceAdapter);
begin
ShowMessage('kk');
end;
constructor TForm5.create(AOwner: TComponent);
begin
ListFoo := TObjectList<TFoo>.create();
ListFoo.Add(TFoo.create('Test'));
ListFoo.Add(TFoo.create('Test 1'));
ListFoo.Add(TFoo.create('Test 2'));
ListFoo.Add(TFoo.create('Test 3'));
inherited create(AOwner);
end;
procedure TForm5.PrototypeBindSource1CreateAdapter(Sender: TObject; var ABindSourceAdapter: TBindSourceAdapter);
begin
ABindSourceAdapter := TListBindSourceAdapter<TFoo>.create(self, ListFoo);
ABindSourceAdapter.AfterScroll := AfterScrool;
end;
{ TFoo }
constructor TFoo.create(sValue: string);
begin
inherited create;
FValue := sValue;
end;
end.
It is possible to connect an "AfterScroll" event on a TListView ?
I found, we need to bind "*" on "Synch" property of TListView
Related
I have an application where an invisible "Host" application object creates main form and main form creates temporarily a data monitoring dialog form.
There is an asynchronous data receiver in "Host" that has a trace output event. This event should be temporarily bound with data monitoring dialog form's method when dialog form exists and unbound when it is about to be destroyed.
I made a minimal equivalent to this application below. Could you check whether it is the right way to do so? Please pay attention to "Attention" comments.
program BindToTempObject;
uses
Vcl.Forms, System.Classes, Vcl.StdCtrls, Vcl.ExtCtrls, System.SysUtils;
type
TBoolEvent = procedure(b: Boolean) of object;
TDialogForm = class(TForm)
public
constructor Create(AOwner: TComponent); override;
procedure BoolEventHandler(b: Boolean);
end;
TMainForm = class(TForm)
private
_btn: TButton;
_onBoolEventRelay: TBoolEvent; //Attention
procedure _btnClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
procedure BoolEventRelay(b: Boolean); //Attention
end;
TAppObject = class
private
_mainForm: TMainForm;
_eventSource: TTimer;
_boolState: Boolean;
procedure _eventSourceTick(Sender: TObject);
public
OnBoolEvent: TBoolEvent;
constructor Create();
destructor Destroy(); override;
end;
var
app: TAppObject;
{ TAppObject }
constructor TAppObject.Create();
begin
Application.CreateForm(TMainForm, _mainForm);
OnBoolEvent := _mainForm.BoolEventRelay; //Attention
_eventSource := TTimer.Create(nil);
_eventSource.OnTimer := _eventSourceTick;
_eventSource.Enabled := True;
end;
destructor TAppObject.Destroy();
begin
_eventSource.OnTimer := nil;
_eventSource.Free();
inherited;
end;
procedure TAppObject._eventSourceTick(Sender: TObject);
begin
_boolState := not _boolState;
if Assigned(OnBoolEvent) then OnBoolEvent(_boolState);
end;
{ TMainForm }
constructor TMainForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Main form';
_btn := TButton.Create(Self);
_btn.Parent := Self;
_btn.Caption := 'Click me';
_btn.OnClick := _btnClick;
end;
procedure TMainForm.BoolEventRelay(b: Boolean);
begin
if Assigned(_onBoolEventRelay) then _onBoolEventRelay(b); //Attention
end;
procedure TMainForm._btnClick(Sender: TObject);
var
dlg: TDialogForm;
begin
dlg := TDialogForm.Create(Self);
try
_onBoolEventRelay := dlg.BoolEventHandler; //Attention
dlg.ShowModal();
finally
_onBoolEventRelay := nil; //Attention
dlg.Free();
end;
end;
{ TDialogForm }
procedure TDialogForm.BoolEventHandler(b: Boolean);
begin
Caption := BoolToStr(b, True);
end;
constructor TDialogForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Dialog form';
end;
begin
Application.Initialize();
app := TAppObject.Create();
try
Application.Run();
finally
app.Free();
end;
end.
You could do it that way, sure. A decent separation of responsibilities between classes, so they don't have to know about each other.
However, in your particular example, since everything is in a single unit, and the app object is globally accessible, you could simplifly the code a little bit by assigning the TDialogForm.BoolEventHandler() method directly to the TAppObject.OnBoolEvent event and get rid of TMainForm as a middle man:
program BindToTempObject;
uses
Vcl.Forms, System.Classes, Vcl.StdCtrls, Vcl.ExtCtrls, System.SysUtils;
type
TBoolEvent = procedure(b: Boolean) of object;
TDialogForm = class(TForm)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
procedure BoolEventHandler(b: Boolean);
end;
TMainForm = class(TForm)
private
_btn: TButton;
procedure _btnClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
end;
TAppObject = class
private
_mainForm: TMainForm;
_eventSource: TTimer;
_boolState: Boolean;
procedure _eventSourceTick(Sender: TObject);
public
OnBoolEvent: TBoolEvent;
constructor Create();
destructor Destroy(); override;
end;
var
app: TAppObject;
{ TAppObject }
constructor TAppObject.Create();
begin
Application.CreateForm(TMainForm, _mainForm);
_eventSource := TTimer.Create(nil);
_eventSource.OnTimer := _eventSourceTick;
_eventSource.Enabled := True;
end;
destructor TAppObject.Destroy();
begin
_eventSource.OnTimer := nil;
_eventSource.Free();
inherited;
end;
procedure TAppObject._eventSourceTick(Sender: TObject);
begin
_boolState := not _boolState;
if Assigned(OnBoolEvent) then OnBoolEvent(_boolState);
end;
{ TMainForm }
constructor TMainForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Main form';
_btn := TButton.Create(Self);
_btn.Parent := Self;
_btn.Caption := 'Click me';
_btn.OnClick := _btnClick;
end;
procedure TMainForm._btnClick(Sender: TObject);
var
dlg: TDialogForm;
begin
dlg := TDialogForm.Create(Self);
try
dlg.ShowModal();
finally
dlg.Free();
end;
end;
{ TDialogForm }
procedure TDialogForm.BoolEventHandler(b: Boolean);
begin
Caption := BoolToStr(b, True);
end;
constructor TDialogForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Dialog form';
app.OnBoolEvent := BoolEventHandler;
end;
destructor TDialogForm.Destroy();
begin
app.OnBoolEvent := nil;
inherited;
end;
begin
Application.Initialize();
app := TAppObject.Create();
try
Application.Run();
finally
app.Free();
end;
end.
I am writing a component inherited from TComboBox. The component has generic methods for adding and retrieving values, which could be record or class types, from a private dictionary with the key as the item index of the string representation of the value.
TGenericCombo = class (TComboBox)
private
FValues: TDictionary<integer, TValue>;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddValue<T>(const StringValue: string; Value: T); overload;
procedure AddValue<T>(Pair: TPair<T, string>); overload;
procedure AddValues<T>(StringFunction: TCalculateStringFunction<T>; Values: TList<T>); overload;
procedure AddValues<T>(Dictionary: TDictionary<T, string>); overload;
function GetCurrentValue<T>: T;
procedure SetCurrentValue<T>(Value: T);
end;
This is the AddItem method, Values are currently stored as TValue, I have tried Variant also.
procedure TGenericCombo.AddValue<T>(const StringValue: string; Value: T);
begin
Items.Add(StringValue);
FValues.Add(Items.Count - 1, TValue.From(Value));
end;
The problem I am having is that when coming to set the selected value in the combo, I am casting the Values in the dictionary to TObject in order to compare with the Value past in. This is raising a 'Invalid type cast' exception at run time. TRttiHelper.ObjectsAreEqual takes 2 TObjects as arguments.
procedure TGenericCombo.SetCurrentValue<T>(Value: T);
var
i: integer;
FFound: Boolean;
ListValue: TPair<integer, TValue>;
begin
for ListValue in FValues do
if TRttiHelper.ObjectsAreEqual(TValue.From(ListValue.Value).AsObject, TValue.From(Value).AsObject) then
begin
ItemIndex := ListValue.Key;
FFound := True;
Break
end;
if not FFound then
ItemIndex := -1;
end;
I'm sure of what type the values, which again could be record types or classes, should be stored as in order to get this to work.
EDIT:
I thought it would be useful to add a couple of usage examples.
TTestEnum = (teEnum1, teEnum2, teEnum3);
TTestObject = class
private
FStringProperty: string;
public
constructor Create(const StringProperty: string);
property StringProperty: string read FStringProperty write FStringProperty;
end;
TForm3 = class(TForm)
GenericCombo1: TGenericCombo;
GenericCombo2: TGenericCombo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
var
TestList: TObjectList<TTestObject>;
begin
TestList := TObjectList<TTestObject>.Create;
try
TestList.Add(TTestObject.Create('Object 1'));
TestList.Add(TTestObject.Create('Object 2'));
TestList.Add(TTestObject.Create('Object 3'));
GenericCombo1.AddValues<TTestList>(function(x: TTestObject): string begin Result := x.StringProperty end, TestObject);
finally
TestList.Free;
end;
end;
{ TTestObject }
constructor TTestObject.Create(const StringProperty: string);
begin
FStringProperty := StringProperty;
end;
procedure TForm3.Button2Click(Sender: TObject);
var
TestList: TDictionary<TTestEnum, string>;
begin
TestList := TDictionary<TTestEnum, string>.Create;
try
TestList.Add(teEnum1, 'Enum 1');
TestList.Add(teEnum2, 'Enum 2');
TestList.Add(teEnum3, 'Enum 3');
GenericCombo1.AddValues<TTestEnum>(TestList);
finally
TestList.Free;
end;
end;
I want to write a custom property editor for my custom component. I have a component declaration like below:
type
TEJsonQuery = class(TComponent)
private
FSql: TStrings;
procedure SetSQL(const Value: TStrings);
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
published
property SQL: TStrings read FSql write SetSQL;
{ Published declarations }
end;
constructor TEJsonQuery.Create;
begin
inherited Create(AOwner);
FSql := TStringList.Create;
end;
procedure TEJsonQuery.SetSQL(const Value: TStrings);
begin
if SQL.Text <> Value.Text then
begin
//Close;
SQL.BeginUpdate;
try
SQL.Assign(Value);
finally
SQL.EndUpdate;
end;
end;
end;
destructor TEJsonQuery.Destroy;
begin
inherited Destroy;
FSql.Free;
end;
And a property editor declaration like below:
type
TQuerySQLProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
end;
Tfrm_JsonQuerySQL = class(TForm)
btn_JsonQuerySQL: TButton;
mem_SQL: TMemo;
btn_OK: TButton;
btn_Cancel: TButton;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frm_JsonQuerySQL: Tfrm_JsonQuerySQL;
procedure Register;
implementation
{$R *.dfm}
procedure Register;
begin
RegisterComponents('MyComponents', [TEJsonQuery]);
RegisterPropertyEditor(TypeInfo(TStrings), TEJsonQuery, 'SQL', TQuerySQLProperty);
end;
procedure TQuerySqlProperty.Edit;
begin
frm_Ekol_JsonQuerySQL := Tfrm_Ekol_JsonQuerySQL.Create(Application);
try
Assert(False, '"' + GetStrValue + '"');
frm_Ekol_JsonQuerySQL.mem_SQL.Lines.Text := GetStrValue;
// show the dialog box
if frm_Ekol_JsonQuerySQL.ShowModal = mrOK then
begin
SetStrValue(frm_Ekol_JsonQuerySQL.mem_SQL.Lines.Text);
end;
finally
frm_Ekol_JsonQuerySQL.Free;
end;
end;
function TQuerySQLProperty.GetAttributes: TPropertyAttributes;
begin
// editor, sorted list, multiple selection
// Result := [paDialog, paMultiSelect, paValueList, paSortList];
Result := [paDialog];
end;
Property editor opens if Assert(False, '"' + GetStrValue + '"'); is commented with empty memo because GetStrValue returns empty string.
The SQL property is a TStrings property, not a string property, and GetStrValue only works on string properties, and if more than one component is selected, it returns the value of GetComponent(0). GetStrValue is a virtual property, so you can implement your own.
Here is what I have in mind:
type
TQuerySqlProperty = ...
public
function GetStrValue : string; override;
...
end;
...
function TQuerySqlProperty.GetStrValue : string;
begin
if GetComponent(0) is TEJsonQuery then
begin
Result := (GetComponent(0) as TEJsonQuery ).SQL.Text;
end
else
begin
Result := inherited;
end;
end;
I need to impliment a TList descendant of controls + an extra object.
something like:
List.Add(AControl, AObject)
So The List will hold both AControl, AObject
What is the best way of doing this with Delphi 7?
You can store a list of records, then you can put whatever you want into the record, eg:
type
PMyRecord = ^MyRecord;
MyRecord = record
Control: TControl;
Object: TObject;
end;
var
Rec: PMyRecord;
begin
New(Rec);
try
Rec.Control := AControl;
Rec.Object := AObject;
List.Add(Rec);
except
Dispose(Rec);
Raise;
end;
end;
var
Rec: PMyRecord;
begin
Rec := PMyRecord(List[SomeIndex]);
// use Rec.Control and Rec.Object as needed...
end;
Don't forget to Dispose() an item when you remove it from the list:
var
Rec: PMyRecord;
begin
Rec := PMyRecord(List[SomeIndex]);
List.Delete(SomeIndex);
Dispose(Rec);
end;
And also when you are finished using the list, or at least when you Clear() it:
var
I: Integer;
Rec: PMyRecord;
begin
for I := o to List.Count-1 do
Dispose(PMyRecord(List[I]));
//...
end;
If you derive a new class from TList, you can override its virtual Notify() method to dispose items:
type
TMyList = class(TList)
protected
function Get(Index: Integer): PMyRecord;
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
function Add(AControl: TControl; AObject: TObject): Integer;
procedure Insert(Index: Integer; AControl: TControl; AObject: TObject);
property Items[Index: Integer]: PMyRecord read Get; default;
end;
function TMyList.Add(AControl: TControl; AObject: TObject): Integer;
var
Rec: PMyRecord;
begin
New(Rec);
try
Rec.Control := AControl;
Rec.Object := AObject;
Result := inherited Add(Rec);
except
Dispose(Rec);
Raise;
end;
end;
procedure TMyList.Insert(Index: Integer; AControl: TControl; AObject: TObject);
var
Rec: PMyRecord;
begin
New(Rec);
try
Rec.Control := AControl;
Rec.Object := AObject;
inherited Insert(Index, Rec);
except
Dispose(Rec);
Raise;
end;
end;
function TMyList.Get(Index: Integer): PMyRecord;
begin
Result := PMyRecord(inherited Get(Index));
end;
procedure TMyList.Notify(Ptr: Pointer; Action: TListNotification);
begin
inherited;
if Action = lnDeleted then
Dispose(PMyRecord(Ptr));
end;
try this
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMyContainer = class
public
ctnGen: TControl;
objGen: TObject;
constructor Create(const ctnGen: TControl; const objGen: TObject);
end;
var
Form1: TForm1;
implementation
uses
Contnrs;
{$R *.DFM}
{ TMyContainer }
constructor TMyContainer.Create(const ctnGen: TControl;
const objGen: TObject);
begin
inherited Create();
Self.ctnGen := ctnGen;
Self.objGen := objGen;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
lstGen: TObjectList;
begin
lstGen := TObjectList.Create(True);
try
lstGen.Add(TMyContainer.Create(Self, Self));
ShowMessage(TMyContainer(lstGen.Items[0]).objGen.ClassName);
finally
lstGen.Free;
end;
end;
TObjectList will free the TMyContainer class
I've used VBto as a starting point plus a lot of study of Delphi 6 User's Guide. I can make my new component compile, but I can't figure a way to get it to display so I can finish debugging it. And 50 years of programming experience isn't helping. Here are the guts of my component:
type
TChangeEvent = procedure(Sender: TObject; v: String) of object;
TTxtSpnr = class(TWinControl)
Lbl: TLabel;
Txt: TEdit;
Scrll: TScrollBar;
private
FonChange: TChangeEvent;
busy, tweaked: Boolean;
NewValue: String;
protected
procedure Changed(v: String); dynamic;
property onChange: TChangeEvent read FonChange write FOnChange;
procedure ScrllChange(Sender: TObject);
procedure ScrllScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure TxtEnter(Sender: TObject);
procedure TxtKeyUp(Sender: TObject; var Key: WORD; Shift: TShiftState);
procedure TxtExit(Sender: TObject);
procedure Txt_Validate(var Cancel: Boolean);
public
function GetCaption(): String;
procedure SetCaption(New_Caption: String);
function GetMax(): Smallint;
procedure SetMax(New_Max: Smallint);
function MaxOf(a: Double; B: Longint): OleVariant;
function MinOf(a: OleVariant; B: Longint): OleVariant;
function GetMin(): Smallint;
procedure SetMin(New_Min: Smallint);
function GetText(): String;
procedure SetText(New_Text: String);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Caption: String read GetCaption write SetCaption;
property Enabled: Boolean read GetEnabled write SetEnabled;
property Max: Smallint read GetMax write SetMax;
property Min: Smallint read GetMin write SetMin;
property Text: String read GetText write SetText;
end;
var
TxtSpnr: TTxtSpnr;
implementation
uses Math;
{$R *.dfm}
procedure TTxtSpnr.Changed(V: String); begin
if assigned(FonChange) then FonChange(self,V);
end;
constructor TTxtSpnr.Create(AOwner: TComponent); begin
inherited Create(AOwner);
Lbl := TLabel.Create(Self);
with Lbl do begin
Parent := Self;
end;
Txt := TEdit.Create(Self);
with Txt do begin
Parent := Self;
end;
Scrll := TScrollBar(Self);
with Scrll do begin
Parent := Self;
end;
end;
and here's the test driver:
type
TForm1 = class(TForm)
FTxtSpnr: TTxtSpnr;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject); begin
FTxtSpnr := TTxtSpnr.create(Self);
with FTxtSpnr do begin
Left:=10;
Top:=10;
Visible:=true;
Show;
end;
end;
But it doesn't compile and says, in the constructor, "An object can't be its own parent". Take out the Parent settings, it compiles but doesn't display the components. What am I missing?
First,
Scrll := TScrollBar(Self);
should of course read
Scrll := TScrollBar.Create(Self);
Second,
FTxtSpnr := TTxtSpnr.create(Self);
with FTxtSpnr do begin
Left:=10;
Top:=10;
Visible:=true;
Show;
end;
should be
FTxtSpnr := TTxtSpnr.create(Self);
with FTxtSpnr do
begin
Parent := Self;
Left := 10;
Top := 10;
end;
You forgot to set the parent.
Also, the global variable
var
TxtSpnr: TTxtSpnr;
looks dangerous. If you don't know exactly why you added those two lines, you should probably remove them.