Access violation when closing the form that has floating component - c++builder

I have a C++Builder VCL application that has some dynamically created components on it. These components should be able to dock and undock from a Panel.
The problem is, if the user closes the form while one of these components are undocked (Floating), I get an error:
First chance exception at $50C278EF. Exception class $C0000005 with message 'access violation at 0x50c278ef: read of address 0x00000010'. Process Project1.exe (8004)
Here is a simplified sample that demonstrate the problem:
The HPP:
//---------------------------------------------------------------------------
#ifndef Unit1H
#define Unit1H
//---------------------------------------------------------------------------
#include <System.Classes.hpp>
#include <Vcl.Controls.hpp>
#include <Vcl.StdCtrls.hpp>
#include <Vcl.Forms.hpp>
#include <Vcl.ExtCtrls.hpp>
//---------------------------------------------------------------------------
class TForm1 : public TForm
{
__published: // IDE-managed Components
TPanel *Panel1;
TPanel *Panel2;
void __fastcall FormCreate(TObject *Sender);
void __fastcall FormDestroy(TObject *Sender);
private: // User declarations
TPanel *Panel3;
public: // User declarations
__fastcall TForm1(TComponent* Owner);
};
//---------------------------------------------------------------------------
extern PACKAGE TForm1 *Form1;
//---------------------------------------------------------------------------
#endif
The CPP
//---------------------------------------------------------------------------
#include <vcl.h>
#pragma hdrstop
#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
void __fastcall TForm1::FormCreate(TObject *Sender)
{
Panel3 = new TPanel((TComponent*)nullptr);
Panel3->Parent = Panel1;
Panel3->Width = 50;
Panel3->Height = 50;
Panel3->DragKind = dkDock;
Panel3->DragMode = dmAutomatic;
}
//---------------------------------------------------------------------------
void __fastcall TForm1::FormDestroy(TObject *Sender)
{
delete Panel3;
}
//---------------------------------------------------------------------------
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
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 128
Top = 48
Width = 409
Height = 217
Caption = 'Panel1'
DockSite = True
TabOrder = 0
object Panel2: TPanel
Left = 216
Top = 8
Width = 185
Height = 97
Caption = 'Panel2'
DragKind = dkDock
DragMode = dmAutomatic
TabOrder = 0
end
end
end
In this example, if Panel3 is Floating and the user closes that form, we get the exception.

Related

Delphi-docking form hides panel

I have a problem that docking form hides some other components inside of panel.
This is simple example of my problem: I have Panel1 with DockSite set to True. Inside Panel1 is Panel2. Panel2 alignts to client (Align=alClient). Inside Panel2 is memo field that is also aligned to client. It overlaps the entire Panel1.
I have another form (Form2) that I want to dock to Panel1. But it overlaps entire Panel1 and hides memo filed. I want to overlap only part of Panel1 (width of the form) and move Panel2 to the rigth or to te left.
Main form:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Panel2: TPanel;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.Show;
end;
end.
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 333
ClientWidth = 754
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
PixelsPerInch = 96
TextHeight = 15
object Button1: TButton
Left = 288
Top = 271
Width = 153
Height = 41
Caption = 'Show dockable form'
TabOrder = 0
OnClick = Button1Click
end
object Panel1: TPanel
Left = 8
Top = 8
Width = 729
Height = 257
Caption = 'Panel1'
DockSite = True
TabOrder = 1
object Panel2: TPanel
Left = 1
Top = 1
Width = 727
Height = 255
Align = alClient
Caption = 'Panel2'
TabOrder = 0
ExplicitLeft = 360
ExplicitTop = 8
ExplicitWidth = 337
ExplicitHeight = 241
object Memo1: TMemo
Left = 1
Top = 1
Width = 725
Height = 253
Align = alClient
Lines.Strings = (
'Memo1')
TabOrder = 0
ExplicitWidth = 216
ExplicitHeight = 144
end
end
end
end
Docking form:
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
end.
object Form2: TForm2
Left = 0
Top = 0
Caption = 'Form2'
ClientHeight = 103
ClientWidth = 273
Color = clBtnFace
DragKind = dkDock
DragMode = dmAutomatic
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
PixelsPerInch = 96
TextHeight = 15
object Label1: TLabel
Left = 22
Top = 24
Width = 227
Height = 45
Caption = 'Dockable form'
DragKind = dkDock
DragMode = dmAutomatic
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -33
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
end
end
The dynamics soon become difficult to master with changing dock sites and alignment changes, but I think the following will do what you ask for.
Change the hierarchy of Form1 to the following and note that Panel2 and Memo1 both are childs of Panel1. Panel2 will act as the docking target. I have set Panel2.Width to 8, to have a visual area where to drop Form2. Here are the essential properties:
object Form1: TForm1
object Button1: TButton
object Panel1: TPanel
Caption = 'Panel1'
object Panel2: TPanel
Width = 8
Align = alRight
Caption = 'Panel2'
DockSite = True
OnDockDrop = Panel2DockDrop
OnDockOver = Panel2DockOver
OnUnDock = Panel2UnDock
end
object Memo1: TMemo
Align = alClient
end
end
end
When Form2 is dragged over Panel2 the OnDockOver event is triggered. Panel2 sets its width to half the width of Panel1, which in turn reduces the Memo1 width with the same amount. (Change as you need)
procedure TForm1.Panel2DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Panel2.Width := Panel1.Width div 2;
end;
When Form2 is dropped on Panel2, the DockRect of the form is set to the rect of Panel2.
procedure TForm1.Panel2DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
begin
Source.DockRect := Rect(Panel2.Width, Panel2.Top, Panel2.Width, Panel2.Height);
end;
When Form2 is undocked from Panel2 it reduces its width to the 8 pixels, which again widen the Memo1 to its original width.
procedure TForm1.Panel2UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl;
var Allow: Boolean);
begin
Panel2.Width := 8;
end;
Here's the complete .dfm of Form1:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 333
ClientWidth = 425
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 15
object Button1: TButton
Left = 120
Top = 284
Width = 153
Height = 41
Caption = 'Show dockable form'
TabOrder = 0
OnClick = Button1Click
end
object Panel1: TPanel
Left = 8
Top = 8
Width = 400
Height = 257
Caption = 'Panel1'
TabOrder = 1
object Panel2: TPanel
Left = 391
Top = 1
Width = 8
Height = 255
Align = alRight
Caption = 'Panel2'
DockSite = True
TabOrder = 0
OnDockDrop = Panel2DockDrop
OnDockOver = Panel2DockOver
OnUnDock = Panel2UnDock
ExplicitLeft = 394
end
object Memo1: TMemo
Left = 1
Top = 1
Width = 390
Height = 255
Align = alClient
Lines.Strings = (
'Memo1')
TabOrder = 1
ExplicitWidth = 725
ExplicitHeight = 253
end
end
end

Delphi TRichEdit.Perform( EM_FORMATRANGE, 0,Longint(#fmtRange));

i want to find the height that needs the TRichEdit control to render itself without showing the vertical scrollbar.
I use this code
function RichEditHeight(var RE : TRichEdit; aForm : TForm) : integer;
var fmtRange: TFormatRange;
begin
FillChar(fmtRange, SizeOf(fmtRange), 0);
with fmtRange do begin
hDC := aForm.canvas.Handle;
hdcTarget := hDC;
rc.left := 0;
rc.right := (RE.ClientWidth * 1440) div screen.pixelsPerInch;
rc.top := 0;
rc.Bottom := MaxInt;
rcPage := rc;
chrg.cpMin := 0;
chrg.cpMax := -1;
end;
RE.Perform(EM_FORMATRANGE, 0, Longint(#fmtRange));
result := round(fmtRange.rc.Bottom*screen.pixelsPerInch/1440);
RE.Perform(EM_FORMATRANGE, 0, 0);
end;
When the document has a few pages (<15 A4 portrait) the result is sufficient.
But with more pages, the rc.bottom seems to be trancated and the control needs the vertical scrollbar.
The question is : there are some limitations inside perform's code ?
If i increase the rc.bottom manually (approximately) then the control renders itself ok but this isn't the case i want.
PS. if matters, the richedit component, actually is a TjvRichEdit one.
Here is a minimal program that can reproduce the problem (for even 2 pages)
unit Unit32;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, winAPI.richedit, JvExStdCtrls, JvRichEdit, Vcl.ExtCtrls;
type
TForm32 = class(TForm)
ScrollBox1: TScrollBox;
Button1: TButton;
RichEdit1: TJvRichEdit;
panel1: TPanel;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var Form32: TForm32;
implementation
{$R *.dfm}
function RichEditHeight(var RE : TjvRichEdit; aForm : TForm) : integer;
var fmtRange: TFormatRange;
begin
FillChar(fmtRange, SizeOf(fmtRange), 0);
with fmtRange do begin
hDC := aForm.canvas.Handle;
hdcTarget := hDC;
rc.left := 0;
rc.right := (RE.ClientWidth * 1440) div screen.pixelsPerInch;
rc.top := 0;
rc.Bottom := 500000;
rcPage := rc;
chrg.cpMin := 0;
chrg.cpMax := -1;
end;
RE.Perform(EM_FORMATRANGE, 0, Longint(#fmtRange));
result := round(fmtRange.rc.Bottom*screen.pixelsPerInch/1440);
RE.Perform(EM_FORMATRANGE, 0, 0);
end;
procedure TForm32.Button1Click(Sender: TObject);
begin
with OpenDialog1 do
if execute then begin
RichEdit1.lines.LoadFromFile(filename);
panel1.height := RichEditHeight(RichEdit1,Form32);
end;
end;
end.
The form
object Form32: TForm32
Left = 0
Top = 0
Caption = 'Form32'
ClientHeight = 615
ClientWidth = 874
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ScrollBox1: TScrollBox
Left = 0
Top = 0
Width = 874
Height = 615
Align = alClient
TabOrder = 0
ExplicitWidth = 885
ExplicitHeight = 583
object Button1: TButton
Left = 632
Top = 24
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object panel1: TPanel
Left = 0
Top = 0
Width = 457
Height = 561
Caption = 'panel1'
TabOrder = 1
object RichEdit1: TJvRichEdit
Left = 1
Top = 1
Width = 455
Height = 559
Align = alClient
Font.Charset = GREEK_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ScrollBars = ssVertical
SelText = ''
TabOrder = 0
ExplicitHeight = 279
end
end
end
object OpenDialog1: TOpenDialog
Left = 656
Top = 88
end
end
and the result with a RTF document (just 2 pages)
Finally, the solution was very simple!
TRichedit has the event onResizeRequest where the actual height of the control is given by the rect parameter

Creating and deleting objects in Fast Report VCL (Delphi)

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.

RichEdit control stop drawing text when it became a parent for other control

RichEdit control stop drawing text when it became a parent for other control.
Is this a feature or a bug?
Is it possible to make RichEdit to be a parent for other control?
Check out next app:
-- Form1.dfm ---
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 282
ClientWidth = 418
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 24
Top = 8
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object RichEdit1: TRichEdit
Left = 16
Top = 72
Width = 145
Height = 105
Font.Charset = RUSSIAN_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Lines.Strings = (
'RichEdit1')
ParentFont = False
TabOrder = 1
end
end
-- Form1.dfm ---
--- Unit1.pas ---
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;
type
TForm3 = class(TForm)
Button1: TButton;
RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
begin
Button1.Parent := RichEdit1;
RichEdit1.Invalidate;
end;
end.
--- Unit1.pas ---
Test under Delphi XE5 + Win 7.
I want to create RichEdit with Edit button like this
This is the result that I want to get - RichEdit with DropDown Editor:
Use an interposer class that handles the WM_PAINT message like so:
type
TRichEdit = class(Vcl.ComCtrls.TRichEdit)
protected
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;
procedure TRichEdit.WMPaint(var Message: TWMPaint);
begin
DefaultHandler(Message);
end;
For reasons lost in the mists of time, TCustomRichEdit does some special handling of WM_PAINT that was only actually needed for the original version of the rich edit DLL. Moreover, this special handling breaks normal painting when another control is parented to the rich edit. As such, fixing the issue requires re-establishing standard VCL/Windows paint handling, which is what the code above does.
That said, I doubt nesting a button inside a rich edit is really what you want - the text won't wrap around it, for example.

Delphi: frame+colorbox=bug

Delphi XE (It works fine in Delphi 2010).
Try: create a frame and a color box inside it. The color box -> set a Selected color other than black and a style = cbCustomColor (not cbCustomColors); paste the frame into the form, save a project.
Close the project. Reopen->errors as below:
I need this "custom color", who is freaking: me, a color box, a frame or whole Delphi? :)
Thanks!!!
Source code:
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 202
ClientWidth = 447
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
inline Frame21: TFrame2
Left = 72
Top = -38
Width = 320
Height = 240
TabOrder = 0
ExplicitLeft = 72
ExplicitTop = -38
end
end
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Unit2;
type
TForm1 = class(TForm)
Frame21: TFrame2;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end.
object Frame2: TFrame2
Left = 0
Top = 0
Width = 320
Height = 240
TabOrder = 0
object ColorBox1: TColorBox
Left = 72
Top = 48
Width = 145
Height = 22
Selected = clGreen
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbCustomColor]
TabOrder = 0
end
end
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TFrame2 = class(TFrame)
ColorBox1: TColorBox;
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.dfm}
end.
This is a bug in Delphi XE. Please add this to the QC bug reporting system at Embarcadero.

Resources