LIB console imitando gráfico
Enviado: 04 Abr 2016 05:38
Só na minha máquina.
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
Código: Selecionar todos
METHOD wvgControl:handleEvent( nMessage, aNM )
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 ) );
}
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
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 )
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
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)));
}
Código: Selecionar todos
FUNCTION MakeLong( a, b )
RETURN b * 32768 + a
Código: Selecionar todos
WIN_MAKELONG( a, b )
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
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
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