Font consistency throughout Project? - delphi

Is there a quick and effective way of applying a global Font to be used in a project?
By this I mean I would like to set a specific Font name that all controls in my project will use such as TButton, TEdit, TLabel etc.
Typically setting the Font for the Form rather than a specific control will change all the controls on that Form to the Font specified.
There is a slight issue with this however, if you have manually changed a Font on a specific control, then setting the Font by the Form will no longer update those controls that have previously been changed manually.
Idea 1
I was thinking of using a For loop and iterating through each component on my Forms and setting the Font this way, such as:
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
with TForm(Self) do
begin
for i := 0 to ComponentCount - 1 do
begin
if Components[i] is TButton then
begin
TButton(Components[i]).Font.Name := 'MS Sans Serif';
TButton(Components[i]).Font.Size := 8;
TButton(Components[i]).Font.Style := [fsBold];
end;
if Components[i] is TLabel then
begin
TLabel(Components[i]).Font.Name := 'MS Sans Serif';
TLabel(Components[i]).Font.Size := 8;
TLabel(Components[i]).Font.Style := [fsBold];
end;
end;
end;
end;
But doing this seems very messy, it will also be a considerable amount of code for a simple task.
Idea 2
I know I could manually change the fonts at design time one by one for each control, but with several forms to go through this could take time and even then I might of missed a control.
Idea 3
Similar to Idea 2, another way could be to view the Form as Text (DFM) and Find and Replace the font that way.
Basically I am going for consistency within my Application, and having one Font used throughout is what I was looking to achieve.
Am I missing something completely obvious here, is what I am trying to do overkill for such a task?

As discussed in the comments, the key to this is the ParentFont property. This property is defined at various points in the VCL hierarchy. If you set ParentFont to be True for all components in the chain, then you can change the fonts for the entire application simply by modifying
Application.DefaultFont
By default most components set ParentFont to True and so you have nothing to do. The odd one out though is TForm. A brand new default form has ParentFont set to False. This is somewhat disappointing but I suspect reflects the fact that the original designers of the VCL did not anticipate this and that ParentFont was grafted on relatively late in the development of the VCL.
No matter, in an ideal world, all forms in your application should be derived from a common base class that you control. If that is so then you can simply make the change there, set ParentFont to be True, make sure no explicit font settings are applied to any components on you forms, and you are golden. Control the entire application's fonts through a single property. If you don't have a common base class for your forms, here's an ideal time to add it. If you don't want to do that then you need to set ParentFont for each form.
Other related properties are Screen.MessageFont and Screen.MenuFont. These provide global control over the fonts used in message boxes and menus. However, recent versions of Delphi have handed back to Windows control over the painting of message boxes and menus and so these properties have no effect.

The real key, as was mentioned, is to ensure that all your forms descend from your own application base form.
Then, you can view each form and button etc, and review the properties, where any modified font property should be displayed in bold, and is easily identified. Most properties have a "Revert to inherited" menu choice. This should essentially undo any previous selection, without having to go to the text version for editting. (Although it probably does exactly that, deleting any text entry resulting from previous font-setting).
I would definitely want to fix each form once rather than leaving it defined incorrectly and adding more code to fix it at runtime. That change will leave you with a worse problem if you later decide to do something different.

If you want to do this runtime, like you describe it in Idea 1, you should consider making it a recursive function, like this:
procedure SetFontProperties(Control: TControl; Name: TFontName; Size: Integer; Styles: TFontStyles);
// Set font properties
var
Index: Integer;
Font: TFont;
AnObject: TObject;
ChildControl: TControl;
begin
// Set font properties
AnObject := GetObjectProp(Control, 'Font', nil);
if AnObject is TFont then
begin
// Set properties
Font := TFont(AnObject);
Font.Name := Name;
Font.Size := Size;
Font.Style := Styles;
end;
// Set child font properties
if Control is TWinControl then
begin
// Set
for Index := 0 to TWinControl(Control).ControlCount - 1 do
begin
// Child control
ChildControl := TWinControl(Control).Controls[Index];
// Set font properties
SetFontProperties(ChildControl, Name, Size, Styles);
end;
end;
end;
You can then switch fonts for all controls within a form by using it like this:
SetFontProperties(Self, 'Courier', 14, []);
The function will then set the font properties of the form, and the font properties of all child controls on the form, including controls nested within TPanels or other container controls.
However I do agree with you that it's sort of a half messy way of doing it.

Related

How to programatically set designtime height / width of TDatamodule in Delphi?

I generate a TDatamodule with a bunch of TFDQueries that it contains. Then, I save this Datamodule .DFM like so
lFileStream := TFileStream.Create('Datamodule.dfm', fmCreate);
lMemoryStream := TMemoryStream.Create;
lMemoryStream.WriteComponent(lDataModule);
lMemoryStream.Seek(0, soFromBeginning);
ObjectBinaryToText(lMemoryStream, lFileStream);
lFileStream.Free;
lMemoryStream.Free;
To be user-friendly, I need to set the width and height of this TDatamodule when I generate it. But I cannot use
lDatamodule.Width := 500; // Does not compile
lDatamodule.Height := 500; // Does not compile
Because Width and Height are registered design time properties. A similar strategy allowing to set the designtime Left and Top properties of TComponents is done using the DesignInfo property as such
procedure BootyShakin;
var
NewDesignInfo : LongRec;
begin
NewDesignInfo.Lo := Word(100);
NewDesignInfo.Hi := Word(100);
lComponent.DesignInfo := Longint(NewDesignInfo);
end;
I am looking for an analogous solution for setting the design time width and height of a TDatamodule before it is saved to .DFM
TDataModule offers a public property DesignSize, which is of type TPoint.
Documentation says:
Specifies the design size for the data module at design time.
An application should never need to set this value. It controls the size of the data module window at design time.
Despite the documentation does not recommend it - for normal applications, which use the TDataModule, I think - you can archieve what you are looking for with this property.

Custom TListBox Style Firemonkey

I have followed the sample supplied by EMB that can be found on
"C:\Users\Public\Documents\Embarcadero\Studio\14.0\Samples\Object Pascal\FireMonkey Desktop\CustomListBox"
this is how it looks like:
This is the code that add the row to the listbox:
procedure TfrmCustomList.Button2Click(Sender: TObject);
var
Item: TListBoxItem;
begin
// create custom item
Item := TListBoxItem.Create(nil);
Item.Parent := ListBox1;
Item.StyleLookup := 'CustomItem';
Item.Text := 'item ' + IntToStr(Item.Index); // set filename
if Odd(Item.Index) then
Item.ItemData.Bitmap := Image1.Bitmap // set thumbnail
else
Item.ItemData.Bitmap := Image2.Bitmap; // set thumbnail
Item.StylesData['resolution'] := '1024x768 px'; // set size
Item.StylesData['depth'] := '32 bit';
Item.StylesData['visible'] := true; // set Checkbox value
Item.StylesData['visible.OnChange'] := TValue.From<TNotifyEvent>(DoVisibleChange); // set OnChange value
Item.StylesData['info.OnClick'] := TValue.From<TNotifyEvent>(DoInfoClick); // set OnClick value
end;
As you can see there is this line where the custom style is applyed:
Item.StyleLookup := 'CustomItem';
There is a StyleBook on the form, and the form is associated to it. The TListBox has not style applied.
However if you change this CustomItem Style, nothing happens. You can even change the names of the itens and nothing happens (not visual change at all) the layout keeps fixed as it is shown on the windows above.
I have added another TTlabel with its own name and tried to assign to it:
Item.StylesData['ghost'] := 'scary thing';
It does not give any error, but no text is shown. The style keeps immutable.
If removed the Item.StyleLookup assignment when creating the item the only thing changed is that the name of the TLabel are lost and then there is no way to assign the value.
So, the style is defined, but I see somehow it seems to be fixed. Any layout change is not applied, somehow seems to only understand the style sub items name changing. That is not useful at all.
How can I truly modify this style? I want to put each of the 3 TLabels side by side in a horizontal layout.
While I understand and share your frustration this problem appears to be your own doing.
However if you change this CustomItem Style, nothing happens.
There are three reasons why this might happen:
You have multiple Stylebook components and you are not editing the active one.
StyleLookup doesn't match any style name in the StyleBook
You copied the example project to a new location and failed to realize that you are still modifying the original files.
I'm quite positive that it's the second reason.
If your Delphi IDE is set to Autosave Project desktop then a .dsk file is generated when you close your project.
When you reopen the project later, the .dsk file is read, and your desktop layout, your breakpoints, and your watches are all restored. Also, all files that were opened when the project was closed are opened again, regardless of whether they are used by the project.
Here is the example with labels in a horizontal layout:
You can download the example from dropbox and examine it to see where you went wrong.

How enable application-wide color schemes?

I would like to apply color schemes to my application. This is done by making all components have their ParentColor set to true as well as ParentBackground and ParentFont. When I change the form color everything changes. There is an exception: toolbars and toolbuttons don't change. Is it possible to change them with the color of the form or must I implement this in a separate way?
The same applies to font colors, but that is a trifle more strange. When I change the font color of the form the font color of a groupbox caption does not change but the caption of label captions (also inside the groupbox) change allright.
When implementing some way to allow the user choose his own colors is this the way to go (change the form color, make all components have ParentColor set) or are there better ways to achieve this goal?
One way to acheive this is to use interfaces.
It is a bit of (manual) work, but if you'd like to do it in a simple manner you could simply define an interface and ensure all your forms implement this interface.
for example:
type ITheme = interface
procedure SetTheme(const AColor : TColor);
end;
then in each of you forms you could implement this interface.
So to change all of your forms' colors you simply need to call 1 function:
procedure SetGlobalTheme(const AColor : TColor);
var Intf : ITheme;
begin
for i:=0 to screen.Formcount-1 do
begin
if Supports(Screen.Forms[i],ITheme,intf) then
intf.SetTheme(AColor);
end;
end;
Using this method you have full control of each components color, albeit with some more coding to be done. The alternative is to use David suggestion of VCL styles (if your IDE supports it)

Right click(popup menu) does not work when change diretion of treeview with SetWindowLong Command

When I use SetWindowLong command to change direction of treeview, popupmenu on its node dose not show. Full Code is here :
Procedure SetWinControlBiDi(Control: TTreeView);
var
ExStyle: Longint;
begin
ExStyle := GetWindowLong(Control.Handle, GWL_EXSTYLE);
SetWindowLong(Control.Handle, GWL_EXSTYLE, ExStyle or WS_EX_RTLREADING or WS_EX_RIGHT or WS_EX_LAYOUTRTL or WS_EX_NOINHERITLAYOUT );
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
SetWinControlBiDi(TreeView1);
end;
The standard way to do this is to use the Delphi BiDiMode property. It's best to do it this way so that the VCL is aware that you want right-to-left. You need to change the BiDiMode property on the popup menu too.
Now, the correct way to do this is not to change the properties on the individual components. Doing it that way is laborious and very error prone. Set Application.BiDiMode somewhere in your application's initialization and the change will propagate through to all your components.
For example you can make the change in your application's .dpr file:
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.BiDiMode := bdRightToLeft;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
You need to make sure that you have not modified any component's BiDiMode or ParentBiDiMode in any .dfm file. If you have simply remove those lines from your .dfm file and that will allow the single application wide Application.BiDiMode setting to control everything.
Your approach of setting GWL_EXSTYLE is problematic. The VCL is in control of that setting and if you do need to change it, doing so in TForm.OnShow will lead to strange bugs. Sometimes windows need to be re-created and when this happens your code to set GWL_EXSTYLE will not run and your tree view will revert to left-to-right. If you do need to modify the window styles then you need to override TWinControl.CreateParams for the component. However, in this case the VCL has direct support for BiDi and that is the best solution.
This is an alternative solution to show TPopupMenu In this case
1- Use OnMouseDown Event
2- Write this code to show a TPopupMenu when you click the right mouse button
var
pt : TPoint;
begin
pt := Mouse.CursorPos;
if Button = mbRight then
APopupMenu.Popup(pt.X, pt.Y);
Good luck !

Making a TPageControl flat in Delphi 7

I don't know whether this question can be answered here, but I hope it will.
I wrote a simple text editor in Delphi 7 that serves as my primary IDE for writing C code under Windows. I run Windows in a VM and I needed something light.
In any case, it uses a TpageControl that gets a new tab whenever you open or create a new file. Pretty standard.
Now, the TPageControl under Delphi has no flat property.
NO I don't mean setting the tab style to tsButtons or tsFlatButtons
the borders cannot be set to "none" and it looks pretty bad when you add a text editor into the tab control.
Is there any way to make a TpageControl flat?
EDIT:
On an open source PageControl that supports flat here's what I found:
procedure TCustomTabExtControl.WndProc(var Message: TMessage);
begin
if(Message.Msg=TCM_ADJUSTRECT) and (FFlat) then
begin
Inherited WndProc(Message);
Case TAbPosition of
tpTop : begin
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Top:=PRect(Message.LParam)^.Top-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
tpLeft : begin
PRect(Message.LParam)^.Top:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Left:=PRect(Message.LParam)^.Left-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
tpBottom : begin
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Bottom:=PRect(Message.LParam)^.Bottom-4;
PRect(Message.LParam)^.Top:=0;
end;
tpRight : begin
PRect(Message.LParam)^.Top:=0;
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=PRect(Message.LParam)^.Right-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
end;
end else Inherited WndProc(Message);
end;
The thing is when I tried something similar on the main application it won't work. It won't even compile.
When the tabs are drawn as buttons, no border is drawn around the display area, so set the Style property to tsButtons or tsFlatButtons. (For non-VCL programmers, this is equivalent to including the tcs_Buttons window style on the tab control.)
An alternative is to use a TNotebook. It holds pages, but it doesn't do any painting at all. You'd have to provide the tabs yourself, such as by setting the tab control's height equal to the height of the tabs, or by using a TTabSet. (TTabSet is available in Delphi 2005; I'm not sure about Delphi 7.)
Regarding the code you found, it would be helpful if you indicated why it doesn't compile, or if you gave a link to where you found it, since I suppose the compilation error was because it refers to fields or properties of the custom class rather than the stock one. Here's what you can try to put it in your own code, without having to write a custom control.
Make two new declarations in your form like this:
FOldTabProc: TWndMethod;
procedure TabWndProc(var Msg: TMessage);
In the form's OnCreate event handler, assign that method to the page control's WindowProc property:
FOldTabProc := PageControl1.WindowProc;
PageControl1.WindowProc := TabWndProc;
Now implement that method and handle the tcm_AdjustRect messsage:
procedure TForm1.TabWndProc(var Msg: TMessage);
begin
FOldTabProc(Msg);
if Msg.Msg = tcm_AdjustRect then begin
case PageControl1.TabPosition of
tpTop: begin
PRect(Msg.LParam)^.Left := 0;
PRect(Msg.LParam)^.Right := PageControl1.ClientWidth;
Dec(PRect(Msg.LParam)^.Top, 4);
PRect(Msg.LParam)^.Bottom := PageControl1.ClientHeight;
end;
end;
end;
end;
You can fill in the other three cases if you need them. Tcm_AdjustRect is a message identifier declared in the CommCtrl unit. If you don't have that message in that unit, declare it yourself; its value is 4904.
I suspect this doesn't stop the control from drawing its borders. Rather, it causes the contained TTabSheet to grow a little bigger and cover up the borders.
I'm using Delphi XE8 and the following seems to do the trick:
ATabControl.Tabs.Clear;
ATabControl.Style := TTabStyle.tsFlatButtons;
ATabControl.Brush.Color := clWhite;
You could always use a commercial solution. I would strongly recommend Raize components, which support flat TPageControls with tabs. The component set is very easy to work with, and supports numerous visual enhancements which in my opinion give a better feel to any application.
(source: raize.com)
Drop two TPageControls, one with tabs as Tabs, with a global height equal to the tabs, and one with flatbuttons and Tabvisible properties set to false, which would be aligned under the first one. Then make sure the tab change on the first TPagecontrol makes the tabs also change in the second one.

Resources