Changing font of form caption

Please help me

I need to change font name and font size of the form's caption. I found a topic at "swissdelphicenter" shownig "how to draw on title bar" but in some conditions, for example when losing focus of application and regaining focus, the caption is cleared and if I add more event catching routines ( for example WM_PAINT) the form's caption flickers.
Is there a better way to do it? Can I make a virtual title bar?

Thank you!
szayeriAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ginsonicCommented:
Function SetCaptionFont(FontName : String) : boolean;
Type
con = array[0..31] of char;
Var
NCM         : TNONCLIENTMETRICS;
begin
Result     := false;
ncm.cbSize := SizeOF(ncm);
//Get old NCM
IF SystemParametersInfo(SPI_GETNONCLIENTMETRICS, ncm.cbSize,  @ncm, 0) then
begin
 //Set new FontName
 Move(PChar(FontName)[0], ncm.lfCaptionFont.lfFaceName[0], SizeOf(ncm.lfCaptionFont.lfFaceName));

 //Set new NCM
 IF SystemParametersInfo(SPI_SETNONCLIENTMETRICS, ncm.cbSize,  @ncm, 0) then
  Result := true;
end;
end;
ginsonicCommented:
or...

{...}

type
  TForm1 = class(TForm)
  private
    { Private-Deklarationen }
    procedure WMNCPaint(var Mes : TWMNCPaint); message WM_NCPAINT;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCPaint(var Mes : TWMNCPaint);
var
  ACanvas : TCanvas;
begin
  ACanvas := TCanvas.Create;
  try
    ACanvas.Handle := GetWindowDC(Form1.Handle);
    with ACanvas do begin
      Brush.Color := clActiveCaption;
      Font.Name := 'Verdana';
      Font.Size := 10;
      Font.Color := clCaptionText;
      Font.Style := [fsBold];
      TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
              Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height))/2) +1,
              ' SwissDelphiCenter');
    end;
  finally
    ReleaseDC(Form1.Handle, ACanvas.Handle);
    ACanvas.Free;
  end;
end;
szayeriAuthor Commented:
Thank you ginsonic

Two useful procedures I knew before.
1) This routine changes the font name systemwide. It's not good to change a user's display settings with no reasons. I need to change my own application's appearance.
2) I had mentioned in my question that this procedure is not reliable. For example use this routine in your program and test it just by clicking on your desktop when the application has focus; the drawn text disappears. Calling the procedure in each application event makes the text flicker.

I'll be so happy and thankful to see your (or any body else's) new comments.
OWASP Proactive Controls

Learn the most important control and control categories that every architect and developer should include in their projects.

blackcat67Commented:
There are freeware tools and packages such as LMD Tools (www.lmd.de), Globus Library (www.torry.net), and RX Tools (www.torry.net) which contain some components that might be helpful.

Also the following code may help too.


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormPaint(Sender:TObject);
var
  LabelHeight, LabelWidth, LabelTop: Integer;
  caption_height, border3d_y, button_width, border_thickness: Integer;
  MyCanvas: TCanvas;
  CaptionBarRect: TRect;
begin
  CaptionBarRect := Rect(0, 0, 0, 0);
  MyCanvas := TCanvas.Create;
  MyCanvas.Handle := GetWindowDC(Form1.Handle);
  border3d_y := GetSystemMetrics(SM_CYEDGE);
  button_width := GetSystemMetrics(SM_CXSIZE);
  border_thickness := GetSystemMetrics(SM_CYSIZEFRAME);
  caption_height := GetSystemMetrics(SM_CYCAPTION);
  LabelWidth := Form1.Canvas.TextWidth(Form1.Caption);
  LabelHeight := Form1.Canvas.TextHeight(Form1.Caption);
  LabelTop := LabelHeight - (caption_height div 2);
  CaptionBarRect.Left := border_thickness + border3d_y + button_width;
  CaptionBarRect.Right := Form1.Width - (border_thickness + border3d_y) - (button_width * 4);
  CaptionBarRect.Top := border_thickness + border3d_y;
  CaptionBarRect.Bottom := caption_height;
  if Form1.Active then
    MyCanvas.Brush.Color := clActiveCaption
  else
    MyCanvas.Brush.Color := clInActiveCaption;
  MyCanvas.Brush.Style := bsSolid;
  MyCanvas.FillRect(CaptionBarRect);
  MyCanvas.Brush.Style := bsClear;
  MyCanvas.Font.Color := clCaptionText;
  MyCanvas.Font.Name := 'MS Sans Serif';
  MyCanvas.Font.Style := MyCanvas.Font.Style + [fsBold];
  DrawText(MyCanvas.Handle, PChar(' '+ Form1.Caption), Length(Form1.Caption) + 1,
                      CaptionBarRect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  MyCanvas.Free;
end;


procedure TForm1.FormResize(Sender: TObject);
begin
  Form1.Paint;
end;


procedure TForm1.FormDeactivate(Sender: TObject);
begin
  Form1.Paint;
end;


procedure TForm1.FormActivate(Sender: TObject);
begin
  Form1.Paint;
end;

end.
gandalf_the_whiteCommented:
making a virtual title bar is quite easy

just make your form with borderstyle .= bsnone
and place a panel with a backgroundimage and label for the caption at the top.
add the three buttons (minimize,...) and the onclick methods and it will look nearly like a title bar

regards
szayeriAuthor Commented:
Dear Blackcat67!
Good links, though, I don't like to use third party components. Your code does not solve my problem. The reason is discused in my previous comment. Thank you any way.

Thank you  gandalf_the_white!
I'm sure you were smiling when writing your comment. Although, I think this may be the final solution if I don't want to transfer more than four hundred lines of code and procedure plus component settings to a new inherited form component (third party).
Any way, is there a way to paint such virtual title bar just like windows does (with any windows version or theme).
gandalf_the_whiteCommented:
often the easy solutions do the job
not sophisticated but working

i feared that you would ask this one ;-)
there should be methods but i don't know them

quite easy but a bit ugly:
you could create a normal form in the background and copy its canvas.
the top area of this form could be the backgroundpicture for your virtual title bar.
(maybe the form has to be visible for the time the canvas is copied)

other things that are changed with the theme just don't come to my mind
szayeriAuthor Commented:
It seems no one has better idea than gandalf_the_white's. Though, some professional programs use such style. I like to accept the above comment but, please, tell me if there is a way to align a panel (or anything) above Menubar. You know a caption under menubar is somehow funny.
gandalf_the_whiteCommented:
i saw no way to align the menu to another position

but i have a different solution:
you can create a second form that acts as a parent for your mainform.
this captionform has the graphic for the virtual titlebar.

  MainForm.parent := Captionform;
  MainForm.Left := 0;
  MainForm.Top := 20;
  MainForm.Show;

if you set borderstyle for both forms to bsnone you wont be able to see that
you are watching a form in a form. as forms are normal wincontrols you can treat them
nearly like buttons ;-)

regards

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.