StatusBar - New features ItemWidth + Color + Alignment

Topic Specific Tutorials and Tips.

Moderator: Rathinagiri

User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil
Has thanked: 100 times
Been thanked: 182 times

StatusBar - New features ItemWidth + Color + Alignment

Post by Pablo César » Wed Apr 01, 2015 6:40 pm

Qué bueno que te gustó y gracias por ayudar a testearlo en otras condiciones.
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein

User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil
Has thanked: 100 times
Been thanked: 182 times

Post by Pablo César » Thu Apr 02, 2015 4:33 pm

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,
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein

Javier Tovar
Posts: 1275
Joined: Tue Sep 03, 2013 4:22 am
Location: Tecámac, México
Has thanked: 1 time
Been thanked: 2 times

Post by Javier Tovar » Thu Apr 02, 2015 6:06 pm

Gracias Pablo César,

Regresando de Vacaciones la analizo y la pruebo!

Saludos

User avatar
Pablo César
Posts: 4059
Joined: Wed Sep 08, 2010 1:18 pm
Location: Curitiba - Brasil
Has thanked: 100 times
Been thanked: 182 times

Post by Pablo César » Thu Apr 02, 2015 7:26 pm

Ops... feliz páscuas y vacaciones, Javier.
No hay prisa alguna ! :)
HMGing a better world
"Matter tells space how to curve, space tells matter how to move."
Albert Einstein

Post Reply