Below is the sample code of my Custom TEdit control.
type
TEdit = class(Vcl.StdCtrls.TEdit)
private
//FTextM : TEXTMETRIC;
public
constructor Create(AOwner : TComponent); override;
end;
constructor TEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BorderStyle := bsNone;
Text := '';
Font.Name := 'Segoe UI';
Font.Size := 9;
Height := 10; //Here height change is not reflected.
end;
Here what ever the value i give in Height it is not updated in runtime. I am seriously missing very simple thing. But i am unable to figure it out on my own.
What will be the correct way to update the height of tedit control.
Update: Here is the form code i am using.
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 242
ClientWidth = 472
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Edit2: TEdit
Left = 216
Top = 184
Width = 121
Height = 21
TabOrder = 1
Text = 'Edit2'
end
object Edit3: TEdit
Left = 40
Top = 136
Width = 121
Height = 21
TabOrder = 0
Text = 'Edit3'
end
end
To be able to change the Height property of the TEdit you must first set the Autosize property to False. otherwise, at runtime the control will change its height based on the font size.
Related
I use a TMemo in TScrollBox to show some text, and a TLabel on top as a header info. Sometimes memo is wider than scroll box and of course Horizontal scroll bar can be used to scroll left and right to see text in memo.
I want to have a label as a header always centered to scroll box visible area. I can do this by setting Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2); and it works but it kind of flickers, shakes when scrolling back and forth. Memo moves smoothly, label doesn't.
Here is unit:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TScrollBox=Class(VCL.Forms.TScrollBox)
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
private
FOnScrollHorz: TNotifyEvent;
public
Property OnScrollHorz:TNotifyEvent read FOnScrollHorz Write FonScrollHorz;
End;
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Label1: TLabel;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure ScrollBox1Resize(Sender: TObject);
private
procedure MyScrollHorz(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TScrollBox.WMHScroll(var Message: TWMHScroll);
begin
inherited;
if Assigned(FOnScrollHorz) then FOnScrollHorz(Self);
end;
procedure TForm1.MyScrollHorz(Sender: TObject);
begin
Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2);
end;
procedure TForm1.ScrollBox1Resize(Sender: TObject);
begin
Label1.Left:= (Scrollbox1.Width div 2) - (Label1.Width div 2);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ScrollBox1.OnScrollHorz := MyScrollHorz;
end;
end.
and dfm:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 212
ClientWidth = 458
Color = clBtnFace
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ScrollBox1: TScrollBox
Left = 0
Top = 0
Width = 458
Height = 212
HorzScrollBar.Smooth = True
HorzScrollBar.Tracking = True
Align = alClient
BiDiMode = bdLeftToRight
DoubleBuffered = True
ParentBiDiMode = False
ParentDoubleBuffered = False
TabOrder = 0
OnResize = ScrollBox1Resize
ExplicitHeight = 337
object Label1: TLabel
Left = 192
Top = 30
Width = 69
Height = 13
BiDiMode = bdLeftToRight
Caption = 'Details header'
ParentBiDiMode = False
end
object Memo1: TMemo
Left = 24
Top = 70
Width = 700
Height = 89
Lines.Strings = (
'Details...')
TabOrder = 0
end
end
end
I tried using DoubleBuffered but doesn't help.
Any suggestions how to make Label1 move without flickering/shaking, as smooth as Memo1 does when scrolling?
EDIT:
The design will eventually be that I have 3 or scrollboxes on form and each one contain up to 3 memos with header. And scrolling needs to be by scrollbox as all memos in same scroll box need to be scrolled at the same time. That means I do not see how it would work with putting label on form or panel and then on form, outside scrollboxes:
EDIT 2:
The answers below do provide good solutions, but they do make necessary to place the Labels, that are centered, out of the Scrollbox and put on the Form itself. And then move either by Scrollbox's scroll bars or by scroll bars directly on Form. This does get desired affect, but it adds a little inconvenience with Labels not being part of Scrollbox, anymore.
-" Memo moves smoothly, label doesn't."
That's because you're trying to prevent it from moving. Detach your OnScrollHorz handler and the label will move smoothly. But that's not what you want, it will not be centered to the form any more.
The problem is, during the inherited call (WM_HSCROLL), the label moves along with the memo. After the default handling, you relocate the label, hence the flicker.
You can expose an additional event handler that will fire before default scrolling (OnBeforeHorzScroll), and hide the label when it fires. While smoothly centered, it will cause a different kind of flicker where the label momentarily disappears. Still may not be satisfactory.
The solution is to use a control that is parented to the form, a sibling to the scroll box. You can't do that with a TLabel as it is a graphic control, but you can use TStaticText. The "structure pane" of the IDE may come handy if the static accidentally goes behind the scroll box at design time.
You can do it like this:
Instead of ScrollBox put a ScrollBar on your form. Set its alignment to bottom (or set its size and position manually if you wish to have more columns or you can put each one in its own panel). Then set the size of your Memos and place Labels to the center of the Form. After setting the size of the Memos (probably dynamically via code) place this code:
ScrollBar1.Min:=0-Memo1.Left;
ScrollBar1.Max:=Memo1.Width-Form1.ClientWidth+Memo1.Left;
The last thing is to set the ScrollBar OnChange event:
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
Memo1.Left:=0-ScrollBar1.Position;
Memo2.Left:=0-ScrollBar1.Position;
...
MemoXY.Left:=0-ScrollBar1.Position;
end;
Your form should look something like this:
Done! You have a stable centered Labels and smoothly scrollable Memos.
Edit:
Here is a version with 3 columns each in his own Panel and also with vertical scrollbars:
And the whole source code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
Memo5: TMemo;
Memo6: TMemo;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
ScrollBar3: TScrollBar;
ScrollBar4: TScrollBar;
ScrollBar5: TScrollBar;
ScrollBar6: TScrollBar;
procedure FormCreate(Sender: TObject);
procedure ScrollBarHChange(Sender: TObject);
procedure ScrollBarVChange(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var cycle: Integer;
begin
//GENERATE YOUR COMPONENTS HERE
//sets every components tag to its default top position
//(you can do this in any other way for example using array)
for cycle:=0 to Form1.ComponentCount-1 do
begin
if(Form1.Components[cycle] is TControl)then
Form1.Components[cycle].Tag:=(Form1.Components[cycle] as TControl).Top
end;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
//changes the panels sizes and positions
Panel1.Width:=Form1.ClientWidth div 3;
Panel2.Width:=Form1.ClientWidth div 3;
Panel3.Width:=Form1.ClientWidth div 3;
Panel2.Left:=Panel1.Width+1;
Panel3.Left:=Panel1.Width+Panel2.Width+1;
//if you dont want all scrollbars to reset on window resize, you need to handle the positioning of elements when window (and panels) size is changing
ScrollBar1.Position:=ScrollBar1.Min;
ScrollBar2.Position:=ScrollBar2.Min;
ScrollBar3.Position:=ScrollBar3.Min;
ScrollBar4.Position:=ScrollBar4.Min;
ScrollBar5.Position:=ScrollBar5.Min;
ScrollBar6.Position:=ScrollBar6.Min;
//make these tests on the widest element of each panel (8 is just a margin so the memo has some space on the right)
if((Memo1.Left+Memo1.Width)>(Panel1.ClientWidth-ScrollBar4.Width-8))then
begin
ScrollBar1.Enabled:=true;
ScrollBar1.Max:=Memo1.Width-Panel1.ClientWidth+Memo1.Left+ScrollBar4.Width+8;
end
else
ScrollBar1.Enabled:=false;
if((Memo3.Left+Memo3.Width)>(Panel2.ClientWidth-ScrollBar5.Width-8))then
begin
ScrollBar2.Enabled:=true;
ScrollBar2.Max:=Memo3.Width-Panel1.ClientWidth+Memo3.Left+ScrollBar5.Width+8;
end
else
begin
ScrollBar2.Position:=ScrollBar2.Min;
ScrollBar2.Enabled:=false;
end;
if((Memo5.Left+Memo5.Width)>(Panel3.ClientWidth-ScrollBar6.Width-8))then
begin
ScrollBar3.Enabled:=true;
ScrollBar3.Max:=Memo5.Width-Panel1.ClientWidth+Memo5.Left+ScrollBar6.Width+8;
end
else
ScrollBar3.Enabled:=false;
//make these tests on the bottom element of each panel (16 is just a margin so the memo has some space on the bottom)
if((Memo2.Top+Memo2.Height)>(Panel1.ClientHeight-ScrollBar1.Height-16))then
begin
ScrollBar4.Enabled:=true;
ScrollBar4.Max:=Memo2.Top+Memo2.Height-Panel1.ClientHeight+ScrollBar1.Height+16;
end
else
ScrollBar4.Enabled:=false;
if((Memo4.Top+Memo4.Height)>(Panel2.ClientHeight-ScrollBar2.Height-16))then
begin
ScrollBar5.Enabled:=true;
ScrollBar5.Max:=Memo4.Top+Memo4.Height-Panel2.ClientHeight+ScrollBar2.Height+16;
end
else
ScrollBar5.Enabled:=false;
if((Memo6.Top+Memo6.Height)>(Panel3.ClientHeight-ScrollBar3.Height-16))then
begin
ScrollBar6.Enabled:=true;
ScrollBar6.Max:=Memo6.Top+Memo6.Height-Panel3.ClientHeight+ScrollBar3.Height+16;
end
else
ScrollBar6.Enabled:=false;
end;
procedure TForm1.ScrollBarHChange(Sender: TObject);
var cycle: Integer;
begin
for cycle:=0 to ((Sender as TScrollBar).Parent as TPanel).ControlCount-1 do
begin
if(((Sender as TScrollBar).Parent as TPanel).Controls[cycle] is TMemo)then
(((Sender as TScrollBar).Parent as TPanel).Controls[cycle] as TMemo).Left:=0-(Sender as TScrollBar).Position+8;
end;
end;
procedure TForm1.ScrollBarVChange(Sender: TObject);
var cycle: Integer;
begin
for cycle:=0 to ((Sender as TScrollBar).Parent as TPanel).ControlCount-1 do
begin
if(not (((Sender as TScrollBar).Parent as TPanel).Controls[cycle] is TScrollBar))then
(((Sender as TScrollBar).Parent as TPanel).Controls[cycle] as TControl).Top:=(((Sender as TScrollBar).Parent as TPanel).Controls[cycle] as TControl).Tag-(Sender as TScrollBar).Position;
end;
end;
end.
And the .dfm:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 473
ClientWidth = 769
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnResize = FormResize
DesignSize = (
769
473)
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 257
Height = 473
Anchors = [akLeft, akTop, akBottom]
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 0
object Label1: TLabel
Left = 104
Top = 16
Width = 31
Height = 13
Caption = 'Label1'
end
object Label2: TLabel
Left = 104
Top = 152
Width = 31
Height = 13
Caption = 'Label2'
end
object Memo1: TMemo
Left = 8
Top = 32
Width = 497
Height = 89
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object Memo2: TMemo
Left = 8
Top = 168
Width = 497
Height = 89
Lines.Strings = (
'Memo2')
TabOrder = 1
end
object ScrollBar1: TScrollBar
AlignWithMargins = True
Left = 0
Top = 452
Width = 236
Height = 17
Margins.Left = 0
Margins.Top = 0
Margins.Right = 17
Margins.Bottom = 0
Align = alBottom
PageSize = 0
TabOrder = 2
OnChange = ScrollBarHChange
ExplicitWidth = 253
end
object ScrollBar4: TScrollBar
Left = 236
Top = 0
Width = 17
Height = 452
Align = alRight
Enabled = False
Kind = sbVertical
PageSize = 0
TabOrder = 3
OnChange = ScrollBarVChange
ExplicitTop = 248
ExplicitHeight = 121
end
end
object Panel2: TPanel
Left = 256
Top = 0
Width = 257
Height = 473
Anchors = [akLeft, akTop, akBottom]
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 1
object Label3: TLabel
Left = 104
Top = 16
Width = 31
Height = 13
Caption = 'Label3'
end
object Label4: TLabel
Left = 104
Top = 152
Width = 31
Height = 13
Caption = 'Label4'
end
object Memo3: TMemo
Left = 8
Top = 32
Width = 497
Height = 89
Lines.Strings = (
'Memo3')
TabOrder = 0
end
object Memo4: TMemo
Left = 8
Top = 168
Width = 497
Height = 89
Lines.Strings = (
'Memo4')
TabOrder = 1
end
object ScrollBar2: TScrollBar
AlignWithMargins = True
Left = 0
Top = 452
Width = 236
Height = 17
Margins.Left = 0
Margins.Top = 0
Margins.Right = 17
Margins.Bottom = 0
Align = alBottom
PageSize = 0
TabOrder = 2
OnChange = ScrollBarHChange
ExplicitWidth = 253
end
object ScrollBar5: TScrollBar
Left = 236
Top = 0
Width = 17
Height = 452
Align = alRight
Enabled = False
Kind = sbVertical
PageSize = 0
TabOrder = 3
OnChange = ScrollBarVChange
ExplicitTop = 248
ExplicitHeight = 121
end
end
object Panel3: TPanel
Left = 512
Top = 0
Width = 257
Height = 473
Anchors = [akLeft, akTop, akBottom]
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 2
object Label5: TLabel
Left = 104
Top = 16
Width = 31
Height = 13
Caption = 'Label5'
end
object Label6: TLabel
Left = 104
Top = 152
Width = 31
Height = 13
Caption = 'Label6'
end
object Memo5: TMemo
Left = 8
Top = 32
Width = 497
Height = 89
Lines.Strings = (
'Memo5')
TabOrder = 0
end
object Memo6: TMemo
Left = 8
Top = 168
Width = 497
Height = 89
Lines.Strings = (
'Memo6')
TabOrder = 1
end
object ScrollBar3: TScrollBar
AlignWithMargins = True
Left = 0
Top = 452
Width = 236
Height = 17
Margins.Left = 0
Margins.Top = 0
Margins.Right = 17
Margins.Bottom = 0
Align = alBottom
PageSize = 0
TabOrder = 2
OnChange = ScrollBarHChange
ExplicitWidth = 253
end
object ScrollBar6: TScrollBar
Left = 236
Top = 0
Width = 17
Height = 452
Align = alRight
Enabled = False
Kind = sbVertical
PageSize = 0
TabOrder = 3
OnChange = ScrollBarVChange
ExplicitTop = 248
ExplicitHeight = 121
end
end
end
Why not use two scroll boxes.
You use one for vertical scrolling. On it you place your label and your second scroll box with memo on it.
This second scroll box will then be used for horizontal scrolling when needed.
Or perhaps even a better solution would be to replace TMemo with some other control like TRichEdit which has its own scrollbars implemented. So you have only one scroll box like now and TRichEdit Will take care of its own scrolling when the text is to wide.
My problem is that I have a TPageControl which contains a dynamically created number of tabs each containing a single (alClient) TMemo. When this number of tabs exceeds the width of the control and the scroll arrows appear on the tab header, all (well a large number) of my controls start to flicker a lot. This flicker only occurs when the pagecontrol is visible once you scroll out of view of the TPageControl it stops. When the pagecontrol is resized so that the scroll arrows are no longer required to see all of the tabs then the flickering stops.
I'm fairly confident that the problem is caused by the scroll arrows causing some painting to occur because when I set the TPageControl.MultiLine to true then there is no flickering. Ideally I wouldn't want to use MultiLine tabs and hope someone can provide a solution.
Information about form layout
I have a (Personal Details) form which contains a number of TSpeedButtons, TLabels, TEdits, a TImage and so on. Many of these elements are inside of a TScrollBox and are grouped into sections using TPanels. The panels are set to alTop in the scrollbox and have autosize set to true but their height never changes.
I have tried setting all controls to have DoubleBuffered set to true where possible and ParentBackground/Color = false but sadly nothing works.
I had flickering issues before adding the PageControls and using David's quick hack answer here TLabel and TGroupbox Captions Flicker on Resize I was able to improve the flickering when resizing the form. By extending TLabel and removing the background clearing from the Paint procedure, as recommended somewhere else, I was able to 99% remove the labels flickering when scrolling the ScrollBox but now I have a new flickering problem.
---EDIT---
Here is a link to a stripped down version of my form with the flickering occurring flickering example
Personnel.DetailsForm.pas
unit Personnel.DetailsForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, System.Actions,
Vcl.ActnList, Vcl.Buttons, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.WinXCtrls, Vcl.Imaging.jpeg;
type
TPersonnelDetailsForm = class(TForm)
ScrollBox_Content: TScrollBox;
panel_AddressDetails: TPanel;
gpanel_Address: TGridPanel;
edit_HomeMobilePhone: TEdit;
edit_HomeTown: TEdit;
edit_HomeStreet: TEdit;
edit_HomePhone: TEdit;
lbl_HomeStreet: TLabel;
lbl_HomePhone: TLabel;
lbl_MobilePhone: TLabel;
lbl_HomeTown: TLabel;
edit_HomeState: TEdit;
edit_HomeEmail: TEdit;
edit_HomeCountry: TEdit;
edit_HomeFax: TEdit;
lbl_HomeState: TLabel;
lbl_Fax: TLabel;
lbl_Email: TLabel;
lbl_HomeCountry: TLabel;
edit_HomePostCode: TEdit;
lbl_HomePostCode: TLabel;
panel_HomeAddressTitle: TPanel;
panel_GeneralNotesDetails: TPanel;
gpanel_GeneralNotesDetails_: TGridPanel;
pageControl_GeneralNotes: TPageControl;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
PersonnelDetailsForm: TPersonnelDetailsForm;
implementation
{$R *.dfm}
uses
System.Math,
System.DateUtils,
System.Threading,
System.RegularExpressions,
System.StrUtils,
System.Contnrs,
System.UITypes,
System.Types,
Winapi.Shellapi,
Vcl.ExtDlgs;
procedure EnableComposited(WinControl: TWinControl);
var
i: Integer;
NewExStyle: DWORD;
begin
NewExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED;
SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle);
for i := 0 to WinControl.ControlCount - 1 do
if WinControl.Controls[i] is TWinControl then
EnableComposited(TWinControl(WinControl.Controls[i]));
end;
procedure TPersonnelDetailsForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Close the form and make sure it frees itself
Action := caFree; // Should allow it to free itself on close
self.Release; // Sends a Release message to itself as backup
end;
procedure TPersonnelDetailsForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
var
LTopLeft, LTopRight, LBottomLeft, LBottomRight: Integer;
LPoint: TPoint;
begin
Handled := true;
// First you have to get the position of the control on screen
// as MousePos coordinates are based on the screen positions.
LPoint := self.ScrollBox_Content.ClientToScreen(Point(0, 0));
LTopLeft := LPoint.X;
LTopRight := LTopLeft + self.ScrollBox_Content.Width;
LBottomLeft := LPoint.Y;
LBottomRight := LBottomLeft + self.ScrollBox_Content.Width;
if (MousePos.X >= LTopLeft) and (MousePos.X <= LTopRight) and (MousePos.Y >= LBottomLeft) and (MousePos.Y <= LBottomRight) then
begin
// If the mouse is inside the scrollbox coordinates,
// scroll it by setting .VertScrollBar.Position.
self.ScrollBox_Content.VertScrollBar.Position := self.ScrollBox_Content.VertScrollBar.Position - WheelDelta;
Handled := true;
end;
if FindVCLWindow(MousePos) is TComboBox then
Handled := true;
end;
procedure TPersonnelDetailsForm.FormShow(Sender: TObject);
var
memo: TMemo;
tabsheet: TTabSheet;
ii: Integer;
begin
for ii := 0 to 7 do
begin
memo := TMemo.Create(self);
memo.Align := TAlign.alClient;
memo.ReadOnly := true;
memo.ScrollBars := TScrollStyle.ssVertical;
memo.ParentColor := false;
tabsheet := TTabSheet.Create(self);
tabsheet.InsertControl(memo);
tabsheet.PageControl := self.pageControl_GeneralNotes;
tabsheet.Caption := 'A New TabSheet ' + IntToStr(ii);
tabsheet.Tag := ii;
memo.Text := 'A New Memo ' + IntToStr(ii);
end;
EnableComposited(self);
self.ScrollBox_Content.ScrollInView(self.panel_AddressDetails);
self.Invalidate;
end;
end.
Personnel.DetailsForm.dfm
object PersonnelDetailsForm: TPersonnelDetailsForm
Left = 0
Top = 0
Caption = 'Personnel Details Form'
ClientHeight = 371
ClientWidth = 800
Color = clBtnFace
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnMouseWheel = FormMouseWheel
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 17
object ScrollBox_Content: TScrollBox
Left = 0
Top = 0
Width = 800
Height = 371
VertScrollBar.Smooth = True
VertScrollBar.Tracking = True
Align = alClient
TabOrder = 0
object panel_AddressDetails: TPanel
Tag = 101
Left = 0
Top = 0
Width = 796
Height = 174
Align = alTop
Padding.Left = 5
Padding.Top = 5
Padding.Right = 5
Padding.Bottom = 5
ParentBackground = False
TabOrder = 0
object gpanel_Address: TGridPanel
Left = 6
Top = 30
Width = 784
Height = 138
Align = alClient
BevelOuter = bvNone
ColumnCollection = <
item
SizeStyle = ssAbsolute
Value = 105.000000000000000000
end
item
Value = 50.000762951094850000
end
item
SizeStyle = ssAbsolute
Value = 105.000000000000000000
end
item
Value = 49.999237048905160000
end>
ControlCollection = <
item
Column = 3
Control = edit_HomeMobilePhone
Row = 1
end
item
Column = 1
Control = edit_HomeTown
Row = 1
end
item
Column = 1
Control = edit_HomeStreet
Row = 0
end
item
Column = 3
Control = edit_HomePhone
Row = 0
end
item
Column = 0
Control = lbl_HomeStreet
Row = 0
end
item
Column = 2
Control = lbl_HomePhone
Row = 0
end
item
Column = 2
Control = lbl_MobilePhone
Row = 1
end
item
Column = 0
Control = lbl_HomeTown
Row = 1
end
item
Column = 1
Control = edit_HomeState
Row = 2
end
item
Column = 3
Control = edit_HomeEmail
Row = 2
end
item
Column = 1
Control = edit_HomeCountry
Row = 3
end
item
Column = 3
Control = edit_HomeFax
Row = 3
end
item
Column = 0
Control = lbl_HomeState
Row = 2
end
item
Column = 2
Control = lbl_Fax
Row = 3
end
item
Column = 2
Control = lbl_Email
Row = 2
end
item
Column = 0
Control = lbl_HomeCountry
Row = 3
end
item
Column = 1
Control = edit_HomePostCode
Row = 4
end
item
Column = 0
Control = lbl_HomePostCode
Row = 4
end>
Padding.Left = 1
Padding.Top = 1
Padding.Right = 1
Padding.Bottom = 1
RowCollection = <
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end
item
SizeStyle = ssAbsolute
Value = 27.000000000000000000
end>
TabOrder = 0
object edit_HomeMobilePhone: TEdit
Left = 498
Top = 29
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 6
Text = 'Mobile Phone'
end
object edit_HomeTown: TEdit
Left = 107
Top = 29
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 1
Text = 'Home Town'
end
object edit_HomeStreet: TEdit
Left = 107
Top = 2
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 0
Text = 'Home Street'
end
object edit_HomePhone: TEdit
Left = 498
Top = 2
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 5
Text = 'Home Phone'
end
object lbl_HomeStreet: TLabel
Left = 2
Top = 2
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Street: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 61
ExplicitWidth = 44
ExplicitHeight = 17
end
object lbl_HomePhone: TLabel
Left = 393
Top = 2
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Home Phone: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 408
ExplicitWidth = 88
ExplicitHeight = 17
end
object lbl_MobilePhone: TLabel
Left = 393
Top = 29
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Mobile Phone: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 402
ExplicitWidth = 94
ExplicitHeight = 17
end
object lbl_HomeTown: TLabel
Left = 2
Top = 29
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Town: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 64
ExplicitWidth = 41
ExplicitHeight = 17
end
object edit_HomeState: TEdit
Left = 107
Top = 56
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 2
Text = 'Home State'
end
object edit_HomeEmail: TEdit
Left = 498
Top = 56
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 7
Text = 'Home Email'
end
object edit_HomeCountry: TEdit
Left = 107
Top = 83
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 3
Text = 'Home Country'
end
object edit_HomeFax: TEdit
Left = 498
Top = 83
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 8
Text = 'Home Fax'
end
object lbl_HomeState: TLabel
Left = 2
Top = 56
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'State: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 66
ExplicitWidth = 39
ExplicitHeight = 17
end
object lbl_Fax: TLabel
Left = 393
Top = 83
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Fax: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 467
ExplicitWidth = 29
ExplicitHeight = 17
end
object lbl_Email: TLabel
Left = 393
Top = 56
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Email: '
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentFont = False
Layout = tlCenter
ExplicitLeft = 454
ExplicitWidth = 42
ExplicitHeight = 17
end
object lbl_HomeCountry: TLabel
Left = 2
Top = 83
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Country: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 47
ExplicitWidth = 58
ExplicitHeight = 17
end
object edit_HomePostCode: TEdit
Left = 107
Top = 110
Width = 284
Height = 25
Align = alClient
BevelInner = bvNone
BevelOuter = bvNone
TabOrder = 4
Text = 'Home Post Code'
end
object lbl_HomePostCode: TLabel
Left = 2
Top = 110
Width = 103
Height = 25
Align = alClient
Alignment = taRightJustify
Caption = 'Post Code: '
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitLeft = 35
ExplicitWidth = 70
ExplicitHeight = 17
end
end
object panel_HomeAddressTitle: TPanel
Left = 6
Top = 6
Width = 784
Height = 24
Align = alTop
Alignment = taLeftJustify
BevelOuter = bvNone
Caption = ' Home Address '
Color = clMedGray
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Segoe UI'
Font.Style = [fsBold, fsUnderline]
ParentBackground = False
ParentFont = False
TabOrder = 1
end
end
object panel_GeneralNotesDetails: TPanel
Tag = 303
Left = 0
Top = 174
Width = 796
Height = 172
Align = alTop
AutoSize = True
Padding.Left = 5
Padding.Top = 5
Padding.Right = 5
Padding.Bottom = 5
ParentBackground = False
TabOrder = 1
object gpanel_GeneralNotesDetails_: TGridPanel
Left = 6
Top = 6
Width = 784
Height = 160
Align = alTop
BevelOuter = bvNone
ColumnCollection = <
item
Value = 100.000000000000000000
end>
ControlCollection = <
item
Column = 0
Control = pageControl_GeneralNotes
Row = 0
end>
Padding.Left = 1
Padding.Top = 1
Padding.Right = 1
Padding.Bottom = 1
RowCollection = <
item
SizeStyle = ssAbsolute
Value = 160.000000000000000000
end>
TabOrder = 0
object pageControl_GeneralNotes: TPageControl
Left = 2
Top = 2
Width = 780
Height = 158
Align = alClient
TabOrder = 0
end
end
end
end
end
I figured out that the problem was caused by the quick hack David answered to TLabel and TGroupbox Captions Flicker on Resize after I removed that the mad flickering when the TPageControl tab scroll buttons were visible went away. So now I'll have to look at his more in-depth solution and see if that can help with some of the flickering I was seeing before.
In my (XE2) IDE I constantly have to switch the settings for Project Options/ Debugger / Parameters because I'm testing for different client configurations, databases etc.
The Parameters dropdown list is becoming unmanageable. Since these have no descriptions either, it's even hard to figure out which ones to remove (How can I clean the Parameters field in the Run -> Parameters menu?).
Any smart ideas on managing these?
In an ideal word I would like to give them a tag/description, reorder them, delete some...
Not ideal but a workaround would be to add a redundant tag parameter as first parameter.
That way at least, when you use the dropdown list, you'll have some indication on what parameter combination you are using.
In addition to Lievens answer I'm adding an answer to my own question.
I have started using [identifier] at the beginning of the run-time parameter, and I can put in there what I want. In addition I have written a small app that lets me clean up the parameters that are stored in the registry (at HKEY_CURRENT_USER\Software\Embarcadero\BDS\9.0\History Lists\hlRunParameters).
Here is the code for that Win32 app. It will let you delete and sort the registry values. It is written in Delphi XE2. Just create a new VCL project and use this as the main form.
uCleanIDEParams.pas
unit uCleanIDEParams;
// https://stackoverflow.com/questions/27502689/how-to-manage-constantly-changing-project-run-time-parameters-in-the-ide
// All 32 bit stuff, the Delphi IDE is 32 bit too
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.CheckLst, Registry,
Vcl.ExtCtrls;
type
TFrmCleanIDEParams = class(TForm)
PnlTop: TPanel;
BtnLoad: TButton;
EdtRegKey: TEdit;
Label1: TLabel;
ChkRedundant: TCheckBox;
PnlBottom: TPanel;
GBxSelection: TGroupBox;
BtnSelectAll: TButton;
BtnSelectNone: TButton;
BtnStartWith: TButton;
ChkNot: TCheckBox;
EdtStartWith: TEdit;
BtnInvert: TButton;
Label2: TLabel;
BtnWrite: TButton;
ChkSort: TCheckBox;
PnlCenter: TPanel;
CLBParams: TCheckListBox;
procedure BtnLoadClick(Sender: TObject);
procedure BtnSelectAllClick(Sender: TObject);
procedure BtnSelectNoneClick(Sender: TObject);
procedure BtnInvertClick(Sender: TObject);
procedure BtnStartWithClick(Sender: TObject);
procedure BtnWriteClick(Sender: TObject);
private
public
end;
var
FrmCleanIDEParams: TFrmCleanIDEParams;
implementation
{$R *.dfm}
procedure TFrmCleanIDEParams.BtnInvertClick(Sender: TObject);
var i: integer;
begin
for i := 0 to CLBParams.Items.Count-1 do CLBParams.Checked[i] := not CLBParams.Checked[i];
end;
procedure TFrmCleanIDEParams.BtnLoadClick(Sender: TObject);
var
lReg : TRegistry;
lValue,
lItem,
lKey : String;
i,
lNrRegVals: Integer;
begin
lKey := Trim(EdtRegKey.Text);
if lKey = '' then Exit;
if lKey[1] = '\' then lKey := Copy(lKey,2);
lReg := TRegistry.Create(KEY_READ);
lReg.RootKey := HKEY_CURRENT_USER;
if not lReg.OpenKey(lKey,false) then
begin
MessageDlg('Key not found', mtError, mbOKCancel, 0);
Exit;
end;
if not lReg.ValueExists('Count') then
begin
MessageDlg('Value ''Count'' not found', mtError, mbOKCancel, 0);
Exit;
end;
lNrRegVals := lReg.ReadInteger('Count');
for i := 0 to lNrRegVals-1 do
begin
lValue := 'Item' + IntToStr(i);
if lReg.ValueExists(lValue) then
begin
lItem := lReg.ReadString(lValue);
if ChkRedundant.Checked then
lItem := Trim(StringReplace(lItem,' ',' ',[rfReplaceAll]));
CLBParams.Items.Add(lItem);
end;
end;
end;
procedure TFrmCleanIDEParams.BtnSelectAllClick(Sender: TObject);
var i: integer;
begin
for i := 0 to CLBParams.Items.Count-1 do CLBParams.Checked[i] := true;
end;
procedure TFrmCleanIDEParams.BtnSelectNoneClick(Sender: TObject);
var i: integer;
begin
for i := 0 to CLBParams.Items.Count-1 do CLBParams.Checked[i] := true;
end;
procedure TFrmCleanIDEParams.BtnStartWithClick(Sender: TObject);
var
i : integer;
lStart,
lItem : string;
begin
lStart := Lowercase(Trim(EdtStartWith.Text));
if lStart = '' then Exit;
for i := 0 to CLBParams.Items.Count-1 do
begin
lItem := lowercase(CLBParams.Items[i]);
if (not ChkNot.Checked) and (Pos(lStart,lItem) = 1)
or (ChkNot.Checked) and (Pos(lStart,lItem) <> 1) then
CLBParams.Checked[i] := true;
end;
end;
procedure TFrmCleanIDEParams.BtnWriteClick(Sender: TObject);
var
lReg : TRegistry;
lValue,
lKey : String;
i,
lNrToWrite,
lNrRegVals: Integer;
begin
for i := CLBParams.Items.Count-1 downto 0 do
if not CLBParams.Checked[i] then
CLBParams.Items.Delete(i);
if CLBParams.Items.Count = 0 then
begin
MessageDlg('Nothing to do', mtInformation, mbOKCancel, 0);
Exit;
end;
if ChkSort.Checked then
CLBParams.Sorted := true;
// Now writing back
lKey := Trim(EdtRegKey.Text);
if lKey = '' then Exit;
if lKey[1] = '\' then lKey := Copy(lKey,2);
lReg := TRegistry.Create(KEY_READ or KEY_WRITE);
lReg.RootKey := HKEY_CURRENT_USER;
if not lReg.OpenKey(lKey,false) then
begin
MessageDlg('Key not found', mtError, mbOKCancel, 0);
Exit;
end;
if not lReg.ValueExists('Count') then
begin
MessageDlg('Value ''Count'' not found', mtError, mbOKCancel, 0);
Exit;
end;
lNrRegVals := lReg.ReadInteger('Count');
lNrToWrite := CLBParams.Items.Count;
lReg.WriteInteger('Count',lNrToWrite);
// Write TCheckListBox items:
for i := 0 to lNrToWrite-1 do
begin
lValue := 'Item' + IntToStr(i);
lReg.WriteString(lValue,CLBParams.Items[i]);
end;
// Remove the rest:
for i := lNrToWrite to lNrRegVals-1 do
lReg.DeleteValue('Item' + IntToStr(i));
end;
end.
uCleanIDEParams.dfm
object FrmCleanIDEParams: TFrmCleanIDEParams
Left = 0
Top = 0
Caption = 'Clean Delphi IDE runtime parameters'
ClientHeight = 560
ClientWidth = 549
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object PnlTop: TPanel
Left = 0
Top = 0
Width = 549
Height = 58
Align = alTop
BevelOuter = bvNone
TabOrder = 0
object Label1: TLabel
Left = 19
Top = 11
Width = 308
Height = 13
Caption = 'HKEY_CURRENT_USER registry key for IDE runtime parameters:'
end
object BtnLoad: TButton
Left = 496
Top = 30
Width = 40
Height = 25
Caption = 'Load'
TabOrder = 0
OnClick = BtnLoadClick
end
object EdtRegKey: TEdit
Left = 16
Top = 32
Width = 473
Height = 21
TabOrder = 1
Text = '\Software\Embarcadero\BDS\9.0\History Lists\hlRunParameters'
end
object ChkRedundant: TCheckBox
Left = 388
Top = 10
Width = 151
Height = 17
Hint = 'Removes leading, trailing, and duplicate spaces'
Caption = 'Remove redundant spaces'
Checked = True
State = cbChecked
TabOrder = 2
end
end
object PnlBottom: TPanel
Left = 0
Top = 471
Width = 549
Height = 89
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
object Label2: TLabel
Left = 74
Top = 62
Width = 287
Height = 13
Caption = 'Click button to write the selected items back to the registry:'
end
object GBxSelection: TGroupBox
Left = 16
Top = -3
Width = 520
Height = 51
Caption = ' Select '
TabOrder = 0
object BtnSelectAll: TButton
Left = 348
Top = 18
Width = 50
Height = 25
Caption = 'All'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = BtnSelectAllClick
end
object BtnSelectNone: TButton
Left = 404
Top = 18
Width = 50
Height = 25
Caption = 'None'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = BtnSelectNoneClick
end
object BtnStartWith: TButton
Left = 51
Top = 18
Width = 79
Height = 25
Hint = 'Selection is additive'
Caption = 'starting with:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = BtnStartWithClick
end
object ChkNot: TCheckBox
Left = 11
Top = 22
Width = 40
Height = 17
Caption = 'NOT'
TabOrder = 3
end
object EdtStartWith: TEdit
Left = 136
Top = 20
Width = 121
Height = 21
Hint = 'Case insensitive match'
ParentShowHint = False
ShowHint = True
TabOrder = 4
Text = '['
end
object BtnInvert: TButton
Left = 460
Top = 18
Width = 50
Height = 25
Caption = 'Invert'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 5
OnClick = BtnInvertClick
end
end
object BtnWrite: TButton
Left = 364
Top = 58
Width = 89
Height = 25
Hint = 'Write the selected items back to the registry'
Caption = 'Write back'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = BtnWriteClick
end
object ChkSort: TCheckBox
Left = 459
Top = 62
Width = 57
Height = 17
Caption = '(sorted)'
Checked = True
State = cbChecked
TabOrder = 2
end
end
object PnlCenter: TPanel
Left = 0
Top = 58
Width = 549
Height = 413
Align = alClient
BevelOuter = bvNone
TabOrder = 2
object CLBParams: TCheckListBox
AlignWithMargins = True
Left = 15
Top = 10
Width = 522
Height = 393
Margins.Left = 15
Margins.Top = 10
Margins.Right = 12
Margins.Bottom = 10
Align = alClient
ItemHeight = 13
TabOrder = 0
end
end
end
Notes:
Do not forget to change the version number in the key if you are using anything other than XE2. For old Delphi versions you may even have to change Embarcadero to Borland.
Do not run this app from within the IDE. When it closes, Delphi will overwrite any changes you made to that registry key, and it looks like your program does not work ;=)
I'm using FastReport 4 to display some dynamically generated data and rearrange it in the report.
I use a "template" object in the report to get the initial position (in my real program I copy font properties, alignment, etc.)
I've managed to create a small project so I can create a memo component in the report, preview the report, and then remove the component so I can reuse the report with different data.
However, when I free the created object, I lose other objects from the report (in this case, my template object is not found the second time I preview the report).
What is the right way to create and remove objects from a Fast Report report?
Here is the pascal unit:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, frxClass;
type
TForm1 = class(TForm)
frxReport1: TfrxReport;
btn1: TButton;
procedure btn1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
modelObj: TfrxComponent;
newObj: TfrxMemoView;
begin
modelObj := frxReport1.FindObject('modelObj');
newObj := TfrxMemoView.Create(modelObj.Parent);
newObj.CreateUniqueName;
newObj.Text := 'Whee';
newObj.SetBounds(modelObj.Left, modelObj.Top + modelObj.Height,
modelObj.Width, modelObj.Height);
frxReport1.PrepareReport;
frxReport1.ShowPreparedReport;
newObj.Free;
end;
end.
Here's the DFM:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btn1: TButton
Left = 224
Top = 48
Width = 75
Height = 25
Caption = 'btn1'
TabOrder = 0
OnClick = btn1Click
end
object frxReport1: TfrxReport
Version = '4.15'
DotMatrixReport = False
IniFile = '\Software\Fast Reports'
PreviewOptions.Buttons = [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFind, pbOutline, pbPageSetup, pbTools, pbEdit, pbNavigator, pbExportQuick]
PreviewOptions.Zoom = 1.000000000000000000
PrintOptions.Printer = 'Por defecto'
PrintOptions.PrintOnSheet = 0
ReportOptions.CreateDate = 41905.757295162040000000
ReportOptions.LastChange = 41905.757295162040000000
ScriptLanguage = 'PascalScript'
ScriptText.Strings = (
'begin'
''
'end.')
Left = 72
Top = 32
Datasets = <>
Variables = <>
Style = <>
object Data: TfrxDataPage
Height = 1000.000000000000000000
Width = 1000.000000000000000000
end
object Page1: TfrxReportPage
PaperWidth = 216.000000000000000000
PaperHeight = 279.000000000000000000
PaperSize = 1
LeftMargin = 10.000000000000000000
RightMargin = 10.000000000000000000
TopMargin = 10.000000000000000000
BottomMargin = 10.000000000000000000
object PageHeader1: TfrxPageHeader
Height = 279.685220000000000000
Top = 18.897650000000000000
Width = 740.787880000000000000
object modelObj: TfrxMemoView
Left = 166.299320000000000000
Top = 30.236240000000000000
Width = 264.567100000000000000
Height = 18.897650000000000000
ShowHint = False
Color = clYellow
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = 'Arial'
Font.Style = []
Memo.UTF8W = (
'Model')
ParentFont = False
end
end
end
end
end
Sorry, for my misleading first answer.
It looks like an internal bug in PrepareReport, the objects seem to be exchanged.
var
modelObj: TfrxComponent;
newObj: TfrxMemoView;
cn:String;
begin
modelObj := frxReport1.FindObject('modelObj');
newObj := TfrxMemoView.Create(modelObj.Parent);
newObj.CreateUniqueName;
cn := newObj.Name; // keep for dirty workaround
newObj.Text := 'Whee';
newObj.SetBounds(modelObj.Left, modelObj.Top + modelObj.Height,
modelObj.Width, modelObj.Height);
Showmessage('New: ' + newObj.Name + ' modelObj: ' + modelObj.Name);
frxReport1.PrepareReport;
Showmessage('New: ' + newObj.Name + ' modelObj: ' + modelObj.Name);
frxReport1.ShowPreparedReport;
newObj := TfrxMemoView(frxReport1.FindObject(cn)); // dirty workaround
newObj.Free;
end;
Output:
New: Memo1 modelObj: modelObj
New: modelObj modelObj: Memo1
The workaround shown here will not be a usable way, so loading reports from a file or placing the TfrxReport component on a datamodule which will be created before printing and destroyed afterwards might be the better workarounds until this bug is fixed.
I am trying to convert a set of forms that were created with a custom tool to Delphi forms. I am trying to add all the necessary components at runtime and then use WriteComponentResFile to create the DFM file.
All of my initial tests looked good until I tried adding a TPageControl and TabSheets. The current forms can have multiple pages so I was going to mirror this using the PageControl. The problem is any components I add to a TabSheet are not streamed out to the DFM. It looks good if I show the form but something is missing for WriteComponentResFile.
I am writing out a corresponding pas file so I can open this up in the IDE once they are done. The goal is to move away from the custom form designer and start to use the Delphi IDE for our form designer.
Here is some sample code showing how I am creating the components:
procedure WriteFormAsDFM(OutputFileName: string);
var
PageIndex: integer;
PageCount: Integer;
OutputForm: TForm;
Pages: TPageControl;
NewPage: TTabSheet;
NewLabel: TLabel;
begin
OutputForm := TForm.Create(nil);
OutputForm.Name := ChangeFileExt(ExtractFileName(OutputFileName), '');
OutputForm.Caption := OutputForm.Name;
OutputForm.Height := 300;
OutputForm.Width := 300;
Pages := TPageControl.Create(OutputForm);
Pages.Parent := OutputForm;
Pages.Top := 50;
Pages.Left := 0;
Pages.Height := 200;
Pages.Width := 200;
NewLabel := TLabel.Create(OutputForm);
NewLabel.Parent := OutputForm;
NewLabel.Caption := 'Label on Form';
//write pages
PageCount := 2;
for PageIndex := 0 to PageCount - 1 do
begin
NewPage := TTabSheet.Create(Pages);
NewPage.Parent := Pages;
NewPage.PageControl := Pages;
NewPage.Caption := 'Page ' + IntToStr(PageIndex);
NewPage.Name := 'tsPage' + IntToStr(PageIndex);
NewLabel := TLabel.Create(NewPage);
NewLabel.Parent := NewPage;
NewLabel.Caption := 'Label on ' + NewPage.Caption;
end;
WriteComponentResFile(OutputFileName, OutputForm);
//WritePasFile(OutputFileName, OutputForm);
OutputForm.ShowModal;
FreeAndNil(OutputForm);
end;
and here is the DFM file that is output. You can see the label on the form is created but not the labels added to the TabSheets.
object Form123: TForm
Left = 69
Top = 69
Caption = 'Form123'
ClientHeight = 264
ClientWidth = 284
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object TLabel
Left = 0
Top = 0
Width = 67
Height = 13
Caption = 'Label on Form'
end
object TPageControl
Left = 0
Top = 50
Width = 200
Height = 200
ActivePage = tsPage0.Owner
TabOrder = 0
object tsPage0: TTabSheet
Caption = 'Page 0'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
end
object tsPage1: TTabSheet
Caption = 'Page 1'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
end
end
end
Try to use the form as owner of the components.
NewPage := TTabSheet.Create(OutputForm);
NewLabel := TLabel.Create(OutputForm);