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.
Exclusive forum for HMG, a Free / Open Source xBase WIN32/64 Bits / GUI Development System
http://hmgforum.com/
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))