Jump to content
Sign in to follow this  

MS Office 2007/2010 with Coloured 'Active Title Bar' Restored

Recommended Posts

Some people find Office-2007 significantly difficult visually because it doesn't have the coloured 'Active Title Bar'.  In Office-2003 the windows had the standard title bar and border which used your colour choices from the screen settings.  In Office-2007 onwards this is missing, and there's only a minimal colour difference when the window gets the focus.

I've been using 2003 so far, but combined with the XP issue I'm being forced to downgrade to W7+Office-2010. (Change to OpenOffice - yes I know, but have to work with 100s of colleagues and customers.)
The program below makes a coloured rectangle around the active window.  This almost restores the original function and makes it much easier to focus quickly on the active window.  It needs some of tweaking but already for me has changed Office-2010 from miserable hard work to tolerable.
Thanks to UEZ for all the GDI+ examples.
- 11-May-2014
- Fixed stupid error so it runs for more than 10 mins.
- Singleton
- Ignore windows with blank titles (some/all of them have excessive dimensions)

  - office windows only?
  - not to prevent drag corners to different size
  - top wider than the others, emphasize the title
  - inbox etc. find the highlight, re-emphasize it somehow (transparent overcolour?)
  - customise colour or follow windows?

#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#include <WindowsConstants.au3>
#include <GUIConstants.au3>
#include <GDIPlus.au3>
#include <Date.au3>
#include <Misc.au3>

Opt('MustDeclareVars', 1)

Func ConFmtWr($sCntrl, $a = "", $b = "", $c = "", $d = "", $e = "", $f = "", $g = "", $h = "", $i = "", $j = "", $k = "", $l = "")
    Combined ConsoleWrite and StringFormat.
    First parameter is the control string, others are values
  ConsoleWrite(StringFormat($sCntrl, $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l))
EndFunc   ;==>ConFmtWr

Func MsgFail($sArg1 = "", $sArg2 = "")
  Local $sMyName
  Beep(256, 100)
  $sMyName = StringRegExpReplace(@ScriptName, ".au3|.exe", "")
  MsgBox(0, $sMyName, $sArg1 & @CRLF & $sArg2, 10)

#Region Globals
Global $sMyName
Global $hwnd, $graphics, $backbuffer, $bitmap, $Pen, $fontsize_txt1
Global $brush_color, $hFamily1, $hFont1, $hFormat, $tLayout
Global $ScreenDc, $dc, $tSize, $pSize, $tSource, $pSource, $tBlend, $pBlend, $tPoint, $pPoint, $gdibitmap
Global $x1, $x2, $y1

Global $Coord[1], $colr, $name
Global $brush1
Global $brush

Const $max_log_lines = 12
Global $sTitle0
Global $sTitle1

Func GDI_Open($width = @DesktopWidth + 4, $height = @DesktopHeight)

    $hwnd = GUICreate($sMyName, $width, $height, -4, 0, -1, BitOR($WS_EX_LAYERED, $WS_EX_TOPMOST))
    $graphics   = _GDIPlus_GraphicsCreateFromHWND($hwnd)
    $bitmap     = _GDIPlus_BitmapCreateFromGraphics($width, $height, $graphics)
    $backbuffer = _GDIPlus_ImageGetGraphicsContext($bitmap)

    ;$hFormat  = _GDIPlus_StringFormatCreate()
    ;$hFamily1 = _GDIPlus_FontFamilyCreate("Courier New")
    ;$hFont1   = _GDIPlus_FontCreate($hFamily1, $fontsize_txt1, 3)
    ; LAST PAR IS BITSET 0 none, 1 bold, 2 italic, 4 underline
    ; 8 stikethrough
    ;$tLayout = _GDIPlus_RectFCreate(0, 0)

Func Rectangle($iClr, $xcoord, $ycoord, $width, $height, $colour = 0x00FF00)

  ; $iClr: 0 - nothing, 1 clear graphic buffer

  $Pen = _GDIPlus_PenCreate(0, 1)
  If $iClr Then
    ;x_GDIPlus_GraphicsClear($backbuffer)             ;clear buffer - black
    _GDIPlus_GraphicsClear($backbuffer, 0x00000000) ;clear buffer - null colour
  ;$Brush = _GDIPlus_BrushCreateSolid("0xEF" & Hex(255, 2) & Hex(0, 2) & Hex(255, 2))
  ;_GDIPlus_PenSetColor($Pen, "0xFF" & Hex(0, 2) & Hex(255, 2) & Hex(255, 2))

  $Brush = _GDIPlus_BrushCreateSolid("0xEF" & Hex($colour, 6))
  _GDIPlus_PenSetColor($Pen        , "0xFF" & Hex($colour, 6))
  _GDIPlus_PenSetWidth($Pen, 5)

  _GDIPlus_GraphicsDrawRect($backbuffer, $xcoord,     $ycoord + 10 , $width, $height,     $Pen)
  ;_GDIPlus_GraphicsDrawRect($backbuffer, $xcoord + 1, $ycoord+1, $width-2, $height-2, $Pen)
  ;_GDIPlus_GraphicsDrawRect($backbuffer, $xcoord + 2, $ycoord+2, $width-4, $height-4, $Pen)
  ;_GDIPlus_GraphicsFillRect($backbuffer, $xcoord    , $ycoord  , $width  , $height  , $Brush) ; filled squares
  _GDIPlus_GraphicsDrawImageRect($graphics, $bitmap, 10, 10, $width, $height) ;copy to bitmap

Func SetTransparentBitmap($hGUI, $hImage, $iOpacity = 0xFF)
    Local $hScrDC, $hMemDC, $hBitmap, $hOld, $pSize, $tSize, $pSource, $tSource, $pBlend, $tBlend
    $hScrDC = _WinAPI_GetDC(0)
    $hMemDC = _WinAPI_CreateCompatibleDC($hScrDC)
    $hBitmap = _GDIPlus_BitmapCreateHBITMAPFromBitmap($hImage)
    $hOld = _WinAPI_SelectObject($hMemDC, $hBitmap)
    $tSize = DllStructCreate($tagSIZE)
    $pSize = DllStructGetPtr($tSize)
    DllStructSetData($tSize, "X", _GDIPlus_ImageGetWidth($hImage))
    DllStructSetData($tSize, "Y", _GDIPlus_ImageGetHeight($hImage))
    $tSource = DllStructCreate($tagPOINT)
    $pSource = DllStructGetPtr($tSource)
    $tBlend = DllStructCreate($tagBLENDFUNCTION)
    $pBlend = DllStructGetPtr($tBlend)
    DllStructSetData($tBlend, "Alpha", $iOpacity)
    DllStructSetData($tBlend, "Format", 1)
    _WinAPI_UpdateLayeredWindow($hGUI,  $hMemDC, 0, $pSize, $hMemDC, $pSource, 0, $pBlend, $ULW_ALPHA)
    _WinAPI_ReleaseDC(0, $hScrDC)
    _WinAPI_SelectObject($hMemDC, $hOld)
EndFunc   ;==>SetTransparentBitmap

#Region Locals
Local $iCnt
Local $iWPos0
Local $iWPos1
Local $bTmp
Local $iCpos
Local $sCtrl
Local $lColr
Local $iWState
Local $bMaxed

$sMyName = StringRegExpReplace(@ScriptName, ".au3|.exe", "")
If _Singleton($sMyName, 1) = 0 Then
  MsgFail($sMyName, "Already running")


$iCnt = 0
While 1
  $sTitle1 = WinGetTitle("[Active]")
  $iWPos1  = WinGetPos("[Active]")
  $iWState = WinGetState("[Active]")
  $bMaxed  = BitAND($iWState, 32) <> 0

  $bTmp = 0
  If $iCnt = 0 Then
    $bTmp = 1
    For $iIx = 0 To 3
      If $iWPos1[$iIx] <> $iWPos0[$iIx] Then
        $bTmp = 1

  If $sTitle1 <> $sTitle0 Or $bTmp Then
    ; Window name or size changed
    ConFmtWr("%s:%02d WB %4d %1d   %4d %4d %4d %4d  ~%s~ \n", _Now(), @MSEC/10, $iCnt, $bMaxed, $iWPos1[0], $iWPos1[1], $iWPos1[2], $iWPos1[3], $sTitle1)

    If $sTitle1 <> "" Then
      ; (Blank window title, with stupid window sizes are messing it up.  For the moment we'll just ignore windows with no title.)
    ; Possibly different colour for development
    $lColr = 0xFF0000
    If @Compiled Then
      $lColr = 0xFF0000

    ; Rectangle around current active window
    If $bMaxed Then
      Rectangle(1, 6, -4, @DesktopWidth - 6, $iWPos1[3] - 15, $lColr)
      Rectangle(1, $iWPos1[0] + 4, $iWPos1[1] -  6, $iWPos1[2] - 04, $iWPos1[3] - 04, $lColr)
      ;            left             top              wid              height
      SetTransparentBitmap($hwnd, $bitmap)
    ConFmtWr("%s:%02d WC\n", _Now(), @MSEC/10)
    $sTitle0 = $sTitle1
    $iWPos0  = $iWPos1
  $iCnt += 1
  ;If $iCnt > 20 And StringInStr($sTitle1, "e\Wind") Then
  ;  Exit


Edited by RichardL

Share this post

Link to post
Share on other sites


... I'm being forced to downgrade to W7+Office-2010



Share this post

Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this