Delphi Firemonkey creating TExpanders and TLabels at runtime - delphi

Using Rad Studio 10.3
I am creating TExpanders at runtime based on a FireDAC query. However i am running into an issue setting the Parent of the label to the expander i have just created.
I am using the following to create the components
procedure TfrmMain.FormCreate(Sender: TObject);
var
i: integer;
begin
// Populate previous saved conversions stringgrid
FDQuery1.SQL.Clear;
FDQuery1.Close;
FDQuery1.SQL.Add('SELECT convert from conversions');
FDQuery1.Open;
i := 1;
while not FDQuery1.Eof do
begin
// Create Expanders here to display database query to user
exp := TExpander.Create(Self);
exp.Parent := layoutDBDisplay;
exp.Align := TAlignLayout.Top;
exp.Name := 'dbExp' + i.ToString;
exp.Height := 100;
exp.TextSettings.Font.Size := 14;
exp.TextSettings.Font.Style := [TFontStyle.fsBold];
// Create TLabel inside of above expander
lab := TLabel.Create(Self);
lab.Parent := TExpander;
lab.Align := TAlignLayout.Top;
lab.Name := 'dbResLabel' + i.ToString;
inc(i);
FDQuery1.Next;
end;
FDQuery1.Close;
end;
The issue is lies in this line
lab.Parent := expName;
Obviously the above won't compile because of the following
[dcc32 Error] frmConverter.pas(266): E2010 Incompatible types: 'TFmxObject' and 'class of TExpander'
Is there a simple solution to this?

Your line
lab.Parent := TExpander;
should be
lab.Parent := Exp;

Related

Dynamically create Tpagecontrol instances

I have searched and searched but found no examples. I would like to dynamically create PageControl instances each with their own setoff TTabsheets. I get no complaints from the Delphi IDE, however I do get:
Access violation in module FormApplication.exe write of address 00000000
Is there something I am missing?
procedure TForm1.FormCreate(Sender: TObject);
type
ABC_Status_Object = record
ABC_PageControl_instance: TPageControl;
quickStat_instance: TTabsheet;
detailStat_instance: TTabsheet;
abc_light: TShape;
end;
var
ABC_Status: array of ABC_Status_Object;
I: Integer;
Frac, Icnt: Extended;
begin
inifile := TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
loadGlobalConfig;
Frac := 100/NUM/100;
for I := 0 to NUM do
begin
{// Create the Tabs: }
ABC_Status[I].ABC_PageControl_instance := TPageControl.Create(self);
ABC_Status[I].ABC_PageControl_instance.Parent := self;
ABC_Status[I].quickStat_instance := TTabsheet.Create(ABC_Status[I].ABC_PageControl_instance);
ABC_Status[I].detailStat_instance := TTabsheet.Create(ABC_Status[I].ABC_PageControl_instance);
ABC_Status[I].quickStat_instance.PageControl := ABC_Status[I].ABC_PageControl_instance;
ABC_Status[I].detailStat_instance.PageControl := ABC_Status[I].ABC_PageControl_instance;
{// Set the attributes of each instance of PageControl, including the tabs: }
ABC_Status[I].ABC_PageControl_instance.Visible := TRUE;
ABC_Status[I].ABC_PageControl_instance.Top := 0;
if(NUM = 1) then
ABC_Status[I].ABC_PageControl_instance.Width := ClientWidth;
if(NUM > 1) AND (NUM < 4) then
begin
Icnt := 100/(I+1)/100;
ABC_Status[I].ABC_PageControl_instance.Width := Trunc(ClientWidth*Frac);
ABC_Status[I].ABC_PageControl_instance.Left := 30;
end;
ABC_Status[I].quickStat_instance.Caption := 'Quick Status';
ABC_Status[I].quickStat_instance.Visible := TRUE;
ABC_Status[I].detailStat_instance.Caption := 'Details';
ABC_Status[I].detailStat_instance.Visible := TRUE;
end;
end;
You did not allocate the array. You need to add the following before you access the array:
SetLength(ABC_Status, NUM+1);
The +1 is because of the rather non-standard loop bounds that you used.
Also 100/100 = 1 and so the expression 100/NUM/100 seems odd. You may as well write 1/NUM.
Your use of the non-standard Extended type also seems strange. I don't see much need for that.
There are probably lots more errors, but I'm stopping here.

Delphi Xe2 inserting records into table based on values from another table

I have the following code that i use to update a table in a database this code used to work in bds 2006 using zeosdblib query components, but now it does not work in delphi xe2. Can anyone please show me where i am going wrong. Thank You
procedure TGoodsReceivedForm.btnCategorizeClick(Sender: TObject);
var
TempCatTotal : Extended;
nCatogory : string;
begin
TempCatTotal := 0;
zroqryExpcat.Open;
with zroqryExpcat do
begin
first;
while not Eof do
begin
zqrySumCategory.Close;
zqrySumCategory.SQL.Clear;
zqrySumCategory.SQL.Add('select costcategory,packcost,sum(qty)*packcost as pamount');
zqrySumCategory.SQL.Add('from pitems');
zqrySumCategory.SQL.Add('where costcategory=:costcategory and orderno=:orderno');
zqrySumCategory.SQL.Add('group by costcategory,packcost');
zqrySumCategory.Params[0].AsString := zroqryExpcat.FieldByName('Description').Value;
zqrySumCategory.Params[1].AsString := NewPurchaseOrderForm.OrderNumber.Caption ;
zqrySumCategory.Open;
zqrySumCategory.First;
TempCatTotal := 0;
while not zqrySumCategory.eof do
begin
TempCatTotal := TempCatTotal+zqrySumCategory.FieldByName('pamount').AsFloat;
zqrySumCategory.Next;
end;
if TempCatTotal > 0 then
begin
zqryInsertExpense.Close;
zqryInsertExpense.Params[0].AsString := NewPurchaseOrderForm.OrderNumber.Caption ;
zqryInsertExpense.Params[1].AsString := zqrySumCategory.Params[0].AsString ;
zqryInsertExpense.Params[2].AsCurrency := TempCatTotal;
zqryInsertExpense.Params[3].Asinteger := zroqryExpcat.FieldByName('gl_account_no').Value;
zqryInsertExpense.Params[4].AsDate := ReceivedDate.Date;
zqryInsertExpense.ExecSQL;
zqryInsertExpense.Close;
end;
next;
end;
end;
zqryListExpenseCat.Close;
zqryListExpenseCat.Params[0].Value := NewPurchaseOrderForm.OrderNumber.Caption;
zqryListExpenseCat.Open;
end;
You are missing ' in the line :
zqryInsertExpense.Params[3].Asinteger := zroqryExpcat.FieldByName (gl_account_no').Value;
near FieldByName( . Are you sure you pasted this code correctly.

Setting TcxSpinEdit property to column when building TcxGrid at runtime

I'm working on someone else's code where they're building a TcxGrid without going through the visual editor. I will be exporting that grid to excel so I need to set the column type to TcxSpinEdit (contents are all numbers).
How can I set the property? I tried with PropertyClass and PropertyClassName but none of them work (I still get the "number as text" warning in excel).
This is the relevant part:
var
Stolpec: TcxGridDBColumn;
[...]
if CheckBoxStevilkoMultiTime.Checked then
begin
Stolpec := cxGrid1DBTableView3.CreateColumn;
Stolpec.DataBinding.FieldName := 'STVLK_INI_C';
Stolpec.Width := larghCol;
Stolpec.FooterAlignmentHorz := taRightJustify;
Stolpec.GroupSummaryAlignment := taRightJustify;
Stolpec.Name := 'cxGrid1DBTableView3' + Colonna.DataBinding.FieldName;
TcxGridDBTableSummaryItem(cxGrid1DBTableView3.DataController.Summary.DefaultGroupSummaryItems[5]).Column := Stolpec;
TcxGridDBTableSummaryItem(cxGrid1DBTableView3.DataController.Summary.DefaultGroupSummaryItems[5]).Position := posIndx;
Stolpec.Caption := 'Stevilko';
Stolpec.Options.Editing := False;
end;
uses
cxSpinEdit;
...
Stolpec.PropertiesClass := TcxSpinEditProperties;
TcxSpinEditProperties(Stolpec.Properties).MaxValue:= 10;
...

TListView: VCL loses the order of columns if you add a column

I'm trying to add a column between existing columns in a TListView. Therefor I add the new column at the end and move it by setting it`s index to the designated value. This works, until adding another new column.
What I did:
Add the column at last position (Columns.Add) and add the subitem at the last position (Subitems.Add) too. Afterwards I move the column by setting it's index to the correct position.
This works fine as long as it's just one column that gets added. When adding a second new column, the subitems get screwed up. The new subitem of the first column is moved to the last position, e.g. like this:
0 | 1 | new A | new B | 3
Caption | old sub 1 | old sub 3 | new Sub B | new sub A
I would be very happy if someone could help!
For example, is there maybe a command or message I can send to the ListView so it refreshes or saves it's Column --> Subitem mapping that I could use after adding the first new column and it's subitems so I can handle the second new column the same way as the first.
Or is this just a bug of TListViews column-->subitem handling or TListColumns...?
example code for a vcl forms application (assign the Form1.OnCreate event):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
listview: TListView;
initButton: TButton;
addColumn: TButton;
editColumn: TEdit;
subItemCount: Integer;
procedure OnInitClick(Sender: TObject);
procedure OnAddClick(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
listview := TListView.Create(self);
with listview do
begin
Left := 8;
Top := 8;
Width := self.Width - 30;
Height := self.Height - 100;
Anchors := [akLeft, akTop, akRight, akBottom];
TabOrder := 0;
ViewStyle := vsReport;
Parent := self;
end;
initButton := TButton.Create(self);
with initButton do
begin
left := 8;
top := listview.Top + listview.Height + 20;
Width := 75;
Height := 25;
TabOrder := 1;
Caption := 'init';
OnClick := OnInitClick;
Parent := self;
end;
editColumn := TEdit.Create(self);
with editColumn do
begin
left := initButton.Left + initButton.Width + 30;
top := listview.Top + listview.Height + 20;
Width := 120;
Height := 25;
TabOrder := 2;
Parent := self;
Caption := '';
end;
addColumn := TButton.Create(self);
with addColumn do
begin
left := editColumn.Left + editColumn.Width + 10;
top := listview.Top + listview.Height + 20;
Width := 75;
Height := 25;
TabOrder := 1;
Enabled := true;
Caption := 'add';
OnClick := OnAddClick;
Parent := self;
end;
end;
procedure TForm1.OnInitClick(Sender: TObject);
var col: TListColumn;
i, j: integer;
item: TListItem;
begin
listview.Items.Clear;
listview.Columns.Clear;
// add items
for I := 0 to 2 do
begin
col := ListView.Columns.Add;
col.Caption := 'column ' + IntToStr(i);
col.Width := 80;
end;
// add columns
for I := 0 to 3 do
begin
item := ListView.Items.Add;
item.Caption := 'ItemCaption';
// add subitems for each column
for j := 0 to 1 do
begin
item.SubItems.Add('subitem ' + IntToStr(j+1));
end;
end;
subItemCount := 5;
end;
procedure TForm1.OnAddClick(Sender: TObject);
var number: integer;
col: TListColumn;
i: Integer;
ascii: char;
begin
listview.Columns.BeginUpdate;
number := StrToInt(editColumn.Text);
ascii := Chr(65 + number);
// create the new column
col := TListColumn(ListView.Columns.add());
col.Width := 80;
col.Caption := ascii;
// add the new subitems
for I := 0 to ListView.Items.Count-1 do
begin
ListView.Items[i].SubItems.Add('subitem ' + ascii);
end;
// move it to the designated position
col.Index := number;
listview.Columns.EndUpdate;
Inc(subItemCount);
end;
end.
Thank you!
Edit: The suggested fix from Sertac Akyuz works fine, though I can't use it because changing the Delphi sourcecode is no solution for my project. Bug is reported.
Edit: Removed the second question that was unintended included in the first post and opened new question (See linked question and Question-revision).
Update: The reported bug is now closed as fixed as of Delphi XE2 Update 4.
Call the UpdateItems method after you've arranged the columns. E.g.:
..
col.Index := number;
listview.UpdateItems(0, MAXINT);
..
Update:
In my tests, I still seem to need the above call in some occasion. But the real problem is that "there is a bug in the Delphi list view control".
Duplicating the problem with a simple project:
Place a TListView control on a VCL form, set its ViewStyle to 'vsReport' and set FullDrag to 'true'.
Put the below code to the OnCreate handler of the form:
ListView1.Columns.Add.Caption := 'col 1';
ListView1.Columns.Add.Caption := 'col 2';
ListView1.Columns.Add.Caption := 'col 3';
ListView1.AddItem('cell 1', nil);
ListView1.Items[0].SubItems.Add('cell 2');
ListView1.Items[0].SubItems.Add('cell 3');
Place a TButton on the form, and put the below code to its OnClick handler:
ListView1.Columns.Add.Caption := 'col 4';
Run the project and drag the column header of 'col 3' to in-between 'col 1' and 'col 2'. The below picture is what you'll see at this moment (everything is fine):
Click the button to add a new column, now the list view becomes:
Notice that 'cell 2' has reclaimed its original position.
Bug:
The columns of a TListView (TListColumn) holds its ordering information in its FOrderTag field. Whenever you change the order of a column (either by setting the Index property or by dragging the header), this FOrderTag gets updated accordingly.
Now, when you add a column to the TListColumns collection, the collection first adds the new TListColumn and then calls the UpdateCols method. The below is the code of the UpdateCols method of TListColumns in D2007 VCL:
procedure TListColumns.UpdateCols;
var
I: Integer;
LVColumn: TLVColumn;
begin
if not Owner.HandleAllocated then Exit;
BeginUpdate;
try
for I := Count - 1 downto 0 do
ListView_DeleteColumn(Owner.Handle, I);
for I := 0 to Count - 1 do
begin
with LVColumn do
begin
mask := LVCF_FMT or LVCF_WIDTH;
fmt := LVCFMT_LEFT;
cx := Items[I].FWidth;
end;
ListView_InsertColumn(Owner.Handle, I, LVColumn);
Items[I].FOrderTag := I;
end;
Owner.UpdateColumns;
finally
EndUpdate;
end;
end;
The above code removes all columns from the underlying API list-view control and then inserts them anew. Notice how the code assigns each inserted column's FOrderTag the index counter:
Items[I].FOrderTag := I;
This is the order of the columns from left to right at that point in time. If the method is called whenever the columns are ordered any different than at creation time, then that ordering is lost. And since items do not change their positions accordingly, it all gets mixed up.
Fix:
The below modification on the method seemed to work for as little as I tested, you need to carry out more tests (evidently this fix does not cover all possible cases, see 'torno's comments below for details):
procedure TListColumns.UpdateCols;
var
I: Integer;
LVColumn: TLVColumn;
ColumnOrder: array of Integer;
begin
if not Owner.HandleAllocated then Exit;
BeginUpdate;
try
SetLength(ColumnOrder, Count);
for I := Count - 1 downto 0 do begin
ColumnOrder[I] := Items[I].FOrderTag;
ListView_DeleteColumn(Owner.Handle, I);
end;
for I := 0 to Count - 1 do
begin
with LVColumn do
begin
mask := LVCF_FMT or LVCF_WIDTH;
fmt := LVCFMT_LEFT;
cx := Items[I].FWidth;
end;
ListView_InsertColumn(Owner.Handle, I, LVColumn);
end;
ListView_SetColumnOrderArray(Owner.Handle, Count, PInteger(ColumnOrder));
Owner.UpdateColumns;
finally
EndUpdate;
end;
end;
If you are not using packages you can put a modified copy of 'comctrls.pas' to your project folder. Otherwise you might pursue run-time code patching, or file a bug report and wait for a fix.

Problem with format a single excel column with OLE automation using Delphi

I have piece of code which I use to format a range of cells in Excel. It works fine in Excel 2007 but when the range is only 1 column wide and it is Excel 2003 instead of 2007, I'll get an error saying the I am assigning invalid value for a border's line style.
** valuables such as "xlInsideHorizontal", I have declared them as CONSTANT with the proper values.
Please help.
procedure formatCells(FRCELLROW, FRCELLCOL, TOCELLROW, TOCELLCOL: Integer;
TOPSTYLE, TOPCOLOUR, TOPWEIGHT,
BOTTOMSTYLE, BOTTOMCOLOUR, BOTTOMWEIGHT,
LEFTSTYLE, LEFTCOLOUR, LEFTWEIGHT,
RIGHTSTYLE, RIGHTCOLOUR, RIGHTWEIGHT: Integer;
INNERVSTYLE, INNERVCOLOUR, INNERVWEIGHT: Integer;
INNERHSTYLE, INNERHCOLOUR, INNERHWEIGHT: Integer;
HORIZONTALCELLALIGNMENT: Integer;
FontBold: Boolean;
NumberFormat: String
);
var
tmpRange: Variant;
begin
tmpRange := eclApp.range[eclApp.Cells[FRCELLROW, FRCELLCOL],
eclApp.Cells[TOCELLROW, TOCELLCOL]];
tmpRange.Borders[xlEdgeTop].LineStyle := TOPSTYLE;
if TOPSTYLE <> xlNone then begin
tmpRange.Borders[xlEdgeTop].ColorIndex := TOPCOLOUR;
tmpRange.Borders[xlEdgeTop].Weight := TOPWEIGHT;
end; //if
tmpRange.Borders[xlEdgeBottom].LineStyle := BOTTOMSTYLE;
if BOTTOMSTYLE <> xlNone then begin
tmpRange.Borders[xlEdgeBottom].ColorIndex := BOTTOMCOLOUR;
tmpRange.Borders[xlEdgeBottom].Weight := BOTTOMWEIGHT;
end; //if
tmpRange.Borders[xlEdgeLeft].LineStyle := LEFTSTYLE;
if LEFTSTYLE <> xlNone then begin
tmpRange.Borders[xlEdgeLeft].ColorIndex := LEFTCOLOUR;
tmpRange.Borders[xlEdgeLeft].Weight := LEFTWEIGHT;
end; //if
tmpRange.Borders[xlEdgeRight].LineStyle := RIGHTSTYLE;
if RIGHTSTYLE <> xlNone then begin
tmpRange.Borders[xlEdgeRight].ColorIndex := RIGHTCOLOUR;
tmpRange.Borders[xlEdgeRight].Weight := RIGHTWEIGHT;
end; //if
tmpRange.Borders[xlInsideVertical].LineStyle := INNERVSTYLE;
if INNERVSTYLE <> xlNone then begin
tmpRange.Borders[xlInsideVertical].ColorIndex := INNERVCOLOUR;
tmpRange.Borders[xlInsideVertical].Weight := INNERVWEIGHT;
end; //if
tmpRange.Borders[xlInsideHorizontal].LineStyle := INNERHSTYLE;
if INNERHSTYLE <> xlNone then begin
tmpRange.Borders[xlInsideHorizontal].ColorIndex := INNERHCOLOUR;
tmpRange.Borders[xlInsideHorizontal].Weight := INNERHWEIGHT;
end; //if
tmpRange.HorizontalAlignment := HORIZONTALCELLALIGNMENT;
tmpRange.Font.Bold := FontBold;
tmpRange.NumberFormat := NumberFormat;
end; //
Likewise, if you have specified a "1" row height, you'd get the same error. Inner styles are for lines between adjacent cells. A "1" column width range have no horizontally adjacent cells, hence no vertical inner lines. Excel 2007 is probably ignoring the invalid value, whereas Excel 2003 is throwing an error.
Test for the number of columns and number of rows for ranges before passing values to your "formatCells" procedure, and if you encounter a "1" in any of these pass "xlNone" (-4142) in place of "INNERVSTYLE, INNERVCOLOUR, INNERVWEIGHT" or "INNERHSTYLE, INNERHCOLOUR, INNERHWEIGHT".

Resources