Writing a Metro like window for our applications with Delphi

Hello, this is my attempt on writing a custom Windows UI for a Delphi application.

Bear in mind that I’m not a professional Delphi programmer, it is my hobby and I’m still learning the tricks behind Windows API. So this will be a walkthrough post that will try to achieve the following Window Metro like on Windows XP or newer (see image below).

Maybe the above picture might look too ambicious but as they say, the more difficult the challenge the better you skills improve.

Hope I will get near to it, so let’s start.

Defining the starting point

To begin with, we need to set the window border style as bsnone and we will be building our Metro-like window taking into consideration every aspect involved on its inherent behaviour, like resizing windows (maximize, restore, minimize, resize, move, aero snap, windows hotkeys, and multimonitor resize).

Let’s add a TLabel component to use it as a title bar

Align:=alTop; //It will occupy the top area as normally does the conventional titlebar
Alignment:=taCenter; // it will align the text horizontally centered
Autosize:=False; // avoid automatic resizing, specially the height
Layout:=tlCenter; // it will align the text vertically centered
Name:=lblAppTitle; //let’s give it a proper name

To give it the power to move the window, we will modify the MouseDown event

procedure TMetroGUI.lblAppTitleMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

As you can see, we release the mousedown event so no click event will be fired, and we perform a window system command, the undocumented $F012 that is send to every window when a Window move event is called.

A gradient color for the background

Let’s add a gradient effect to the window, it will give a look like the goal’s background color.

To achiveve that, we will use the code published at about.delphi.com http://delphi.about.com/od/adptips2006/qt/gradient_fill.htm

uses Math, ...
 
 procedure GradHorizontal(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
 var
   X:integer;
   dr,dg,db:Extended;
   C1,C2:TColor;
   r1,r2,g1,g2,b1,b2:Byte;
   R,G,B:Byte;
   cnt:integer;
 begin
   C1 := FromColor;
   R1 := GetRValue(C1) ;
   G1 := GetGValue(C1) ;
   B1 := GetBValue(C1) ;
 
   C2 := ToColor;
   R2 := GetRValue(C2) ;
   G2 := GetGValue(C2) ;
   B2 := GetBValue(C2) ;
 
   dr := (R2-R1) / Rect.Right-Rect.Left;
   dg := (G2-G1) / Rect.Right-Rect.Left;
   db := (B2-B1) / Rect.Right-Rect.Left;
 
   cnt := 0;
   for X := Rect.Left to Rect.Right-1 do
   begin
     R := R1+Ceil(dr*cnt) ;
     G := G1+Ceil(dg*cnt) ;
     B := B1+Ceil(db*cnt) ;
 
     Canvas.Pen.Color := RGB(R,G,B) ;
     Canvas.MoveTo(X,Rect.Top) ;
     Canvas.LineTo(X,Rect.Bottom) ;
     inc(cnt) ;
   end;
 end;
 
 procedure GradVertical(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
 var
   Y:integer;
   dr,dg,db:Extended;
   C1,C2:TColor;
   r1,r2,g1,g2,b1,b2:Byte;
   R,G,B:Byte;
   cnt:Integer;
 begin
    C1 := FromColor;
    R1 := GetRValue(C1) ;
    G1 := GetGValue(C1) ;
    B1 := GetBValue(C1) ;
 
    C2 := ToColor;
    R2 := GetRValue(C2) ;
    G2 := GetGValue(C2) ;
    B2 := GetBValue(C2) ;
 
    dr := (R2-R1) / Rect.Bottom-Rect.Top;
    dg := (G2-G1) / Rect.Bottom-Rect.Top;
    db := (B2-B1) / Rect.Bottom-Rect.Top;
 
    cnt := 0;
    for Y := Rect.Top to Rect.Bottom-1 do
    begin
       R := R1+Ceil(dr*cnt) ;
       G := G1+Ceil(dg*cnt) ;
       B := B1+Ceil(db*cnt) ;
 
       Canvas.Pen.Color := RGB(R,G,B) ;
       Canvas.MoveTo(Rect.Left,Y) ;
       Canvas.LineTo(Rect.Right,Y) ;
       Inc(cnt) ;
    end;
 end;

And On Paint event of the Form, we’ll add the following

procedure TMetroGUI.FormPaint(Sender: TObject);
begin
  GradHorizontal(Canvas, ClientRect, $e7ded5,$e2e5df);
end;

And the resulting appearance is like this

However, there is no shadow, and since Windows doesn’t apply the normal shadow to a window without style, we need to apply by ourselves, be it by using the so old simple shadow or creating a layered window as a shadow. This last one we’ll be a little difficult but doable, let’s just start with the old shadow one.

For this purpose we need to modify the form create params.

...
  protected
    procedure CreateParams(var Params: TCreateParams);override;
  end;
...
implementation
...
procedure TMetroGUI.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WindowClass.style := Params.WindowClass.style or CS_DROPSHADOW;
end;

We only need to enable the CS_DROPSHADOW flag and we now have a simple shadow.

Now it have a better look. At the end, I’m planning to add a better shadow using another form.

On Lost Focus (onDeactive)

Now let’s add a on lost focus feature, we will change the color of the background to give the users a hint that our application is not the active one.

Let’s create a private variable that will hold the state, and the procedures for activate and deactivate events:

private
    { Private declarations }
    isFocused: Boolean;
    procedure LostFocus(Sender: TObject);
    procedure SetFocus(Sender: TObject);

And they will toggle the focus state an call the repaint procedure

procedure TMetroGUI.LostFocus(Sender: TObject);
begin
  isFocused:=False;
  Repaint;
end;

procedure TMetroGUI.SetFocus(Sender: TObject);
begin
  isFocused:=True;
  Repaint;
end;

But we need to modify the FormPaint procedure in order to get that effect

procedure TMetroGUI.FormPaint(Sender: TObject);
begin
  if isFocused then
    GradHorizontal(Canvas, ClientRect, $e7ded5,$e2e5df)
  else
    GradHorizontal(Canvas, ClientRect, $c8c0b8,$c0c3bd);
end;

Now, we have to background gradient colors depending on form focus state

The normal state

and the unfocused state

The white border line

Let’s give it a white line, to give it a different border line

So, it only needs to be modified the FormPaint

procedure TMetroGUI.FormPaint(Sender: TObject);
begin
  if isFocused then
    GradHorizontal(Canvas, ClientRect, $e7ded5,$e2e5df)
  else
    GradHorizontal(Canvas, ClientRect, $c8c0b8,$c0c3bd);
  with canvas do begin
    Pen.Color:=$eeeeee;
    MoveTo(0,0);
    LineTo(0,ClientHeight-1);
    LineTo(ClientWidth-1, ClientHeight-1);
    LineTo(ClientWidth-1,0);
    LineTo(0,0);
  end;
end;

We just added, with canvas… that draws the almost white line, you can change to any other color of course

Resize borders

It is time to add a resize area, generally it will be located in the bottom-right part of the window.

Let’s add a simple drawing on the right bottom area of our form adding to our formpaint procedure

//lets draw a resize area in the rightbottom part
    Brush.Color:=clwhite;
    FillRect(rect(ClientWidth-4,ClientHeight-4,ClientWidth-2,ClientHeight-2));
    FillRect(rect(ClientWidth-7,ClientHeight-4,ClientWidth-5,ClientHeight-2));
    FillRect(rect(ClientWidth-10,ClientHeight-4,ClientWidth-8,ClientHeight-2));
    FillRect(rect(ClientWidth-13,ClientHeight-4,ClientWidth-11,ClientHeight-2));

    FillRect(rect(ClientWidth-4,ClientHeight-7,ClientWidth-2,ClientHeight-5));
    FillRect(rect(ClientWidth-7,ClientHeight-7,ClientWidth-5,ClientHeight-5));
    FillRect(rect(ClientWidth-10,ClientHeight-7,ClientWidth-8,ClientHeight-5));

    FillRect(rect(ClientWidth-4,ClientHeight-10,ClientWidth-2,ClientHeight-8));
    FillRect(rect(ClientWidth-7,ClientHeight-10,ClientWidth-5,ClientHeight-8));

    FillRect(rect(ClientWidth-4,ClientHeight-13,ClientWidth-2,ClientHeight-11));

It is a simple way to draw a triangle area with separated dots as shown in the following picture

Now, it needs to respond a mousedown event that will perform the resize action

procedure TMetroGUI.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //let's resize if on resize area
  if (X>ClientWidth-13) and (Y > ClientHeight-11) then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND,$F008,0);
  end;
end;

The formMouseDown procedure shown above limits the mouse area to that specific area, sending a system command corresponding to the resize width & height together. The result is:

As you can see, it needs somethign more to make it better, since the painting fails, so we just need to call repaint on resize event.

procedure TMetroGUI.FormResize(Sender: TObject);
begin
  Repaint;
end;

And that is enough to make it work better.

Fixing a weird behaviour on resizing the form:

As you can see, the resize procedure can resize the window too much that the user can turn the form like a one pixel form. So we need to limit the minimum width and height to avoid that ugly behaviour.

So on FormCreate, we define those constraints

procedure TMetroGUI.FormCreate(Sender: TObject);
begin
  Application.OnDeactivate:= LostFocus;
  Application.OnActivate:= SetFocus;

  Constraints.MinWidth:=400;
  Constraints.MinHeight:=200;
end;

Now we have a better resizable form.

Double Click Resize

By now, we have a working example of a form. We need to add a double click event to the application title bar, so we will add a double click event to the lblAppTitle component.

Adding a double click procedure for the Application Title

procedure TMetroGUI.lblAppTitleDblClick(Sender: TObject);
begin
  ReleaseCapture;
  if WindowState = wsMaximized then
    Perform(WM_SYSCOMMAND,SC_RESTORE,0)
  else
    Perform(WM_SYSCOMMAND,SC_MAXIMIZE,0);
end;

As you can see, first, we need to know the current window status, if it is already maximized, then we will restore it, otherwise, we will maximize it.

However, this perform function is okay, but we need to modify something because it will maximize to the entire desktop screen size without respecting the working area (all window minus the taskbar area usually).

As we are sending a syscommand event, we need to modify this event, so let’s add it to the form private area

  private
    { Private declarations }
    isFocused: Boolean;
    procedure LostFocus(Sender: TObject);
    procedure SetFocus(Sender: TObject);

    procedure WMSysCommand (var Msg: TWMSysCommand); message WM_SYSCOMMAND;

Now wee need to handle the maximize message

procedure TMetroGUI.WMSysCommand(var Msg: TWMSysCommand);
begin
  if Msg.CmdType = SC_MAXIMIZE then
  begin
    if (WindowState = wsNormal) or (WindowState = wsMinimized) then
    begin
      WindowState:=wsMaximized;
      with Screen.WorkAreaRect do
        MetroGUI.SetBounds(Left, Top, Right - Left -1, Bottom - Top -1);
        Msg.Result:=0;
        Exit;
    end;
  end;

  DefaultHandler(Msg);
end;

As you see, we intercept the SC_MAXIMIZE message and verify if the current window state is different than wsMaximized then we change the windowState to wsMaximized and resize according to the screen work area rect (keep in mind this will only work on one monitor setups, that would be modified later to improve it for dual o multimonitor). Back to the code, we set the actual form bounds to the size of the work area rect, and after that we clear the msg result and exit before giving the msg to the default window handler.

Now our form resizes correctly. In the following steps we will drop that approach with a better one.

Windows 7 Aero Snap support

What if we like to use the windows hotkeys (winkey+arrowkeys) to resize our form?

This can be done easily since any window that is not borderless (non bsNone), will respond to these hotkeys.

To get that behaviour, we will add to CreateParams a style for our form, the WS_OVERLAPPEDWINDOW

Saddly this style gives back the non bsnone borderstyle, i.e., it has the non wanted classic windows border. However, this border style responds correctly to WinKey+ArrowKeys to resize with AeroSnap feature. So we need to get rid again of this classic windows border style.

  protected
    procedure WndProc(var Message: TMessage);override;
    procedure CreateParams(var Params: TCreateParams);override;

So we just added a new procedure that will take care of the Windows processes.

procedure TMetroGUI.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_NCCALCSIZE then
  begin
    Message.Msg:= WM_NULL;
  end;
  Inherited WndProc(Message);
end;

There we will modify the WM_NCCALCSIZE message which is used to determine the border style size, and with it the window manager draws the classic border. We change that msg to 0 (WM_NULL) as when bsnone borderstyle. And for the other messages, we inherit them.

But, now we see a window resize bug when we Snap to the top screen to maximize it

If you don’t see it, it is the application title bar reduce size, if you compare to the previous snapshot of the maximize event, you will notice that the title’s caption is located a little bit down.

Before proceeding, we will get rid of WMSysCommand procedure we wrote before, since it is not needed anymore because we gave the almost correct maximize event with the AeroSnap feature.

And to fix the bad maximize effect, we will copy the old WMSysCommand procedures to the FormResize event.

procedure TMetroGUI.FormResize(Sender: TObject);
begin
  if (WindowState = wsMaximized)then
  begin
    with Screen.WorkAreaRect do
      MetroGUI.SetBounds(Left, Top, Right - Left-1, Bottom - Top-1);
  end;
  Repaint;
end;

As in the previous procedure, we need to adapt it for multimonitor setups. We’ll add it later.

We’re good till here. However, one thing drives to another one. The new issue due to WinSnap support is that the old system buttons re appear when we click over its area.

To get rid of it we need to set this application as non layered window.

procedure TMetroGUI.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WindowClass.style := Params.WindowClass.style or CS_DROPSHADOW;
  Params.Style:=params.Style or WS_OVERLAPPEDWINDOW and not WS_SYSMENU;
end;

So we just added and not WS_SYSMENU to the Params.Style. However, there will not be a Alt-Space application context menu. But in order to give our app the same experience as with a normal form, we can use a tpanel set align to  alClient and the lblAppTitle move inside it, finally the resize mouse area moved to that panel mousedown event.

Clear the TPanel bevelouter to bvNone and only bypass the mouse down event

procedure TMetroGUI.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FormMouseDown(Sender,Button, Shift,X,Y);
end;

Easy, ain’t it, just get rid of the Panel caption to erase that Panel1 string on our form.

Metro like system buttons

Now, we’re going to add PNG files to mimic the zune metro system menu.

We add them as resource files, with the Project->Resource and Images… menu, if you have a different Delphi version which lacks that feature, you can still compile RC files with those files.

Once done, we can draw them like this.

procedure TMetroGUI.FormPaint(Sender: TObject);
var
  png:TPngImage;
begin
  ...
  with canvas do begin
    ...
    //let's paint the buttons
    png:=TPngImage.Create;
    try
      png.LoadFromResourceName(HInstance,'PNGCLOSE');
      Draw(ClientWidth-22,8,png);
      png.LoadFromResourceName(HInstance, 'PNGMAX');
      Draw(ClientWidth-44,8,png);
      png.LoadFromResourceName(HInstance, 'PNGMIN');
      Draw(ClientWidth-66,8,png);
    finally
      FreeAndNil(png);
    end;
  end;

end;

This has been added to our existing FormPaint procedure. Make sure to include at Uses clause the PNGImage unit.

Using TImage for Sysmenu buttons

Instead of drawing our custom system buttons, we will use timages with autosize enabled.

Rename them to imgBtnClose, imgBtnResize, imgBtnMin accordingly.

Load them with the default pictures.

Now well add their coordinates to the formResize event

...
//align our metro system buttons
  imgBtnClose.Left:=ClientWidth-22;
  imgBtnClose.Top:=8;
  imgBtnResize.Left:=ClientWidth-44;
  imgBtnResize.Top:=8;
  imgBtnMin.Left:=ClientWidth-66;
  imgBtnMin.Top:=8;
 ...

And to interact with mouse over and mouse out, we will use the event MouseEnter and MouseLeave

procedure TMetroGUI.imgBtnCloseMouseEnter(Sender: TObject);
var
  png: TPngImage;
begin
  png := TPngImage.Create;
  try
    png.LoadFromResourceName(HInstance, 'PNGCLOSEON');
    imgBtnClose.Picture.Assign(png);
  finally
    png.Free;
  end;
end;

procedure TMetroGUI.imgBtnCloseMouseLeave(Sender: TObject);
var
  png: TPngImage;
begin
  png := TPngImage.Create;
  try
    png.LoadFromResourceName(HInstance, 'PNGCLOSE');
    imgBtnClose.Picture.Assign(png);
  finally
    png.Free;
  end;
end;

And now for the Resize button (maximize & restore)

procedure TMetroGUI.imgBtnResizeMouseEnter(Sender: TObject);
var
  png: TPngImage;
begin
  png := TPngImage.Create;
  try
    if WindowState = wsMaximized then
      png.LoadFromResourceName(HInstance, 'PNGRESTOREON')
    else
      png.LoadFromResourceName(HInstance, 'PNGMAXON');
    imgBtnResize.Picture.Assign(png);
  finally
    png.Free;
  end;
end;

procedure TMetroGUI.imgBtnResizeMouseLeave(Sender: TObject);
var
  png: TPngImage;
begin
  png := TPngImage.Create;
  try
    if WindowState = wsMaximized then
      png.LoadFromResourceName(HInstance, 'PNGRESTORE')
    else
      png.LoadFromResourceName(HInstance, 'PNGMAX');
    imgBtnResize.Picture.Assign(png);
  finally
    png.Free;
  end;
end;

As you can see, first we verify if our window is maximized to either draw the restore icon or the maximize one.

Now, to make sure its icon (button pic) shows the correct one when resizing it via hotkey or other ways, we will add to FormResize this simple procedure call

...
  imgBtnResizeMouseLeave(Sender);
...  

That will be enough to make it aware of resizing events and will show the correct button image.

Finally we need to add functions to those custom system buttons.

procedure TMetroGUI.imgBtnMinClick(Sender: TObject);
begin
  Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

procedure TMetroGUI.imgBtnResizeClick(Sender: TObject);
begin
  if WindowState = wsMaximized then
    Perform(WM_SYSCOMMAND, SC_RESTORE, 0)
  else
    Perform(WM_SYSCOMMAND, SC_MAXIMIZE,0);
end;
  
procedure TMetroGUI.imgBtnCloseClick(Sender: TObject);
begin
  close
end;  

Always taking into account the window state, specially for the resize button.

Multimonitor Support

If you have more than one monitor, you will see that it maximizes to only one of them. To avoid that we need to figure it out how many monitors we have, and according to where our application is, we maximize to that monitor.

This is a function that tells us where a specific X,Y coordinate is located, i.e., in which monitor.

function WhichMonitor(horizCenter,vertCenter: integer):integer;
var
  I: Integer;
begin
  result:=-1;
  for I := 0 to Screen.MonitorCount-1 do
  begin
    if(screen.Monitors[I].Left<horizCenter)
    and(screen.Monitors[I].Left+Screen.Monitors[I].Width>horizCenter)
    and(Screen.Monitors[I].Top<vertCenter)
    and(Screen.Monitors[I].Top+Screen.Monitors[I].Height>vertCenter)
    then
    result:=I;
  end;

end;

So when resizing our form, we make sure that the center X,Y of our form is located between those boundaries.

So we modify it to include the monitor support:

procedure TMetroGUI.FormResize(Sender: TObject);
begin
  if (WindowState = wsMaximized)then
  begin
    if Screen.MonitorCount>1 then
    begin
      with Screen.Monitors[WhichMonitor(left+width div 2,top+Height div 2)].WorkareaRect do
        MetroGUI.SetBounds(Left, Top, Right - Left-1, Bottom - Top-1);
    end
    else
    with Screen.WorkAreaRect do
      MetroGUI.SetBounds(Left, Top, Right - Left-1, Bottom - Top-1);
  end;
  ...

And that’s all, now we have a fully functional Metro Skin.

SYSMENU by right click on App Title

Our application wouldn’t be complete if we leave the right click that shows the System Menu of our application. So we will use the MouseUp event of lblAppTitle

procedure TMetroGUI.lblAppTitleMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  WM_SYSMENU = 787;
var
  P: TPoint;
  MP: Integer;
begin
  if Button = mbRight then
  begin
    P:= ClientToScreen(Point(X,Y));
    asm
      mov ax, word(P.Y);
      shl eax, 16;
      mov ax, word(P.X);
      mov MP, eax;
    end;
    SendMessage(Handle,WM_SYSMENU,0,MP);
  end;
end;

For this purpose we first make sure we clicked with the right button of our mouse (this is hacky approach since other user might have enabled the left handed feature that uses the oposite buttons). Anyways, let’s continue.

The X and Y values store the coordinates relative to our form, so we need to convert it to screen coordinates, thankfully with ClientToScreen we can do that.

After that we place those new coordinates in a 32bits value, the first 16bits holding the Y value and the last 16bits the X value. I don’t know how to do it, so assembly might help . And finally we send a message to our application with the command SysMENU and MP holding the coordinates where it will be shown.

Conclusion

Making a custom Delphi application that mimics the Metro Style of Zune is not a trivial work without the knowledge of WINAPI tricks, and taking into consideration every aspect that a normal application has. However, they’re not as difficult as it might look, with the right tools everything is possible. I know there are many ways to achieve this pseudo skin, with VCL components already built, but I found them the lack of WinSnap, and other features. With this approach you have the entire control of your code.

However, our work until here is not complete, we need to add a shadow effect and the correct icons as our main goal was the Metro Browser concept by Sputnik8, and of course adding the WebBrowser support maybe with TWebBrowser or TChromium.

Finally, I would like to thank you for reading this walkthrough of building a Metro like application with Delphi. Hope you liked it and hope it might be of use for your projects. It took me a lot of try and error, and finally I’ve come up with something I’m satisfied by now.

Download sources

You can get this article source codes for free here:

My final result, very ugly, I know.

Download sources only here, the binary here.

Metro UI with Delphi by Victor Alberto Gil <vhanla> is licensed under a Creative Commons Attribution 3.0 Unported License.
Based on a work at www.theverge.com.