[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2228
  • Last Modified:

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!
0
szayeri
Asked:
szayeri
  • 3
  • 3
  • 2
  • +1
3 Solutions
 
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;
0
 
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;
0
 
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.
0
Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

 
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.
0
 
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
0
 
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).
0
 
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
0
 
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.
0
 
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
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 3
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now