StatusBar - New features ItemWidth + Color + Alignment

[Pablo César]

Qué bueno que te gustó y gracias por ayudar a testearlo en otras condiciones.

[Pablo César]

Hola Javier !

Para este caso tuyo que utilizas mucho el AERO, no sé si ya utilizas la funcion IsAppThemed() que sirve para retornar si el Windows está temeado.

Hice esta adaptación para ejemplificar, espero que te sea útil:

Code: Select all

/*
   Sizing, Trimming and Coloured StatusBar Demo
   By Pablo César Arrascaeta
   1st, April 2015
*/

#include <hmg.ch>

#define My_StatusBarColor    {102,102,255}
#define SB_SETBKCOLOR        8193

Function Main()
Public aRGB := My_StatusBarColor
DEFINE WINDOW Form_1 MAIN WIDTH 400 ON SIZE {|| My_Sizing() } ;
    TITLE "StatusBar Features Demo"
	
	DEFINE STATUSBAR FONT "Courier New" SIZE 9
        STATUSITEM "New Project" WIDTH 110
        STATUSITEM "Esc for Exit" // (Not Width defined. Be taken this cell for trimming)          
        STATUSITEM "Version 1.1" WIDTH 110
    END STATUSBAR
	
	DEFINE BUTTON Button_1
        ROW    40
        COL    50
        WIDTH  200
        HEIGHT 28
        ACTION My_SetStatusBarSize("Form_1",{110,,110})
        CAPTION "Set StatusBar Size"
        FONTBOLD .T.
    END BUTTON
	
	DEFINE BUTTON Button_2
        ROW    90
        COL    50
        WIDTH  200
        HEIGHT 28
        ACTION if ( IsAppThemed(), MsgInfo("Sorry this option is not able when IsAppThemed",GetThemName()), My_SetStatusBarBackColor("Form_1",GetColor(aRGB)) )
        CAPTION "Set StatusBar BackColor"
        FONTBOLD .T.
    END BUTTON
	
	DEFINE BUTTON Button_3
        ROW    140
        COL    50
        WIDTH  200
        HEIGHT 28
        ACTION My_SetStatusBarTrim("Form_1",{"L","C","R"})
        CAPTION "Set StatusBar Trimming"
        FONTBOLD .T.
    END BUTTON
	
END WINDOW
My_SetStatusBarSize("Form_1",{110,,110})
My_SetStatusBarBackColor("Form_1",My_StatusBarColor)
My_SetStatusBarTrim("Form_1",{"L","C","R"})
Form_1.Center
Form_1.Activate
Return Nil

Function My_Sizing()
aRGB[1] := If((aRGB[1]-10)<0,255,aRGB[1]-5)
aRGB[2] := If((aRGB[2]-10)<0,255,aRGB[2]-5)
// aRGB[3] := If((aRGB[3]-10)<0,255,aRGB[3]-5)

My_SetStatusBarSize("Form_1",{110,,110})
My_SetStatusBarTrim("Form_1",{"L","C","R"})
My_SetStatusBarBackColor("Form_1",aRGB)
Return Nil

Function My_SetStatusBarSize(cParentForm,anWidths)
Local nParentHandle, nStatusHandle, nLength
Local i, nIdx, nTotWidth := 0
Local nMaxWidth := 0
Local aNil := {}
Local nP := 1

nParentHandle := GetFormHandle ( cParentForm )
nIdx := GetControlIndex ("STATUSBAR",cParentForm)
nStatusHandle := _HMG_SYSDATA [3] [nIdx]

For i := 1 To HMG_LEN (anWidths)
	If ValType ( anWidths [i] ) <> 'N'
		anWidths [i] := 120
		Aadd(aNil,i)
	EndIf
	If anWidths[i] > nMaxWidth
	   nMaxWidth := anWidths[i]
	   nP := i
	Endif
	nTotWidth := nTotWidth + anWidths [i]
Next i
If HMG_Len(aNil)=1
   nP := aNil[1]
ElseIf HMG_Len(aNil)>1
   nP := 1
Endif
nTotWidth := nTotWidth - anWidths [nP]
anWidths[nP] := GetWindowWidth ( nParentHandle ) - nTotWidth
InitStatusBarSize ( nStatusHandle, anWidths )
_HMG_SYSDATA[20][nIdx]:=anWidths // Force new atribution upto be fixed at HMG library
Return Nil

Function My_SetStatusBarTrim(cParentForm,aPads)
Local i, nIdx, anWidths, cText, nParentHandle, nStatusHandle, nCharLen, nUnitLen
Local cFont:=GetProperty(cParentForm,"StatusBar","FontName")
Local nSize:=GetProperty(cParentForm,"StatusBar","FontSize")
Local lBold:=GetProperty(cParentForm,"StatusBar","FontBold")
Local lItalic:=GetProperty(cParentForm,"StatusBar","FontItalic")
Local lUnderline:=GetProperty(cParentForm,"StatusBar","Underline")
Local lStrikeOut:=GetProperty(cParentForm,"StatusBar","StrikeOut")

nParentHandle := GetFormHandle ( cParentForm )
nIdx := GetControlIndex ("STATUSBAR",cParentForm)
nStatusHandle := _HMG_SYSDATA [3] [nIdx]
anWidths:=_HMG_SYSDATA [20] [nIdx]

For i := 1 To HMG_LEN (aPads)
	cText:=AllTrim(GetProperty(cParentForm,"StatusBar","Item",i))
	nUnitLen:=GetStrWidth(nStatusHandle,Space(1),cFont,nSize,lBold,lItalic,lUnderline,lStrikeOut)
	nCharLen:=Int(anWidths[i]/nUnitLen)
	Do Case
	   Case aPads[i]="L"
	        cText := HMG_PadL(cText,nCharLen)
	   Case aPads[i]="C"
	        cText := HMG_PadC(cText,nCharLen)
	   Case aPads[i]="R"
	        cText := HMG_PadR(cText,nCharLen)
	EndCase
	SetProperty(cParentForm,"StatusBar","Item",i,cText)
Next
Return Nil

Function My_SetStatusBarBackColor( cParentForm, aBColor )
Local nIdx, nParentHandle, nStatusHandle

nParentHandle := GetFormHandle ( cParentForm )
nIdx := GetControlIndex ("STATUSBAR",cParentForm)
nStatusHandle := _HMG_SYSDATA [3] [nIdx]
SendMessage(nStatusHandle, SB_SETBKCOLOR, 0, ArrayRGB_TO_COLORREF(aBColor))
Return Nil

Function GetStrWidth(nHandle,cText,cFontName,nFontSize,lBold,lItalic,lUnderline,lStrikeOut)
Local nTextWidth, hFont

hFont := HMG_CreateFont (NIL, cFontName, nFontSize, lBold, lItalic, lUnderline, lStrikeOut )
If hFont = 0
   MsgInfo("Fail to create logical font", "CreateLogFont fail")
   Return 0
EndIf
nTextWidth := GetTextWidth(Nil, cText, hFont)
DeleteObject(hFont)
Return nTextWidth

Function GetThemName()
Local cRet:=RegistryRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\CurrentTheme")

Return HMG_Upper(cFileNoPath(cRet))

Lo interesante tambien es que puede obtener el nombre del tema que está activo.

Saludos,

[Javier Tovar]

Gracias Pablo César,

Regresando de Vacaciones la analizo y la pruebo!

Saludos

[Pablo César]

Ops... feliz páscuas y vacaciones, Javier.
No hay prisa alguna !