Serge_G

Hi, I wrote a component but when I use visual livebindings this one is linked as a bidirectionnal LinkPropertyToFieldText. The component (a test one to get the good link) is a sort of thermometer unit CThermometre; interface uses System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls, FMX.Objects,FMX.Graphics, Data.Bind.Components; type [ObservableMembers('Progress')] TThermometre = class(TRectangle) private FProgress: integer; procedure SetProgress(const Value: integer); procedure ObserverToggle(const AObserver: IObserver; const Value: Boolean); { Déclarations privées } protected { Déclarations protégées } function CanObserve(const ID: Integer): Boolean; override; { declaration is in System.Classes } procedure ObserverAdded(const ID: Integer; const Observer: IObserver); override; { declaration is in System.Classes } procedure OnResize; public constructor Create(AOwner: TComponent); override; function Paint: Boolean; reintroduce; { Déclarations publiques } published { Déclarations publiées } property Progress : integer read FProgress write SetProgress; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TThermometre]); end; { TRectangle1 } function TThermometre.CanObserve(const ID: Integer): Boolean; begin case ID of TObserverMapping.EditLinkID, TObserverMapping.ControlValueID: Result := True; else Result := False; end; end; constructor TThermometre.create(AOwner: TComponent); var pos : single; Brosse : TBrush; begin if not(csloading in ComponentState) then begin inherited; width:=30; height:=110; Xradius:=10; Yradius:=10; FProgress:=50; pos:=0.5; if pos=1 then pos:=1-0.000001; Brosse:=TBrush.Create(TBrushKind.Gradient,Talphacolors.null); try Brosse.Gradient.StartPosition.X:=0.5; Brosse.Gradient.StartPosition.Y:=1; Brosse.Gradient.StopPosition.X:=0.5; Brosse.Gradient.StopPosition.Y:=0; Brosse.Gradient.Points.Clear; Brosse.Gradient.Points.Add; Brosse.Gradient.Points[0].Color:=Talphacolors.red; Brosse.Gradient.Points[0].Offset:=0; Brosse.Gradient.Points.Add; Brosse.Gradient.Points[1].Color:=Talphacolors.red; Brosse.Gradient.Points[1].Offset:=pos; Brosse.Gradient.Points.Add; Brosse.Gradient.Points[2].Color:=Talphacolors.null; Brosse.Gradient.Points[2].Offset:=pos+0.000001; Brosse.Gradient.Points.Add; Brosse.Gradient.Points[3].Color:=Talphacolors.null; Brosse.Gradient.Points[3].Offset:=1; Fill:=Brosse; finally Brosse.Free; end; end; end; procedure TThermometre.ObserverAdded(const ID: Integer; const Observer: IObserver); begin if ID = TObserverMapping.EditLinkID then Observer.OnObserverToggle := ObserverToggle; end; procedure TThermometre.ObserverToggle(const AObserver: IObserver; const Value: Boolean); var LEditLinkObserver: IEditLinkObserver; begin if Value then begin if Supports(AObserver, IEditLinkObserver, LEditLinkObserver) then Enabled := not LEditLinkObserver.IsReadOnly; end else Enabled := True; end; procedure TThermometre.OnResize; begin Paint; end; function TThermometre.Paint: Boolean; var pos : single; begin BeginUpDate; pos:=(FProgress/100); if pos=1 then pos:=1-0.000001; Fill.Gradient.Points.Clear; Fill.Gradient.Points.Add; Fill.Gradient.Points[0].Color:=Talphacolors.red; Fill.Gradient.Points[0].Offset:=0; Fill.Gradient.Points.Add; Fill.Gradient.Points[1].Color:=Talphacolors.red; Fill.Gradient.Points[1].Offset:=pos; Fill.Gradient.Points.Add; Fill.Gradient.Points[2].Color:=Talphacolors.null; Fill.Gradient.Points[2].Offset:=pos+0.000001; Fill.Gradient.Points.Add; Fill.Gradient.Points[3].Color:=Talphacolors.null; Fill.Gradient.Points[3].Offset:=1; EndUpdate; result:=true; end; procedure TThermometre.SetProgress(const Value: integer); begin if FProgress<>Value then begin FProgress := Value; Paint; end; end; initialization Data.Bind.Components.RegisterObservableMember (TArray<TClass>.create(TThermometre), 'Progress', 'FMX'); finalization Data.Bind.Components.UnregisterObservableMember (TArray<TClass>.create(TThermometre)); end. Works fine but I was expecting a LinkPropertyToFieldText (more logic). I suspect something is missing in the functions/ procedures ObserverAdded, ObserverToggle or CanObserve. Any clues ?

Hi, this morning, digging deep in the source I found the solution. My fault was in the use of Data.Bind.Components.RegisterObservableMember to have a LinkPropertyToFieldText link you have to use Data.Bind.Components.RegisterValuePropertyName initialization Data.Bind.Components.RegisterValuePropertyName (TArray<TClass>.create(TLThermo), 'Progress', 'FMX'); finalization Data.Bind.Components.UnRegisterValuePropertyName (TArray<TClass>.create(TLThermo)); So, it's solved

Yes, you can't pass a list value as a parameter. @Henry Olive try to be more precise in your question If you use Firedac you can use a macro. if you use another connector with no macro implementation you can use replacestr or replacetext SQL : String; myvalue : String; begin SQL:='SELECT * WHERE MYFIELD IN (MYVALUE)'; myValue:=QuotedStr('AA')+','+QuotedStr('BB'); // you can use a stringlist to get the same result S.SQL.Text:=ReplaceText(SQL,'MYVALUE',myvalue); If you speak about a PSQL you can use a SQL STATEMENT procedure whatever(myvalue : VARCHAR(160)) as Declare variable STMT varchar(1024); begin STMT='SELECT * WHERE MY FIELD IN ('|| : MYVALUE||')'; FOR EXECUTE STATEMENT STMT INTO <list of output field> DO SUSPEND; end; But, in this case, it's to you to check SQL is correct and myvalue parameter good

I don't think there are much. I wrote some in French (https://delphi.developpez.com/tutoriels/firemonkey/intro-styles-firemonkey-xe4/) and I wrote also tips in my French blog https://www.developpez.net/forums/blogs/138527-sergiomaster/. But my predilection subject is more TListview than TListBox. It's true that I am thinking writing an opus on these 2 components, but it is a long process I can't insert in my professional agenda. I still have some problems with TListview, adding some more delay (and chapter) to the goal

Ok so, if backup is like the Firebird one, emptying garbage, I guess you have some problems with transactions

SELECT DISTINCT slm.sma2_log_merged_idno FROM sma2_log_merged slm INNER JOIN sma2_message sm ON sm.sma2_message_idno = slm.sma2_message_idno INNER JOIN sma2_plant sp ON sp.sma2_plant_idno = slm.sma2_plant_idno WHERE ((slm.forget_until IS NULL) OR (slm.forget_until<CURRENT_DATE)) AND (slm.deleted=FALSE) AND (slm.afgehandeld=FALSE) AND (((slm.datetime_end>= '2021-12-03') AND (slm.leeftijd_in_dagen>=2)) OR (slm.is_alarm=TRUE)) AND ((sm.ignore=FALSE) OR (slm.is_alarm=TRUE)) AND ((sp.ignore_untill IS NULL) OR (sp.ignore_untill<CURRENT_DATE)) --AND (sp.deleted_for_me=FALSE) AND (NOT (sp.deleted_for_me=TRUE)) Try this one too, I am not certain that using where condition in jointures is a good idea

You mean how to assign event? Ok, let me show you 2 methods in the same code private { Private declarations } procedure ItemApplyStyleLookup(Sender: TObject); procedure ItembuttonClick(Sender : TObject); procedure ItemSpeedButtonClick(Sender : TObject); public { Public declarations } end; var Form1: TForm1; implementation {$R *.fmx} uses System.Rtti; procedure TForm1.AddItembtnClick(Sender: TObject); Var ListBoxItem: TListBoxItem; begin // First, we create an empty ListBoxItem with no parent ListBoxItem := TListBoxItem.Create(self); // now, we set a parent for this item ListBoxItem.BeginUpdate; ListBoxItem.Parent := ListBox1; ListBoxItem.Height := 113; ListBoxItem.Width := 336; ListBoxItem.StyleLookup := 'NewList'; ListboxItem.StylesData['txt']:='Data hello'; ListboxItem.StylesData['button.text']:='Data btn'; ListboxItem.StylesData['speedbtn.text']:='speed btn'; // First Method, using onApplyStyleLookup ListBoxItem.OnApplyStyleLookup:=ItemApplyStyleLookup; ListBoxItem.StylesData['button.tag'] := ListBox1.Items.Count-1; // to get itemindex // Second method, direct with StylesData ListBoxItem.StylesData['speedbtn.tag'] := ListBox1.Items.Count-1; // to get itemindex ListBoxItem.StylesData['speedbtn.OnClick'] := TValue.From<TNotifyEvent>(ItemSpeedButtonClick); ListBoxItem.ItemData.Bitmap.LoadFromFile('D:\XE8\icons8-planète-terre-48.png'); ListBoxItem.EndUpdate; end; procedure TForm1.ItemApplyStyleLookup(Sender: TObject); var CustButton : TCustomButton; img : Timage; circle : TCircle; begin custButton:=TListboxItem(Sender).FindStyleResource('button') as TCustomButton; if assigned(custbutton) then custButton.OnClick:=ItembuttonClick; end; procedure TForm1.ItembuttonClick(Sender: TObject); begin ShowMessage('Click on Button '+TCustomButton(Sender).Tag.ToString); end; procedure TForm1.ItemSpeedButtonClick(Sender: TObject); begin ShowMessage('Click on SpeedButton '+TCustomButton(Sender).Tag.ToString); end; Still working on image, thinking about a mask But, consider changing your mind. Instead of a TListBox and style you can use a VerticalScrollBox and Frame

I use some of these CData Drivers. No, these are derivation of FireDAC.Phys.ODBCBase.pas and FireDAC.Phys.ODBC.pas and some registering classes FDPhysManager().RegisterRDBMSKind FDPhysManager().RegisterDriverClass

listboxitem.stylesdata['Btn.text']:='btn Hello'; I think there is also a way to fit image in the circle (fill.bitmap) but I still investigate

Well there is LIST but, I am not sure you agree the result (even if you can work with via a TStringList) PIVOT, I don't think it's supported even in FB4. I see that it is a view, don't you think that using the original table should be better? NOTE : Please for SQL questions, furnish a script for creating table, and filling it. Something like CREATE TABLE TESTHO( ITEMNO VARCHAR(10), WHNO INTEGER, INCOME INTEGER, OUTGO INTEGER); COMMIT; INSERT INTO TESTHO VALUES('AAA',1,10,0); INSERT INTO TESTHO VALUES('AAA',2,20,0); INSERT INTO TESTHO VALUES('AAA',3,30,0); INSERT INTO TESTHO VALUES('AAA',3,0,10); this to avoid us the "coding" for the test. With LIST you can do something like SET TERM !! ; EXECUTE BLOCK RETURNS ( ITEMNO VARCHAR(10), TOTAL INTEGER, WHNOS VARCHAR(250), QTYS VARCHAR(250) ) AS BEGIN SELECT ITEMNO,SUM(INCOME-OUTGO) FROM TESTHO GROUP BY ITEMNO INTO ITEMNO,TOTAL; WITH C AS (SELECT ITEMNO,WHNO, SUM(a.INCOME-a.OUTGO) Q FROM TESTHO a GROUP BY ITEMNO,WHNO) SELECT LIST(WHNO,';'),LIST(Q,';') FROM C a GROUP BY ITEMNO INTO WHNOS,QTYS; SUSPEND; END!! SET TERM ; !! And obtain ITEMNO TOTAL WHNOS QTYS AAA 50 1;2;3 10;20;20 but your test data is too small and don't expect order in both lists always correct

I had this problem long time ago but don't remember how I manage it! Indeed, a test with D10 reproduces this behavior (I only had to change a few lines of your program, and use default style removing default, renaming windows 7 to blank -> default). If you read French (google trad can be a friend), I wrote a tutorial long time ago (https://delphi.developpez.com/tutoriels/firemonkey/intro-styles-firemonkey-xe4/). Ideas : Try yo use standard stylenames i.e. txt,icon (especially this one) mystyle : here icon and text can be accessed via ListboxItem.StylesData['txt']:='Data hello'; ListBoxItem.ItemData.Bitmap.LoadFromFile('D:\XE8\icons8-planète-terre-48.png'); As you can see, stile using findstyleresource coding it works better (only speedbutton hidden) but if you code (here, I test my new style) ListboxItem.StylesData['button.text']:='Data btn'; ListboxItem.StylesData['speedbtn.text']:='speed btn'; instead of sequence // Itembtn := ListBoxItem.FindStyleResource('button') as TSpeedButton; // if Assigned(Itembtn) then // Itembtn.Text := 'Btn Hello!'; the whole stuff works as expected. Nowadays, I use more often Listview (dynamic appearance) than ListBox, Writing this other tutorial, I bang another time in this "empty object problem" I override also playing with link (disabling/enabling) and not only with the BeginUpdate/EndUpdate. However I never tested with the new versions to find out if this potential bug had been fixed.

And what method did you use finally ?

As other alternatives Step by Step - using fdbatchmove (during design time that's work, using fdbatchmove context menu) - extracting data in SQL insert statements

I will, but not for now, my applications involving REST (linking Prestashop to my home-maid ERP shoes factory business) are functional without this suffix thing But thanks for the offer. Returning to Firebird 4 things. I installed it (dual install on another port than 3050) but only test with Flamerobin. I'll take some time to connect a database with Firedac, but I am not certain if the good fbclient.dll should be used except in an embedded way

As I (but the replay). I use Rest for quite a while, but I was not aware of that suffix property 😮. I still have some difficulty with the usage of this thing (better that parameters I think ?) I am not so far in your book (the priority chapters for me were Livebindings and FMX Styles)

And when did Firedac will support Firebird for Android? Actually, Unidac can (it's just a little hard to deploy Firebird correctly)! I am not an Interbase fan, especially when I found that Interbase don't have windowing functions Oh, I also asked a question about Firebird with same behaviour : ignored. Don't know if I made a mistake with webinar or there was an Embarcadero filter

Please, when you post a question like this, don't forget to give us table description and in which context (Delphi+Component, GUI etc.! An advice : Get the Firebird 4.0 migration guide https://www.firebirdnews.org/migration-guide-to-firebird-4/ or read short version here I think that one problem is how you have migrated your Interbase BDD to Firebird and I persist, in my mind, version 3 would have been a better target As Vandrovnick said typecasting should a solution but try also a ROUND function (especially if QTY is not an integer) SELECT ID, ROUND(UPRICE * QTY,2) PRICE -- To test FROM TABLE1 Note : did you test without parenthesis? SELECT ID,UPRICE*QTY PRICE FROM TABLE1

firebird .conf says # ---------------------------- # External Function (UDF) Paths/Directories # # UdfAccess may be None, Full or Restrict. If you choose # Restrict, provide ';'-separated trees list, where UDF libraries # are stored. Relative paths are treated relative to the root directory # of firebird. # # Since FB4.0 default value is None. Set it to 'Restrict UDF' to have # the same restrictions as in previous FB versions. To specify access # to specific trees, enum all required paths (for Windows this may be # something like 'C:\ExternalFunctions', for unix - '/db/udf;/mnt/udf'). # # NOTE: THE EXTERNAL FUNCTION ENGINE FEATURE COULD BE USED TO COMPROMISE # THE SERVER/HOST AS WELL AS DATABASE SECURITY!! # # IT IS STRONGLY RECOMMENDED THAT THIS SETTING REMAINS NONE! # # Type: string (special format) # #UdfAccess = None First change is to uncomment (removing #) last line and say UdfAccess = Restrict UDF as wrote line 10 (pointing the dir_udf directory C:\Program Files\Firebird\Firebird_4 _0\UDF) or indicate directories like indicated below line 10 UdfAcess=C:\interbase\UDF;C:\MyUDF .... If you make a non customed install of Firebird 4.0 you should see the UDF directory don't exist, and no udflib dll copied AS I said if you want a near Interbase Firebird use version 3

By the way, don't forget to indicate the GUI (or other) you use for the SQL. With FlameRobin (I guessed) you need these SET TERM, but with IBExpert it wouldn't have been necessary.

Hi, First, know that : there are many internal functions in Firebird SUBSTR should be replaced advantageously by SUBSTRING (even if a little more "verbose" syntax) Udf are deprecated in Firebird 4.0 (P.S. don't ask me about UDR, I am still with 2.5 in production, 3 running only for test, 4 only installed) read 5.10 chapter of Firebird 4.0 Language reference In my mind, Firebird 3 is closer Interbase For the declaration of the UDF, I think you have to first check firebird .conf file (default parameter “UdfAccess” set to “None” ) , UDFs directories and bitness of the library also involved

Use SET TERM SET TERM $ ; CREATE PROCEDURE CUSTITEMMOVEMENT ( CUSTNO INTEGER ) RETURNS ( RNO INTEGER, TNAME VARCHAR(5), TDATE DATE, DOCNO VARCHAR(12), QTY NUMERIC(18, 2), NETPRICE NUMERIC(18, 4), ITEMNO VARCHAR(20), ITEMNAME VARCHAR(40) ) AS BEGIN FOR SELECT IM.RNO,IM.TNAME,IM.TDATE,IM.DOCNO,IM.QTY, IM.NETPRICE,IM.ITEMNO, IT.ITEMNAME FROM ITEMMOVEMENTS IM JOIN ITEMS IT ON IT.ITEMNO=IM.ITEMNO WHERE (IM.CUSTNO= :CUSTNO) ORDER BY IM.TDATE, IM.DOCNO INTO :RNO,:TNAME,:TDATE,:DOCNO,:QTY,:NETPRICE,:ITEMNO,:ITEMNAME DO SUSPEND; END $ SET TERM ; $ By the way, don't use quotation marks except if you want columns names to be case-sensitive and, for purpose of maintenance I suggest you not to name your columns xxxNO if type is not a number

Yes, but if I do so, it's because the AIndex argument of OnDelete event is always 0 ! (what a strange thing no ?)

Hi, No, the image I post was a "classic" ImageListItemRightButton Item appearance (with TextButton visible) , and ImageListItemRightButtonDelete for the ItemEdit appearance. The "access error", I got it when I try to use a ListView1.DeleteItem(AItem.Index); beforehand declared as an helper (only way I found to raise OnDelete/Ondeleting event with touch input unavailable. TListViewHelper = class helper for TListView public function DeleteItem(const ItemIndex: Integer): Boolean; end; { TListViewHelper } function TListViewHelper.DeleteItem(const ItemIndex: Integer): Boolean; begin inherited; end; And using the OnButtonClick event of TListView (guilt, the TListItem.MouseUp event) Using the OnItemClick to use DeleteItem procedure TForm1.ListView1ItemClick(const Sender: TObject; const AItem: TListViewItem); begin ListView1.DeleteItem(AItem.Index); end; I have no "access error" Sorry, it was an "argument out of range" not an "access violation" (guilty TListItemView.GetObject). My test (on Android), shows me that if there is only one item (the one to delete) this exception does not raise. Yes, perhaps a bypass but in wich event ?

So, I test this on Android. @Tang I can submit you this solution Add a private variable (in my code key : integer;) procedure TForm1.ListView1DeleteItem(Sender: TObject; AIndex: Integer); begin if FDMemtable1.Locate('id',key) then fdmemtable1.Delete; // delete the record end; procedure TForm1.ListView1DeletingItem(Sender: TObject; AIndex: Integer; var ACanDelete: Boolean); begin key:=listView1.Items[aIndex].Tag; // get the key to delete ACandelete:=true; end; But, yes, there is one, I think there is a bug I wrote in the prior post :

Ok, but I try this on a windows pc how can I "simulate" this wipeleft ? On another hand, with a "classic" windows app (D11 Alexandria). I found that Deleting last item of the list raise an 'access violation' ! procedure TForm1.LinkListControlToField1FilledListItem(Sender: TObject; const AEditor: IBindListEditorItem); begin (AEditor.CurrentObject as TListItem).Tag := FDTable1.FieldByName('ID').AsInteger; end; procedure TForm1.ListView1ButtonClick(const Sender: TObject; const AItem: TListItem; const AObject: TListItemSimpleControl); begin if FDtable1.Locate('Id',AItem.Tag) then FDtable1.Delete; end;