LIB console imitando gráfico

[JoséQuintas]

Só na minha máquina.

[JoséQuintas]

Todo controle é uma janela, então é criada uma janela.
O "desenho" da janela, no geral é definido pelo estilo, e o tratamento do Windows para o controle é definido por classes padrão.
Esta parte define isso

Código: Selecionar todos

   CASE ::WControlName == "CMDBUTTON"   ; ::className := "BUTTON"       ; ::objType := objTypePushButton  ; ::style += WIN_WS_CHILD + BS_PUSHBUTTON + BS_NOTIFY + BS_FLAT
   CASE ::WControlName == "CHECKBOX"    ; ::ClassName := "BUTTON"       ; ::objType := objTypeCheckBox    ; ::Style += WIN_WS_CHILD + BS_CHECKBOX + WIN_WS_TABSTOP + WIN_WS_GROUP
   CASE ::WControlName == "COMBOBOX"    ; ::ClassName := "COMBOBOX"     ; ::ObjType := objTypeComboBox    ; ::Style += WIN_WS_TABSTOP + WIN_WS_GROUP + WIN_WS_CHILD + CBS_DROPDOWNLIST
   CASE ::WControlName == "FRAME"       ; ::ClassName := "STATIC"       ; ::ObjType := objTypeStatic      ; ::Style += WIN_WS_CHILD + WIN_WS_GROUP + BS_GROUPBOX
   CASE ::WControlName == "GROUPBOX"    ; ::className := "BUTTON"       ; ::objType := objTypeStatic      ; ::style += WIN_WS_CHILD + BS_GROUPBOX + WIN_WS_GROUP
   CASE ::WControlName == "IMAGE"       ; ::className := "STATIC"       ; ::objType := objTypeStatic      ; ::style += WIN_WS_CHILD
   CASE ::WControlName == "LABEL"       ; ::ClassName := "STATIC"       ; ::objType := objTypeStatic      ; ::Style += WIN_WS_CHILD + WIN_WS_GROUP + SS_LEFT
   CASE ::WControlName == "LISTBOX"     ; ::ClassName := "LISTBOX"      ; ::objType := objTypeListBox     ; ::Style += WIN_WS_TABSTOP + WIN_WS_GROUP + WIN_WS_CHILD + WIN_WS_BORDER
   CASE ::WControlName == "PROGRESSBAR" ; ::ClassName := "PROGRESS_BAR" ; ::ObjType := objTypeStatic      ; ::Style += WIN_WS_CHILD + WIN_WS_GROUP
   CASE ::WControlName == "TEXTBOX"     ; ::ClasName  := "EDIT"         ; ::objType := objTypeSLE         ; ::Style += WIN_WS_BORDER + WIN_WS_CHILD + WIN_WS_TABSTOP + WIN_WS_GROUP

Faz parte também desse estilo algumas mudanças visuais e/ou de comportamento.

A partir daí, o tratamento adicional vai ser feito por esta função/método.

Código: Selecionar todos

METHOD wvgControl:handleEvent( nMessage, aNM )

Cada evento passa por essa função, através de mensagens.
No geral é enviar/receber mensagens, a função acima recebe, wapi_SendMessage() envia.

Certos parâmetros não são compatíveis com Harbour, como já disse antes.

Resumindo:
GTWVG Pode funcionar como console ou GUI.
Só o esqueleto básico está pronto, com controles básicos e funções básicas.
Se falta alguma coisa é porque ninguém fez.

[JoséQuintas]

Comparar OOHG mostra exatamente do que eu venho falando.

OOHG:

Código: Selecionar todos

Function MsgInfo( Message, Title, Mode )
   DEFAULT Message TO _OOHG_MsgDefaultMessage
   DEFAULT Title TO _OOHG_MsgDefaultTitle
   DEFAULT Mode TO _OOHG_MsgDefaultMode
   c_msginfo( Message, Title, Mode )
Return Nil

Function MsgStop( Message, Title, Mode )
   DEFAULT Message TO _OOHG_MsgDefaultMessage
   DEFAULT Title TO _OOHG_MsgDefaultTitle
   DEFAULT Mode TO _OOHG_MsgDefaultMode
   c_msgstop( Message, Title, Mode )
Return Nil

Function MsgExclamation( Message, Title, Mode )
   DEFAULT Message TO _OOHG_MsgDefaultMessage
   DEFAULT Title TO _OOHG_MsgDefaultTitle
   DEFAULT Mode TO _OOHG_MsgDefaultMode
   c_msgexclamation( Message, Title, Mode )
Return Nil

Function MsgExclamationYesNo( Message, Title, Mode )
Local t
   DEFAULT Message TO _OOHG_MsgDefaultMessage
   DEFAULT Title TO _OOHG_MsgDefaultTitle
   DEFAULT Mode TO _OOHG_MsgDefaultMode
   t := c_msgexclamationyesno( Message, Title, Mode )
Return ( t == 6 )

Function MsgBox( Message, Title, Mode )
   DEFAULT Message TO _OOHG_MsgDefaultMessage
   DEFAULT Title TO _OOHG_MsgDefaultTitle
   DEFAULT Mode TO _OOHG_MsgDefaultMode
   c_msgbox( Message, Title, Mode )
Return Nil

Código: Selecionar todos

#define _WIN32_IE      0x0500
#define HB_OS_WIN_32_USED
#define _WIN32_WINNT   0x0400
#include <shlobj.h>

#include <windows.h>
#include <commctrl.h>
#include "hbapi.h"
#include "hbvm.h"
#include "hbstack.h"
#include "hbapiitm.h"
#include "winreg.h"
#include "tchar.h"
#include "oohg.h"
HB_FUNC( C_MSGYESNO )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   hb_retni( MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), MB_YESNO | MB_ICONQUESTION | uType ) );
}

HB_FUNC( C_MSGYESNOCANCEL )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   hb_retni( MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), MB_YESNOCANCEL | MB_ICONQUESTION | uType ) );
}
HB_FUNC( C_MSGBOX )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), uType );
}

HB_FUNC( C_MSGINFO )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), MB_OK | MB_ICONINFORMATION | uType );
}

HB_FUNC( C_MSGSTOP )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), MB_OK | MB_ICONSTOP | uType );
}

HB_FUNC( C_MSGEXCLAMATION )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), MB_ICONEXCLAMATION | MB_OK | uType );
}

HB_FUNC( C_MSGEXCLAMATIONYESNO )
{
   int uType;

   if( HB_ISNIL( 3 ) )
   {
      uType = MB_SYSTEMMODAL;
   }
   else
   {
      uType = hb_parni( 3 );
   }

   hb_retni( MessageBox( GetActiveWindow(), hb_parc( 1 ), hb_parc( 2 ), MB_YESNO | MB_ICONEXCLAMATION | uType ) );
}

comparado com

Código: Selecionar todos

FUNCTION MsgYesNo( cText )
   LOCAL lValue
   lValue := wapi_MessageBox( wapi_GetActiveWindow(), cText, "Confirmação", WIN_MB_YESNO + WIN_MB_ICONQUESTION + WIN_MB_DEFBUTTON2 ) == IDYES
   RETURN lValue

FUNCTION MsgExclamation( cText )
   wapi_MessageBox( wapi_GetActiveWindow(), cText, "Atenção", WIN_MB_ICONASTERISK )
   RETURN NIL

FUNCTION MsgWarning( cText )
   wapi_MessageBox( wapi_GetActiveWindow(), cText, "Atenção", WIN_MB_ICONEXCLAMATION )
   RETURN NIL

FUNCTION MsgStop( cText )
   wapi_MessageBox( wapi_GetActiveWindow(), cText, "Atenção", WIN_MB_ICONHAND )
   RETURN NIL

Se uma simples MsgBox() não está padrão, já dá pra imaginar o restante.
A diferença entre as LIBs começa por aí.
Se essa função que é simples, e já existe padronizada, não está padrão, o que dizer das demais que não são padrão.

[JoséQuintas]

Já o button, separar umas partes do fonte não ficar muito grande:

Código: Selecionar todos

   nStyle := ::InitStyle( ,, Invisible, NoTabStop, lDisabled ) + BS_PUSHBUTTON + ;
             if( ValType( flat ) == "L"      .AND. flat,         BS_FLAT, 0 )     + ;
             if( ValType( lNoPrefix ) == "L" .AND. lNoPrefix,    SS_NOPREFIX, 0 ) + ;
             if( lBitMap,                                        BS_BITMAP, 0 ) + ;
             if( ValType( lMultiLine ) == "L" .AND. lMultiLine,  BS_MULTILINE, 0 )
...
   IF VALTYPE( cAlign ) $ "CM"
      cAlign := ALLTRIM( UPPER( cAlign ) )
      DO CASE
         CASE EMPTY( cAlign )
            cAlign := 2
         CASE "LEFT" == cAlign
            cAlign := 0
         CASE "RIGHT" == cAlign
            cAlign := 1
         CASE "BOTTOM" == cAlign
            cAlign := 3
         CASE "CENTER" == cAlign
            cAlign := 4
         OTHERWISE                         // TOP
            cAlign := 2
      ENDCASE
   ENDIF
...
HB_FUNC( INITBUTTON )
{
   HWND hbutton;
   int Style, StyleEx;

   Style =  BS_NOTIFY | WS_CHILD | hb_parni( 9 );

   StyleEx = hb_parni( 10 ) | _OOHG_RTL_Status( hb_parl( 8 ) );

   hbutton = CreateWindowEx( StyleEx, "button", hb_parc( 2 ), Style,
                             hb_parni( 4 ), hb_parni( 5 ), hb_parni( 6 ), hb_parni( 7 ),
                             HWNDparam( 1 ), ( HMENU ) hb_parni( 3 ), GetModuleHandle( NULL ), NULL );

   lpfnOldWndProc = ( WNDPROC ) SetWindowLong( hbutton, GWL_WNDPROC, ( LONG ) SubClassFunc );

   HWNDret( hbutton );
}

Código: Selecionar todos

   CASE ::WControlName == "CMDBUTTON"   ; ::className := "BUTTON"       ; ::objType := objTypePushButton  ; ::style += WIN_WS_CHILD + BS_PUSHBUTTON + BS_NOTIFY + BS_FLAT
...
   IF ::nImageAlignment != 0
      ::Style += ::nImageAlignment
   ENDIF
...
   ::wvgWindow:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )

Aqui se percebe a diferença na rotina de criar janela, que na OOHG é em C, e uma rotina pra cada controle.
Na GTWVG essa rotina está unificada, e em código Harbour, não limitando a conhecer linguagem C.

[JoséQuintas]

A questão principal é que isso faz parte dos fontes do Harbour.
Quando baixamos o Harbour, a hbwin e a GTWVG vém junto.

Comparando GTWVG e OOHG, com certeza OOHG tem mais recursos.
Mas comparando os fontes... prefiro da GTWVG.

A GTWVG tá aí, faz parte do Harbour, só precisa melhorias.
Acho que não vai ser expulsa do Harbour como a QT, porque não depende de nada externo.

A OOHG segue mais parecido com GTWVG, apesar de muitas rotinas em C, como mostrei acima, até mesmo pra criar a janela.

Só lembrando um dos exemplos da GTWVG, criando tudo dinâmico.

A GTWVG permite ser usada em console.
Mas ela também permite ser usada totalmente GUI.

Só falta alguém interesssado em implementar melhorias, e que tenha conhecimento pra isso.
Se for o que já existe na OOHG.... vai centralizar muitos usuários....

[JoséQuintas]

Uia... mais interessante ainda... dezembro/2003, há 13 anos atrás.
De lá pra cá, a grande mudança foi isso de criar controles usando a API do Windows, que recebou outro nome: gtwvg
Agora já não serão necessários 13 anos.
O próximo nome nem importa, o que importa é o conteúdo.
Pode ser gtwvg extended, ou oowvg.... rs

[JoséQuintas]

Só corrigindo o que passei errado:
a criação do controle não é em wvgWindow:Create(), e sim em wvgWindow:CreateControl()

Código: Selecionar todos

METHOD WvgWindow:createControl()
   LOCAL hWnd, aPosSz
   ::nID := ::oParent:GetControlId()
   aPosSz := ::getPosAndSize( ::aPos, ::aSize )
   hWnd := wapi_CreateWindowEx( ;
      ::exStyle, ;
      ::className(), ;
      "", ;                              /* window name */
      ::style, ;
      aPosSz[ 1 ], aPosSz[ 2 ], ;
      aPosSz[ 3 ], aPosSz[ 4 ], ;
      ::oParent:hWnd, ;
      ::nID, ;                           /* hMenu       */
      NIL, ;                             /* hInstance   */
      NIL )                              /* lParam      */
   IF wapi_IsWindow( hWnd )
      ::hWnd := ::pWnd := hWnd
      wapi_SendMessage( ::hWnd, WIN_WM_SETFONT, wapi_GetStockObject( WIN_DEFAULT_GUI_FONT ), 1 )
      ::hWndTT := wvg_CreateToolTipWindow( ::hWnd )
   ENDIF
   RETURN Self

como dá pra ver, é uma chamada à API do Windows CreateWindowEx(), passando os parâmetros necessários.
Igual às outras LIBs GUI, mas em código Harbour.
O posicionamento usa funções da GTWVG, porque converte linha/coluna para equivalentes em pixels.

Essa é uma parte que eu gostaria de alterar, porque a rotina que faz os cálculos se baseia em linha/coluna em números inteiros.
Bem que poderia aceitar decimais, por exemplo, linha 3.5, e converter pra inteiros somente antes de chamar a função de API.
Como essa rotina de cálculo está em C, não sei alterar.

[JoséQuintas]

Uia, saiu alguma coisa do progressbar.
Ainda não está totalmente funcional, por causa de parâmetros em C, por exemplo a combinação de dois números inteiros pra formar um número "long".

progressbar.png (1.96 KiB) Exibido 5931 vezes

Se pegar as rotinas da OOHG já resolve, mas quero evitar rotina em C.
Talvez algum equivalente a MAKEINT() pra usar em Harbour.

[JoséQuintas]

Aliás está aí mais um exemplo do que venho dizendo, a progressbar da OOHG.

Código: Selecionar todos

CLASS TProgressBar FROM TControl
   DATA Type        INIT "PROGRESSBAR" READONLY
   DATA nRangeMin   INIT 0
   DATA nRangeMax   INIT 100
   DATA nVelocity   INIT 30
   DATA lRunning    INIT .F.
   METHOD Define
   METHOD Value               SETGET
   METHOD RangeMin            SETGET
   METHOD RangeMax            SETGET
   METHOD FontColor           SETGET
   METHOD BackColor           SETGET
   METHOD SetStyleMarquee
   METHOD SetStyleNormal
   METHOD IsStyleMarquee
   METHOD IsStyleNormal
   METHOD StartMarquee
   METHOD StopMarquee
   METHOD IsMarqueeRunning
   EMPTY( _OOHG_AllVars )
ENDCLASS

METHOD Define( ControlName, ParentForm, x, y, w, h, lo, hi, tooltip, ;
               vertical, smooth, HelpId, invisible, nValue, BackColor, ;
               BarColor, lRtl, nVelocity ) CLASS TProgressBar
Local ControlHandle
   ASSIGN vertical  VALUE vertical  TYPE "L" DEFAULT .F.
   ASSIGN smooth    VALUE smooth    TYPE "L" DEFAULT .F.
   ASSIGN h         VALUE h         TYPE "N" DEFAULT if( vertical, 120, 25 )
   ASSIGN w         VALUE w         TYPE "N" DEFAULT if( vertical, 25, 120 )
   ASSIGN lo        VALUE lo        TYPE "N" DEFAULT 0
   ASSIGN hi        VALUE hi        TYPE "N" DEFAULT 100
   ASSIGN nValue    VALUE nValue    TYPE "N" DEFAULT 0
   ASSIGN invisible VALUE invisible TYPE "L" DEFAULT .F.
   ::SetForm( ControlName, ParentForm,,, BarColor, BackColor,, lRtl  )
   ControlHandle := InitProgressBar ( ::ContainerhWnd, 0, x, y, w, h ,lo ,hi, vertical, smooth, invisible, nValue, ::lRtl )
   ::Register( ControlHandle, ControlName, HelpId, ! Invisible, ToolTip )
   ::SizePos( y, x, w, h )
   ::nRangeMin := Lo
   ::nRangeMax := Hi
   if ::BackColor <> Nil
      SetProgressBarBkColor( ControlHandle, ::BackColor[1], ::BackColor[2], ::BackColor[3] )
   endif
   if ::FontColor <> Nil
      SetProgressBarBarColor( ControlHandle, ::FontColor[1], ::FontColor[2], ::FontColor[3] )
   endif
   if HB_IsNumeric( nVelocity )
      ::nVelocity := nVelocity
      ::SetStyleMarquee( nVelocity )
   endif
Return Self

METHOD SetStyleMarquee( nVelocity ) CLASS TProgressBar
   if ! IsWindowStyle( ::hWnd, PBS_MARQUEE )
     ::Style( ::Style() + PBS_MARQUEE )
   endif
   if HB_IsNumeric( nVelocity ) .and. nVelocity > 0
      ::nVelocity := nVelocity
      ::StartMarquee()
   else
      ::StopMarquee()
   endif
Return Nil

METHOD SetStyleNormal( uValue ) CLASS TProgressBar
   if IsWindowStyle( ::hWnd, PBS_MARQUEE )
      ::StopMarquee()
      ::Style( ::Style() - PBS_MARQUEE )
      if ! HB_IsNumeric( uValue ) .or. uValue < 0
        uValue := 0
      endif
      ::value := uValue
   endif
Return Nil

METHOD IsStyleMarquee() CLASS TProgressBar
Return IsWindowStyle( ::hWnd, PBS_MARQUEE )

METHOD IsStyleNormal() CLASS TProgressBar
Return ! IsWindowStyle( ::hWnd, PBS_MARQUEE )

METHOD StartMarquee() CLASS TProgressBar
   if IsWindowStyle( ::hWnd, PBS_MARQUEE )
      if ! ::lRunning
         ::lRunning := .T.
         if ::nVelocity <= 0
            ::nVelocity := 30
         endif
         // 1 => start
         SendMessage( ::hWnd, PBM_SETMARQUEE, 1, ::nVelocity )
      endif
   endif
Return Nil

METHOD StopMarquee() CLASS TProgressBar
   if IsWindowStyle( ::hWnd, PBS_MARQUEE )
      if ::lRunning
        ::lRunning := .F.
         if ::nVelocity <= 0
            ::nVelocity := 30
         endif
         // 0 => stop
         SendMessage( ::hWnd, PBM_SETMARQUEE, 0, ::nVelocity )
      endif
   endif
Return Nil

METHOD IsMarqueeRunning() CLASS TProgressBar
Return ::lRunning

METHOD Value( uValue ) CLASS TProgressBar
   IF HB_IsNumeric( uValue )
      SendMessage( ::hWnd, PBM_SETPOS, uValue, 0 )
   ENDIF
RETURN SendMessage( ::hWnd, PBM_GETPOS, 0, 0)

METHOD RangeMin( uValue ) CLASS TProgressBar
   IF HB_IsNumeric( uValue )
      ::nRangeMin := uValue
      SetProgressBarRange( ::hWnd, uValue, ::nRangeMax )
   ENDIF
RETURN ::nRangeMin

METHOD RangeMax( uValue ) CLASS TProgressBar
   IF HB_IsNumeric( uValue )
      ::nRangeMax := uValue
      SetProgressBarRange( ::hWnd, ::nRangeMin, uValue )
   ENDIF
RETURN ::nRangeMax

METHOD FontColor( uValue ) CLASS TProgressBar
   IF HB_IsNumeric( uValue )
      ::Super:FontColor := uValue
      SetProgressBarBarColor( ::hWnd, ::FontColor[1], ::FontColor[2], ::FontColor[3] )
   ENDIF
RETURN ::Super:FontColor

METHOD BackColor( uValue ) CLASS TProgressBar
   IF HB_IsArray( uValue )
      ::Super:BackColor := uValue
      SetProgressBarBkColor( ::hWnd, ::BackColor[1], ::BackColor[2], ::BackColor[3] )
   ENDIF
RETURN ::Super:BackColor

Código: Selecionar todos

static WNDPROC lpfnOldWndProc = 0;

static LRESULT APIENTRY SubClassFunc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam )
{
   return _OOHG_WndProcCtrl( hWnd, msg, wParam, lParam, lpfnOldWndProc );
}

HB_FUNC( INITPROGRESSBAR )
{
	HWND hwnd;
	HWND hbutton;
   int StyleEx;
	int Style = WS_CHILD  | hb_parni( 2 );

	INITCOMMONCONTROLSEX  i;
	i.dwSize = sizeof(INITCOMMONCONTROLSEX);
	i.dwICC = ICC_DATE_CLASSES;
	InitCommonControlsEx(&i);

   hwnd = HWNDparam( 1 );

   StyleEx = WS_EX_CLIENTEDGE | _OOHG_RTL_Status( hb_parl( 13 ) );

	if ( hb_parl (9) )
	{
		Style = Style | PBS_VERTICAL ;
	}

	if ( hb_parl (10) )
	{
		Style = Style | PBS_SMOOTH ;
	}

	if ( ! hb_parl (11) )
	{
		Style = Style | WS_VISIBLE ;
	}

    hbutton = CreateWindowEx( StyleEx,
                             "msctls_progress32" ,
                             0 ,
                             Style ,
                             hb_parni(3) ,
                             hb_parni(4) ,
                             hb_parni(5) ,
                             hb_parni(6) ,
                             hwnd,(HMENU)hb_parni(2) ,
                             GetModuleHandle(NULL) ,
                             NULL ) ;

	SendMessage(hbutton,PBM_SETRANGE,0,MAKELONG(hb_parni(7),hb_parni(8)));
	SendMessage(hbutton,PBM_SETPOS,(WPARAM) hb_parni(12),0);

   lpfnOldWndProc = ( WNDPROC ) SetWindowLong( ( HWND ) hbutton, GWL_WNDPROC, ( LONG ) SubClassFunc );

   HWNDret( hbutton );
}

HB_FUNC ( SETPROGRESSBARRANGE )
{
        SendMessage( HWNDparam( 1 ), PBM_SETRANGE,0,MAKELONG(hb_parni(2),hb_parni(3)));
}

HB_FUNC ( SETPROGRESSBARBKCOLOR )
{
        SendMessage( HWNDparam( 1 ), PBM_SETBKCOLOR,0,RGB(hb_parni(2),hb_parni(3),hb_parni(4)));
}

HB_FUNC ( SETPROGRESSBARBARCOLOR )
{
        SendMessage( HWNDparam( 1 ), PBM_SETBARCOLOR,0,RGB(hb_parni(2),hb_parni(3),hb_parni(4)));
}

Pra usar esse mesmo fonte na GTWVG, pode até ser os mesmos fontes em C.
Mas tudo em C pode ser eliminado, já que a hbwin tem wapi_SendMessage(), e a GTWVG já tem a criação da janela.
Foi isso que eu fiz, mas não sei o equivalente desse MAKELONG(a,b) que está em C.

[asimoes]

Obrigado Quintas,

Os códigos estão no forno e bem interessantes.

[JoséQuintas]

Os fontes que postei pra progressbar são da OOHG, e não fazem uso da HBWIN.
Dá pra incluir tudo na GTWVG usando do mesmo jeito, mas o ideal seria fazer uso da HBWIN e eliminar esse fonte em C.
Como dá pra perceber, faz uso de SendMessage(), que é equivalente a wapi_SendMessage().

Alguém por aí sabe qual o equivalente a MAKELONG( a, b ) ?

[asimoes]

Quintas,

Procurei na MiniGui

#define MAKELONG( a, b ) ( ( LONG ) ( ( ( WORD ) ( ( DWORD_PTR ) ( a ) & 0xffff ) ) | ( ( ( DWORD ) ( ( WORD ) ( ( DWORD_PTR ) ( b ) & 0xffff ) ) ) << 16 ) ) )

[JoséQuintas]

Encontrei no google sobre ser a junção de dois números 16 bits, chutei e deu certo.

Código: Selecionar todos

FUNCTION MakeLong( a, b )
   RETURN b * 32768 + a

Mas no harbour-users, o Viktor me passou uma definição existente na hbwin:

Código: Selecionar todos

WIN_MAKELONG( a, b )

Resultado:

progressbar.png (7.61 KiB) Exibido 5908 vezes

Progressbar usando "marquee" (que apenas indica movimentação) ou que indica progresso.

Mas valeu assim mesmo.

[JoséQuintas]

A propósito, peguei o fonte do pushbutton e fiz as modificações pro progressbar, aliás... chamei de wvgcontrol pra encher de testes num lugar só.... rs
Usei a OOHG de referência para o que faltava ( o fonte postado anteriormente )

Código: Selecionar todos

   // progressbar
   VAR    lVertical                                INIT .F.
   VAR    lSmooth                                  INIT .F.
   VAR    nValue
   VAR    nRangeMin
   VAR    nRangeMax
   VAR    nVelocity
   VAR    lMarquee    INIT .F.
   VAR    nSpeed      INIT 30
   METHOD ForeColor( nColor )   SETGET
   METHOD BackColor( nColor )   SETGET
   METHOD SetValue( nValue, nRangeMin, nRangeMax, nSpeed )
...
METHOD wvgControl:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )
...
   CASE ::WControlName == "PROGRESSBAR"
      ::ClassName := "msctls_progress32"
      ::ObjType := objTypeStatic
      ::Style += WIN_WS_CHILD + WIN_WS_GROUP + WIN_WS_EX_CLIENTEDGE + ;
      iif( ::lMarquee, PBS_MARQUEE, 0 ) + ;
      iif( ::lVertical, PBS_VERTICAL, 0 ) + ;
      iif( ::lSmooth, PBS_SMOOTH, 0 )
...
   CASE ::WControlName $ "PROGRESSBAR"
      ::SetValue( ::nValue, ::nRangeMin, ::nRangeMax, ::nSpeed )
   ENDCASE
...
METHOD wvgControl:SetValue( nValue, nRangeMin, nRangeMax, nSpeed )
   IF HB_ISNUMERIC( nRangeMin ) .AND. HB_ISNUMERIC( nRangeMax ) .AND. .NOT. ::lMarquee
      ::nRangeMin := nRangeMin
      ::nRangeMax := nRangeMax
      wapi_SendMessage( ::hWnd, PBM_SETRANGE, 0, WIN_MAKELONG( ::nRangeMin, ::nRangeMax ) )
   ENDIF
   IF HB_ISNUMERIC( nValue ) .AND. .NOT. ::lMarquee
      wapi_SendMessage( ::hWnd, PBM_SETPOS, nValue, 0 )
      ::nValue := nValue
   ENDIF
   IF HB_ISNUMERIC( nSpeed ) .AND. ::lMarquee
      wapi_SendMessage( ::hWnd, PBM_SETMARQUEE, 1, nSpeed )
      ::nSpeed := nSpeed
   ENDIF
   RETURN wapi_SendMessage( ::hWnd, PBM_GETPOS, 0, 0 )

METHOD wvgControl:ForeColor( nColor )
   IF HB_ISNUMERIC( nColor )
      wapi_SendMessage( ::hWnd, PBM_SETBARCOLOR, 0, nColor )
   ENDIF
   RETURN NIL

METHOD wvgControl:BackColor( nColor )
   IF HB_ISNUMERIC( nColor )
      wapi_SendMessage( ::hWnd, PBM_SETBKCOLOR, 0, nColor )
   ENDIF
   RETURN NIL

Foram essas rotinas que acrescentei para o progressbar.
Ainda não testei o smooth e o vertical.
Dá pra dizer que acabou sendo o mesmo progressbar da OOHG, que deve ser o mesmo da minigui, e o mesmo do Windows.

[JoséQuintas]

O fonte completo.
Com certeza misturando tudo fica mais complicado ainda, mas agora que alguns funcionaram já dá pra começar a separar.

Código: Selecionar todos

#include "hbclass.ch"
#include "inkey.ch"
#include "hbgtinfo.ch"

#include "hbgtwvg.ch"
#include "wvtwin.ch"
#include "wvgparts.ch"

#define PBS_MARQUEE      0x08
#define PBM_SETMARQUEE   ( WM_USER + 10 )
#define WM_USER          0x0400


CREATE CLASS wvgControl INHERIT WvgWindow

   VAR    autosize                              INIT .F.
   VAR    Border                                INIT .T.
   VAR    cancel                                INIT .F.
   VAR    caption
   VAR    default                               INIT .F.
   VAR    drawMode                              INIT WVG_DRAW_NORMAL
   VAR    lImageResize                          INIT .F.
   VAR    nImageAlignment                       INIT 0
   VAR    oImage
   VAR    preSelect                             INIT .F.
   VAR    pointerFocus                          INIT .F.
   VAR    Style                                 INIT 0
   VAR    WControlName                          INIT "NONE"
   // progressbar
   VAR    lVertical                                INIT .F.
   VAR    lSmooth                                  INIT .F.
   VAR    nValue
   VAR    nRangeMin
   VAR    nRangeMax
   VAR    nVelocity
   VAR    lMarquee    INIT .F.
   VAR    nSpeed      INIT 30
   METHOD ForeColor( nColor )   SETGET
   METHOD BackColor( nColor )   SETGET
   METHOD SetValue( nValue, nRangeMin, nRangeMax, nSpeed )

   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 setCaption( cCaption )
   METHOD draw( xParam )                        SETGET
   METHOD Repaint()

   METHOD setColorFG()                          INLINE NIL
   METHOD setColorBG()                          INLINE NIL
ENDCLASS


METHOD wvgControl:new( oParent, oOwner, aPos, aSize, aPresParams, lVisible )

   ::wvgWindow:new( oParent, oOwner, aPos, aSize, aPresParams, lVisible )


   RETURN Self


// https://msdn.microsoft.com/en-us/library/windows/desktop/bb761822(v=vs.85).aspx
// Windows Vista and Upper, can show image + text. Need do not set BS_ICON or BS_BITMAP
// XP and lower, or image only, need set BS_ICON or BS_BITMAP

METHOD wvgControl:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )

   DO CASE
   //CASE ::WControlName == "ANIMATION"   ;
   CASE ::WControlName == "BITMAP"      ; ::ClassName := "STATIC"       ; ::ObjType := objTypeStatic      ; ::Style += SS_BITMAP + SS_CENTERIMAGE + WIN_WS_CHILD + WIN_WS_GROUP
   CASE ::WControlName == "CHECKBOX"    ; ::ClassName := "BUTTON"       ; ::objType := objTypeCheckBox    ; ::Style += WIN_WS_CHILD + BS_CHECKBOX + WIN_WS_TABSTOP + WIN_WS_GROUP
   CASE ::WControlName == "COMBOBOX"    ; ::ClassName := "COMBOBOX"     ; ::ObjType := objTypeComboBox    ; ::Style += WIN_WS_TABSTOP + WIN_WS_GROUP + WIN_WS_CHILD + CBS_DROPDOWNLIST
   //CASE ::WControlName == "DATETIMEPICKER"
   CASE ::WControlName == "EDIT"        ; ::ClassName  := "EDIT"         ; ::objType := objTypeSLE         ; ::Style += WIN_WS_BORDER + WIN_WS_CHILD + WIN_WS_TABSTOP + WIN_WS_GROUP
   //CASE ::WControlName == "FLATSCROLLBAR"
   CASE ::WControlName == "GROUPBOX"    ; ::className := "BUTTON"       ; ::objType := objTypeStatic      ; ::style += WIN_WS_CHILD + BS_GROUPBOX + WIN_WS_GROUP
   //CASE ::WControlName == "HEADERCONTROL"
   //CASE ::WControlName == "HOTKEY"
   //CASE ::WcontrolName == "HYPERLINK"   ; ::ClassName  := "WC_LINK"      ; ::objType :=                    ; ::Style += WIN_WS_CHILD + WIN_WS_TABSTOP + WIN_WS_GROUP
   CASE ::WControlName == "ICON"        ; ::ClassName  := "STATIC"       ; ::objType := objTypeStatic      ; ::Style += WIN_WS_CHILD + WIN_WS_GROUP + SS_ICON + SS_CENTERIMAGE
   //CASE ::WControlName == "IMAGELIST"
   //CASE ::WControlName == "IPADRESSCONTROL"
   CASE ::WControlName == "LINE"        ; ::ClassName  := "STATIC"       ; ::objType := objTypeStatic      ; ::Style += SS_ETCHEDHORZ + SS_SUNKEN
   CASE ::WControlName == "LISTBOX"     ; ::ClassName := "LISTBOX"      ; ::objType := objTypeListBox     ; ::Style += WIN_WS_TABSTOP + WIN_WS_GROUP + WIN_WS_CHILD + WIN_WS_BORDER
   //CASE ::WControlName == "LISTVIEW"    ; ::ClassName := "WC_LISTVIEW"  ; ::ObjType :=                    ; ::Style += WIN_WS_BORDER + WIN_WS_TABSTOP
   //CASE ::WControlName == "MASKEDEDIT"  ; ::ClassName := "???"
   //CASE ::WControlName == "MONTHCALENDAR"
   //CASE ::WControlName == "PAGER"
   //CASE ::WControlName == "PATHEDIT"    ; ::ClassName := "???"
   CASE ::WControlName == "PROGRESSBAR"
      ::ClassName := "msctls_progress32"
      ::ObjType := objTypeStatic
      ::Style += WIN_WS_CHILD + WIN_WS_GROUP + WIN_WS_EX_CLIENTEDGE + ;
      iif( ::lMarquee, PBS_MARQUEE, 0 ) + ;
      iif( ::lVertical, PBS_VERTICAL, 0 ) + ;
      iif( ::lSmooth, PBS_SMOOTH, 0 )
   CASE ::WControlName == "PUSHBUTTON"  ; ::className := "BUTTON"       ; ::objType := objTypePushButton  ; ::style += WIN_WS_CHILD + BS_PUSHBUTTON + BS_NOTIFY + BS_FLAT
   //CASE ::WControlName == "RICHEDIT"
   //CASE ::WControlName == "SCROLLBAR"
   //CASE ::WControlName == "SCROLLTEXT"  ; ::ClassName  := "RICHEDIT"     ; ::objType :=                    ; ::Style += WIN_WS_CHILD + WIN_WS_TABSTOP + WIN_WS_VSCROLL + WIN_WS_AUTOVSCROLL + WIN_WS_GROUP + ES_READONLY
   //CASE ::WControlName == "TAB"
   //CASE ::WControlName == "TABCTL32"
   //CASE ::WControlName == "TASKDIALOG"
   CASE ::WControlName == "TEXT"        ; ::ClassName := "STATIC"       ; ::objType := objTypeStatic      ; ::Style += WIN_WS_CHILD + WIN_WS_GROUP + SS_LEFT
   //CASE ::WControlName == "TOOLBAR"
   //CASE ::WControlName == "TOOLTIP"
   //CASE ::WControlName == "TRACKBAR"
   //CASE ::WControlName == "TREEVIEW"
   //CASE ::WControlName == "UPDOWN"

   CASE ::WControlName == "FRAME"       ; ::ClassName := "STATIC"       ; ::ObjType := objTypeStatic      ; ::Style += WIN_WS_CHILD + WIN_WS_GROUP + BS_GROUPBOX
   CASE ::WControlName == "IMAGE"       ; ::className := "STATIC"       ; ::objType := objTypeStatic      ; ::style += WIN_WS_CHILD
   ENDCASE

   DO CASE
   CASE .NOT. ::WControlName $ "CMDBUTTON"
   CASE HB_ISSTRING( ::Caption ) .AND. win_osIsVistaOrUpper()
   CASE HB_ISNUMERIC( ::oImage )
      ::style += BS_BITMAP
   CASE HB_ISSTRING( ::oImage )
      SWITCH Lower( hb_FNameExt( ::caption ) )
      CASE ".ico"
         ::style += BS_ICON
         EXIT
      CASE ".bmp"
         ::style += BS_BITMAP
         EXIT
      ENDSWITCH
   CASE HB_ISARRAY( ::oImage )
      ASize( ::oImage, 3 )
      IF HB_ISNUMERIC( ::oImage[ 2 ] )
         SWITCH ::oImage[ 2 ]
         CASE WVG_IMAGE_ICONFILE
         CASE WVG_IMAGE_ICONRESOURCE
            ::style += BS_ICON
            EXIT
         CASE WVG_IMAGE_BITMAPFILE
         CASE WVG_IMAGE_BITMAPRESOURCE
            ::style += BS_BITMAP
            EXIT
         ENDSWITCH
      ENDIF
   ENDCASE

   IF ! ::border .AND. ::WControlName == "CMDBUTTON"
      ::style += BS_FLAT
   ENDIF
   IF ::nImageAlignment != 0
      ::Style += ::nImageAlignment
   ENDIF

   ::wvgWindow:create( oParent, oOwner, aPos, aSize, aPresParams, lVisible )

   ::oParent:AddChild( Self )

   ::createControl()
#if 0
   ::SetWindowProcCallback()  /* Let parent take control of it */
#endif

   IF ::visible
      ::show()
   ENDIF
   ::setPosAndSize()
   IF ::WControlName $ "GROUPBOX,CMDBUTTON" .AND. HB_ISCHAR( ::Caption )
      ::SetCaption()
   ENDIF
   DO CASE
   CASE ::WControlName $ "CMDBUTTON"
      ::Repaint()
   CASE ::WControlName $ "PROGRESSBAR"
      ::SetValue( ::nValue, ::nRangeMin, ::nRangeMax, ::nSpeed )
   ENDCASE
   RETURN Self


METHOD wvgControl:handleEvent( nMessage, aNM )

   DO CASE
   CASE nMessage == HB_GTE_RESIZED
      IF ::isParentCrt()
         ::rePosition()
      ENDIF
      wapi_SendMessage( ::hWnd, WIN_WM_SIZE, 0, 0 )
      IF HB_ISEVALITEM( ::sl_resize )
         Eval( ::sl_resize, , , Self )
      ENDIF
      IF ::WControlName $ "CMDBUTTON"
         ::Repaint()
      ENDIF

   CASE nMessage == HB_GTE_COMMAND .AND. ::WControlName $ "CMDBUTTON"
      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

#if 0  /* Must not reach here if WndProc is not installed */
   CASE 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
#endif
   ENDCASE

   RETURN EVENT_UNHANDLED


METHOD PROCEDURE wvgControl:destroy()

   ::wvgWindow:destroy()

   RETURN


METHOD wvgControl:configure( oParent, oOwner, aPos, aSize, aPresParams, lVisible )

   ::Initialize( oParent, oOwner, aPos, aSize, aPresParams, lVisible )

   RETURN Self


METHOD wvgControl:setCaption( cCaption )
   IF HB_ISCHAR( cCaption )
      ::Caption := cCaption
   ENDIF
   IF HB_ISCHAR( ::Caption )
      wapi_SendMessage( ::hWnd, WIN_WM_SETTEXT, 0, ::Caption )
   ENDIF
   RETURN NIL


METHOD wvgControl:draw( xParam )

   IF HB_ISEVALITEM( xParam ) .OR. xParam == NIL
      ::sl_paint := xParam
   ENDIF

   RETURN Self

// https://msdn.microsoft.com/en-us/library/windows/desktop/ms648045(v=vs.85).aspx
// Windows Vista and Upper, wapi_LoadImage() can resize image
// To do: Found a better resize when using text + image + border

METHOD wvgControl:RePaint()

   LOCAL nLoadFromResByIdNumber := 0
   LOCAL nLoadFromResByIdName   := 1
   LOCAL nLoadFromDiskFile      := 2
   LOCAL aWindowRect := {}, nWidth, nHeight

   IF .NOT. ::WControlName $ "CMDBUTTON,IMAGE"
      RETURN NIL
   ENDIF
   IF ::lImageResize
      wapi_GetWindowRect( ::hWnd, @aWindowRect )
      nWidth  := Int( ( aWindowRect[ 3 ] - aWindowRect[ 1 ] ) ) - 3 // 3=border
      nHeight := Int( ( aWindowRect[ 4 ] - aWindowRect[ 2 ] ) ) - 3 // 3=border
      IF HB_ISSTRING( ::Caption )
         DO CASE
         CASE ::nImageAlignment == BS_TOP   .OR. ::nImageAlignment == BS_BOTTOM
            nHeight -= hb_gtInfo( HB_GTI_FONTSIZE ) - 2
         CASE ::nImageAlignment == BS_RIGHT .OR. ::nImageAlignment == BS_LEFT
            nWidth := nHeight
         ENDCASE
      ENDIF
   ENDIF

   DO CASE
   CASE HB_ISSTRING( ::oImage )

      SWITCH Lower( hb_FNameExt( ::oImage ) )
      CASE ".ico"
         wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_ICON, wvg_LoadImage( ::oImage, nLoadFromDiskFile, WIN_IMAGE_ICON, nWidth, nHeight ) )
         EXIT
      CASE ".bmp"
         wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_BITMAP, wvg_LoadImage( ::oImage, nLoadFromDiskFile, WIN_IMAGE_BITMAP, nWidth, nHeight ) )
         EXIT
      //OTHERWISE
      //   wapi_SendMessage( ::hWnd, WIN_WM_SETTEXT, 0, ::caption )
      ENDSWITCH

   CASE HB_ISNUMERIC( ::oImage )  /* Handle to the bitmap */
      wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_BITMAP, ::oImage )

   CASE HB_ISARRAY( ::oImage )
      ASize( ::oImage, 4 )
      IF HB_ISCHAR( ::oImage[ 1 ] )
         // wapi_SendMessage( ::hWnd, WIN_WM_SETTEXT, 0, xCaption[ 1 ] )
      ENDIF
      IF ! Empty( ::oImage[ 2 ] )
         SWITCH ::oImage[ 2 ]
         CASE WVG_IMAGE_ICONFILE
            wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_ICON, wvg_LoadImage( ::oImage[ 3 ], nLoadFromDiskFile, WIN_IMAGE_ICON, nWidth, nHeight ) )
            EXIT
         CASE WVG_IMAGE_ICONRESOURCE
            IF HB_ISSTRING( ::oImage[ 3 ] )
               wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_ICON, wvg_LoadImage( ::oImage[ 3 ], nLoadFromResByIdName, WIN_IMAGE_ICON, nWidth, nHeight ) )
            ELSE
               wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_ICON, wvg_LoadImage( ::oImage[ 3 ], nLoadFromResByIdNumber, WIN_IMAGE_ICON, nWidth, nHeight ) )
            ENDIF
            EXIT
         CASE WVG_IMAGE_BITMAPFILE
            wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_BITMAP, wvg_LoadImage( ::oImage[ 3 ], nLoadFromDiskFile, WIN_IMAGE_BITMAP, nWidth, nHeight ) )
            EXIT
         CASE WVG_IMAGE_BITMAPRESOURCE
            IF HB_ISSTRING( ::oImage[ 3 ] )
               wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_BITMAP, wvg_LoadImage( ::oImage[ 3 ], nLoadFromResByIdName, WIN_IMAGE_BITMAP, nWidth, nHeight ) )
            ELSE
               wapi_SendMessage( ::hWnd, BM_SETIMAGE, WIN_IMAGE_BITMAP, wvg_LoadImage( ::oImage[ 3 ], nLoadFromResByIdNumber, WIN_IMAGE_BITMAP, nWidth, nHeight ) )
            ENDIF
            EXIT
         ENDSWITCH
      ENDIF
   ENDCASE
   IF HB_ISSTRING( ::Caption )
      wapi_SendMessage( ::hWnd, WIN_WM_SETTEXT, 0, ::caption )
   ENDIF

   RETURN Self

METHOD wvgControl:activate( xParam )

   IF HB_ISEVALITEM( xParam ) .OR. xParam == NIL
      ::sl_lbClick := xParam
   ENDIF

   RETURN Self


METHOD wvgControl:SetValue( nValue, nRangeMin, nRangeMax, nSpeed )
   IF HB_ISNUMERIC( nRangeMin ) .AND. HB_ISNUMERIC( nRangeMax ) .AND. .NOT. ::lMarquee
      ::nRangeMin := nRangeMin
      ::nRangeMax := nRangeMax
      wapi_SendMessage( ::hWnd, PBM_SETRANGE, 0, WIN_MAKELONG( ::nRangeMin, ::nRangeMax ) )
   ENDIF
   IF HB_ISNUMERIC( nValue ) .AND. .NOT. ::lMarquee
      wapi_SendMessage( ::hWnd, PBM_SETPOS, nValue, 0 )
      ::nValue := nValue
   ENDIF
   IF HB_ISNUMERIC( nSpeed ) .AND. ::lMarquee
      wapi_SendMessage( ::hWnd, PBM_SETMARQUEE, 1, nSpeed )
      ::nSpeed := nSpeed
   ENDIF
   RETURN wapi_SendMessage( ::hWnd, PBM_GETPOS, 0, 0 )

METHOD wvgControl:ForeColor( nColor )
   IF HB_ISNUMERIC( nColor )
      wapi_SendMessage( ::hWnd, PBM_SETBARCOLOR, 0, nColor )
   ENDIF
   RETURN NIL

METHOD wvgControl:BackColor( nColor )
   IF HB_ISNUMERIC( nColor )
      wapi_SendMessage( ::hWnd, PBM_SETBKCOLOR, 0, nColor )
   ENDIF
   RETURN NIL

/*
HBRUSH hBackground = CreateSolidBrush(RGB(0, 0, 0));

case WM_CTLCOLORSTATIC:
{
    HDC hdc = (HDC)wParam;
    SetBkMode(hdc, TRANSPARENT);
    SetTextColor(hdc, RGB(255, 255, 255));
    return (LONG) hBackground;
}
*/

//FUNCTION MakeLong( a, b )
//   RETURN b * 32768 + a

e o fonte de teste:

Código: Selecionar todos

PROCEDURE Main

   LOCAL nCont, nRow := 5, nCol := 5, oControl, oControlList := {}


   SetColor( "W/B,W/GR+,,,W/B" )
   SetMode( 33, 100 )
   CLS

   FOR nCont = 1 TO 14
      AAdd( oControlList, CreateControl( nCont, nRow, nCol ) )
      nRow += 5
      IF nRow > MaxRow() - 5
         nRow := 5
         nCol += 30
      ENDIF
   NEXT
   FOR EACH oControl IN oControlList
      IF oControl:wControlName == "PROGRESSBAR" .AND. .NOT. oControl:lMarquee
         FOR nCont = 10 TO 100
            oControl:SetValue( nCont )
            Inkey(1)
         NEXT
      ENDIF
   NEXT
   Inkey(0)
   RETURN


STATIC FUNCTION CreateControl( nCont, nRow, nCol )

   LOCAL oControl, nTemp := 1

   oControl := wvgControl():New()
   DO CASE
   CASE nCont == nTemp++; oControl:WControlName := "BITMAP"      ; oControl:Caption := "Bitmap"
   CASE nCont == nTemp++; oControl:WControlName := "CHECKBOX"    ; oControl:Caption := "Checkbox"
   CASE nCont == nTemp++; oControl:WControlName := "COMBOBOX"    ; oControl:Caption := "Combobox"
   CASE nCont == nTemp++; oControl:WControlName := "EDIT"        ; oControl:Caption := "TextBox"
   CASE nCont == nTemp++; oControl:WControlName := "FRAME"
   CASE nCont == nTemp++; oControl:WControlName := "GROUPBOX"    ; oControl:Caption := "Groupbox"
   CASE nCont == nTemp++; oControl:WControlName := "ICON"        ; oControl:Caption := "Icon"
   CASE nCont == nTemp++; oControl:WControlName := "IMAGE"       ; oControl:Caption := "Image"
   CASE nCont == nTemp++; oControl:WControlName := "LINE"        ; oControl:Caption := "Line"
   CASE nCont == nTemp++; oControl:WControlName := "LISTBOX"     ; oControl:Caption := "Listbox"
   CASE nCont == nTemp++; oControl:WControlName := "PROGRESSBAR" ; oControl:Caption := "ProgressBar" ; oControl:lMarquee := .T.; oControl:nSpeed := 30
   CASE nCont == nTemp++; oControl:WControlName := "PROGRESSBAR" ; oControl:Caption := "ProgressBar" ; oControl:lMarquee := .F.; oControl:SetValue( 1, 1, 100 )
   CASE nCont == nTemp++; oControl:WControlName := "PUSHBUTTON"  ; oControl:Caption := "CmdButton"
   CASE nCont == nTemp++; oControl:WControlName := "TEXT"        ; oControl:Caption := "Label"
   CASE nCont == nTemp // só pra facilitar
   ENDCASE
   oControl:Create( , , { -nRow, -nCol }, { -3, -20 } )
   RETURN oControl

Isso gera esta tela