Solved

Highlighted caption bar on Frame

Posted on 2004-10-05
7
647 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
ID: 12228339
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
ID: 12235015
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
ID: 12236683
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:diver999
ID: 12250083
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
ID: 12289095
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
ID: 12308361
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
ID: 12320722
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Simple Delphi Question 9 83
Internet Explorer View Settings Question 15 106
Show Listview image from database (String field) 5 112
how to update exe applicatio from internet ? 6 67
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this video I am going to show you how to back up and restore Office 365 mailboxes using CodeTwo Backup for Office 365. Learn more about the tool used in this video here: http://www.codetwo.com/backup-for-office-365/ (http://www.codetwo.com/ba…
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…

911 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

19 Experts available now in Live!

Get 1:1 Help Now