PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

LIB console imitando gráfico

https://pctoledo.org/viewtopic.php?t=16957

Página 5 de 8

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:29
por JoséQuintas
tstEdit

Código: Selecionar todos

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
uso

Código: Selecionar todos

   oControl := TstEdit():New()
   oControl:Style += ES_NUMBER + ES_RIGHT
   oControl:cText := "1234567"
   oControl:Create( , , { -15, -43 }, { -1, -18 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:30
por JoséQuintas
tstEditMultiline

Código: Selecionar todos

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
uso

Código: Selecionar todos

   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"

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:32
por JoséQuintas
tstGroupbox

Código: Selecionar todos

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
uso

Código: Selecionar todos

   oControl := TstGroupbox():new()
   oControl:cText := "Compiler"
   oControl:Create( , , { -7, -43 }, { -4, -17 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:33
por JoséQuintas
tstIcon

Código: Selecionar todos

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
uso

Código: Selecionar todos

   oControl := TstIcon():New()
   oControl:cImage := "tstico"
   oControl:Create( , , { -19, -2 }, { -3, -8 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:34
por JoséQuintas
tstMonthCalendar

Código: Selecionar todos

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
uso

Código: Selecionar todos

   oControl := TstMonthCalendar():New()
   oControl:Create( , , { -1, -63 }, { -10, -25 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:35
por JoséQuintas
tstProgressbar

Código: Selecionar todos

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
uso

Código: Selecionar todos

   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

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:37
por JoséQuintas
tstRadioButton

Código: Selecionar todos

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
uso

Código: Selecionar todos

   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 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:38
por JoséQuintas
tstScrollbar

Código: Selecionar todos

CREATE CLASS TstScrollbar INHERIT TstAny
   VAR ClassName INIT "SCROLLBAR"
   VAR Style     INIT WIN_WS_CHILD
   ENDCLASS
uso

Código: Selecionar todos

   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 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:40
por JoséQuintas
tstStatusbar

Código: Selecionar todos

CREATE CLASS TstStatusbar INHERIT TstAny
   VAR ClassName INIT "msctls_statusbar32"
   VAR Style  INIT WIN_WS_CHILD + WIN_WS_BORDER
   ENDCLASS
uso

Código: Selecionar todos

   oControl := TstStatusbar():New()
   oControl:Create( , , { -28, 1 }, { -1, -50 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:41
por JoséQuintas
tstText

Código: Selecionar todos

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
uso

Código: Selecionar todos

   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 } )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:42
por JoséQuintas
tstTrackbar

Código: Selecionar todos

CREATE CLASS TstTrackbar INHERIT TstAny
   VAR ClassName INIT "msctls_trackbar32"
   VAR Style     INIT WS_CHILD + WS_VISIBLE + TBS_AUTOTICKS + TBS_ENABLESELRANGE
   ENDCLASS
uso

Código: Selecionar todos

   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 )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:43
por JoséQuintas
tstUpdown

Código: Selecionar todos

CREATE CLASS TstUpDown INHERIT TstAny
   VAR ClassName INIT "msctls_updown32"
   VAR Style     INIT WS_CHILD + WS_VISIBLE + UDS_ALIGNRIGHT
   ENDCLASS
uso

Código: Selecionar todos

   oCOntrol := TstUpDown():New()
   oControl:Create( , , { -18, -82 }, { -3, -5 } )
   oControl:SendMessage( UDM_SETRANGE, 0, WIN_MAKELONG( 1, 100 ) )
   oControl:SendMessage( UDM_SETPOS, 0, 1 )

LIB console imitando gráfico

Enviado: 30 Abr 2016 10:45
por JoséQuintas
Como dá pra perceber, TODOS fazem herança a tstAny, que contém rotinas comuns.

Código: Selecionar todos

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

LIB console imitando gráfico

Enviado: 30 Abr 2016 11:27
por JoséQuintas
Ok, estão incompletos, tem rotina no fonte de teste que deveria ser função da classe do controle, etc. etc.

Agora é ir "recheando" cada um, com fonte PRG combinado com :sendMessage.

Controles mais complexos são a combinação dos anteriores, e rotinas de desenhar/escrever diretamente nas janelas.

Em último caso, é uma boa referência à API do Windows, e de como as coisas funcionam no Windows.

É tudo na base de janelas, para cada ítem da tela. Por isso o nome: Windows

LIB console imitando gráfico

Enviado: 30 Abr 2016 11:31
por JoséQuintas
Nota:
Talvez este tópico se encaixe melhor em contribuições.
Acabou mostrando o uso dos controles que existem no Windows, e todo básico do que acontece na programação Windows.
Infelizmente acabei misturando com a TUI, que era o assunto inicial.
De qualquer forma, tudo que foi usado está dentro dos fontes do Harbour, até mesmo a gtwvg.
Todos os horários são UTC-03:00
Página 5 de 8

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB