I looked through the forum and found that there are some old posts where a MONTHCALENDAR command has WIDTH and HEIGHT. I also looked through Stack Overflow and found that changing the font size in this control does change the size of the control in XP, but does not in Vista. The reason is themes -- in Vista and later, you must first turn off the theme, and then the window will be resized. So I now think that
- The WIDTH and HEIGHT clauses were once in HMG but were removed because they stopped working in Vista.
- The WIDTH and HEIGHT clauses could be added back in if there were a way to turn off the theme.
Code: Select all
/*
Modified form of MONTHCALENDAR command, with WIDTH and HEIGHT clauses
and using _DefineMonthCal2 instead of _DefineMonthCal
*/
#xcommand @ <row>,<col> MONTHCALENDAR <name> ;
[ <dummy1: OF, PARENT> <parent> ] ;
[ VALUE <v> ] ;
[ FONT <fontname> ] ;
[ SIZE <fontsize> ] ;
[ WIDTH <width> ] ;
[ HEIGHT <height> ] ;
[ <bold : BOLD> ] ;
[ <italic : ITALIC> ] ;
[ <underline : UNDERLINE> ] ;
[ <strikeout : STRIKEOUT> ] ;
[ TOOLTIP <tooltip> ] ;
[ < notoday: NOTODAY > ] ;
[ < notodaycircle: NOTODAYCIRCLE > ] ;
[ < weeknumbers: WEEKNUMBERS > ] ;
[ < invisible: INVISIBLE > ] ;
[ < notabstop: NOTABSTOP > ] ;
[ ON CHANGE <change> ] ;
[ HELPID <helpid> ] ;
=>;
_DefineMonthCal2 ( <"name"> , ;
<"parent"> , ;
<col> , ;
<row> , ;
<width> , ;
<height> , ;
<v> , ;
<fontname> , ;
<fontsize> , ;
<tooltip> , ;
<.notoday.> , ;
<.notodaycircle.> , ;
<.weeknumbers.> , ;
<{change}> , <helpid>, <.invisible.>, <.notabstop.> ,<.bold.>, <.italic.>, <.underline.>, <.strikeout.> )
Code: Select all
/*
_DefineMonthCal2()
Modified version of _DefineMonthCal() in SOURCE\h_monthcal.prg
This version accepts nonzero width and height parameters,
which set the width and height of the calendar.
*/
MEMVAR _HMG_SYSDATA
#include "hmg.ch"
#include "common.ch"
Function _DefineMonthCal2 ( ControlName, ParentForm, x, y, w, h, value, ;
fontname, fontsize, tooltip, notoday, notodaycircle, ;
weeknumbers, change, HelpId, invisible, notabstop, ;
bold, italic, underline, strikeout )
*-----------------------------------------------------------------------------*
Local cParentForm , mVar , k := 0
Local aControlHandle
Local cParentTabName
DEFAULT w TO 0
DEFAULT h TO 0
DEFAULT value TO date()
DEFAULT change TO ""
DEFAULT bold TO FALSE
DEFAULT italic TO FALSE
DEFAULT underline TO FALSE
DEFAULT strikeout TO FALSE
if _HMG_SYSDATA [ 264 ] = .T.
ParentForm := _HMG_SYSDATA [ 223 ]
if .Not. Empty (_HMG_SYSDATA [ 224 ]) .And. ValType(FontName) == "U"
FontName := _HMG_SYSDATA [ 224 ]
EndIf
if .Not. Empty (_HMG_SYSDATA [ 182 ]) .And. ValType(FontSize) == "U"
FontSize := _HMG_SYSDATA [ 182 ]
EndIf
endif
if _HMG_SYSDATA [ 183 ] > 0
IF _HMG_SYSDATA [ 240 ] == .F.
x := x + _HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]]
y := y + _HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]]
ParentForm := _HMG_SYSDATA [ 332 ] [_HMG_SYSDATA [ 183 ]]
cParentTabName := _HMG_SYSDATA [ 225 ]
ENDIF
EndIf
If .Not. _IsWindowDefined (ParentForm)
MsgHMGError("Window: "+ ParentForm + " is not defined. Program terminated")
Endif
If _IsControlDefined (ControlName,ParentForm)
MsgHMGError ("Control: " + ControlName + " Of " + ParentForm + " Already defined. Program terminated")
endif
mVar := '_' + ParentForm + '_' + ControlName
cParentForm := ParentForm
ParentForm = GetFormHandle (ParentForm)
if valtype(fontname) != "U" .and. valtype(fontsize) != "U"
aControlHandle := InitMonthCal ( ParentForm, 0, x, y, w, h , fontname , fontsize , notoday , notodaycircle , weeknumbers, invisible, notabstop, bold, italic, underline, strikeout )
Else
aControlHandle := InitMonthCal ( ParentForm, 0, x, y, w, h , _HMG_SYSDATA [ 342 ] , _HMG_SYSDATA [ 343 ] , notoday , notodaycircle , weeknumbers, invisible, notabstop, bold, italic, underline, strikeout )
endif
if ISVISTA() .And. IsAppThemed()
SetWindowTheme(aControlHandle[1], "", "")
endif
if w != 0 .and. h != 0
SetWindowPos(aControlHandle[1], NIL, x, y, w, h, SWP_NOZORDER)
endif
If _HMG_SYSDATA [ 265 ] = .T.
aAdd ( _HMG_SYSDATA [ 142 ] , aControlhandle[1] )
EndIf
SetMonthCal( aControlHandle[1] ,year(value), month(value), day(value) )
if valtype(tooltip) != "U"
SetToolTip ( aControlHandle[1] , tooltip , GetFormToolTipHandle (cParentForm) )
endif
w := GetWindowWidth ( aControlHandle[1] )
h := GetWindowHeight ( aControlHandle[1] )
k := _GetControlFree()
Public &mVar. := k
_HMG_SYSDATA [1] [k] := "MONTHCAL"
_HMG_SYSDATA [2] [k] := ControlName
_HMG_SYSDATA [3] [k] := aControlHandle[1]
_HMG_SYSDATA [4] [k] := ParentForm
_HMG_SYSDATA [ 5 ] [k] := 0
_HMG_SYSDATA [ 6 ] [k] := ""
_HMG_SYSDATA [ 7 ] [k] := {}
_HMG_SYSDATA [ 8 ] [k] := Nil
_HMG_SYSDATA [ 9 ] [k] := ""
_HMG_SYSDATA [ 10 ] [k] := ""
_HMG_SYSDATA [ 11 ] [k] := ""
_HMG_SYSDATA [ 12 ] [k] := change
_HMG_SYSDATA [ 13 ] [k] := .F.
_HMG_SYSDATA [ 14 ] [k] := Nil
_HMG_SYSDATA [ 15 ] [k] := Nil
_HMG_SYSDATA [ 16 ] [k] := ""
_HMG_SYSDATA [ 17 ] [k] := {}
_HMG_SYSDATA [ 18 ] [k] := y
_HMG_SYSDATA [ 19 ] [k] := x
_HMG_SYSDATA [ 20 ] [k] := w
_HMG_SYSDATA [ 21 ] [k] := h
_HMG_SYSDATA [ 22 ] [k] := 0
_HMG_SYSDATA [ 23 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 333 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 24 ] [k] := iif ( _HMG_SYSDATA [ 183 ] > 0 ,_HMG_SYSDATA [ 334 ] [_HMG_SYSDATA [ 183 ]] , -1 )
_HMG_SYSDATA [ 25 ] [k] := ""
_HMG_SYSDATA [ 26 ] [k] := 0
_HMG_SYSDATA [ 27 ] [k] := fontname
_HMG_SYSDATA [ 28 ] [k] := fontsize
_HMG_SYSDATA [ 29 ] [k] := {bold,italic,underline,strikeout}
_HMG_SYSDATA [ 30 ] [k] := tooltip
_HMG_SYSDATA [ 31 ] [k] := cParentTabName
_HMG_SYSDATA [ 32 ] [k] := 0
_HMG_SYSDATA [ 33 ] [k] := ''
_HMG_SYSDATA [ 34 ] [k] := if(invisible,FALSE,TRUE)
_HMG_SYSDATA [ 35 ] [k] := HelpId
_HMG_SYSDATA [ 36 ] [k] := aControlHandle[2]
_HMG_SYSDATA [ 37 ] [k] := 0
_HMG_SYSDATA [ 38 ] [k] := .T.
_HMG_SYSDATA [ 39 ] [k] := 0
_HMG_SYSDATA [ 40 ] [k] := { NIL , NIL , NIL , NIL , NIL , NIL , NIL , NIL }
Return Nil
Code: Select all
/*
Modified version of SAMPLES\Controls\MonthCalendar\MONTHCAL_4\demo.prg
This version has a second calendar with WIDTH and HEIGHT clauses
and additional menu options.
*/
#include "hmg.ch"
FUNCTION Main()
DEFINE WINDOW Win_1 ;
AT 0,0 ;
WIDTH 500 ;
HEIGHT 500 ;
TITLE 'Win_1' ;
MAIN ;
NOSIZE
DEFINE MAIN MENU
DEFINE POPUP 'Test 1'
MENUITEM 'Set Row' ACTION Win_1.Control_1.Row := Val(InputBox('Enter Row',''))
MENUITEM 'Set Col' ACTION Win_1.Control_1.Col := Val(InputBox('Enter Col',''))
MENUITEM 'Set Width' ACTION Win_1.Control_1.Width := Val(InputBox('Enter Width',''))
MENUITEM 'Set Height' ACTION Win_1.Control_1.Height := Val(InputBox('Enter Height',''))
SEPARATOR
MENUITEM 'Get Row' ACTION MsgInfo ( Str ( Win_1.Control_1.Row ) )
MENUITEM 'Get Col' ACTION MsgInfo ( Str ( Win_1.Control_1.Col ) )
MENUITEM 'Get Width' ACTION MsgInfo ( Str ( Win_1.Control_1.Width ) )
MENUITEM 'Get Height' ACTION MsgInfo ( Str ( Win_1.Control_1.Height ) )
MENUITEM 'Get Font Name' ACTION MsgInfo ( Win_1.Control_1.FontName )
MENUITEM 'Get Font Size' ACTION MsgInfo ( Str ( Win_1.Control_1.FontSize ) )
SEPARATOR
MENUITEM 'Get Value' ACTION MsgInfo ( GetDate ( Win_1.Control_1.Value ) )
END POPUP
DEFINE POPUP 'Test 2'
MENUITEM 'Set Row' ACTION Win_1.Control_2.Row := Val(InputBox('Enter Row',''))
MENUITEM 'Set Col' ACTION Win_1.Control_2.Col := Val(InputBox('Enter Col',''))
MENUITEM 'Set Width' ACTION Win_1.Control_2.Width := Val(InputBox('Enter Width',''))
MENUITEM 'Set Height' ACTION Win_1.Control_2.Height := Val(InputBox('Enter Height',''))
SEPARATOR
MENUITEM 'Get Row' ACTION MsgInfo ( Str ( Win_1.Control_2.Row ) )
MENUITEM 'Get Col' ACTION MsgInfo ( Str ( Win_1.Control_2.Col ) )
MENUITEM 'Get Width' ACTION MsgInfo ( Str ( Win_1.Control_2.Width ) )
MENUITEM 'Get Height' ACTION MsgInfo ( Str ( Win_1.Control_2.Height ) )
MENUITEM 'Get Font Name' ACTION MsgInfo ( Win_1.Control_2.FontName )
MENUITEM 'Get Font Size' ACTION MsgInfo ( Str ( Win_1.Control_2.FontSize ) )
SEPARATOR
MENUITEM 'Get Value' ACTION MsgInfo ( GetDate ( Win_1.Control_2.Value ) )
END POPUP
END MENU
@ 10,10 MONTHCALENDAR CONTROL_1 ;
OF Win_1 ;
FONT 'Arial' ;
SIZE 8
@ 200,10 MONTHCALENDAR CONTROL_2 ;
OF Win_1 ;
WIDTH 320 ;
HEIGHT 230 ;
FONT 'Arial' ;
SIZE 12
END WINDOW
ACTIVATE WINDOW Win_1
RETURN NIL
//***************************************************************************
Static Function GetDate ( dDate )
Local nDay := Day(dDate)
Local nMonth := Month(dDate)
Local nYear := Year(dDate)
Local cRet := ""
cRet += "Day: "+StrZero(nDay,2)
cRet += space(2)
cRet += "Month: "+StrZero(nMonth,2)
cRet += space(2)
cRet += "Year: "+StrZero(nYear,4)
Return cRet