Jump to content

Serge_G

Members
  • Content Count

    315
  • Joined

  • Last visited

  • Days Won

    1

Everything posted by Serge_G

  1. Serge_G

    Which version BDE

    You mean DBD32.Exe and the 2 errors about directories? Well, I don't use, it but you have to know some clues The location of the BDE "Working" and "Private" directories are stored in HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\WorkDir and HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\PrivDir respectively. Each directory default value stores the data containing So my first suggestion is to check this. Other solution is to install D7 with the same hints as BDE (but you will get some trouble with coexistence, I ran into during a demo, TClientDataset) and use the DBD32.exe of this version. But, I have a doubt, if you need this old program, did you mean that you still use Paradox/DBase tables?
  2. Serge_G

    Which version BDE

    But BDE 5.2.0.2 is one of the last versions (remember deprecated for 20 years an not updated) It's easy to install BDE on Win 10 if you respect some hints. - don't install in the default directory (c:\progran files (x86)) but in a non-secured by UAC windows directory - run BDEAdmin as administrator - change NETDIR of paradox (see picture, from my w10 pc) - change memory size and address (depending on tour computer) - save IDAPI32.CFG to a non-secured by UAC windows directory and confirm it should be the default configuration file dialog when you exit BDE Even so, you will run into some problems from time to time (I suspect windows update) By the way, it's first time I check my version is
  3. Serge_G

    Which version BDE

    Yes You have a tool to migrate from BDE Components to Firedac ones : "refind" (C:\Users\Public\Documents\Embarcadero\Studio\22.0\Samples\Object Pascal\Database\FireDAC\Tool\reFind) You will find some step to step migration in docwiki (https://docwiki.embarcadero.com/RADStudio/Sydney/en/ReFind.exe,_the_Search_and_Replace_Utility_Using_Perl_RegEx_Expressions) But, before this, you have to go on your registered product portal and download BDE for your version. By experience even if it works, I prefer to create new Firedac components (connection, table and query) because Firedac is more powerful than BDE (i.e. macros)
  4. Serge_G

    error on Interbase 2020 server

    Well, in fact Interbase 2017 had non recursive CTE possiblities (named derived table) Good news to have now recursive ones, and can we expect in a near future, windows functions?
  5. 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/
  6. Serge_G

    Firebird 3 Client Installation

    Why don't you use firebird's installer ? You have an option to install only client.
  7. 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.
  8. 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
  9. 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
  10. 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
  11. 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
  12. 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. 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
  14. 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
  15. 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
  16. 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
  17. 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
  18. 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
  19. 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
  20. 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
  21. 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
  22. 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.
  23. Serge_G

    IB -> FB Data Transfer

    And what method did you use finally ?
  24. 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
  25. 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
×