Code: Select all
#include "fivewin.ch"
#include "metropnl.ch"
static oMetro, oMetro1, oMetro2, oMetro3, lMetro[3], oTools, oSBtn[6], oFont1, oFont2, oBigfont
static nClrBack := CLR_GREEN, aRect[4], nPanel := 1
static lMainBar := .F., lSubBar := .F., c_Path, c_Path1, oMainBar, oSubBar, nWColorT := 0
static nWStyle := 4, nWColorF := 16443068, nWColorB := 10899511, nWGradPos := 0.2
static lWDirect := .T., cWBrush := "BluStone.Bmp", cWImage := "Fantasy2.Jpg"
FUNCTION MAIN( cParam )
LOCAL oWnd, oBar, oBrush
LOCAL cTitle := "CATALOGO VINHOS "
SET DELETED ON
SET SOFTSEEK OFF
SET EPOCH TO 1950
SET DATE FORMAT "dd/mm/yyyy"
oFont1 := TFont():New("Arial",0,-16,.F.,.T.,0,0,0,.F. )
oFont2 := TFont():New("Arial",0,-25,.F.,.T.,0,0,0,.F. )
oBigFont := TFont():New("Arial",0,-38,.F.,.T.,0,0,0,.F. )
oSmallFont := TFont():New("Arial",0,-12,.F.,.T.,0,0,0,.F. )
aRect[3] := GetSysmetrics( 1 ) - 25 // Screen-Height
aRect[4] := GetSysmetrics( 0 ) // Screen-Width
c_path := cFilePath(GetModuleFileName( GetInstance() ) )
// lChDir( "../" ) // needed starting from a subdirectory
c_path1 := c_path + "Bitmaps\"
c_path2 := c_path + "Bitmaps\Hires\"
c_path3 := c_path + "Bitmaps\AlphaBmp\"
c_path4 := c_path + "Bitmaps\Metro\"
lMetro[1] := .F.
lMetro[2] := .F.
lMetro[3] := .F.
REQUEST DBFCDX
IF FILE( c_Path + "F_REG.DBF" )
DBSELECTAREA( 1 )
NET_USE (c_Path + "F_REG.DBF", 3,.T.)
ELSE
MSGALERT("ARQUIVO REGIÕES INEXISTENTE","Atenção")
ENDIF
DEFINE WINDOW oWnd TITLE cTitle STYLE nOr( WS_POPUP, WS_MAXIMIZE );
COLOR 255, CLR_GREEN
oMetro1 := MakeMetroPanel( oWnd )
oMetro1:bRClicked := { |Row,Col,f,o| IIF( lSubBar = .F., MAIN_MOVE() , ;
( oSubBar:End(), MAIN_MOVE() ) ) }
ACTIVATE WINDOW oWnd MAXIMIZED ;
ON INIT ( STARTUP(oMetro1,1), ;
oMetro1:Show(), ;
oWnd:Move( 0, 0, aRect[4], aRect[3], .f. ) ) // Top, left, width, height
oFont1:End()
oFont2:End()
oBigFont:End()
oSmallFont:End()
RETURN NIL
//----------------------------------------------------------------------------//
STATIC FUNCTION MAKEMETROPANEL( oWnd )
local oMetro1, oBtn,cnt:=0,oBt[50],nRec[20],aNReg:={},aCReg:={},NBTNPOS,octl
DEFINE METROPANEL oMetro1 OF oWnd TITLE "Catálogo de Vinhos" ;
ON CLICK oWnd:End()
oMetro1:lDesignMode := .t.
lMetro[1] := .T.
DBSELECTAREA(1)
DBGOTOP()
while !eof()
DEFINE METROBUTTON oBtn OF oMetro1 ;
PROMPT FieldGet( 1 ) COLOR CLR_WHITE, RGB( 2, 174, 224 ) ; // 1 primer campo
IMAGE "..\bitmaps\metro\files.bmp" ;
ACTION ShowRecords( ::Cargo )
oBtn:Cargo := RecNo()
DbSkip()
end
DEFINE METROBUTTON oBt OF oMetro1 ;
COLOR CLR_WHITE,RGB( 255, 0, 66 ) ;
CAPTION "Exit" ;
ALIGN "TOPRIGHT" ;
GROUP 2 ;
BITMAP c_path4 + "exit.bmp" ;
BMPALIGN "BOTTOMLEFT" ;
SIZE 48, 48 ;
ACTION If( MsgYesNo( "Want to exit ?" ), oWnd:End(),)
RETURN oMetro1
FUNCTION ShowRecords()
//aqui preciso saber o recno() para fazer o filtro do artigos.dbf e mostrar em metrobutton
RETURN NIL
// --------------------------
FUNCTION STARTUP(oMetro,nPanel)
DBSELECTAREA(1)
DBGOTO(nPanel)
oMetro:SetColor( nWColorT, )
IF nWStyle = 1 // Color
D_BACKGRD( oMetro, 1, nWColorF )
ELSEIF nWStyle = 2 // Gradient
D_BACKGRD( oMetro, 2, nWColorF, nWColorB, nWGradPos, lWDirect )
ELSEIF nWStyle = 3 // BRUSH
D_BACKGRD( oMetro, 3, , , , , c_path1 + cWBrush )
ELSEIF nWStyle = 4 // Image
D_BACKGRD( oMetro, 4, , , , , , c_path2 + cWImage )
ENDIF
RETURN( NIL )
// ----------------------------------------------------------------------------
FUNCTION MAIN_MOVE()
LOCAL nStepL := 0, nLPos := aRect[4]
IF lMainBar = .F. // Move IN
DO WHILE .T.
nStepL := nStepL + 6
IF nStepL > 100
EXIT
ENDIF
INKEY(0.02)
nLPos := aRect[4] - nStepL
oMainBar:Move( 0, nLPos, , aRect[3], .f. ) // Top, left, width, height
ENDDO
lMainBar = .T.
ELSE
DO WHILE .T.
nStepL := nStepL + 6
IF nStepL > 100
EXIT
ENDIF
INKEY(0.02)
nLPos := aRect[4] - 100 + nStepL
oMainBar:Move( 0, nLPos, , aRect[3], .f. ) // Top, left, width, height
ENDDO
lMainBar = .F.
ENDIF
RETURN NIL
// -------- WINDOW / DIALOG - Background ---------------
FUNCTION D_BACKGRD( oDlg, nStyle, nColor1, nColor2, nMove, lDirect, cBrush, cImage )
LOCAL oBrush, hDC, aGrad, oImage
LOCAL aRect := GETCLIENTRECT( oDlg:hWnd )
IF nStyle = 1 // COLOR
DEFINE BRUSH oBrush COLOR nColor1
oDlg:SetBrush( oBrush )
oBrush:End()
ENDIF
IF nStyle = 2 // GRADIENT Brush
aGrad := { { nMove, nColor1, nColor2 }, { nMove, nColor2, nColor1 } }
hDC = CreateCompatibleDC( oDlg:GetDC() )
hBmp = CreateCompatibleBitMap( oDlg:hDC, oDlg:nWidth, oDlg:nHeight )
hBmpOld = SelectObject( hDC, hBmp )
GradientFill( hDC, 0, 0, oDlg:nHeight, oDlg:nWidth, aGrad, lDirect ) // .T: = Vertical
DeleteObject( oDlg:oBrush:hBrush )
oBrush := TBrush():New( ,,,, hBmp )
oBrush:Cargo := aGrad
SelectObject( hDC, hBmpOld )
ReleaseDC(hDC)
oDlg:SetBrush( oBrush )
oBrush:End()
ENDIF
IF nStyle = 3 // BMP-BRUSH
DEFINE BRUSH oBrush FILE cBrush
oDlg:SetBrush( oBrush )
oBrush:End()
ENDIF
IF nStyle = 4 // Image ADJUSTED
IF FILE( cImage )
DEFINE IMAGE oImage FILE cImage
oBrush := TBrush():new( ,,,, ResizeBmp( oImage:hBitmap, aRect[4], aRect[3], .T. ) )
oImage:End()
oDlg:SetBrush( oBrush )
oBrush:End()
ELSE
IF !EMPTY(cImage)
MsgAlert( "File : " + cImage + CRLF + ;
"does not exist" + CRLF + ;
"to show Image !", "ATTENTION" )
ENDIF
ENDIF
ENDIF
RETURN( NIL )
// ---------- NET - FUNCTIONS ----------------------------
FUNCTION NET_USE ( cDBName1, ntrials, net)
LOCAL lReturn := .T.
LOCAL lOpen := .F.
LOCAL close := 1
ntrcount := ntrials
JaNein := .F.
// SHARED all Users
// EXCLUSIVE 1 User
IF File( cDBName1 )
ntrials := ntrcount
DO WHILE !lOpen
close := 2
DO WHILE .T.
IF !net
USE &cDBName1 EXCLUSIVE
ELSE
USE &cDBName1 SHARED
ENDIF
IF !NetErr()
lReturn := .T.
lOpen := .T.
ntrials := 0
ELSE
IF net = .T.
status := "SHARED"
ELSE
status := "EXCLUSIVE"
ENDIF
IF ntrcount = ntrials
xName := WNetGetUser()
IF MsgYesNo( "Open " + status + " of " + upper(cDBName1) + " not possible !" + ;
" try again ?", "Network-error -> &xName !" )
ntrials := ntrcount
JaNein := .T.
ELSE
ntrials := 0
JaNein := .F.
ENDIF
ENDIF
IF JaNein = .T.
ntrials --
IF ntrials > 0 .AND. ntime > 0
NET_WAIT ( ntrcount, ntrials, ntime)
ENDIF
IF ntrials = 0
ntrials := ntrcount
ENDIF
ELSE
lReturn := .F.
lOpen := .T.
ntrials := 0
ENDIF
ENDIF
IF ntrials = 0
lOpen := .T.
EXIT
ENDIF
ENDDO
ENDDO
ELSE
nMsgBox ("File -> " + cDBName1 + " is missing !", "Attention !")
SET RESOURCES to
set _3DLOOK OFF
FreeLibrary()
close database
QUIT
ENDIF
RETURN lReturn
//-------------------------------------------------------
FUNCTION NET_RLOCK( ntrials, ntime )
LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL nZSek := 0
ntrcount := ntrials
DO WHILE !lReturn
DO WHILE ntrials > 0
IF !RLock()
ntrials --
IF ntrials > 0 .AND. ntime > 0
NET_WAIT ( ntrcount, ntrials, ntime )
ENDIF
ELSE
lReturn := .T.
EXIT
ENDIF
ENDDO
IF ntrials = 0
IF MsgYesNo( "Not possible, to lock the record !" + ;
" Try again ?", "Network Error !" )
lOpen :=.T.
ntrials := ntrcount
ELSE
lReturn := .F.
lOpen := .F.
EXIT
ENDIF
ENDIF
ENDDO
IF lReturn = .F.
nMsgBox ("Files are not saved !!!", "Attention !")
ENDIF
RETURN lReturn
//-------------------------------------------------------
FUNCTION NET_ULOCK ()
LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL nZSek := 0
IF len(fieldname(1)) > 0 && DB offen ?
UNLOCK && ja
ENDIF
RETURN lReturn
// ----------------------
FUNCTION NET_CLOSE(ntrials, ntime, net)
LOCAL lReturn := .T.
LOCAL lOpen := .F.
LOCAL close := 1
ntrcount := ntrials
JaNein := .F.
JaNein := .F.
cDBName1 := DBF()
DO WHILE !lOpen
close := 1
DO WHILE ntrials > 0
USE
IF NetErr()
ntrials --
IF MsgYesNo( "Close of file : " + upper(cDBName1) + " not possible !" + ;
" Try again ?", "Network-Error !" )
lOpen :=.T.
ntrials := ntrcount
IF ntrials > 0 .AND. ntime > 0
NET_WAIT ( ntrcount, ntrials, ntime)
ENDIF
ELSE
lReturn := .F.
lOpen := .T.
ntrials := 0
ENDIF
ELSE
geschloss := .T.
lReturn := .T.
lOpen := .T.
ntrials := 0
ENDIF
ENDDO
ENDDO
RETURN lReturn
// --------------------------------------------
FUNCTION NET_WAIT ( ntrcount, ntrials, ntime )
local oMeter, oText1
MsgMeter( { | oMeter, oText1 | ;
SHOW_WAIT(ntrcount, ntrials, ntime, oMeter, oText1) } , ;
"rest trials : " + ltrim(str(ntrials)) + ". trial..." )
RETURN nil
//----------------------------------------------------------------------------//
STATIC FUNCTION SHOW_WAIT(ntrcount, ntrials, ntime, oMeter, oText1)
oMeter:nTotal = ntrcount
nZSek := Seconds()
oText1:SetText( "rest of trials : " + ltrim(str(ntrials)))
oMeter:Set( ntrials )
SysRefresh()
DO WHILE Seconds() < nZSek + ntime
ENDDO
RETURN nil
// -------------------------------------
FUNCTION NET_DELETE ( nSeconds )
LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL cDatabase := DBF()
ntrcount := nSeconds
DO WHILE !lReturn
DO WHILE nSeconds > 0
IF !RLock()
nSeconds --
IF nSeconds > 0
NET_WAIT ( nSeconds )
ENDIF
ELSE
DELETE
lReturn := .T.
EXIT
ENDIF
ENDDO
IF nSeconds = 0
IF MsgYesNo( "Not possible to delete a Record of" + upper(cDatabase) + ;
" try again ?", "Network-Error !" )
nSeconds := ntrcount
ELSE
lReturn := .F.
EXIT
ENDIF
ENDIF
ENDDO
if lReturn = .F.
MsgAlert("The Record is not deleted !!!", "Attention !")
endif
RETURN lReturn
// ----------------------------------------------
FUNCTION NET_APPEND ( ntrials, ntime )
LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL nZSek := 0
ntrcount := ntrials
DO WHILE !lReturn
DO WHILE ntrials > 0
DBAppend()
IF NetErr()
ntrials --
IF ntrials > 0 .AND. ntime > 0
NET_WAIT ( ntrcount, ntrials, ntime )
ENDIF
ELSE
lReturn := .T.
EXIT
ENDIF
ENDDO
IF ntrials = 0
IF MsgYesNo( "Append in : " + upper(cDBName) + " not possible !" + ;
" Try again ?", "Network Error !" )
lOpen :=.T.
ntrials := ntrcount
ELSE
lReturn := .F.
lOpen := .F.
EXIT
ENDIF
ENDIF
ENDDO
if lReturn = .F.
nMsgBox ( "No Record appended !!!", "Attention !")
endif
RETURN lReturn
// ----------------------------------------
// --------- DBF Array ----------------
STATIC FUNCTION NEW_DBF()
LOCAL DBFARRAY := {}
AADD(DBFARRAY, { "CODIGO", "C", 2, 0 })
AADD(DBFARRAY, { "N_FAM", "C", 250, 0 })
cDbfName := c_Path + "F_REG.DBF"
DELETE FILE &cDbfName
IF LEN(DBFARRAY) == 0
MsgInfo( "DBF Structure-Error", "New Structure" )
RETURN NIL
ENDIF
DBCREATE( cDbfName, DBFARRAY )
// DbCreate(cDir+'CL',{ {aClienti[1],aClienti[2],aClienti[3],aClienti[4]}} , 'DBFCDX')
DBSELECTAREA( 1 )
NET_USE (c_Path + "F_REG.DBF", 3,.T.)
NET_APPEND ( 3, 3 )
IF NET_RLOCK( 5, 5 )
(1)->CODIGO := "DOURO"
(1)->NOME := "REGIÃO DO DOURO"
NET_ULOCK()
ENDIF
NET_APPEND ( 3, 3 )
IF NET_RLOCK( 5, 5 )
(1)->CODIGO := "ALENTEJO"
(1)->NOME := "REGIÃO DO ALENTEJO"
NET_ULOCK()
ENDIF
NET_APPEND ( 3, 3 )
IF NET_RLOCK( 5, 5 )
(1)->CODIGO := "LISBOA"
(1)->NOME := "REGIÃO DE LISBOA"
NET_ULOCK()
ENDIF
COMMIT
DBGOTOP()
NET_CLOSE ( 3,5,.T.)
IF File( cDbfName )
MsgInfo( "Novo DBF Criado! ( " + ALLTRIM(STR(LEN(DBFARRAY))) + " registos )", "Nova Estrutura" )
ELSE
MsgAlert( "Não consiguiu criar novo ficheiro!","Projecto-Ficheiro")
ENDIF
RETURN NIL
Code: Select all
/*
*
* MetroPnl.Prg
*
*/
#include "fivewin.ch"
#include "metropnl.ch"
#include "hbcompat.ch" // important
// CLASSES: TMetroPanel and TMetroBtn
#define BTN_GAP 8
#define GRP_GAP 32
#define SCRLB_HEIGHT 20
//----------------------------------------------------------------------------//
static oDragWnd
//----------------------------------------------------------------------------//
CLASS TMetroPanel FROM TPanel
CLASSDATA lRegistered AS LOGICAL
CLASSDATA oActive // for internal use
//
CLASSDATA nBtnSize, nMetroRows, nMetroTop, nMetroMargin, nSliderTop
//
DATA nOffset INIT 0
DATA nScrollRange INIT 0
DATA nScrollRatio INIT 1
DATA oFont, oFontB
DATA oBtnFont, oTextFont
DATA nGroups INIT 1
DATA aButtons INIT Array(0)
DATA lArranged INIT .f.
DATA lDesignMode INIT .f.
DATA nClrScroll
DATA nClrThumb
DATA nMetroWidth, nThumbSize, nThumbWidth
DATA nThumbPos INIT 60
DATA hPen
DATA cTitle
DATA nRow, nCol
DATA oParent
// lDrag, nDragRow, nOldCol used for metro sliding by dragging on screen or scrollbar
DATA lDrag INIT .F.
DATA nDragRow
DATA nOldCol INIT 0
DATA nScrollBarTop
METHOD New( oWnd, cTitle, nClrText, nClrPane, bLClicked, nBtnSize, ;
nClrThumb, nClrScroll ) CONSTRUCTOR
METHOD Paint()
METHOD AddButton( lLarge, nGroup, cCaption, bAction, nClrText, nClrPane, cImgName, oFont, ;
nAlign, nBmpAlign, nBmpWidth, nBmpHeight, cText, nTextAlign, ;
oTextFont, oSubMetro, cBackImage )
METHOD Show() INLINE ( ::Arrange(), ::oBrush:ReSize( Self ), Super:Show(), ::lVisible := .t. )
METHOD Hide() INLINE ( Super:Hide(), ::lVisible := .f. )
METHOD Arrange()
METHOD LButtonDown( nRow, nCol, nFlags )
METHOD LButtonUp( nRow, nCol, nFlags )
METHOD MouseMove( nRow, nCol, nFlags )
METHOD MoveBtn( oBtnDrag, oBtnOver )
METHOD SwitchTo( oNext, lRight )
METHOD MouseWheel( nKey, nDelta, nXPos, nYPos )
METHOD Slide( nPixels )
METHOD ProgramCode()
METHOD Destroy()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( oWnd, cTitle, nClrText, nClrPane, bLClicked, nBtnSize, ;
nClrThumb, nClrScroll ) CLASS TMetroPanel
DEFAULT cTitle := "Start", nClrText := CLR_WHITE, nClrPane := CLR_GREEN
DEFAULT ::nBtnSize := IfNil( nBtnSize, 132 )
DEFAULT ::nMetroRows := Int( GetSysMetrics( 1 ) / ( ::nBtnSize + BTN_GAP ) ) - 1
DEFAULT ::nMetroTop := ::nBtnSize
DEFAULT ::nMetroMargin := ::nBtnSize
Super:New( 0, 0, GetSysMetrics( 1 ) , GetSysMetrics( 0 ), oWnd )
::cTitle = cTitle
::nRow = 0
::nCol = 0
::nClrThumb = nClrThumb
::nClrScroll = nClrScroll
::hPen = CreatePen( PS_SOLID, 2, CLR_BLACK )
DEFAULT ::nClrScroll := RGB( 108, 110, 190 ), ;
::nClrThumb := RGB( 148, 150, 230 )
DEFINE FONT ::oFont NAME "Segoe UI Light" SIZE 0, -52
DEFINE FONT ::oFontB NAME "Segoe UI Light" SIZE 0, -60 BOLD
DEFINE FONT ::oBtnFont NAME "Segoe UI Light" SIZE 0, -20 BOLD
DEFINE FONT ::oTextFont NAME "Segoe UI Light" SIZE 0, -16 BOLD
::lVisible := .t.
::SetColor( nClrText, nClrPane )
::bLClicked := bLClicked
if ::oActive == nil
::oActive := Self
endif
DEFAULT ::bLClicked := { || If( ::oParent == nil,, ::SwitchTo( ::oParent, .t. ) ) }
::oWnd:oClient := Self
::Hide()
return Self
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TMetroPanel
local aInfo
local oRect := ::GetCliRect()
local hScrollBrush, hThumbBrush
local nBarTotal
aInfo := ::DispBegin()
FillRect( ::hDC, oRect:aRect, ::oBrush:hBrush )
::Say( ( ::nBtnSize - ::oFont:nHeight ) / 2, ::nMetroTop, ::cTitle,,, ::oFont, .t., .t. )
if ::nScrollRange > 0
hScrollBrush := CreateSolidBrush( ::nClrScroll )
hThumbBrush := CreateSolidBrush( ::nClrThumb )
::nThumbWidth := Int( ::nThumbSize * ( oRect:nWidth - 120 ) )
nBarTotal := oRect:nWidth - 120 - ::nThumbWidth
::nThumbPos := Int( Abs( ::nOffSet / ::nScrollRange ) * nBarTotal ) + 60
oRect:nTop := oRect:nBottom - SCRLB_HEIGHT
oRect:nHeight := SCRLB_HEIGHT
::nScrollBarTop := oRect:nTop
::nScrollRatio := ( ::nScrollRange / nBarTotal )
FillRect( ::hDC, oRect:aRect, hScrollBrush )
FillRect( ::hDC, { oRect:nTop, oRect:nLeft + ::nThumbPos, oRect:nBottom, ;
oRect:nLeft + ::nThumbPos + ::nThumbWidth }, hThumbBrush )
DeleteObject( hScrollBrush )
DeleteObject( hThumbBrush )
MoveTo( ::hDC, oRect:nLeft + 32, oRect:nTop + 4 )
LineTo( ::hDC, oRect:nLeft + 24, oRect:nTop + 10, ::hPen )
LineTo( ::hDC, oRect:nLeft + 32, oRect:nTop + 16, ::hPen )
MoveTo( ::hDC, oRect:nRight - 32, oRect:nTop + 4 )
LineTo( ::hDC, oRect:nRight - 24, oRect:nTop + 10, ::hPen )
LineTo( ::hDC, oRect:nRight - 32, oRect:nTop + 16, ::hPen )
else
::nScrollBarTop := oRect:nBottom + 2
endif
if ValType( ::bPainted ) == "B"
Eval( ::bPainted, ::hDC, ::cPS, Self )
endif
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD Arrange( lReArrange ) CLASS TMetroPanel
local nGrpLeft := ::nMetroMargin + ::nOffset
local nGrpRight
local nGroup
local aBtns, nBtns, oBtn, nCols
local nRow, nCol, n
if lReArrange == .t.
::lArranged := .f.
endif
if ::lArranged
return Self
endif
for nGroup := 1 to ::nGroups
aBtns := {}
nBtns := 0
for each oBtn in ::aButtons
if oBtn:nGroup == nGroup
AAdd( aBtns, oBtn )
nBtns++
if oBtn:lLarge
nBtns++
endif
endif
next
nCols := Ceiling( nBtns / ::nMetroRows )
nRow := nCol := 0
nGrpRight := nGrpLeft
for each oBtn in aBtns
if If( oBtn:lLarge, nCol + 1, nCol ) > nCols
nRow++
nCol := 0
endif
oBtn:nTop := ::nMetroTop + nRow * ( ::nBtnSize + BTN_GAP )
oBtn:nLeft := nGrpLeft + nCol * ( ::nBtnSize + BTN_GAP )
nGrpRight := Max( nGrpRight, oBtn:nLeft + oBtn:nWidth )
nCol++
if oBtn:lLarge
nCol++
endif
next
::nScrollRange := nGrpLeft - ::nMetroMargin - ::nOffSet
nGrpLeft := nGrpRight + GRP_GAP
nGrpRight := nGrpLeft
next nGroup
::nMetroWidth := nGrpRight - ::nOffSet
::nScrollRange := Max(( ::nMetroWidth - ScreenWidth() ), ::nScrollRange )
::nScrollRange := Max( 0, ::nScrollRange )
::nThumbSize := 1 - ( ::nScrollRange / ::nMetroWidth )
::lArranged := .t.
return Self
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMetroPanel
if nRow < ::nScrollBarTop .or. ( nCol >= ::nThumbPos .and. nCol <= ( ::nThumbPos + ::nThumbWidth ) )
::lDrag = .T.
::nDragRow = nRow
::nOldCol = nCol
endif
return nil
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TMetroPanel
::lDrag = .F.
::nDragRow = nil
return nil
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nFlags ) CLASS TMetroPanel
if ::lDrag .and. ::nScrollRange > 0
if ::nDragRow < ::nScrollBarTop .and. nRow < ::nScrollBarTop
::Slide( nCol - ::nOldCol )
elseif ::nDragRow > ::nScrollBarTop .and. nRow > ::nScrollBarTop
::Slide( ( Int( ::nOldCol - nCol ) * ::nScrollRatio ) )
else
::lDrag := .f.
::nDragRow := nil
endif
::nOldCol = nCol
endif
return nil
//----------------------------------------------------------------------------//
METHOD MoveBtn( oBtnDrag, oBtnOver ) CLASS TMetroPanel
local nDrag, nOver
SysRefresh()
if oDragWnd != nil
oDragWnd:End()
oDragWnd := nil
endif
if oBtnDrag == oBtnOver
return Self
endif
nDrag := AScan( ::aButtons, { |o| o == oBtnDrag } )
ADel( ::aButtons, nDrag, .t. )
nOver := AScan( ::aButtons, { |o| o == oBtnOver } )
AIns( ::aButtons, nOver + If( nDrag == nOver, 1, 0 ), oBtnDrag, .t. )
oBtnDrag:nGroup := oBtnOver:nGroup
::lArranged := .f.
::Arrange()
::Refresh()
AEval( ::aButtons, { |o| o:Refresh() } )
return Self
//----------------------------------------------------------------------------//
METHOD ProgramCode( lShow ) CLASS TMetroPanel
local cPrg := ''
local oTile
DEFAULT lShow := .f.
cPrg := "static function MakeMetroPanel( oWnd )" + CRLF + CRLF
cPrg += " local oMetro, oBtn" + CRLF + CRLF
cPrg += ' DEFINE METROPANEL oMetro OF oWnd TITLE "' + ::cTitle + '" ;' + CRLF
cPrg += ' COLOR ' + cClrToCode( ::nClrText ) + ', ' + cClrToCode( ::nClrPane ) + ' ;' + CRLF
cPrg += ' ON CLICK oWnd:End()' + CRLF + CRLF
if ::lDesignMode
cPrg += ' oMetro:lDesignMode := .t.' + CRLF + CRLF
endif
for each oTile in ::aButtons
cPrg += oTile:ProgramCode()
next
cPrg += CRLF + "return oMetro" + CRLF + CRLF
if lShow
ViewCode( cPrg )
endif
return cPrg
//----------------------------------------------------------------------------//
METHOD Destroy() CLASS TMetroPanel
RELEASE FONT ::oFont, ::oFontB, ::oBtnFont, ::oTextFont
DeleteObject( ::hPen )
return Super:Destroy()
//----------------------------------------------------------------------------//
METHOD SwitchTo( oNext, lRight ) CLASS TMetroPanel
::Hide()
::oWnd:oClient := oNext
oNext:Show()
::oActive := oNext
return Self
//----------------------------------------------------------------------------//
METHOD AddButton( lLarge, nGroup, cCaption, bAction, nClrText, nClrPane, cImgName, oFont, ;
nAlign, nBmpAlign, nBmpWidth, nBmpHeight, cText, nTextAlign, ;
oTextFont, oSubMetro, cBackImage, cAction, cSub ) CLASS TMetroPanel
local oBtn
local nX := ::nMetroMargin + ( ::nRow * ( ::nBtnSize + 8 ) )
local nY := ::nMetroTop + ( ::nCol * ( ::nBtnSize + 8 ) )
DEFAULT lLarge := .F.
DEFAULT nClrText := CLR_WHITE, nClrPane := NextClr()
oBtn := TMetroBtn():New( nX, nY, lLarge, Self, cCaption, cImgName, bAction, nAlign, ;
nBmpAlign, nBmpWidth, nBmpHeight, oFont, cText, nTextAlign, oTextFont, oSubMetro, ;
nGroup, cBackImage, cAction, cSub )
oBtn:SetColor( nClrText, nClrPane )
oBtn:nClrCaption := nClrText
if ValType( cBackImage ) == 'C' .and. File( cBackImage )
oBtn:SetBackGround( cBacKImage )
endif
AAdd( ::aButtons, oBtn )
::nCol++
if lLarge
::nCol++
endif
if ::nCol > 5
::nRow++
::nCol = 0
endif
return oBtn
//----------------------------------------------------------------------------//
METHOD MouseWheel( nKey, nDelta, nXPos, nYPos ) CLASS TMetroPanel
local nMove := Int( nDelta / 3 )
local n, oBtn
::oActive:Slide( nDelta / 3 )
return nil
//----------------------------------------------------------------------------//
METHOD Slide( nPixels ) CLASS TMetroPanel
local aRect
if ::nScrollRange > 0
if nPixels > 0
nPixels := Min( nPixels, -::nOffSet )
endif
if ::nOffSet + nPixels < -::nScrollRange
nPixels := -::nScrollRange- ::nOffSet
endif
if nPixels != 0
aRect = GetClientRect( ::hWnd )
aRect[ 1 ] = IfNil( ::nSliderTop, ::nMetroTop )
aRect[ 3 ] -= ( SCRLB_HEIGHT + 2 )
ScrollWindow( ::hWnd, nPixels, 0, 0, aRect )
::nOffSet += nPixels
if ::nScrollRange > 0
::Refresh()
endif
endif
endif
return Self
//----------------------------------------------------------------------------//
CLASS TMetroBtn FROM TBtnBmp
CLASSDATA lRegistered AS LOGICAL
DATA nGroup INIT 1
DATA nMargin INIT 8
DATA lLarge INIT .f.
DATA nCapAlign INIT nOr( DT_TOP, DT_RIGHT )
DATA nBmpAlign INIT nOr( DT_BOTTOM, DT_LEFT )
DATA nBmpTop, nBmpLeft, nBmpWidth, nBmpHeight
DATA cBmpSource
DATA cText
DATA nTextAlign INIT nOr( DT_RIGHT, DT_VCENTER )
DATA nClrCaption
DATA oTextFont
DATA cAction, cSub
DATA oSub
METHOD New( nTop, nLeft, lLarge, oMetro, cCaption, uImage, bAction, nAlign, ;
nBmpAlign, nBmpWidth, nBmpHeight, oFont, oSub, nGroup, cBackImage, cAction, cSub ) CONSTRUCTOR
METHOD LoadBitmaps( uBmp )
METHOD Paint()
METHOD DrawPrompt( cPrompt, oFont, nColor, nAlign )
METHOD DrawMultiLine( cText, oFont, nColor, nAlign )
METHOD DesignMenu()
METHOD AlignObject( nRow, nCol )
METHOD CalcBmpAlign( lRecalc )
METHOD SetBackGround( cImage )
METHOD SetBitmap( cImage )
METHOD ToggleSize()
METHOD ProgramCode()
METHOD Destroy()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, lLarge, oMetro, cCaption, uImage, bAction, nAlign, ;
nBmpAlign, nBmpWidth, nBmpHeight, oFont, cText, nTextAlign, ;
oTextFont, oSub, nGroup, cBackImage, cAction, cSub ) CLASS TMetroBtn
local nWidth := oMetro:nBtnSize + If( lLarge, oMetro:nBtnSize + 8, 0 )
DEFAULT nAlign := nOr( DT_TOP, DT_RIGHT ), nBmpAlign := nOr( DT_BOTTOM, DT_LEFT ), ;
cText := '', nTextAlign := nOr( DT_VCENTER, DT_RIGHT )
if ValType( nAlign ) == 'C'
nAlign := StrToAlign( nAlign, DT_TOP + DT_RIGHT )
endif
if ValType( nBmpAlign ) == 'C'
nBmpAlign := StrToAlign( nBmpAlign, DT_BOTTOM + DT_LEFT )
endif
if ValType( nTextAlign ) == 'C'
nTextAlign := StrToAlign( nTextAlign, DT_VCENTER + DT_RIGHT )
endif
DEFAULT nGroup := oMetro:nGroups
oMetro:nGroups := Max( oMetro:nGroups, nGroup )
::nGroup := nGroup
::lLarge := lLarge
::lTransparent := .f.
::nCapAlign := nAlign
::nBmpAlign := nBmpAlign
::nBmpWidth := nBmpWidth
::nBmpHeight := nBmpHeight
::cText := cText
::nTextAlign := nTextAlign
::oTextFont := oTextFont
::oSub := oSub
::cAction := cAction
::cSub := cSub
if ValType( ::cText ) == 'C'
::cText := StrTran( ::cText, ';', CRLF )
endif
Super:New( nTop, nLeft, nWidth, oMetro:nBtnSize, uImage, nil, nil, nil, bAction, ;
oMetro, nil, nil, .f., .t., cCaption, oFont, nil, nil, .f., 'BOTTOM', ;
.f. )
DEFAULT ::bAction := { || If( ::oSub == nil,, ( ::oSub:oParent := ::oWnd, ::oWnd:SwitchTo( ::oSub ) ) ) }
DEFINE CURSOR ::oDragCursor DRAG
::bDragBegin := { |r,c,f,o| BtnDragBegin( r,c,f,o ) }
::bRClicked := { |r,c,f| ::DesignMenu(r,c,f) }
::bMMoved := { |r,c,f,lDrag| if( oDragWnd == nil, ;
If( ::nLeft + ::nWidth > ::oWnd:oWnd:nWidth, ::oWnd:Slide( ::oWnd:oWnd:nWidth - ::nLeft - ::nWidth ),;
If( ::nLeft < 0 , ::oWnd:Slide( -::nLeft + 8 ) , nil ) ), ;
If( lDrag == .t., oDragWnd:Move( ::nTop + r -oDragWnd:Cargo[1], ;
::nLeft + c - oDragWnd:Cargo[2], ::nWidth, ::nHeight, .t. ), ;
(oDragWnd:End(),oDragWnd := nil ) ) ) }
::OnClick := { || If( ::bAction == nil,,Eval( ::bAction, Self )) }
return Self
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TMetroBtn
local aInfo, nStyle, aRect, hOldFont, hBmpOld, nOldClr, nZeroZeroClr
local cText
aInfo := ::DispBegin()
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
if ! Empty( ::hBitmap1 )
if HasAlpha( ::hBitmap1 )
ABPaint( ::hDC, ::nBmpLeft, ::nBmpTop, ::hBitmap1, 255 )
elseif .f.
DrawTransparent( ::hDC, ::hBitmap1, ::nBmpTop, ::nBmpLeft )
elseif .t.
hBmpOld := SelectObject( ::hDC, ::hBitmap1 )
nZeroZeroClr := GetPixel( ::hDC, 0, 0 )
SelectObject( ::hDC, hBmpOld )
// nOldClr = SetBkColor( ::hDC, CLR_WHITE )
TransBmp( ::hBitmap1, ::nBmpWidth, ::nBmpHeight, nZeroZeroClr, ::hDC, ;
::nBmpLeft, ::nBmpTop, ::nBmpWidth, ::nBmpHeight )
// SetBkColor( ::hDC, nOldClr )
endif
endif
if ! Empty( ::cCaption )
::DrawPrompt( ::cCaption, IfNil( ::oFont, ::oWnd:oBtnFont ), ;
IfNil( ::nClrCaption, ::nClrText ), ::nCapAlign )
endif
if ! Empty( ::cText )
::DrawPrompt( ::cText, IfNil( ::oTextFont, ::oFont, ::oWnd:oTextFont ), ;
::nClrText, ::nTextAlign )
endif
::DispEnd( aInfo )
return nil
//----------------------------------------------------------------------------//
METHOD DrawPrompt( cText, oFont, nColor, nAlign ) CLASS TMetroBtn
local aRect, hOldFont
if ValType( cText ) == 'B'
cText := Eval( cText, Self )
endif
cText := AllTrim( cValToChar( cText ) )
if CRLF $ cText
return ::DrawMultiLine( cText, oFont, nColor, nAlign )
else
SetTextColor( ::hDC, nColor )
SetBkMode( ::hDC, 1 )
hOldFont := SelectObject( ::hDC, oFont:hFont )
aRect := { ::nMargin, ::nMargin, ::nHeight - ::nMargin, ::nWidth - ::nMargin }
DrawTextEx( ::hDC, cText, aRect, nOr( nAlign, DT_SINGLELINE ) )
SelectObject( ::hDC, hOldFont )
endif
return nil
//----------------------------------------------------------------------------//
METHOD DrawMultiLine( cText, oFont, nColor, nAlign ) CLASS TMetroBtn
local aRect, hOldFont, nTextHeight
SetTextColor( ::hDC, nColor )
SetBkMode( ::hDC, 1 )
hOldFont := SelectObject( ::hDC, oFont:hFont )
aRect := { ::nMargin, ::nMargin, ::nHeight - ::nMargin, ::nWidth - ::nMargin }
if lAnd( nAlign, nOr( DT_VCENTER, DT_BOTTOM ) )
nTextHeight := DrawTextEx( ::hDC, cText, aRect, nOr( DT_CALCRECT, DT_WORDBREAK ) )
if lAnd( nAlign, DT_BOTTOM )
aRect[ 1 ] := ::nHeight - ::nMargin - nTextHeight
else
aRect[ 1 ] := ( ::nHeight - nTextHeight ) / 2
endif
endif
DrawTextEx( ::hDC, cText, aRect, nAlign )
SelectObject( ::hDC, hOldFont )
return nil
//----------------------------------------------------------------------------//
METHOD LoadBitmaps( uBmp ) CLASS TMetroBtn
local hBmp := 0
local hBmp1, nBmpWidth, nBmpHeight
if ValType( uBmp ) == 'N' .and. uBmp != 0
if IsGdiObject( uBmp )
hBmp := uBmp
else
hBmp := LoadBitmap( GetInstance(), uBmp )
endif
elseif ValType( uBmp ) == 'C'
if '.' $ uBmp
if File( uBmp )
if Lower( Right( uBmp, 4 ) ) == '.bmp'
hBmp := ReadBitmap( 0, uBmp )
else
hBmp := FILoadImg( uBmp )
endif
endif
else
hBmp := LoadBitmap( GetInstance(), uBmp )
endif
endif
if ! Empty( hBmp )
::cBmpSource := uBmp
nBmpWidth := nBmpWidth( hBmp )
nBmpHeight := nBmpHeight( hBmp )
DEFAULT ::nBmpWidth := nBmpWidth, ::nBmpHeight := nBmpHeight
if nBmpWidth != ::nBmpWidth .or. nBmpHeight != ::nBmpHeight
hBmp := ResizeImg( ( hBmp1 := hBmp ), ::nBmpWidth, ::nBmpHeight )
DeleteObject( hBmp1 )
endif
::CalcBmpAlign()
endif
::hBitmap1 := hBmp
return Self
//----------------------------------------------------------------------------//
METHOD CalcBmpAlign( lRecalc ) CLASS TMetroBtn
DEFAULT lRecalc := .f.
if lRecalc
::nBmpTop := ::nBmpLeft := nil
endif
if ! Empty( ::nBmpWidth ) .and. ! Empty( ::nBmpHeight )
if ::nBmpTop == nil
if lAnd( ::nBmpAlign, DT_BOTTOM )
::nBmpTop := ::nHeight - ::nMargin - ::nBmpHeight
elseif lAnd( ::nBmpAlign, DT_VCENTER )
::nBmpTop := ( ::nHeight - ::nBmpHeight ) / 2
else
::nBmpTop := ::nMargin
endif
endif
if ::nBmpLeft == nil
if lAnd( ::nBmpAlign, DT_RIGHT )
::nBmpLeft := ::nWidth - ::nMargin - ::nBmpWidth
elseif lAnd( ::nBmpAlign, DT_CENTER )
::nBmpLeft := ( ::nWidth - ::nBmpWidth ) / 2
else
::nBmpLeft := ::nMargin
endif
endif
endif
return Self
//----------------------------------------------------------------------------//
METHOD DesignMenu( nRow, nCol, nFlags ) CLASS TmetroBtn
local oPop, c
if ! ::oWnd:lDesignMode
return nil
endif
MENU oPop POPUP 2007
MENUITEM "Large Size" WHEN { |o| o:SetCheck( ::lLarge ), .t. } ;
ACTION oMenuItem:SetCheck( ::ToggleSize() )
SEPARATOR
MENUITEM "Colors"
MENU
MENUITEM "Tile" ACTION ::SelColor( .f. )
MENUITEM "Caption" ACTION ( ::nClrCaption := ChooseColor( ::nClrCaption ), ::Refresh() )
MENUITEM "BodyText" ACTION ( ::nClrText := ChooseColor( ::nClrText ), ::Refresh() )
ENDMENU
MENUITEM "Set Images"
MENU
MENUITEM "Tile" ACTION ::SetBackGround()
MENUITEM "Bitmap" ACTION ::SetBitmap()
ENDMENU
MENUITEM "Edit Text"
MENU
MENUITEM "Caption" ACTION ( c := PadR( IfNil( ::cCaption, '' ), 15 ), ;
If( MsgGet( "Caption", "Enter 15 Chars for Caption", @c ), ;
( ::cCaption := AllTrim( c ), ::Refresh() ), nil ) )
MENUITEM "BodyText" ACTION ( c := PadR( IfNil( ::cText, '' ), 45 ), ;
If( MsgGet( "Body Text", "Enter 45 Chars for Body", @c ), ;
( ::cText := StrTran( AllTrim( c ), ';', CRLF ), ;
::Refresh() ), nil ) )
ENDMENU
MENUITEM "Align Elements"
MENU
MENUITEM "Caption" ACTION ( ::nCapAlign := ::AlignObject( nRow, nCol ), ::Refresh() )
MENUITEM "BodyText" ACTION ( ::nTextAlign := ::AlignObject( nRow, nCol ), ::Refresh() )
MENUITEM "Bitmap" ACTION ( ::nBmpAlign := ::AlignObject( nRow, nCol ), ;
::CalcBmpAlign( .t. ), ::Refresh() ) ;
WHEN ! Empty( ::hBitmap1 )
ENDMENU
SEPARATOR
MENUITEM "Add New Tile" ACTION ( ::oWnd:AddButton( ::lLarge, ::nGroup, "New" ), ::oWnd:Arrange( .t. ):Refresh() )
MENUITEM "Insert New Tile" ACTION ::oWnd:MoveBtn( ::oWnd:AddButton( ::lLarge, ::nGroup, "New" ), Self )
SEPARATOR
MENUITEM "GenerateCode"
MENU
MENUITEM "Tile" ACTION ::ProgramCode( .t. )
MENUITEM "Metro" ACTION ::oWnd:ProgramCode( .t. )
ENDMENU
ENDMENU
oPop:Activate( nRow, nCol, Self )
return nil
//----------------------------------------------------------------------------//
METHOD AlignObject( nRow, nCol ) CLASS TMetroBtn
local nAlign
local n := ::nWidth / 3
nAlign := If( nCol > n, If( nCol > ( n + n ), 2, 1 ), 0 )
n := ::nHeight / 3
nAlign += If( nRow > n, If( nRow > ( n + n ), 8, 4 ), 0 )
return nAlign
//----------------------------------------------------------------------------//
METHOD SetBackGround( cImage ) CLASS TMetroBtn
local lSet := .f.
local oBrush
DEFAULT cImage := cGetFile( "Image File (*.bmp,*.jpg,*.png)|*.bmp;*.jpg;*.png|", ;
"Select Background Image",,CurDir() )
if ! Empty( cImage )
DEFINE BRUSH oBrush FILE cImage RESIZE
::SetBrush( oBrush )
::oBrush:Resize( Self )
::Refresh()
RELEASE BRUSH oBrush
lSet := .t.
endif
return lSet
//----------------------------------------------------------------------------//
METHOD SetBitmap( cImage ) CLASS TMetroBtn
local w, h, hBmp
DEFAULT cImage := cGetFile( "Image File (*.bmp,*.jpg,*.png,*.ico)|*.bmp;*.jpg;*.png;*.ico|", ;
"Select Bitmap File",,CurDir() )
if ! Empty( cImage )
if ! Empty( ::hBitmap1 )
DeleteObject( ::hBitmap1 )
endif
::nBmpTop := ::nBmpLeft := nil
::nBmpWidth := ::nBmpHeight := 50
::LoadBitmaps( cImage )
/*
w := nBmpWidth( ::hBitmap1 )
h := nBmpHeight(::hBitmap1 )
if w > ::nWidth / 3 .or. h > ::nHeight / 3
hBmp := ResizeBitmap( ::hBitmap1, ::nWidth / 3, ::nHeight / 3, 3 )
DeleteObject( ::hBitmap1 )
::hBitmap1 := hBmp
::CalcBmpAlign( .t. )
endif
*/
::Refresh()
endif
return Self
//----------------------------------------------------------------------------//
METHOD ToggleSize() CLASS TMetroBtn
::lLarge := ! ::lLarge
::nWidth := ::oWnd:nBtnSize + If( ::lLarge, ::oWnd:nBtnSize + BTN_GAP, 0 )
::CalcBmpAlign( .t. )
::oWnd:Arrange( .t. ):Refresh()
AEval( ::oWnd:aButtons, { |o| o:Refresh() } )
return ::lLarge
//----------------------------------------------------------------------------//
METHOD ProgramCode( lShow ) CLASS TMetroBtn
local cPrg := ''
DEFAULT lShow := .f.
#define NL ' ;' + CRLF
cPrg := ' DEFINE METROBUTTON oBtn OF oMetro'
cPrg += NL + ' COLOR ' + cClrToCode( ::nClrText ) + ',' + cClrToCode( ::nClrPane )
if ! Empty( ::cCaption )
cPrg += NL + ' CAPTION "' + ::cCaption + '"'
cPrg += NL + ' ALIGN "' + AlignStr( ::nCapAlign ) + '"'
endif
if ::nGroup > 1
cPrg += NL + ' GROUP ' + LTrim( Str( ::nGroup ) )
endif
if ! Empty( ::hBitmap1 ) .and. ! Empty( ::cBmpSource )
cPrg += NL + ' BITMAP "' + ::cBmpSource + '"'
cPrg += NL + ' BMPALIGN "' + AlignStr( ::nBmpAlign ) + '"'
cPrg += NL + ' SIZE ' + LTrim( Str( ::nBmpWidth ) ) + ', ' + ;
LTrim( Str( ::nBmpHeight ) )
endif
if ! Empty( ::cText )
cPrg += NL + ' BODYTEXT "' + StrTran( ::cText, CRLF, ';' ) + '"'
cPrg += NL + ' TEXTALIGN "' + AlignStr( ::nTextAlign ) + '"'
endif
if ! Empty( ::oBrush:hBitmap ) .and. ! Empty( ::oBrush:cBmpFile )
cPrg += NL + ' BACKGROUND "' + ::oBrush:cBmpFile + '"'
endif
if ::lLarge
cPrg += NL + ' LARGE '
endif
if ! Empty( ::cSub )
cPrg += NL + ' MENU ' + ::cSub
elseif ! Empty( ::cAction )
cPrg += NL + ' ACTION ' + ::cAction
endif
cPrg += CRLF
if ::nClrCaption != ::nClrText
cPrg += ' oBtn:nClrCaption := ' + cClrToCode( ::nClrCaption ) + CRLF
endif
cPrg += CRLF
if lShow
ViewCode( cPrg )
endif
#undef NL
return cPrg
//----------------------------------------------------------------------------//
METHOD Destroy() CLASS TMetroBtn
if ::oDragCursor != nil
RELEASE CUSROR ::oDragCursor
endif
return Super:Destroy()
//----------------------------------------------------------------------------//
// SUPPORT FUNCTIONS
//----------------------------------------------------------------------------//
static function StrToAlign( cAlign, nDefault )
local x, y
DEFAULT nDefault := 0
cAlign := Upper( cAlign )
x := If( 'LEF' $ cAlign, 0, If( 'CEN' $ cAlign, 1, If( 'RIG' $ cAlign, 2, nAnd( nDefault, 3 ) ) ) )
y := If( 'TOP' $ cAlign, 0, If( 'MID' $ cAlign, 4, If( 'BOT' $ cAlign, 8, nAnd( nDefault, 12 ) ) ) )
return nOr( x, y )
//----------------------------------------------------------------------------//
static function AlignStr( nAlign )
local cAlign := ''
local n := nAnd( nAlign, 12 )
cAlign := If( n == 8, 'BOTTOM', If( n == 4, 'MIDDLE', 'TOP' ) )
n := nAnd( nAlign, 3 )
cAlign += If( n == 2, 'RIGHT', If( n == 1, 'CENTER', 'LEFT' ) )
return cAlign
//----------------------------------------------------------------------------//
static function NextClr()
static n := 1
local cClr := "E0AE022770EA3C1FB54E98188546020EB15601B1D5ADA6491B30BB008DD49E313A00AB899B83715A0061863B0DADA84B"
local nClr := HexToNum( SubStr( cClr, n, 6 ) )
n += 6
if n > Len( cClr )
n := 1
endif
return nClr
//----------------------------------------------------------------------------//
static function BtnDragBegin( nRow, nCol, nFlags, oBtn )
local oBmp, hBmp
SetDropInfo( oBtn )
if oDragWnd != nil
oDragWnd:End()
oDragWnd := nil
endif
hBmp := WndBitmap( oBtn:hWnd )
DEFINE WINDOW oDragWnd COLOR oBtn:nClrText, oBtn:nClrPane ;
STYLE nOr( WS_POPUP, WS_VISIBLE )
oDragWnd:nOpacity := 180
@ 0,0 BITMAP oBmp OF oDragWnd SIZE oBtn:nWidth, oBtn:nHeight PIXEL
oBmp:hBitmap := hBmp
oBmp:bDropOver := { |u,r,c,f| BtnDragEnd( u,r,c,f ) }
oDragWnd:Cargo := { nRow, nCol }
ACTIVATE WINDOW oDragWnd ;
ON INIT ( oDragWnd:Move( oBtn:nTop,oBtn:nLeft,oBtn:nWidth,oBtn:nHeight,.t. ) )
return nil
//----------------------------------------------------------------------------//
static function BtnDragEnd( oDragged, nRow, nCol, nFlags )
local oMetro := oDragged:oWnd
local hDropBtn, oDroppedOn
local r, c, o
if oDragWnd != nil
oDragWnd:End()
oDragWnd := nil
endif
r := oDragged:nTop + nRow
c := oDragged:nLeft + nCol
if r > 0x8000
r -= 0xffff
endif
if c > 0x8000
c -= 0xffff
endif
for each o in oMetro:aButtons
if r >= o:nTop .and. r <= o:nTop + o:nHeight
if c >= o:nLeft .and. c <= o:nLeft + o:nWidth
oDroppedOn := o
exit
endif
endif
next
if oDroppedOn != nil .and. oDroppedOn:IsKindOf( 'TMETROBTN' )
oMetro:MoveBtn( oDragged, oDroppedOn )
endif
return nil
//----------------------------------------------------------------------------//
static function ViewCode( cCode )
local oGet
local oDlg
local oFont
#define DLGWD 350 //250
#define DLGHT 250
DEFINE FONT oFont NAME 'LUCIDA CONSOLE' SIZE 0,-12
DEFINE DIALOG oDlg SIZE DLGWD*2, DLGHT*2 PIXEL ;
TITLE "Program Code Generated" ;
FONT oFont
@ 10,10 GET oGet VAR cCode TEXT ;
SIZE DLGWD-10,DLGHT-45 PIXEL ;
OF oDlg FONT oFont
@ DLGHT-20,05 BUTTONBMP BITMAP '..\bitmaps\copy3.bmp' SIZE 16,16 PIXEL OF oDlg ;
ACTION CopyToClip( cCode )
@ DLGHT-20,DLGWD-21 BUTTONBMP BITMAP '..\bitmaps\close.bmp' ;
SIZE 16,16 PIXEL OF oDlg ;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
static function CopyToClip( cText )
local oClip
oClip := TClipBoard():New()
if oClip:Open()
oClip:SetText( cText )
oClip:Close()
endif
oClip:End()
return nil
