StatusBar - New features ItemWidth + Color + Alignment
Posted: Wed Apr 01, 2015 6:40 pm
Qué bueno que te gustó y gracias por ayudar a testearlo en otras condiciones.
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))Saludos,
