Dynamic TImage's in dynamic TPanel's? - delphi

OK, I'm trying to create some custom number of TPanel's at runtime on TScrollBox surface like you can see on following image.
To get this I'm using following code and that works fine.
var
pan: array of TPanel;
maxp, i, x, y: Integer;
...
maxp := 10;
SetLength(pan, maxp);
for i := 1 to maxp do begin
// x is correct value; doesn't cause problem
// y is correct value; doesn't cause problem
pan[i-1] := TPanel.Create(form1);
with pan[i-1] do begin
Width := 100;
Height := 150;
Top := x * 151;
Left := y * 101;
Parent := ScrollBox1;
end;
end;
Now, I have problems to put TImage object in every TPanel with same index (img[0] -> pan[0], img[1] -> pan[1], etc). Look at the following image:
Using same logic, I've tried to create TImage's but w/ no success.
I'm using this code and cant figure out what's wrong. It looks so simple to me, but somehow it doesn't provide expected effect.
var
pan: array of TPanel;
img: array of TImage;
maxp, i, x, y: Integer;
...
maxp := 10;
SetLength(pan, maxp);
SetLength(img, maxp);
for i := 1 to maxp do begin
// x is correct value; doesn't cause problem
// y is correct value; doesn't cause problem
pan[i-1] := TPanel.Create(form1);
with pan[i-1] do begin
Width := 100;
Height := 150;
Top := x * 151;
Left := y * 101;
Parent := ScrollBox1;
end;
img[i-1] := TImage.Create(form1);
with img[i-1] do begin
Width := 98;
Left := 1;
Height := 148;
Top := 1;
// in original code next line had img[0]. which caused problem
Picture.LoadFromFile('some_image_file');
Parent := pan[i-1];
end;
end;
Somehow it places all TImage objects on same place in first TPanel (pan[0]). It's confusing for me because it says Parent := pan[i-1]; but for some reason it always puts TImage in pan[0]. I've tried using breakpoints to see what's going on after every for-loop cycle (added Application.ProcessMessages at the end) and it really creates 10 different images but puts them onto pan[0]. Of course, at the end it shows just last image loaded into pan[0].
My question is how to make one dynamic TImage per dynamic TPanel (with same array indices)?
SOLVED!

And word of advice - get rid of the with blocks. They may seem innocent and simple at first, but in the long run they only serve to write sloppy code that is hard to troubleshoot. Had you been using explicit variable references instead, this problem would never had occurred in the first place.
var
  Panels: array of TPanel;
Panel: TPanel;
  Images: array of TImage;
Image: TImage;
  maxp, i, x, y: Integer;
...
maxp := 10;
SetLength(Panels, maxp);
SetLength(Images, maxp);
for i := 1 to maxp do begin
  Panel := TPanel.Create(form1);
Panels[i-1] := Panel;
Panel.Parent := ScrollBox1;
  Panel.SetBounds(...);
  Image := TImage.Create(form1);
Images[i-1] := Image;
Image.Parent := Panel;
Image.SetBounds(...);
  Image.Picture.LoadFromFile('some_image_file');
end;

You set Height twice and no Left, so it seems.
with pan[i-1] do begin
Width := 100;
Height := 150;
Top := x * 151;
Height := y * 101;
Parent := ScrollBox1;
end;

Ah, I found it... how blind I am really...
To get auto-complete in delphi, i've used img[0] in front of Picture.LoadFromFile(). Then, obviously I forgot to remove it from code, and since hour ago that 'prefix' stayed there making all images load into same img[0]. I was sure there's something wrong with Parent or Pos/Size properties and have been focused on this things not caring so much about this.
I actually had
with img[i-1] do begin
Width := 98;
Left := 1;
Height := 148;
Top := 1;
img[0].Picture.LoadFromFile('some_image_file');
Parent := pan[i-1];
end;
But somehow I've removed that img[0] part while posting this question, and haven't seen it as problem in my Delphi code. Obviously, when I was formatting this code, i removed some parts and that made answering my question here impossible :(
Really sorry for bothering you guys, that was my bad.

Related

I want to draw 2 rectangles that superimpose on one another with Windows.FillRect

I want to draw 2 rectangles that superimpose on one another. One of which I want it a smaller size(A) than the other one (B) so that I can view the one at the back(B).
procedure DrawRectangle(drawDC:HDC;cellBrush:TBrush);
var
gridCellRect, gridCellRect1 :Trect ;
begin
gridCellRect.Top := 75;
gridCellRect.Bottom := 150;
gridCellRect.Left := 192;
gridCellRect.right := 200;
SetBkMode(drawDC, OPAQUE);
cellBrush.color := claqua;
Windows.FillRect(DrawDC, gridCellRect, cellBrush.Handle);
gridCellRect1 := gridCellRect;
// I tried to modify the top position to make it visible
gridCellRect1.Top := gridCellRect -5;
cellBrush.color := clBlack;
Windows.FillRect(DrawDC, gridCellRect, cellBrush.Handle);
end;
You've got your colors reversed (you're drawing in the wrong order), your gridCellRect.Left and gridCellRect.Right are far too narrow (8 pixels), and you don't need the call to SetBkMode at all.
In addition, you've got an error in gridCellRect - 5 (which won't even compile), and you never try to draw to the rectangle defined in gridCellRect1 even if it did. (Your second call to FillRect uses gridCellRect instead of gridCellRect1.)
Here's a corrected version of the code that should get you started:
procedure DrawRectangle(drawDC:HDC;cellBrush:TBrush);
var
gridCellRect, gridCellRect1 :Trect ;
begin
gridCellRect.Top := 75;
gridCellRect.Bottom := 150;
gridCellRect.Left := 125; // Changed left and right to widen
gridCellRect.right := 200;
cellBrush.color := clBlack;
Windows.FillRect(DrawDC, gridCellRect, cellBrush.Handle);
gridCellRect1 := gridCellRect;
gridCellRect1.Top := gridCellRect.Top + 5;
gridCellRect1.Bottom := gridCellRect.Bottom - 5;
cellBrush.color := clAqua;
Windows.FillRect(DrawDC, gridCellRect1, cellBrush.Handle);
end;
Tested with
procedure TForm1.FormPaint(Sender: TObject);
begin
DrawRectangle(Canvas.Handle, Canvas.Brush);
end;

Trouble synchronizing generic TList and TListBox

I have trouble keeping a TListbox in sync with a TList. Each time an item is added to a generic TList, OnNotify is called and the callback calls just one procedure: create_gradients. Its code is below:
procedure TColor_Dialog.create_gradients;
var Editor: TGradient_Editor;
eGradient: Int32;
y: single;
s: string;
begin
List_Names.Clear;
List_Gradients.Clear;
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
List_Names.Items.Add (FColor_Editor [eGradient].Check_Rainbow.Text);
end; // for
List_Gradients.BeginUpdate;
try
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
Editor := FColor_Editor [eGradient];
y := (eGradient + 1) * Editor.Height;
Editor.Position.Y := y;
s := Editor.Check_Rainbow.Text;
List_Gradients.AddObject (Editor);
end; // for
finally
List_Gradients.EndUpdate;
end; // try..finally
end; // create_gradients //
As you see it simply enumerates all items in the list. Each item in the list is a TGradient_Editor which in turn has TFrame as a parent. On the parent are some FMX controls as combolorboxes, an image and a checkbox (Check_Rainbow). Check_Rainbow.Text is used for identification purposes. When the gradient editor is created, it creates a unique name from frame_%s where %s is a sequence number that is incremented each time a gradient editor is created. Owner and Parent are both List_Gradients.
From the image above you can see what happens. the listbox on the right is added for checking and just shows the text's, which is the correct sequence by the way. When I use the debugger to follow the addition of the gradient editors to List_Gradient they are processed in the same order. But the order of the gradient editors is wrong. I have to mention that the aligment of the gradient editors is alTop. I added even some code to ensure that the editor is Positioned at the very bottom of the List_Gradients.
I appear not to understand something. I cannot imagine that sequential adding to a TListBox cannot result in the correct order. What am I doing wrong?
Try this instead:
procedure TColor_Dialog.create_gradients;
var
Editor: TGradient_Editor;
eGradient: Int32;
y: single;
begin
List_Names.Clear;
List_Gradients.Clear;
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
List_Names.Items.Add (FColor_Editor[eGradient].Check_Rainbow.Text);
end;
List_Gradients.BeginUpdate;
try
y := 0.0; // or whatever value you want to start at...
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
Editor := FColor_Editor[eGradient];
Editor.Position.Y := y;
List_Gradients.AddObject(Editor);
y := y + Editor.Height;
end;
finally
List_Gradients.EndUpdate;
end;
end;
As requested I moved the answer to this section. The correct code is:
procedure TColor_Dialog.create_gradients;
var Editor: TGradient_Editor;
eGradient: Int32;
y: single;
begin
List_Gradients.BeginUpdate;
try
List_Gradients.Clear;
y := 0;
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
Editor := FColor_Editor [eGradient];
Editor.Position.X := 0;
Editor.Position.Y := y;
Editor.Width := List_Gradients.Width;
List_Gradients.AddObject (Editor);
y := y + Editor.Height;
end; // for
finally
List_Gradients.EndUpdate;
end; // try..finally
end; // create_gradients //
and not using any alignment anymore. Adding Objects to a TListBox is a real nice feature of FMX. However, be prepared that things sometimes work differently than you expect. For one thing: objects are not positioned in the same way as strings.

Dynamically created THTMLabel.Height always return default value?

I am creating a number of dynamically created THTMLabels but after these are created,when I try to get it's height,it always return the default height value.
Here is my code:
for i := 0 to ASentencePtr^.MUS.Count - 1 do
begin
j := Random(slTemp.Count);
sSen := ASentencePtr^.MUS.Strings[StrToInt(slTemp.Strings[j])] + ' / ';
THTMLabel.Create(Self).Name := 'lblSen_' + slTemp.Strings[j];
with THTMLabel(FindComponent('lblSen_' + slTemp.Strings[j])) do
begin
Font.Size := 18;
Font.Style := [fsBold];
Parent := FlowPanel1;
Width := Parent.Width;
Cursor := crHandPoint;
DragMode := dmAutomatic;
ControlStyle := ControlStyle + [csDisplayDragImage];
HTMLText.Add(sSen);
Autosizing := True;
end;
slTemp.Delete(j);
end;
Now when I try to access THTMLabel(FindComponent('lblSen_0')).Height, it returns only the default value which is 17. Where have I gone wrong? Any thoughts anyone? Any help is greatly appreciated, thanks.
We had the same problems but managed to solve them with the THTMLStaticText component and this function that calculates the height when dynamically (height) adjusted:
function CalculateDynamicHeight( aLabel: TLabel; htmlStaticText: THTMLStaticText): Integer;
var
lRect : TRect;
lText : string;
begin
lRect := Rect( 0, 0, htmlStaticText.Width, 0);
lText := htmlStaticText.Text;
aLabel.Caption := htmlStaticText.Text;
aLabel.Font := htmlStaticText.Font;
aLabel.Canvas.Font := htmlStaticText.Font;
aLabel.Canvas.TextRect(
{var} lRect, //will be modified to fit the text dimensions
{var} lText, //not modified, unless you use the "tfModifyingString" flag
[tfCalcRect, tfWordBreak] //flags to say "compute text dimensions with line breaks"
);
ASSERT( lRect.Top = 0 ); //this shouldn't have moved
aLabel.Height := lRect.Bottom;
Result := lRect.Bottom;
end;
The function requires a TLabel component, used exclusively for calculation purposes (you can set the visibility to false). The htmlStaticText component should have AutoSize set to true (in our case AutoSizeType is set to asVertical) and the htmlStaticText.Text should be present when calling the function.
I think THTMLLabel is part of the Jedi Library, itsn't? This problem is weird. I don't know the implementation of this control, but if you are having this problem, then there's may be a very bad implementation of the AutoSize Property.
If you can't inspect and fix the source of this control, try to use the BoundsRect property to get the height:
LabelHeight := THTMLabel(FindComponent('lblSen_0')).BoundsRect.Bottom;

Animating the addition of a string to a ListBox in FireMonkey

The following code nicely animates adding a new string to the end of a ListBox
procedure TForm6.AddItem(s: string);
var
l : TListBoxItem;
OldHeight : Single;
begin
l := TListBoxItem.Create(Self);
l.Text := s;
OldHeight := l.Height;
l.Height := 0;
l.Parent := ListBox1;
l.Opacity := 0;
l.AnimateFloat('height', OldHeight, 0.5);
l.AnimateFloat('Opacity', 1, 0.5);
end;
The item expands and fades in. However I want to be able to add the string into an arbitrary location in the ListBox - actually at the current ItemIndex.
Does anyone know how to do this?
To work around the fact that ListBox1.InsertObject and ListBox1.Items.Insert don't work you can do the following
procedure TForm1.AddItem(s: string);
var
l : TListBoxItem;
OldHeight : Single;
I: Integer;
index : integer;
begin
l := TListBoxItem.Create(nil);
l.Text := s;
OldHeight := l.Height;
l.Height := 0;
l.Opacity := 0;
l.Index := 0;
l.Parent := ListBox1;
Index := Max(0, ListBox1.ItemIndex);
for I := ListBox1.Count - 1 downto Index + 1 do
begin
ListBox1.Exchange(ListBox1.ItemByIndex(i), ListBox1.ItemByIndex(i-1));
end;
ListBox1.ItemIndex := Index;
l.AnimateFloat('height', OldHeight, 0.5);
l.AnimateFloat('Opacity', 1, 0.5);
end;
but is a bit ridiculous. It (eventually) adds the string in position 0 if there is no item selected, otherwise adds it before the selected item. This solution reminds me too much of Bubble Sort. You will need to add the math unit to your uses clause for the max function to work.
This does indeed seem to be a bug in FireMonkey (check Quality Central #102122), However I suspect a future FireMonkey update will fix this. If anyone can see a better way of doing this....
I've also made a movie about this for those who are interested, which illustrates things more clearly.
This should work, but it does nothing:
l := TListBoxItem.Create(ListBox1);
ListBox1.InsertObject(Max(ListBox1.ItemIndex, 0), l);
If I then call the following, I get an access violation:
ListBox1.Realign;
In fact, even this gives me an AV:
ListBox1.Items.Insert(0, 'hello');
ListBox1.Realign;
But this adds one, of course:
ListBox1.Items.Add('hello');
A bug perhaps?
Instead of
l.Parent := ListBox1;
use
ListBox1.InsertObject(Index, l);
where Index is the insertion position.
(Untested but from reading the sources it should work).

How to find the actual width of grid component with scrollbar in Delphi

I have a grid component (DBGrid) which has lots of columns on it. Because of large number of columns, a scrollbar was created, and thus some part of grid remains hidden. I need to find out what is the real width of DBGrid, including the part which is not shown due to scroll bar. But Width property gives only the width of the component itself. Anybody has any idea?
TDBGrid has a Columns property. Each of the columns has its own Width property. So you could loop through all of the columns and sum up their widths.
Like this:
function TotalColumnsWidth(var AGrid: TDBGrid);
var
i: Integer;
begin
Result := 0;
for i := to AGrid.Columns.Count - 1 do
Result := Result + AGrid.Columns[i].Width;
end;
Perhaps this may be helpful. It is part of a class helper for TDBGrid that auto sizes the last column, so that the grid has no empty space. Should be easy to adjust to your needs.
As you may notice, the CalcDrawInfo method is what you are seeking for. As it is protected you can either use a class helper or the usual protected-hack to get hands on it.
procedure TDbGridHelper.AutoSizeLastColumn;
var
DrawInfo: TGridDrawInfo;
ColNo: Integer;
begin
ColNo := ColCount - 1;
CalcDrawInfo(DrawInfo);
if (DrawInfo.Horz.LastFullVisibleCell < ColNo - 1) then Exit;
if (DrawInfo.Horz.LastFullVisibleCell < ColNo) then
ColWidths[ColNo] := DrawInfo.Horz.GridBoundary - DrawInfo.Horz.FullVisBoundary
else
ColWidths[ColNo] := ColWidths[ColNo] + DrawInfo.Horz.GridExtent - DrawInfo.Horz.FullVisBoundary
end;
I think I have found a solution (although it seems a little strange). In order to find the difference between column widths and real width of the DBgrid (that means find the width of the empty space left after last column), we need to keep track of which column is shown on the left now (what is current column that is scrolled to). We can do that using OnDrawColumnCell event, since it will draw only columns which are scrolled on now. Then we need to calculate sum of widths of all visible columns, and subtract that from DBGrid's width. P.S. Sorry for bad english
Ex code:
For i:=0 to Last do
if Vis[i] then
Begin
Sum:=Sum+DBG.Columns[i].Width;
Inc(Cnt);
End;
if dgColLines in DBG.Options then
Sum := Sum + Cnt;
//add indicator column width
if dgIndicator in DBG.Options then
Sum := Sum + IndicatorWidth;
Dif:=DBG.ClientWidth - Sum;
Here are functions we have used in the past. It takes into account the width of data based on the font and also compensates for vertical lines if they are visible
function GridTextWidth(fntFont : TFont; const sString : OpenString) :
integer;
var
f: TForm;
begin
try
f:=TForm.Create(nil);
f.Font:=fntFont;
result:=f.canvas.textwidth(sstring);
finally
f.Free;
end;
end;
function CalcGridWidth(dbg : TDBGrid { the grid to meaure }): integer; { the "exact" width }
const cMEASURE_CHAR = '0';
iEXTRA_COL_PIX = 4;
iINDICATOR_WIDE = 11;
var i, iColumns, iColWidth, iTitleWidth, iCharWidth : integer;
begin
iColumns := 0;
result := GetSystemMetrics(SM_CXVSCROLL);
iCharWidth := GridTextWidth(dbg.font,cMeasure_char);
with dbg.dataSource.dataSet do begin
DisableControls;
for i := 0 to FieldCount - 1 do with Fields[i] do
if visible then
begin
iColWidth := iCharWidth * DisplayWidth;
if dgTitles in dbg.Options then begin
ititlewidth:=GridTextWidth(dbg.titlefont,displaylabel);
if iColWidth < iTitleWidth then
iColWidth := iTitleWidth;
end;
inc(iColumns, 1);
inc(result, iColWidth + iEXTRA_COL_PIX);
end;
EnableControls;
end;
if dgIndicator in dbg.Options then
begin
inc(iColumns, 1);
inc(result, iINDICATOR_WIDE);
end;
if dgColLines in dbg.Options then
inc(result, iColumns)
else
inc(result, 1);
end;

Resources