Searching for a Delphi label component with basic format/markup support I came across Delphi Markup Label (MDLabel). As a bonus it supports links. Unfortunately I can't get it working. The component is provided as a single MD_Label.pas file. I've created a component package for it and installed it. I can now select it from the components list, but adding it to a form throws an error:
Control 'MDLabel1' has no parent window."
I traced it down to the call CreateWnd and found some topics for similar problems, but still wasn't able to solve this. Did I do something wrong or is this something that needs to be adjusted because the initial code was written for Delphi 2007 and I'm using XE?
The component is to large to post the whole source code here, but you can download it from the link above. Here's the creation part:
constructor TMDLabel.Create(AOwner: TComponent);
begin
FInitialized := False; // required for runtime creation of MDLabel
inherited;
ControlStyle := [csOpaque, csCaptureMouse, csClickEvents, csSetCaption];
FLinkFontNormal := TFont.Create;
FLinkFontNormal.Assign(Font);
FLinkFontNormal.Color := clBlue;
FLinkFontNormal.Style := [];
FLinkFontHover := TFont.Create;
FLinkFontHover.Assign(Font);
FLinkFontHover.Color := clRed;
FLinkFontHover.Style := [fsUnderline];
Width := 100;
Height := 13;
Cursor := crArrow;
TabStop := False;
DoubleBuffered := True;
FTextHeight := 0;
FAutoSizeWidth := True;
FAutoSizeHeight := True;
FTextAlignment := taLeftJustify;
FCompressSpaces := False;
FTabWidth := 8;
FParsingText := False;
FBuildingLines := False;
FRebuildLines := False;
FMaxWidth := 0;
FLinkFontNormal.OnChange := DoFontChange;
FLinkFontHover.OnChange := DoFontChange;
FOnLinkClicked := nil;
FOnPaintBackground := nil;
FOnHeightChanged := nil;
FOnWidthChanged := nil;
FLines := TList.Create;
FWords := TList.Create;
FLinkRCs := TList.Create;
FMouseDownMove := False;
FMouseWasDown := False;
FMouseDownIndex := - 1;
FInitialized := True;
end;
procedure TMDLabel.CreateWnd;
begin
inherited CreateWnd;
{$IFNDEF UNICODE}
if (inherited Caption <> '') and (FCaptionUTF8 = '') then CaptionUTF8 := inherited Caption;
{$ENDIF}
end;
Full source: http://pastebin.com/sxYvpqTy
As a side note: If you feel that there's a better component that supports formating text within labels, please feel free to share as a comment (TJvHTLabel and TJvMarkupLabel are not good).
This error is a very common one for component authors who don't understand how the VCL works internally.
The fact that the error occurs while dropping the component on the Form at design-time means that the component's constructor is doing something it should not be. One of the operations requires the component's Handle to have an allocated HWND, but that is not possible at the time of the error because the component's Parent property has not been assigned yet, or the Parent.Handle does not have an allocated HWND of its own. The Parent is not assigned until after the constructor exits.
So, you need to debug the code and find the offending constructor code that relies on the component's Handle property, and move it out of the constructor. Depending on which code it is, it either belongs in Loaded() or CreateWnd(), or even SetParent(), or it may even need to be disabled completely at design-time (sometimes run-time code should not be executed at design-time or during DFM streaming at all).
Related
I have created dynamic Form as the next :
procedure TForm1.Button1Click(Sender: TObject);
var
Frm:TForm2;
begin
frm:=TForm2.Create(nil);
Frm.Left:=5;
Frm.Top:=5;
Frm.Parent:=Self;
Frm.OnCreate:=OncreateFrm;
Frm.Show;
end;
and when am trying to change the AlphaBlend property, the transparency wouldn't change..
procedure TForm1.OncreateFrm(Sender: TObject);
begin
AlphaBlend:=True;
AlphaBlendValue:=200;
end;
Also overriding the constructor it gave the same result ..
Thanks.
Your approach
Frm := TForm2.Create(nil);
Frm.Left := 5;
Frm.Top := 5;
Frm.Parent := Self;
Frm.OnCreate := OncreateFrm;
Frm.Show;
cannot possibly work because you set the OnCreate handler on line 5, which is after the form has been created on line 1; consequently, at the time the form is created (line 1), it sees that OnCreate is nil and so does nothing. Your instruction on line 5 has no effect.
This is like telling your fiend "Please buy some milk on your way home from work" after your friend has already come home from work.
Solutions
1: Set the properties at design time
Of course, you can use the Object Inspector to set the AlphaBlend and AlphaBlendValue properties of TForm2 at design time. But I suspect you want to do it dynamically, because you ask this question.
2: Use the OnCreate handler on TForm2
Just open TForm2 in the form editor and double click it to give it its own OnCreate handler:
// in Unit2.pas
procedure TForm2.FormCreate(Sender: TObject);
begin
AlphaBlend := True;
AlphaBlendValue := 128;
end;
3: Override TForm2's constructor
// in Unit2.pas
constructor TForm2.Create(AOwner: TComponent);
begin
inherited;
AlphaBlend := True;
AlphaBlendValue := 128;
end;
4: Set the properties when you create the object
// in Unit1.pas
procedure TForm1.Button1Click(Sender: TObject);
var
Frm: TForm2;
begin
Frm := TForm2.Create(nil);
Frm.Left := 5;
Frm.Top := 5;
Frm.AlphaBlend := True;
Frm.AlphaBlendValue := 128;
Frm.Show;
end;
Unlike the previous three approaches, this one affects only this instance of TForm2 -- it doesn't affect the class itself.
All these approaches work.
There is a "but"
Your line
Frm.Parent := Self
means that you make this form into a control instead of a top-level window.
And layered windows (the Win32 feature on which the VCL's AlphaBlend feature is based) are only supported as child windows in Windows 8 and later.
Therefore, if you are using Windows 7 or earlier, you cannot use AlphaBlend in this case.
i used Delphi XE7 and DevExpress component, i need to create dxTileBarItem at runtime and add this to my dxTileBar but i cant.
var
//Tile4:TdxTileControlItem;
Tile4:TdxTileBarItem;
begin
Tile4 := TdxTileBarItem.Create(dxTileBar1);
Tile4.Name := 'Tile4';
Tile4.GroupIndex := 0;
Tile4.IndexInGroup := 3;
what is my mistake?
then i want to store a form object in manually created dxTileItem and call each from on OnTileClick such as ListBox, what do i should?
You can use the CreateItem method, for example:
var
MyTile: TdxTileBarItem;
begin
MyTile := dxTileBar1.CreateItem(tbisRegular);
MyTile.Name := 'My Tile';
...
end;
Or you can follow quite common pattern used by Delphi controls, add the item to the control's Items collection, for example:
var
MyTile: TdxTileBarItem;
begin
dxTileBar1.BeginUpdate;
try
MyTile := TdxTileBarItem(dxTileBar1.Items.Add);
MyTile.Name := 'My Tile';
...
finally
dxTileBar1.EndUpdate;
end;
MyTile.MakeVisible;
end;
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;
...
I have been using code similar to this
MessageDlg('', mtWarning, [mbOK], 0);
throughout my project, (thanks to the GExperts Message Dialog tool :) ) and i was wondering if anyone knows of a way do override the call and show my own custom Form.
The only way i can think to do it its make a New Form with something like
function MessageDlg(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
//show my own code here
end;
and put it each of my uses lists before the Dialogs unit but is there a guaranteed way to make sure it uses my code not the Dialogs unit Code.
I don't like the idea of copying the dialogs unit to a local dir and making changes to it.
Or is this all to much work and should i just use my own function call and replace all the MessageDlg with my own. (which would not be fun, ive prob used MessageDlg too much)
BTW, you want to add it after the Dialogs unit in your uses clause.
You have three choices in my opinion:
Add your own unit after the Dialogs unit that has a method called MessageDlg and has the same signature to create your own form.
Or create a whole new method, or set of methods, that creates specific dialogs using your own form.
Do a global Search & Replace for MessageDlg with DarkAxi0mMessageDlg and then add your DarkAxi0mDialogs unit to your uses clause.
The first one is problematic because you might miss a unit and still get the old MessageDlg. The second one takes a lot more use, but provides better flexibility in the long run. The third one is probably the easiest and with the least downsides. Make sure you backup before doing the replace, and then use a diff tool (like Beyond Compare) to check your changes.
I would recommend you to encapsulate the MessageDlg inside of you own procedures, this way if you change your procedures all your Message dialogs will be changed and you keep a standard.
Example: Create some procedures like, Alert(), Error(), Warning(), etc. If you ever need to change your error message looks, you need to do it only in one place.
Someday you might want to add a picture to your error messages, alerts... whatever, who knows?
You can use a tool like TextPad to search/replace all instances of a string across folders and subfolders. So, I would suggest that you replace "MessageDlg(" with "MyMessageDlg(" so that you can customize it at will. Should take all of 5 minutes.
I think it would cause you problems to create a replacement and leave it named as it is currently in conflict with the VCL.
You can hijack the MessageDlg function and make it point to your own MyMessageDlg function (with same signature) but I think it would the least safe of all the solutions.
A bad hack in lieu of clean code IMO.
Save the original opcodes of MessageDlg (asm generated by the compiler)
Put a hard jump to your MyMessageDlg code
...then any call to MessageDlg will actually execute YOUR code ...
Restore the original code to MessageDlg
MessageDlg now behaves as usual
It works but should be reserved for desperate situations...
i made a MessageDlgEx function based on MessageDlg and dropped it into one of my "library" files so all my apps can use it. my function allows you to specify default & cancel buttons, give button texts, etc. it'd be a bad practice to modify/replace the built-in function. i still use the built-in function but keep this function on hand for situations where a little more is needed.
FYI--the function returns the number of the button pressed. the first button is 1. pressing Close causes a return value of 0. the buttons have no glyphs.
i have been using this for about 5 years & it's served me well.
function MessageDlgEx(Caption, Msg: string; AType: TMsgDlgType;
AButtons: array of string;
DefBtn, CanBtn: Integer; iWidth:integer=450;bCourier:boolean=false): Word;
const
icMin=50;
icButtonHeight=25;
icInterspace=10;
icButtonResultStart=100;
icFirstButtonReturnValue=1;
var
I, iButtonWidth, iAllButtonsWidth,
iIconWidth,iIconHeight:Integer;
LabelText:String;
Frm: TForm;
Lbl: TLabel;
Btn: TBitBtn;
Glyph: TImage;
FIcon: TIcon;
Rect:TRect;
Caption_ca:Array[0..2000] of Char;
begin
{ Create the form.}
Frm := TForm.Create(Application);
Frm.BorderStyle := bsDialog;
Frm.BorderIcons := [biSystemMenu];
Frm.FormStyle := fsStayOnTop;
Frm.Height := 185;
Frm.Width := iWidth;
Frm.Position := poScreenCenter;
Frm.Caption := Caption;
Frm.Font.Name:='MS Sans Serif';
Frm.Font.Style:=[];
Frm.Scaled:=false;
if ResIDs[AType] <> nil then
begin
Glyph := TImage.Create(Frm);
Glyph.Name := 'Image';
Glyph.Parent := Frm;
FIcon := TIcon.Create;
try
FIcon.Handle := LoadIcon(HInstance, ResIDs[AType]);
iIconWidth:=FIcon.Width;
iIconHeight:=FIcon.Height;
Glyph.Picture.Graphic := FIcon;
Glyph.BoundsRect := Bounds(icInterspace, icInterspace, FIcon.Width, FIcon.Height);
finally
FIcon.Free;
end;
end
else
begin
iIconWidth:=0;
iIconHeight:=0;
end;
{ Loop through buttons to determine the longest caption. }
iButtonWidth := 0;
for I := 0 to High(AButtons) do
iButtonWidth := Max(iButtonWidth, frm.Canvas.TextWidth(AButtons[I]));
{ Add padding for the button's caption}
iButtonWidth := iButtonWidth + 18;
{assert a minimum button width}
If iButtonWidth<icMin Then
iButtonWidth:=icMin;
{ Determine space required for all buttons}
iAllButtonsWidth := iButtonWidth * (High(AButtons) + 1);
{ Each button has padding on each side}
iAllButtonsWidth := iAllButtonsWidth +icInterspace*High(AButtons);
{ The form has to be at least as wide as the buttons with space on each side}
if iAllButtonsWidth+icInterspace*2 > Frm.Width then
Frm.Width := iAllButtonsWidth+icInterspace*2;
if Length(Msg)>sizeof(Caption_ca) then
SetLength(Msg,sizeof(Caption_ca));
{ Create the message control}
Lbl := TLabel.Create(Frm);
Lbl.AutoSize := False;
Lbl.Left := icInterspace*2+iIconWidth;
Lbl.Top := icInterspace;
Lbl.Height := 200;
Lbl.Width := Frm.ClientWidth - icInterspace*3-iIconWidth;
Lbl.WordWrap := True;
Lbl.Caption := Msg;
Lbl.Parent := Frm;
if bCourier then
lbl.Font.Name:='Courier New';
Rect := Lbl.ClientRect;
LabelText:=Lbl.Caption;
StrPCopy(Caption_ca, LabelText);
Lbl.Height:=DrawText(Lbl.Canvas.Handle,
Caption_ca,
Length(LabelText),
Rect,
DT_CalcRect or DT_ExpandTabs or DT_WordBreak Or DT_Left);
If Lbl.Height<iIconHeight Then
Lbl.Height:=iIconHeight;
{ Adjust the form's height accomodating the message, padding and the buttons}
Frm.ClientHeight := Lbl.Height + 3*icInterspace + icButtonHeight;
{ Create the pusbuttons}
for I := 0 to High(AButtons) do
begin
Btn := TBitBtn.Create(Frm);
Btn.Height := icButtonHeight;
Btn.Width := iButtonWidth;
Btn.Left:=((Frm.Width-iAllButtonsWidth) Div 2)+I*(iButtonWidth+icInterspace);
Btn.Top := Frm.ClientHeight - Btn.height-icInterspace;
Btn.Caption := AButtons[I];
Btn.ModalResult := I + icButtonResultStart + icFirstButtonReturnValue;
Btn.Parent := Frm;
If I=DefBtn-1 Then
Begin
Frm.ActiveControl:=Btn;
Btn.Default:=True;
End
Else
Btn.Default:=False;
If I=CanBtn-1 Then
Btn.Cancel:=True
Else
Btn.Cancel:=False;
end;
Application.BringToFront;
Result := Frm.ShowModal;
{trap and convert user Close into mrNone}
If Result=mrCancel Then
Result:=mrNone
Else
If Result>icButtonResultStart Then
Result:=Result - icButtonResultStart
Else
Exception.Create('Unknown MessageDlgEx result');
Frm.Free;
end;
Is it possible to, for instance, replace and free a TEdit with a subclassed component instantiated (conditionally) at runtime? If so, how and when it should be done? I've tried to set the parent to nil and to call free() in the form constructor and AfterConstruction methods but in both cases I got a runtime error.
Being more specific, I got an Access violation error (EAccessViolation). It seems François is right when he says that freeing components at frame costruction messes with Form controls housekeeping.
This more generic routine works either with a Form or Frame (updated to use a subclass for the new control):
function ReplaceControlEx(AControl: TControl; const AControlClass: TControlClass; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
begin
Result := nil;
Exit;
end;
Result := AControlClass.Create(AControl.Owner);
CloneProperties(AControl, Result);// copy all properties to new control
// Result.Left := AControl.Left; // or copy some properties manually...
// Result.Top := AControl.Top;
Result.Name := ANewName;
Result.Parent := AControl.Parent; // needed for the InsertControl & RemoveControl magic
if IsFreed then
FreeAndNil(AControl);
end;
function ReplaceControl(AControl: TControl; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
Result := nil
else
Result := ReplaceControlEx(AControl, TControlClass(AControl.ClassType), ANewName, IsFreed);
end;
using this routine to pass the properties to the new control
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
use it like:
procedure TFrame1.AfterConstruction;
var
I: Integer;
NewEdit: TMyEdit;
begin
inherited;
NewEdit := ReplaceControlEx(Edit1, TMyEdit, 'Edit2') as TMyEdit;
if Assigned(NewEdit) then
begin
NewEdit.Text := 'My Brand New Edit';
NewEdit.Author := 'Myself';
end;
for I:=0 to ControlCount-1 do
begin
ShowMessage(Controls[I].Name);
end;
end;
CAUTION: If you are doing this inside the AfterConstruction of the Frame, beware that the hosting Form construction is not finished yet.
Freeing Controls there, might cause a lot of problems as you're messing up with Form controls housekeeping.
See what you get if you try to read the new Edit Caption to display in the ShowMessage...
In that case you would want to use
...ReplaceControl(Edit1, 'Edit2', False)
and then do a
...FreeAndNil(Edit1)
later.
You have to call RemoveControl of the TEdit's parent to remove the control. Use InsertControl to add the new control.
var Edit2: TEdit;
begin
Edit2 := TEdit.Create(self);
Edit2.Left := Edit1.Left;
Edit2.Top := Edit2.Top;
Edit1.Parent.Insertcontrol(Edit2);
TWinControl(Edit1.parent).RemoveControl(Edit1);
Edit1.Free;
end;
Replace TEdit.Create to the class you want to use, and copy all properties you need like I did with Left and Top.
You can actually use RTTI (look in the TypInfo unit) to clone all the matching properties. I wrote code for this a while back, but I can't find it now. I'll keep looking.