Jump to content

Serge_G

Members
  • Content Count

    321
  • Joined

  • Last visited

  • Days Won

    1

Everything posted by Serge_G

  1. Serge_G

    Create a bitmap of selected control?

    Ah, I knew I faced this GetItemRect somewhere ! It was when I compare the new VCL TControlList to FMX.TListView. In fact, I was deploring the lack of the method (not lack but private one) GetItemRect (I found in FMX.TListview) in the VCL.TControlList Was not so old finally, but other context . (webinaire sur TControlList partie sur le dragdrop) I quickly check and "joy" got the same results No mousemove event will fire, I think. And tracking the movement of the finger should be a real challenge
  2. Serge_G

    Interbase - Update & Select

    Hi, I have to put water in my wine even though it's a wine heresy I just read that the interbase 2020 update 2 allows recursive CTEs https://docwiki.embarcadero.com/InterBase/2020/en/What's_New_in_InterBase_2020_Update_2 so I do a first try (with firebird) not a good one SQL but as first attempt not so bad WITH RECURSIVE R AS (SELECT CUSTNO,1 AS LNo,Item,Price FROM TABLE_1 UNION all SELECT r.CUSTNO,r.LNo+1,Item,Price FROM R WHERE r.LNo< (SELECT COUNT(*) LINES FROM TABLE_1 WHERE CUSTNO=r.CUSTNO) ) SELECT CUSTNO,LNO,item,price FROM r Give me a first look, not a good one but an approximation
  3. Serge_G

    Create a bitmap of selected control?

    Note : in case of headers/footers a loop in the items till item index shall certainly do the job. My question : what event will you used to detect drag mode ?
  4. Serge_G

    Create a bitmap of selected control?

    I don't found the source I had in mind, but ... If there are no headers or footers procedure TForm1.ListView1ItemClick(const Sender: TObject; const AItem: TListViewItem); begin if AItem.Purpose=TListItemPurpose.None then begin memo1.Lines.Clear; memo1.Lines.Add('Item width '+(Listview1.width).ToString); memo1.Lines.Add('real Item width '+(Listview1.width-Listview1.ItemSpaces.Left-ListView1.ItemSpaces.Right).ToString); memo1.Lines.Add('Item Height '+Listview1.ItemAppearance.ItemHeight.toString); memo1.Lines.Add('real Item height '+(Listview1.ItemAppearance.Itemheight-Listview1.ItemSpaces.top-ListView1.ItemSpaces.bottom).ToString); memo1.Lines.Add('cursor '+Listview1.ScrollViewPos.ToString); memo1.Lines.Add(' Item toppos in list '+(AItem.index*Listview1.ItemAppearance.ItemHeight-Listview1.ScrollViewPos).ToString); memo1.Lines.Add(' real Item toppos in list '+(AItem.index*Listview1.ItemAppearance.ItemHeight- Listview1.ScrollViewPos+Listview1.ItemSpaces.top).ToString); end; end; With this, it's easy to make a bitmap extracted from ListView1.MakeScreenShot like this procedure TForm1.ListView1ItemClick(const Sender: TObject; const AItem: TListViewItem); var aBitmap : TBitmap; rect : Trect; begin if AItem.Purpose=TListItemPurpose.None then begin Rect:=TRect.Create(TPoint.Zero); Rect.Left:=Trunc(ListView1.ItemSpaces.Left); Rect.Top:=trunc(AItem.index*Listview1.ItemAppearance.ItemHeight-Listview1.ScrollViewPos+Listview1.ItemSpaces.top); Rect.Right:=Rect.Left+Trunc(Listview1.width-ListView1.ItemSpaces.Right); Rect.Bottom:=Rect.Top+Trunc(Listview1.ItemAppearance.Itemheight-ListView1.ItemSpaces.bottom); aBitmap:=TBitmap.Create; try aBitmap.Width:=Rect.Width; abitmap.Height:=Rect.Height; aBitmap.CopyFromBitmap(Listview1.MakeScreenshot,Rect,0,0); aBitmap.SaveToFile('itemtest.bmp'); finally abitmap.Free; end; end; end; result : Ok, I just forget to discount Scrollbar width, but that's the idea
  5. Serge_G

    Create a bitmap of selected control?

    Yes, even if I don't remember how I proceed. I will look for in my ('old') sources code tests. I remember there are some private properties but, but these memories are polluted by more recent tests on VCL.TControlList (sorry) As soon as I find these sources, I come back.
  6. Serge_G

    Interbase - Update & Select

    Well, I install Interbase and was rather disappointed! No context variables (a bypass : using a temporary table) nor windows functions . I don't investigate for Recursive CTE, but I am afraid there is not. How can that be possible as of today? I understand more Ann Harrison mother of Interbase/Firebird point of view. As quick as I install Interbase, I desinstall it 😖 really disappointed. I have no doubt there are good things in Interbase but my way is now Firebird (event if missing some crypto columns)
  7. Serge_G

    Interbase - Update & Select

    CTE, ok, but windows functions ? I am really disappointed if Interbase don't applies new SQL standard. Time is the key word, if I have some in future week I will install manually (because of 3050 port) Interbase 2020 Delphi version just to check what's new But there are some comparisons available (not commercial Embarcadero ones) https://db-engines.com/en/system/Firebird%3BInterbase or you can read https://ib-aid.com/en/articles/differences-between-firebird-and-interbase/ vs https://www.embarcadero.com/fr/products/interbase/compare/interbase_firebird And make a choice Well I do that years ago and had no problem with
  8. Serge_G

    Interbase - Update & Select

    Well, with Firebird it is, using variable context (old way). I do not remember if Interbase had this capacity (guess yes) P.S. By the way, what is your Interbase version ? SELECT CUSTNO, rdb$get_context('USER_TRANSACTION', 'row#') as LINENO, rdb$set_context('USER_TRANSACTION','row#', coalesce(cast(rdb$get_context('USER_TRANSACTION', 'row#') as integer), 0) + 1), ITEMNO, PRICE FROM table-1 ORDER BY CUSTNO But you need to add some context variable to check and reset to 1 when changing of CUSTNO New ways - Recursive Common Table Expression (I will not expand because best way is below) - Windows function SELECT CUSTNO, ROW_NUMBER() OVER (partition by CUSTNO) LINENO, ITEM, PRICE FROM TABLE_1 ORDER BY CUSTNO I suggest you to search in Interbase (version ?) documentation with these two terms By the way, I suggest you a best way to ask a SQL question : add a script CREATE TABLE table_1 ( CUSTNO INTEGER NOT NULL, ITEM CHAR(2), PRICE NUMERIC(10,2) ); INSERT INTO TABLE_1 VALUES (1,'AA',100); INSERT INTO TABLE_1 VALUES (1,'BB',150); INSERT INTO TABLE_1 VALUES (2,'AA',100); INSERT INTO TABLE_1 VALUES (2,'CC',200); INSERT INTO TABLE_1 (CUSTNO, ITEM, PRICE) VALUES ('3', 'BB', '150.00'); INSERT INTO TABLE_1 (CUSTNO, ITEM, PRICE) VALUES ('3', 'AA', '100.00'); INSERT INTO TABLE_1 (CUSTNO, ITEM, PRICE) VALUES ('3', 'CC', '200.00'); and then the expected result (ok, here I cheat it's the result of the windows function SQL using the data I used
  9. Serge_G

    Interbase Update

    What if you use a trigger BEFOREUPDATE on table Master ?
  10. Serge_G

    TListView OnItemClick problems

    I don't have any Apple devices but on Androïd OnItemClick works fine. for IOS : what about onTap or Gesture management
  11. Serge_G

    Vcl to Fmx

    My preference goes to Grid rather than StringGrid, but I prefer a ListView Agree sjordi, VCL components are poor if you compare. i.e a VCL app use Tpanel, a FMX app will use Layout or TRectangle
  12. Serge_G

    TListView first and last item visible

    IMHO if your listview only have items not resized you can use ScrollViewPos property and perhaps the ScrollViewChange event var first, last : integer; begin first:=Trunc(listview1.ScrollViewPos/listview1.ItemAppearance.ItemHeight); Last:=First+Trunc(ListView1.Height/listview1.ItemAppearance.ItemHeight); memo1.lines.add(Format('First %d Last %d',[first,last])); If you have a TSearchbox visible I think it's easy to take care of it (using Searchbox unit to get the height) If you have groups or variable height items this should be harder but still using ScrollViewPos I think it's playable, you "just" have to calc from top, cumulate all items height till reaching ScrollViewPos for first and ScrollViewPos+ListView.Height for last
  13. Serge_G

    TListView Paging

    Hi, Well, logic, yes. Depending on the REST API server function. On another side a TListview (livebinded) for only 10 records a VerticalScrollbox filled by code should be a good alternative, IMO getting previous page and next page (30 records) during thread process should be better
  14. Serge_G

    FMX TListView with dynamicappearance. Create progress bar as bitmap.

    Hi Sorry but, I think we don't play in the same playground. For me, a TListView is used with Livebindings to fill it with data coming from a data source (table, query or list of Object). You use it like a TListBox! With a TListBox it's easy to put in a style whatever you want (in this case a text and a progress bar). By the way, your code is more for this kind of component, Create a style (layout, ttext, progressbar) just to adapt your code in the "for FR in FArray do" loop set the style of the created item item.stylelookup:='mystyleprogress' insert an item.applystylelookup change access to the objects of the item
  15. Serge_G

    FMX TListView with dynamicappearance. Create progress bar as bitmap.

    Hi, if you mean something like this (my first try) I use this code unit UnitProgess; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, Data.Bind.GenData, System.Rtti, System.Bindings.Outputs, FMX.Bind.Editors, Data.Bind.EngExt, FMX.Bind.DBEngExt, Data.Bind.Components, Data.Bind.ObjectScope, FMX.ListView, Fmx.Bind.GenData; type TForm18 = class(TForm) ListView1: TListView; PrototypeBindSource1: TPrototypeBindSource; BindingsList1: TBindingsList; LinkListControlToField1: TLinkListControlToField; procedure ListView1UpdateObjects(const Sender: TObject; const AItem: TListViewItem); private { Déclarations privées } public { Déclarations publiques } end; var Form18: TForm18; implementation {$R *.fmx} procedure TForm18.ListView1UpdateObjects(const Sender: TObject; const AItem: TListViewItem); var pBitMap: TBitmap; // for further purpose pListItemImage : TListItemImage; begin if AItem.Purpose = TListItemPurpose.None then begin pListItemImage:=AItem.Objects.FindObjectT<TListItemImage>('ProgressBar'); if assigned(pListItemImage) then begin pListItemImage.Bitmap.Width:=400-(abs(PrototypeBindSource1.DataGenerator.FindField('intfield1').GetTValue.AsInteger)*10); pListItemImage.Bitmap.Clear(Talphacolors.RED); end; end; end. Quick designed But I shall investigate more because this "version" need a link to (bitmap1 -> Item.ProgressBar) I was enabled to add a bitmap directly (PlistItemImage is unassigned if there is no link)
  16. Hi I am trying to split an Image stored in a first TImageList into a second TImageList all my attempts to access a multiresbitmap contained in a TImagelist show an error on program exit TImageListHelper = class helper for TImageList function Add(aBitmap: TBitmap): integer; end; var Form18: TForm18; implementation {$R *.fmx} uses FMX.MultiResBitmap; procedure TForm18.Button1Click(Sender: TObject); var sbitmap, pBitmap: TBitmap; vSource: TCustomSourceItem; vBitmapItem: TCustomBitmapItem; vDest: TCustomDestinationItem; begin Images.ClearCache; Images.BeginUpdate; if Images.Destination.Count > 0 then Images.Destination.Clear; vSource := ImageList1.Source.Items[1]; vBitmapItem := vSource.MultiResBitmap.ItemByScale(1, True, True); sbitmap := vBitmapItem.Bitmap; pBitmap := TBitmap.Create(100, 100); try for var l := 0 to 3 do for var c := 0 to 3 do begin var r: TRect := TRect.Create(pBitmap.Width * c, pBitmap.Height * l, pBitmap.Width * c + pBitmap.Width, pBitmap.Height * l + pBitmap.Height); pBitmap.CopyFromBitmap(sbitmap, r, 0, 0); Images.Add(pBitmap); end; finally pBitmap := nil; // if not an EAccessViolation exception raised when program close pBitmap.Free; end; Images.EndUpdate; end; { TImageListHelper } function TImageListHelper.Add(aBitmap: TBitmap): integer; const SCALE = 1; var vSource: TCustomSourceItem; vBitmapItem: TCustomBitmapItem; vDest: TCustomDestinationItem; vLayer: TLayer; begin result := -1; if (aBitmap.Width = 0) or (aBitmap.Height = 0) then exit; // add source bitmap vSource := Source.Add; vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia; vSource.MultiResBitmap.SizeKind := TSizeKind.Source; vSource.MultiResBitmap.Width := Round(aBitmap.Width / SCALE); vSource.MultiResBitmap.Height := Round(aBitmap.Height / SCALE); vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True); if vBitmapItem = nil then begin vBitmapItem := vSource.MultiResBitmap.Add; vBitmapItem.SCALE := SCALE; end; vBitmapItem.Bitmap.Assign(aBitmap); vDest := Destination.Add; vLayer := vDest.Layers.Add; vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero, vSource.MultiResBitmap.Width, vSource.MultiResBitmap.Height); vLayer.Name := vSource.Name; result := vDest.Index; end; AccessViolation if pbitmap:=nil is omitted >>EAccessViolation exception in module taKinFMX.exe in 00008338 >>Violation of access to the address 00408338 in the module 'taKinFMX.exe'. Reading of the address FFFFFFFC. ... >> The instruction at 0x0000000000408338 uses the memory address 0x00000000FFFFFFFC. Memory state cannot be read. and cause Unexpected Memory Leaks An unexpected memory leak has occurred. The unexpected small block leaks are: 29 - 36 bytes: TD2DBitmapHandle x 1, TBitmapImage x 1 45 - 52 bytes: TBitmap x 1 61 - 68 bytes: Unknown x 1 Where does I go wrong ? Is there another way to split (like during design time) an image ?
  17. Serge_G

    Getting bitmap from an ImageList source

    Take in mind that in the another imagelist (let say the source one) I have various images and the goal is to have the destination list filled with only one of these. I found the problem deeply looking in the code used in the helper. (helper I merged) uses FMX.MultiResBitmap; procedure TForm18.Button1Click(Sender: TObject); const SCALE = 1; var pBitmap : TBitmap; sbitmap : TCustomBitmapItem; vSource: TCustomSourceItem; vBitmapItem: TCustomBitmapItem; vDest: TCustomDestinationItem; vLayer: TLayer; begin Images.ClearCache; Images.BeginUpdate; if Images.Destination.Count > 0 then Images.Destination.Clear; vSource := ImageList1.Source.Items[0]; sbitmap := vSource.MultiResBitmap.ItemByScale(SCALE, True, True); pbitmap:=TBitmap.Create(100,100); try for var l := 0 to 3 do for var c := 0 to 3 do begin var r: TRect := TRect.Create(100*c,100* l, 100*c+100,100*l+100); pBitmap.CopyFromBitmap(sbitmap.Bitmap, r, 0, 0); // add source bitmap vSource := Images.Source.Add; vSource.MultiResBitmap.TransparentColor := TColorRec.Fuchsia; vSource.MultiResBitmap.SizeKind := TSizeKind.Source; vSource.MultiResBitmap.Width := Round(pBitmap.Width / SCALE); vSource.MultiResBitmap.Height := Round(pBitmap.Height / SCALE); vBitmapItem := vSource.MultiResBitmap.ItemByScale(SCALE, True, True); if vBitmapItem = nil then begin vBitmapItem := vSource.MultiResBitmap.Add; vBitmapItem.SCALE := SCALE; end; vBitmapItem.Bitmap.Assign(pBitmap); vDest := Images.Destination.Add; vLayer := vDest.Layers.Add; vLayer.SourceRect.Rect := TRectF.Create(TPoint.Zero, vSource.MultiResBitmap.Width, vSource.MultiResBitmap.Height); vLayer.Name := vSource.Name; end; finally pBitmap.Free; end; Images.EndUpdate; end; And now I can play
  18. Good thing to report it another time because I don't know if EMB report RSP of a version to another one (hope so but ...), even if you should have a "closed : duplicate case" (I'm used to this kind of response when I report one) Yes, there are quite some but decreasing (even if I don't use 10.4 for production, I should make another try with 10.4.2 when I'll be a little less busy). My idea for IDE crashes : LSP is a good thing but need memory, more than 4Mo I recommend 8 minima (I will soon make my HP laptop open-heart surgery to 16 I think) Still mine, and now I am a FMX, LiveBindings fan, all my new desktop pro applications (even if Windows only) are FMX, but the first steps were hard!
  19. Serge_G

    Client Data Set FILTER

    Hi, For me, filter expressions complies only with the old LocalSQL of BDE so no STARTS nor CONTAINING. Usually, I don't use tables, only querys to avoid this problem, and some Query data components have the good idea to offer macros to manage this sort of case
  20. Hi, It's a known and reported bug RSP-16453, till your post I had no idea of this one No idea, except modifying unit containing TWinAcceleratorKeyRegistry
  21. Serge_G

    TListView and Stylebook on 10.4

    I should not be so affirmative. @MarkShark it's a FMX.TListView not a VCL one. @Michele If you think : style of an item like for a FMX.TListBox, yes you can't change Item style. You can only change Appearance and only use one for all the list, The Dynamic appearance is one of the most adaptable. if you think : changing background colors you can You can see above a personalized style, quick done, I only change itembackground.Color and buttontext.Color (listviewappearance = ImageListItemRightButton)
  22. It's a "business layer" so I should say DataModule and perhaps TDataSource on Form Agree with haentschman but "Like" can't be "parametrized". Anyway you have the macro solution https://www.devart.com/mydac/docs/devart.dac.tcustomdadataset.macros.htm So your query should be like this Select * from <tablename> &where and the code and this should respond your second interrogation (you can even use a macro for table name Query.SQl.Text := 'select Bla from Bubb &where' Query.MacroByName('where').AsString := Format('WHERE FIELD1 LIKE %s AND FIELD2 LIKE %s',[QuotedStr('%'+value1+'%'),QuotedStr('%'+value2+'%')]); Query.Open;
  23. Serge_G

    TListView different background color for each item

    It depends on whether you are using a dynamic skin or not. I wrote a few posts and tutorials (in French) on the subject. Anyway if you can't read French, googletrad should be your friend blog : https://www.developpez.net/forums/blogs/138527-sergiomaster/ tutorials list : https://serge-girard.developpez.com/ in my mind this one https://serge-girard.developpez.com/tutoriels/Delphi/Livebindings/ListView/
  24. Serge_G

    fmx grid error

    Hi, I was afraid of, but no, I wrote a quick test (I don't use Grid often) and my conclusion is : no problem found.
  25. Hi, Maybe this is the same problem as arabic, a font problem and not a database problem. I don't remember in which post I saw that, but I remember changing some emb. units did the trick for arabic. ( changing those 3 files FMX.TextLayout.GPU, FMX.FontGlyphs and FMX.FontGlyphs.Android. )
×