Moderador: Moderadores
por JoséQuintas » 30 Abr 2016 10:29
CREATE CLASS TstEdit INHERIT TstAny
VAR ClassName INIT "EDIT"
VAR objType INIT objTypeSLE
VAR Style INIT WIN_WS_CHILD + WIN_WS_TABSTOP + WIN_WS_BORDER
ENDCLASS
oControl := TstEdit():New()
oControl:Style += ES_NUMBER + ES_RIGHT
oControl:cText := "1234567"
oControl:Create( , , { -15, -43 }, { -1, -18 } )
por JoséQuintas » 30 Abr 2016 10:30
CREATE CLASS TstEditMultiline INHERIT TstAny
VAR ClassName INIT "EDIT"
VAR ObjType INIT objTypeMLE
VAR Style INIT WIN_WS_CHILD + WIN_WS_TABSTOP + ES_AUTOVSCROLL + ES_MULTILINE + ;
ES_WANTRETURN + WIN_WS_BORDER + WIN_WS_VSCROLL
ENDCLASS
oControl := TstEditMultiline():New()
oControl:cText := GetEditText()
oControl:Create( , , { -1, -2 }, { -15, -35 } )
...
STATIC FUNCTION GetEditText()
RETURN ;
"This sample is to show GTWVG possibilites." + hb_eol() + ;
"It does not use existing GTWVG controls," + hb_eol() + ;
"but uses features of GTWVG." + hb_eol() + ;
"Think possibilites to expand." + hb_eol() + ;
+ hb_eol() + ;
"Text from sample used as base:" + hb_eol() + ;
"Welcome in the Wonderful World of Harbour!" + ;
hb_eol() + hb_eol() + ;
"When Peter Rees first published GTWVT, a Windows " + ;
"Terminal Driver, on 22 Dec 2003, everybody took it " + ;
"lightly, except for me, as I was aware that what " + ;
"wonderful contribution to Harbour he has made, " + ;
"what immense possibilities he has opened for Harbour " + ;
"developers, what limitations he has cleared for Cl*pper " + ;
"savvy user base." + ;
hb_eol() + hb_eol() + ;
"With a little effort I could extend GTWVT " + ;
"to give it a GUI look. I also tried to give it " + ;
"an event driven functionality, and up came Wvt*Classes." + ;
hb_eol() + hb_eol() + ;
"And yet another feather is added in the cap of GTWVT " + ;
"as it is now capable of firing modeless dialogs like the one " + ;
"you are viewing. These dialogs can be constructed dynamically ( Courtesy hbwhat ) " + ;
"at run time or can be one of resources. At present 20 such dialogs " + ;
"can be active at any given time. Also note that dialogs created " + ;
"dynamically respect Top, Left, Rows, Cols coordinates, which is an " + ;
"undisputed productivity boost!" + ;
hb_eol() + hb_eol() + ;
"Enjoy!" + hb_eol() + ;
"Pritpal Bedi, INDIA"
por JoséQuintas » 30 Abr 2016 10:32
CREATE CLASS TstGroupbox INHERIT TstAny
VAR className INIT "BUTTON"
VAR objType INIT objTypePushButton
VAR style INIT WIN_WS_CHILD + WIN_WS_VISIBLE + WIN_WS_TABSTOP + BS_GROUPBOX + WIN_WS_EX_TRANSPARENT
ENDCLASS
oControl := TstGroupbox():new()
oControl:cText := "Compiler"
oControl:Create( , , { -7, -43 }, { -4, -17 } )
por JoséQuintas » 30 Abr 2016 10:33
CREATE CLASS TstIcon INHERIT TstAny
VAR ClassName INIT "STATIC"
VAR objType INIT objTypeStatic
VAR Style INIT WIN_WS_CHILD + WIN_WS_GROUP + SS_ICON + SS_CENTERIMAGE + BS_NOTIFY
VAR nIconBitmap INIT WIN_IMAGE_ICON
ENDCLASS
oControl := TstIcon():New()
oControl:cImage := "tstico"
oControl:Create( , , { -19, -2 }, { -3, -8 } )
por JoséQuintas » 30 Abr 2016 10:34
CREATE CLASS TstMonthCalendar INHERIT TstAny
VAR ClassName INIT "SysMonthCal32"
VAR objType INIT objTypeStatic
VAR Style INIT WIN_WS_CHILD // + MCS_NOTODAY + MCS_NOTODAYCIRCLE + MCS_WEEKNUMBERS
ENDCLASS
oControl := TstMonthCalendar():New()
oControl:Create( , , { -1, -63 }, { -10, -25 } )
por JoséQuintas » 30 Abr 2016 10:35
CREATE CLASS TstProgressbar INHERIT TstAny
VAR ClassName INIT "msctls_progress32"
VAR ObjType INIT objTypeStatic
VAR Style INIT WIN_WS_CHILD + WIN_WS_GROUP + WIN_WS_EX_CLIENTEDGE
ENDCLASS
oProgress := TstProgressbar():New()
oProgress:Create( , , { -23, -1 }, { -1, -50 } )
oProgress:sendMessage( PBM_SETRANGE, 0, WIN_MAKELONG( 1, 20 ) )
oProgress:sendMessage( PBM_SETPOS, 0, 0 )
...
DO WHILE nKey != K_ESC
oProgress:SendMessage( PBM_SETPOS, iif( nLoop > 20, 20, nLoop++ ), 0 )
nKey := Inkey(1)
ENDDO
por JoséQuintas » 30 Abr 2016 10:37
CREATE CLASS TstRadioButton INHERIT TstAny
VAR ClassName INIT "BUTTON"
VAR ObjType INIT objTypePushButton
VAR Style INIT WIN_WS_CHILD + WIN_WS_TABSTOP + BS_AUTORADIOBUTTON
ENDCLASS
oControl := TstRadioButton():New()
oControl:cText := "Harbour"
oControl:Create( , , { -8, -45 }, { -1, -12 } )
oControl:SendMessage( BM_SETCHECK, BST_CHECKED, 0 )
oControl := TstRadioButton():New()
oControl:Style += BS_LEFTTEXT
oControl:cText := "Clipper"
oControl:Create( , , { -9, -45 }, { -1, -12 } )
por JoséQuintas » 30 Abr 2016 10:38
CREATE CLASS TstScrollbar INHERIT TstAny
VAR ClassName INIT "SCROLLBAR"
VAR Style INIT WIN_WS_CHILD
ENDCLASS
oControl := TstScrollbar():New()
oControl:Style += SBS_VERT
oControl:Create( , , { -1, -39 }, { -14, -2 } )
oControl := TstScrollbar():New()
oControl:Style += SBS_HORZ
oControl:Create( , , { -17, -2 }, { -1, -36 } )
por JoséQuintas » 30 Abr 2016 10:40
CREATE CLASS TstStatusbar INHERIT TstAny
VAR ClassName INIT "msctls_statusbar32"
VAR Style INIT WIN_WS_CHILD + WIN_WS_BORDER
ENDCLASS
oControl := TstStatusbar():New()
oControl:Create( , , { -28, 1 }, { -1, -50 } )
por JoséQuintas » 30 Abr 2016 10:41
CREATE CLASS TstText INHERIT TstAny
VAR ClassName INIT "STATIC"
VAR objType INIT objTypeStatic
VAR Style INIT WIN_WS_CHILD + WIN_WS_GROUP + SS_LEFT + WIN_WS_EX_TRANSPARENT + SS_SIMPLE // SS_LABEL
ENDCLASS
oControl := TstText():New()
oControl:cText := "Scrollable Text"
oControl:Create( , , { -12, -43 }, { -1, -18 } )
oControl := TstText():New()
oControl:cText := "Right Justified Numerics"
oControl:Create( , , { -14, -43 }, { -1, -18 } )
por JoséQuintas » 30 Abr 2016 10:42
CREATE CLASS TstTrackbar INHERIT TstAny
VAR ClassName INIT "msctls_trackbar32"
VAR Style INIT WS_CHILD + WS_VISIBLE + TBS_AUTOTICKS + TBS_ENABLESELRANGE
ENDCLASS
oControl := TstTrackbar():New()
oControl:Create( , , { -20, -63 }, { -3, -15 } )
oControl:SendMessage( TBM_SETRANGE, 1, WIN_MAKELONG( 1, 10 ) )
oControl:SendMessage( TBM_SETSEL, 0, WIN_MAKELONG( 1, 10 ) )
oControl:SendMessage( TBM_SETPOS, 1, 1 )
por JoséQuintas » 30 Abr 2016 10:43
CREATE CLASS TstUpDown INHERIT TstAny
VAR ClassName INIT "msctls_updown32"
VAR Style INIT WS_CHILD + WS_VISIBLE + UDS_ALIGNRIGHT
ENDCLASS
oCOntrol := TstUpDown():New()
oControl:Create( , , { -18, -82 }, { -3, -5 } )
oControl:SendMessage( UDM_SETRANGE, 0, WIN_MAKELONG( 1, 100 ) )
oControl:SendMessage( UDM_SETPOS, 0, 1 )
por JoséQuintas » 30 Abr 2016 10:45
CREATE CLASS TstAny INHERIT WvgWindow
VAR autosize INIT .F.
VAR Border INIT .T.
VAR cancel INIT .F.
VAR cText
VAR default INIT .F.
VAR drawMode INIT WVG_DRAW_NORMAL
VAR preSelect INIT .F.
VAR pointerFocus INIT .F.
VAR Style INIT 0
VAR cImage
VAR nIconBitmap INIT 0
VAR lSetCallback INIT .F.
VAR cFontName
VAR nFontSize
METHOD new( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
METHOD create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
METHOD configure( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
METHOD destroy()
METHOD handleEvent( nMessage, aNM )
METHOD activate( xParam ) SETGET
METHOD setText()
METHOD SetImage()
METHOD draw( xParam ) SETGET
ENDCLASS
METHOD TstAny:new( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
::wvgWindow:new( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
RETURN Self
METHOD TstAny:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
LOCAL hOldFont
//DO CASE
//CASE ::nIconBitmap == 1 ; ::style += BS_ICON
//CASE ::nIconBitmap == 2 ; ::style += BS_BITMAP
//ENDCASE
::wvgWindow:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
::oParent:AddChild( Self )
::createControl()
IF ::lSetCallback
::SetWindowProcCallback() /* Let parent take control of it */
ENDIF
IF ::cFontName != NIL
hOldFont := ::SendMessage( WIN_WM_GETFONT )
::SendMessage( WIN_WM_SETFONT, wvt_CreateFont( ::cFontName, ::nFontSize ), 0 )
wvg_DeleteObject( hOldFont )
ENDIF
::SetImage()
::SetText()
//IF ::IsCrtParent()
//hOldFont := ::oParent:SendMessage( WIN_WM_GETFONT )
//::SendMessage( WIN_WM_SETFONT, hOldFont, 0 )
//ENDIF
IF ::visible
::show()
ENDIF
::setPosAndSize()
RETURN Self
METHOD TstAny:handleEvent( nMessage, aNM )
DO CASE
CASE nMessage == HB_GTE_RESIZED
IF ::isParentCrt()
::rePosition()
ENDIF
IF ::ClassName == "SysMonthCal32"
::InvalidateRect()
ELSE
::sendMessage( WIN_WM_SIZE, 0, 0 )
IF HB_ISEVALITEM( ::sl_resize )
Eval( ::sl_resize, , , Self )
ENDIF
ENDIF
//IF ::WControlName $ "CMDBUTTON"
// ::Repaint()
//ENDIF
CASE nMessage == HB_GTE_COMMAND
IF aNM[ 1 ] == BN_CLICKED
IF HB_ISEVALITEM( ::sl_lbClick )
IF ::isParentCrt()
::oParent:setFocus()
ENDIF
Eval( ::sl_lbClick, , , Self )
IF ::pointerFocus
::setFocus()
ENDIF
ENDIF
RETURN EVENT_HANDLED
ENDIF
CASE nMessage == HB_GTE_NOTIFY
CASE nMessage == HB_GTE_CTLCOLOR
IF HB_ISNUMERIC( ::clr_FG )
wapi_SetTextColor( aNM[ 1 ], ::clr_FG )
ENDIF
IF ! Empty( ::hBrushBG )
wapi_SetBkMode( aNM[ 1 ], WIN_TRANSPARENT )
RETURN ::hBrushBG
ENDIF
CASE ::lSetCallback .AND. nMessage == HB_GTE_ANY
IF aNM[ 1 ] == WIN_WM_LBUTTONUP
IF HB_ISEVALITEM( ::sl_lbClick )
IF ::isParentCrt()
::oParent:setFocus()
ENDIF
Eval( ::sl_lbClick, , , Self )
ENDIF
ENDIF
ENDCASE
RETURN EVENT_UNHANDLED
METHOD PROCEDURE TstAny:destroy()
LOCAL hOldFont
IF ::cFontName != NIL
hOldFont := ::SendMessage( WIN_WM_GETFONT )
::wvgWindow:destroy()
::wvgWindow:destroy()
wvg_DeleteObject( hOldFont )
ENDIF
RETURN
METHOD TstAny:configure( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
::Initialize( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
RETURN Self
METHOD TstAny:SetText()
IF HB_ISCHAR( ::cText )
::sendMessage( WIN_WM_SETTEXT, 0, ::cText )
ENDIF
RETURN NIL
METHOD TstAny:SetImage()
IF ::cImage != NIL .AND. ( ::nIconBitmap == WIN_IMAGE_ICON .OR. ::nIconBitmap == WIN_IMAGE_BITMAP )
// BM_SETIMAGE on button, STM_SETIMAGE em outros
::sendMessage( STM_SETIMAGE, ::nIconBitmap, wvg_LoadImage( ::cImage, 1, ::nIconBitmap ) )
ENDIF
RETURN NIL
METHOD TstAny:draw( xParam )
IF HB_ISEVALITEM( xParam ) .OR. xParam == NIL
::sl_paint := xParam
ENDIF
RETURN Self
METHOD TstAny:activate( xParam )
IF HB_ISEVALITEM( xParam ) .OR. xParam == NIL
::sl_lbClick := xParam
ENDIF
RETURN Self
por JoséQuintas » 30 Abr 2016 11:27
por JoséQuintas » 30 Abr 2016 11:31
Usuários vendo este fórum: Nenhum usuário registrado online e 9 visitantes
