Solved

Highlighted caption bar on Frame

Posted on 2004-10-05
7
645 Views
Last Modified: 2007-12-19
I am trying to make a frame within a form with a caption bar (just like a normal form)
The border is for visual appeal and ideally should show as a highlighted cation bar.
I guess this is the reverse of Q_21056929.
On D7, when I create the frame, it has the broder and caption bar, but when I place it on my main form the border disappears.  On D8, the border is not there when the frame is created.

I can do this by drawing a bitmap of the border, but this seems tacky - also the frame can be sized by a config file.

This is probably a really simple thing...!

Thanks
Richard
0
Comment
Question by:diver999
7 Comments
 
LVL 17

Expert Comment

by:Wim ten Brink
Comment Utility
Frames are supposed to be borderless and captionless. If you want a window in your form then use a normal form and make it an MDI child...
0
 
LVL 27

Expert Comment

by:kretzschmar
Comment Utility
alex may boxing me, but take a look to q
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20358590.html

its using a normal TForm not a TFrame

meikl ;-)
0
 

Author Comment

by:diver999
Comment Utility
Thanks...
If I only make one MDI Child then both the main form and the child have highlighted caption bars - just right.
If I make a second one, the caption bar of the first child is greyed.

Also, controls on the main form do not quite seem to update properly e.g. colours of edit boxes, etc don't change - nor do glyphs on speedbuttons.

As mentioned, this is for aesthetics - one of the child forms contains an image (which is sized according to a config file at startup) and the other contains data derived from the image.  The main form has controls to go to other screens, which is where I am using the speed buttons.

I haven't used MDI's before - so apologies if it's something stupid...

Richard

0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:diver999
Comment Utility
To highlight the inactive MDI child windows, I went to Control panel | Display | Appearance | Advanced and set the colours for Inactive window the same as active.  But they didn't change.

There was a cryptic note on the form that says "if you select a windows and buttons setting other than Windows Classic it will over-ride the following settings, ..."

Does anyone know if this can be done by some other way ?
It would be nice to do it from within the program.

Richard
0
 
LVL 33

Accepted Solution

by:
Slick812 earned 250 total points
Comment Utility
hello diver999, I am not to sure about what you want to end up with, as I understand you, you want to have several runtime created child "Windows" (parent is a TForm) that have a Caption (not so hard to do). . . AND you require that  ALL of these windows with captions have a "HighLite" color caption (I think it may be called "Active") and NOT the InActive caption color. . .

OK, you may could use MDI, but I would not use that,
you may could Custom draw your caption on a borderless frame, but that may be a hassel in windows XP

here is some code that seems to do what I get as what you want, it uses the WM_NCPAINT to custom paint the caption, it has a Form1, as the Main Form of this program, several of these frames are created with a form1 button click, as a Child of Form1

code for the TFrame  unit -



unit newFrame;

interface

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

type
  TFrame1 = class(TFrame)
    but_FrameBut: TButton;
    Label1: TLabel;
    procedure but_FrameButClick(Sender: TObject);
  private
    { Private declarations }
    procedure WMClose(var Message: TMessage); message WM_Close;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
  end;

implementation

{$R *.DFM}

uses NewFade1, ShellApi, TmSchema, UxTheme;

var
hTheme: THandle = 0;
hCapFont: THandle = 0;
hSmIcon: HICON = 0;
capBut: TPoint = (x: 19; y:19);
borWidth: Integer = 1;

procedure TFrame1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
  begin
  Caption := 'Size Box Info';
  Style := Style or WS_SIZEBOX or WS_CAPTION or WS_SYSMENU;
  WindowClass.style := WindowClass.style or CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNCLIENT;
  WindowClass.hIcon := Application.Icon.Handle;
  end;
end;

procedure TFrame1.WMClose(var Message: TMessage);
begin
Form1.KillFrame(Self);
end;

procedure TFrame1.WMNCPaint(var Message: TMessage);
var
fDC: HDC;
RectR: TRect;
buf: Array[Byte] of Char;
begin
inherited;
fDC := GetWindowDC(Handle);
try
if hTheme = 0 then
  begin
  RectR := Rect(borWidth,3,Width-borWidth,capBut.y+5);
  DrawCaption(Handle, fDC, RectR, DC_ACTIVE or DC_ICON or DC_TEXT or DC_Gradient);
  SetRect(RectR,Width-(capBut.y+4),borWidth+3,Width-6,borWidth+(capBut.y-1));
  DrawFrameControl(fDC,RectR,DFC_CAPTION,DFCS_CAPTIONCLOSE);
  end else
  begin
  RectR := Rect(0,0,Width-borWidth,capBut.y+3);
  GetWindowText(Handle, buf, 256);
  DrawThemeBackground(hTheme, fDC,WP_CAPTION, CS_ACTIVE, RectR, @RectR);
  SetRect(RectR,Width-(capBut.x+7), 6, Width-6, capBut.y);
  DrawThemeBackground(hTheme, fDC,WP_CLOSEBUTTON, CBS_NORMAL, RectR, @RectR);

  if hCapFont <> 0 then
    SelectObject(fDC, hCapFont);
  setTextColor(fDC, $505050);
  setBkMode(fDC, 1);
  TextOut(fDC, 27+borWidth,7+borWidth, buf, StrLen(buf));
  setTextColor(fDC, GetSysColor(COLOR_CAPTIONTEXT));
  TextOut(fDC, 26+borWidth,6+borWidth, buf, StrLen(buf));
  if hSmIcon <> 0 then
    DrawIconEx(fDC,6+borWidth,6+borWidth, hSmIcon, 0, 0, 0, 0, DI_NORMAL);
  end;
finally
ReleaseDC(Handle, fDC);
end;
end;

procedure TFrame1.but_FrameButClick(Sender: TObject);
begin
Label1.Caption := 'bor W '+IntToStr(borWidth)+' cap y '+IntToStr(capBut.y)+
                  ' cap x '+IntToStr(capBut.x);
end;

procedure DoInit;
var
NonClMetrics: TNonClientMetrics;
LIcon: HICON;
logFont1: TLogFont;
begin
if InitThemeLibrary and UseThemes then
  hTheme := OpenThemeData(Application.Handle, 'window');
     
if hTheme <> 0 then
  begin
  if GetThemeSysFont(hTheme, TMT_CAPTIONFONT, logFont1) = 0 then
    hCapFont := CreateFontIndirect(logFont1);
  capBut.x := GetThemeSysSize(hTheme, SM_CXSIZE);
  capBut.y := GetThemeSysSize(hTheme, SM_CYSIZE);
  end;

  NonClMetrics.cbSize := SizeOf(NonClMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS,0,@NonClMetrics, 0) then
    begin
    if hCapFont = 0 then
      hCapFont := CreateFontIndirect(NonClMetrics.lfCaptionFont);
    if hTheme = 0 then
      begin
      capBut.x := NonClMetrics.iCaptionWidth;
      capBut.y := NonClMetrics.iCaptionHeight;
      end;
    borWidth := NonClMetrics.iBorderWidth;
    if hTheme = 0 then
      borWidth := borWidth+2;
    end;

ExtractIconEx(PChar(ParamStr(0)),0,lIcon,hSmIcon, 1);
end;

initialization
DoInit;

finalization
if hTheme <> 0 then
  CloseThemeData(hTheme);
DeleteObject(hCapFont);

end.


 = = = = = = = = = = = = =  = = = = = = = = =  = = = = = = = = = = = =  = =

this  seems to work in XP and NON-XP  systems, , I do not have the time to really test this (different Themes, different system caption heights, ect), so this is an example, not a finall version

ask questions if you need more information
0
 

Author Comment

by:diver999
Comment Utility
Hi Slick,
That's brilliant - thanks for your help.  I've just ordered a book from Amazon on Win32 API...

Just one question - when I put :

procedure TFrame1.CaptionChange(s : ShortString);
begin
  Caption := s;
end;

-- in the newframe unit and call from the main form, the caption bar returns to the Inactive state.
What do I have to do to force it back to the original condition ?

The background to this, is that I have been given a GUI spec generated by some genius consultants, whose idea of implementation is to put everything in bitmaps.  So when Longhorn comes out with tartan theming, everything has to be done all over again, I guess.

I have some other things I am trying to do, but I will post those as seperate questions

One again, many thanks !

Richard
0
 
LVL 33

Expert Comment

by:Slick812
Comment Utility
when the window's caption text changes, it does not get the WM_NCPAINT message, I got the WM_SETTEXT message and then drew the custom caption. Here are the code changes for the frame unit -


  private
    { Private declarations }
    procedure CaptionPaint;
    procedure WMClose(var Message: TMessage); message WM_Close;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;




procedure TFrame1.CaptionPaint;
var
fDC: HDC;
RectR: TRect;
buf: Array[Byte] of Char;
begin
fDC := GetWindowDC(Handle);
try
if hTheme = 0 then
  begin
  RectR := Rect(borWidth,3,Width-borWidth,capBut.y+5);
  DrawCaption(Handle, fDC, RectR, DC_ACTIVE or DC_ICON or DC_TEXT or DC_Gradient);
  SetRect(RectR,Width-(capBut.y+4),borWidth+3,Width-6,borWidth+(capBut.y-1));
  DrawFrameControl(fDC,RectR,DFC_CAPTION,DFCS_CAPTIONCLOSE);
  end else
  begin
  RectR := Rect(0,0,Width-borWidth,capBut.y+3);
  GetWindowText(Handle, buf, 256);
  DrawThemeBackground(hTheme, fDC,WP_CAPTION, CS_ACTIVE, RectR, @RectR);
  SetRect(RectR,Width-(capBut.x+7), 6, Width-6, capBut.y);
  DrawThemeBackground(hTheme, fDC,WP_CLOSEBUTTON, CBS_NORMAL, RectR, @RectR);

  if hCapFont <> 0 then
    SelectObject(fDC, hCapFont);
  setTextColor(fDC, $505050);
  setBkMode(fDC, 1);
  TextOut(fDC, 27+borWidth,7+borWidth, buf, StrLen(buf));
  setTextColor(fDC, GetSysColor(COLOR_CAPTIONTEXT));
  TextOut(fDC, 26+borWidth,6+borWidth, buf, StrLen(buf));
  if hSmIcon <> 0 then
    DrawIconEx(fDC,6+borWidth,6+borWidth, hSmIcon, 0, 0, 0, 0, DI_NORMAL);
  end;
finally
ReleaseDC(Handle, fDC);
end;
end;

procedure TFrame1.WMSetText(var Message: TWMSetText);
begin
inherited;
CaptionPaint;
end;

procedure TFrame1.WMNCPaint(var Message: TMessage);
begin
inherited;
CaptionPaint;
end;


 = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

this will get the title bar to appear Active on a text change, , ,

I am glad that you got a book to help you pick up some API methods. . .

This next is just My Opinion, - -
According to MS, it will not be long before they release the new 64 bit windows OS (now called LongHorn), so the grave for win32 API is being dug. If like the release of windows 95, when 16 bit code became nearly worthless, 32 bit code will also not fare well when Longhorn is released. . .  From what I gather about the API for 64 bit windows, , , is that this API will abandon the win32 methods and will be in the NET methods. So you may not want to spend alot of time and effort in learning win32 API? If you plan on developing for more than a couple of years, you might want to start to learn the newer NET "Form" API methods. . .

MSDN Longhorn for developers -
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnintlong/html/longhornintro.asp

MSDN about NET development
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnwxp/html/winxpintro.asp
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now