I am trying to enable the dragging and dropping for TListBoxItems inside a TListBox in FireMonkey. It seems to drag and drop sometimes, but other times it does not even enter the event handler
procedure TForm1.ListBox1DragChange(SourceItem, DestItem: TListBoxItem; var Allow: Boolean);
begin
SourceItem.Index := DestItem.Index;
end;
I have the DragMode as dmManual
object ListBox1: TListBox
Height = 200.000000000000000000
Position.X = 224.000000000000000000
Position.Y = 144.000000000000000000
TabOrder = 1
Width = 200.000000000000000000
AllowDrag = True
Items.Strings = (
'First'
'Second'
'Third'
'Fourth'
'Fifth'
'Sixth')
DefaultItemStyles.ItemStyle = ''
DefaultItemStyles.GroupHeaderStyle = ''
DefaultItemStyles.GroupFooterStyle = ''
OnDragChange = ListBox1DragChange
end
Related
I have a form with at TListBox that I populate in the onCreate event, where I also set the selected item. I want the List Box to have the selected item in view when the form shows, so I tried firing the ScrollToItem method. This does not work. I also tried putting it in OnShow and OnActivate events, but it still does not work. Is there a way to get this to work?
Here is a sample program that illustrates the problem:
`type
TForm5 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.fmx}
procedure TForm5.FormCreate(Sender: TObject);
var
i: Integer;
lbi: TListBoxItem;
begin
for i := 1 to 50 do
begin
lbi := TListBoxItem.Create(ListBox1);
lbi.Text := 'item ' + inttostr(i);
ListBox1.AddObject( lbi );
end;
ListBox1.itemindex := ListBox1.items.indexof('item 48');
ListBox1.ScrollToItem(ListBox1.Selected);
end;
end.`
and the FMX file:
`object Form5: TForm5
Left = 0
Top = 0
Caption = 'Form5'
ClientHeight = 480
ClientWidth = 640
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
DesignerMasterStyle = 0
object ListBox1: TListBox
Position.X = 224.000000000000000000
Position.Y = 144.000000000000000000
TabOrder = 1
DisableFocusEffect = True
DefaultItemStyles.ItemStyle = ''
DefaultItemStyles.GroupHeaderStyle = ''
DefaultItemStyles.GroupFooterStyle = ''
Viewport.Width = 196.000000000000000000
Viewport.Height = 196.000000000000000000
end
end`
TListBox has a property ViewportPosition: TPointF that sets the scrollbars. Add the following line after you set ListBox1.ItemIndex:
ListBox1.ViewportPosition := PointF(0.0, ListBox1.itemindex * ListBox1.ItemHeight);
The previous assumes that all items have the same height (TListBox1.ItemHeight set in Object Inspector or in code earlier). Your FMX file doesn't reflect this, so you may want to add it, otherwise the scrolling will not take place.
You might want to set individual height for the items. In that case you must traverse all items up to the one you want to be selected and sum their heights to get the Y term for the ViewportPosition.
I have several task on button click.
eg.
Show form or please wait panel....
Load data from database (duration 5-10 seconds)
Clear all TEdit field
Hide form or please wait panel....
ShowMessage('completed')
Is it possible After click on button show please wait panel or form and after all completed hide that panel.
How to Synchronize Perform Tasks One by one.
Or any other simple solution.
This is a simple example that creates a "placeholder" which looks like this:
The rectangle has a black background and contains a layout which is aligned to Center; inside you can find a label (aligned to Top) and an arc (aligned to Client). The code is here:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 418
ClientWidth = 490
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
DesignerMasterStyle = 0
object Rectangle1: TRectangle
Align = Client
Fill.Color = xFF222222
Size.Width = 490.000000000000000000
Size.Height = 418.000000000000000000
Size.PlatformDefault = False
Visible = False
object Layout1: TLayout
Align = Center
Size.Width = 170.000000000000000000
Size.Height = 102.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object Label1: TLabel
Align = Top
StyledSettings = [Family, Size, Style]
Size.Width = 170.000000000000000000
Size.Height = 41.000000000000000000
Size.PlatformDefault = False
TextSettings.FontColor = claWhite
TextSettings.HorzAlign = Center
Text = 'Please wait'
TabOrder = 0
end
object Arc1: TArc
Align = Center
Size.Width = 50.000000000000000000
Size.Height = 50.000000000000000000
Size.PlatformDefault = False
Stroke.Color = claCoral
EndAngle = -90.000000000000000000
object FloatAnimation1: TFloatAnimation
Enabled = True
Duration = 1.000000000000000000
Loop = True
PropertyName = 'RotationAngle'
StartValue = 0.000000000000000000
StopValue = 360.000000000000000000
end
end
end
end
end
The Visible property of the rectangle is set to False so that you won't see immediately the rectangle. Note that I have created an animation in the arc component so that you can see it spinning around:
In this way you can mimic a loading spinner. Then I have added this code in the OnCreate event of the form just as example of how you could do this.
procedure TForm1.FormCreate(Sender: TObject);
begin
TTask.Run(procedure
begin
TThread.Synchronize(nil, procedure
begin
Rectangle1.Visible := true;
//Rectangle1.BringToFront;
// ^ call the above if needed, just to be sure
// that you'll always see the rectangle on screen
end);
Sleep(4000);
TThread.Synchronize(nil, procedure
begin
Rectangle1.Visible := false;
ShowMessage('Finish!');
end);
end);
end;
The Sleep(4000) simulates a long task and this piece of code should be replaced with your tasks. Actually I'd do something like this:
procedure TForm1.FormCreate(Sender: TObject);
begin
TTask.Run(procedure
var
arr: array [0..1] of ITask;
begin
TThread.Synchronize(nil, procedure
begin
Rectangle1.Visible := true;
Rectangle1.BringToFront;
end);
arr[0] := TTask.Run(procedure
begin
//load data from the database
end);
arr[1] := TTask.Run(procedure
begin
//something else
end);
//this call is blocking but you are calling this in a worker thread!
//your UI won't freeze and at the end you'll see the message appearing
TTask.WaitForAll(arr);
TThread.Synchronize(nil, procedure
begin
Rectangle1.Visible := false;
ShowMessage('Finish!');
end);
end);
end;
Of course you should place this code in a ButtonClick and not in a FormCreate event handler!
I have custom styled FireMonkey control. Its style contains several levels of nested controls.
I need to access those controls and change some style properties at run-time. To do that I am using FindStyleResource<T> method.
I have no problem in retrieving first level of controls inside style. But accessing controls on second level with FindStyleResource fails if control parent is descendant of TStyledControl.
Question is how to access those nested style controls regardless of their parent type?
Style:
object TStyleContainer
object TLayout
StyleName = 'MyHeader'
Align = Center
Size.Width = 100.000000000000000000
Size.Height = 50.000000000000000000
Size.PlatformDefault = False
Visible = False
TabOrder = 0
object TLabel
StyleName = 'title'
Align = Client
StyledSettings = [Style]
Size.Width = 36.000000000000000000
Size.Height = 50.000000000000000000
Size.PlatformDefault = False
TextSettings.HorzAlign = Center
Text = 'Title'
end
object TLayout
StyleName = 'green'
Align = MostLeft
Size.Width = 32.000000000000000000
Size.Height = 50.000000000000000000
Size.PlatformDefault = False
object TPath
StyleName = 'greenpath'
Align = Fit
Data.Path = {
07000000000000000000404100000041010000000000C0400000604101000000
B81EED405C8F76410100000000004041AE472D410100000052B884415C8F7641
010000000000904100006041030000000000404100000041}
Fill.Color = claGreen
HitTest = False
Size.Width = 32.000000000000000000
Size.Height = 50.000000000000000000
Size.PlatformDefault = False
Stroke.Kind = None
WrapMode = Fit
end
end
object TSpeedButton
StyleName = 'red'
Align = MostRight
Position.X = 68.000000000000000000
Size.Width = 32.000000000000000000
Size.Height = 50.000000000000000000
Size.PlatformDefault = False
object TPath
StyleName = 'redpath'
Align = Fit
Data.Path = {
07000000000000000000404100000041010000000000C0400000604101000000
B81EED405C8F76410100000000004041AE472D410100000052B884415C8F7641
010000000000904100006041030000000000404100000041}
Fill.Color = claRed
HitTest = False
Size.Width = 32.000000000000000000
Size.Height = 32.571426391601560000
Size.PlatformDefault = False
Stroke.Kind = None
WrapMode = Fit
end
end
end
end
Control:
type
TMyHeader = class(TStyledControl)
protected
procedure ApplyStyle; override;
function GetDefaultStyleLookupName: string; override;
end;
procedure TMyHeader.ApplyStyle;
var
LGreen: TLayout;
LGreenPath: TPath;
LRed: TSpeedButton;
LRedPath: TPath;
begin
inherited;
if FindStyleResource<TLayout>('green', LGreen) then
begin
// following call will find greenpath control
if FindStyleResource<TPath>('greenpath', LGreenPath) then
LGreenPath.Fill.Color := TAlphaColorRec.Blue;
end;
if FindStyleResource<TSpeedButton>('red', LRed) then
begin
// following call will fail to find find redpath control
if FindStyleResource<TPath>('redpath', LRedPath) then
LRedPath.Fill.Color := TAlphaColorRec.Blue;
// this variant also fails
if LRed.FindStyleResource<TPath>('redpath', LRedPath) then
LRedPath.Fill.Color := TAlphaColorRec.Blue;
end;
end;
function TMyHeader.GetDefaultStyleLookupName: string;
begin
Result := 'MyHeader';
end;
Original style:
Changed style (only green arrow color was successfully changed)
In ApplyStyle method I can access greenpath from the style and change its color to blue. Hoewever, I cannot get redpath using FindStyleResource method.
The standard way to access style elements is via TFMXObject and iterate the children style objects.
Try this:
procedure TMyHeader.ApplyStyle;
var
objFMX,
inObjFMX: TFMXObject;
LRed: TSpeedButton;
LRedPath: TPath;
begin
inherited;
objFMX:=FindStyleResource('red');
if assigned(objFMX) and (objFMX is TSpeedButton) then
begin
LRed:=objFMX as TSpeedButton;
inObjFMX:=LRed.FindStyleResource('redpath');
if assigned(inObjFMX) and (inObjFMX is TPath) then
begin
LRedPath:=inObjFMX as TPath;
LRedPath.Fill.Color := TAlphaColorRec.Blue;
end;
end
end;
Updated Code: The FindStyleResource does not work in the above code. A different approach is followed below.
procedure TMyHeader.ApplyStyle;
var
objFMX,
inObjFMX: TFMXObject;
LRedPath: TPath;
begin
inherited;
objFMX:=FindStyleResource('red');
if assigned(objFMX) and (objFMX is TSpeedButton) then
begin
for inObjFMX in objFMX.Children do
begin
if inObjFMX is TPath then
begin
LRedPath:=inObjFMX as TPath;
LRedPath.Fill.Color:=TAlphaColorRec.Blue;
Break;
end;
end;
end;
end;
That works on 10.2
I have form (Height = 500) and TVertScrollBox on it (align set to TAlignLayout.Client and range is 5000px). I wrote simple method, which show position of mouse when I click on scroll box.
procedure TformMain.VertScrollBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
ShowMessage(FloatToStr(X) + ' ' + FloatToStr(Y));
end;
When the scroll bar is on top and I click on top of the scroll box, Y in message is 0. That's right. But when I scroll down to the half and click on top of the scroll box, Y in message is 0, too (not 2500). How can I get the position relative to scroll box?
This is my FMX code for TForm and TVertScrollBox:
object formMain: TformMain
Left = 0
Top = 0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = Single
Caption = 'Gear Studio 1.0'
ClientHeight = 600
ClientWidth = 450
Position = DesktopCenter
StyleBook = StyleBookPanel
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnCloseQuery = FormCloseQuery
DesignerMasterStyle = 0
object VertScrollBox1: TVertScrollBox
Align = Client
Size.Width = 450.000000000000000000
Size.Height = 576.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'VertScrollBox1Style1'
TabOrder = 1
OnMouseDown = VertScrollBox1MouseDown
Viewport.Width = 450.000000000000000000
Viewport.Height = 576.000000000000000000
end
...
...
end
That's how I am adding panels:
SetLength(MyItems, i+1);
MyItems[i] := TItem.Create(i);
with MyItems[i] do begin
...
end;
constructor TItem.Create(number: integer);
var
ThisItem: TItem;
begin
inherited Create(nil);
ThisItem := Self;
with ThisItem do begin
if number = -1 then begin
... //not important
end;
end else if number > 0 then begin
Width := 370;
Height := 35;
...
end;
Position.X := 10;
Parent := formMain.VertScrollBox1;
PopupMenu := formMain.PopupMenu1;
OnDblClick := DblClick;
OnMouseEnter := MouseEnter;
OnMouseLeave := MouseLeave;
end;
end;
MyItems is dynamical array of TItem (it is normal TPanel with added some properties).
You need to add VertScrollBox1.ViewportPosition.Y property to get the absolute coordinate.
ShowMessage(FloatToStr(X) + ' ' + FloatToStr(VertScrollBox1.ViewportPosition.Y+Y));
shows correct result.
There are moments that I need to present a message for the user and the length of the message is bigger than the space available.
It does not matter which control to be used, I am looking for a way to know when the text is not fully visible and how to apply a scrolling effect (to be more precise scroll the text to the left slowly until all the hidden text is shown and repeat all over again forever).
I am using Delphi XE7.1
Scrolling marquee in Delphi XE7 using standard RTL controls:
procedure TForm1.Button1Click(Sender: TObject);
begin
FloatAnimation1.Enabled := True;
FloatAnimation1.StartValue := Form1.Width;
FloatAnimation1.StopValue := 0-Label1.Width;
end;
object Label1: TLabel
AutoSize = True
Position.X = 240.000000000000000000
Position.Y = 232.000000000000000000
Size.Width = 37.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
TextSettings.WordWrap = False
Text = 'Label1'
object FloatAnimation1: TFloatAnimation
Duration = 1.000000000000000000
Loop = True
PropertyName = 'Position.X'
StartValue = 0.000000000000000000
StartFromCurrent = True
StopValue = 0.000000000000000000
end
end
object Button1: TButton
Position.X = 248.000000000000000000
Position.Y = 312.000000000000000000
TabOrder = 1
Text = 'Button1'
OnClick = Button1Click
end