Jump to content

Serge_G

Members
  • Content Count

    311
  • Joined

  • Last visited

  • Days Won

    1

Everything posted by Serge_G

  1. Serge_G

    Firebird 3 Client Installation

    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/
  2. Serge_G

    Firebird 3 Client Installation

    Why don't you use firebird's installer ? You have an option to install only client.
  3. Serge_G

    How to make ListView items multiline?

    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.
  4. Serge_G

    TControlList - Jump to Selected

    Yes, I was a little disappointed with all those needed private functions but was too lazy to suggest changes in the Quality portal
  5. Serge_G

    TControlList - Jump to Selected

    Hi, if you read French (or if you can translate it easily) I wrote some posts, sort of "Deep Diving in TControlList" in my blog starting from this one. I am certain you will find some clues in this post
  6. Serge_G

    search string word by word in table field

    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 Video_2021-12-18_115311.wmv Now it's up to you to create 'good' expressions
  7. Serge_G

    search string word by word in table field

    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
  8. 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 ?
  9. 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
  10. Serge_G

    Firebird3 - WHERE MYFIELD IN : MYVALUE

    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
  11. Serge_G

    Custom ListBox Layout in fmx

    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
  12. Serge_G

    INTERBASE strange performance problem

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

    INTERBASE strange performance problem

    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
  14. Serge_G

    Custom ListBox Layout in fmx

    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
  15. Serge_G

    Third party FireDAC drivers

    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
  16. Serge_G

    Custom ListBox Layout in fmx

    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
  17. Serge_G

    FB3.0 SQL

    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
  18. Serge_G

    Custom ListBox Layout in fmx

    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.
  19. Serge_G

    IB -> FB Data Transfer

    And what method did you use finally ?
  20. Serge_G

    IB -> FB Data Transfer

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

    Delphi/FireDAC and Firebird 4

    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
  22. Serge_G

    Delphi/FireDAC and Firebird 4

    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)
  23. Serge_G

    Delphi/FireDAC and Firebird 4

    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
  24. Serge_G

    Firebird 4.0 Unknown sql type err.

    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
  25. Serge_G

    Firebird 4.0 UDF

    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
×