domingo, 27 de mayo de 2012

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

Sputnik8

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

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

metroguititle

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

metrogui[3]

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.

metroguishadow[3]

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

metroguion

The normal state

metroguioff

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

metroguilineborder

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

metrouiresizeborder

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:

metrouiresizenorepaint

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.

metroguiresizebetter

Fixing a weird behaviour on resizing the form:

metroguiresizenobounds

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.

metroguifullwindow

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

metroguisnap

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

metroguibadresizemaxim

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.

metroguioldsysbuttons

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;

metroguipaneled

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.

metroguisysmenures

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.

MetroGUIFirstPrototype


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.

MetroGUISysmenusbutns

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.

MetroGUIFull

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 Lengua fuera. And finally we send a message to our application with the command SysMENU and MP holding the coordinates where it will be shown.

MetroGUISysMenuclick

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:

MetroUIDelphi

My final result, very ugly, I know.

Download sources only here, the binary here.

Creative Commons License
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.

4 comentarios:

  1. This post is great Victor.
    But it would be better create a few components that helps to build "Metro" applications.

    This is a very good start :D

    ResponderEliminar
  2. thanks a lot
    but, with the webbrowser, it's impossible resize the form becouse it covers the bottom-right angle of the form.

    ResponderEliminar
  3. Your article is very good!
    I search for win snap for a long time and your tehcnique is very good.

    For your resize, you can use WMNCHitTest like this (resize by corners or border like win default)

    const
    RZ:integer=5;

    procedure TmetroForm.WMNCHitTest(var M: TWMNCHitTest);
    var
    x,y : integer;
    begin
    inherited;
    if not Fresizable then exit;
    x := M.XPos-Left;
    y := M.YPos-top;
    //drag from caption bar
    //if (y<22) then M.Result := htCaption;

    if WindowState<>wsMaximized then
    begin
    //resize from top
    if yWidth-RZ then M.Result := HTRIGHT;
    //resize from bottom
    if y>Height-RZ then M.Result := HTBOTTOM;
    //resize from left
    if xWidth-RZ)) then M.Result := HTTOPRIGHT;
    //resize from bottom right
    if ((y>Height-RZ) AND (x>Width-RZ)) then M.Result := HTBOTTOMRIGHT;
    //resize from bottom left
    if ((y>Height-RZ) AND (x<RZ)) then M.Result := HTBOTTOMLEFT;
    end;
    end;

    Where RZ is the initial border width of the OS (i found 5 by default but it should be calculated with the winapi)

    ResponderEliminar
  4. Harrah's Resort Southern California Casino & Spa - KTNV
    Harrah's 세종특별자치 출장샵 Resort Southern 보령 출장샵 California Casino & 남양주 출장마사지 Spa locations, rates, amenities: expert Southern California research, 김포 출장샵 only at Hotel 시흥 출장안마 and Travel Index.

    ResponderEliminar