-
Content Count
311 -
Joined
-
Last visited
-
Days Won
1
Posts posted by Serge_G
-
-
Why don't you use firebird's installer ? You have an option to install only client.
-
Hi,
What do you mean ? Something like this ?
An item with a height depending on the text size
You can find the source of this one here https://github.com/Serge-Girard/FMXListView10.4.2, object of a RSP https://quality.embarcadero.com/browse/RSP-33360.
- 1
-
2 minutes ago, Hugo Bendtner said:I was fearful that I may have to extend the TControlList class, and that looks to be what you've done, because bizarrely the most useful functions are private
Yes, I was a little disappointed with all those needed private functions but was too lazy to suggest changes in the Quality portal
-
-
Hi,
Firedac and SQLite. Ok.
You can read this (french) blog post https://www.developpez.net/forums/blogs/138527-sergiomaster/b9985/firedac-sqlite-ajout-fonctions/ to know how to add a TFDSQLiteFunction (english video included)
SQlite function should be something like
procedure TForm131.SimilarToCalculate(AFunc: TSQLiteFunctionInstance; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject); var Match: TMatch; begin Match := TRegEx.Match(AInputs[0].AsString, AInputs[1].AsString); if Match.Success then Aoutput.Asboolean:=true else AOutput.AsBoolean:=False; end;
Query like (for your demand)
SELECT * FROM MYTABLE WHERE SIMILAR(RecipeTitel,'(?i-msn-x).*/sgreen/s.{4}/segg/s.*)=1
Here is a little demo
Now it's up to you to create 'good' expressions
- 1
-
Hi, the first thing you have to give us is : Database ? Your message is partly incomprehensible without this info.
I think you are searching the word regular expressions unit system.regularexpressions
find "green" within 4 of "egg" you can translate by an expression, something like this one
(?i-msn-x:).*/sgreen/s.{4}/segg/s.*
Expresso Screenshot
NB. I don't understand this story about Rubicon.
1- Considering you use Firedac ?
2- Database :
- SQLite ? If so you can, let say, "append" functions to the database (see Extending SQLite Engine Custom Functions Chapter) and then your function can use regexpressions
- Firebird ? regular expressions can be used using SIMILAR TO
- 1
-
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
- 1
-
5 hours ago, Dany Marmur said:I do not think you can do that at all
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
-
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 ?
-
13 hours ago, xorpas said:tuto For a complete Using And access To Listboxitem ?
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
- 1
-
24 minutes ago, mvanrijnen said:The test DB is a database which get restored everynight from a backup from the productiondb.
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
- 1
-
16 hours ago, xorpas said:Thank you VM , sorry men How about click button
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
- 2
-
I use some of these CData Drivers.
8 hours ago, Lachlan Gemmell said:did CData have to get specific code changes made by Embarcadero in FireDAC for their drivers
No, these are derivation of FireDAC.Phys.ODBCBase.pas and FireDAC.Phys.ODBC.pas and some registering classes
FDPhysManager().RegisterRDBMSKind FDPhysManager().RegisterDriverClass
- 1
-
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
- 1
-
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;20but 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.
- 2
-
And what method did you use finally ?
-
-
12 hours ago, corneliusdavid said:We could start a new topic to discuss this if you want.
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
-
18 hours ago, Carlos Tré said:I watched a replay of you session and would like to thank you
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
11 hours ago, Lajos Juhász said:It seems hard to believe, but I've just asked the same question in DelphiCon's session on FireDAC Q&A and was completely ignored.
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
- 1
-
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
QuoteExtracted from Firebird 4.0 migration guide :
Some programming languages, components, and access drivers may not support Firebird 4’s new data types.
For example,.... when we try to open a query that accesses a table with decfloat fields using a version of the IBObjects component that (so far) does not support decfloat you get an unsupported type column error
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
Firebird 3 Client Installation
in Databases
Posted
By the way, if you want to install Firebird using another installer (or the installer of your app) you can read this FAQ http://www.firebirdfaq.org/faq193/