Serge_G

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, 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

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

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

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
 

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 

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

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   

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

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 

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 

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

Quote

Extracted 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

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 :

1. there are many internal functions in Firebird SUBSTR should be replaced advantageously by SUBSTRING (even if a little more "verbose" syntax)
2. 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)
3. 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