Clase GETBTN

Clase GETBTN

Postby Compuin » Wed May 25, 2016 7:59 pm

Hola

Alguien tiene o sabe donde puedo conseguir la clase GETBTN ?
FWH 20.12
Hbmk2 32/64 Bits (Build 19.29.30133)
Microsoft Visual C 32 Bits
MySql 8.0.24 32/64 Bits
VS Code
Compuin
 
Posts: 1214
Joined: Tue Dec 28, 2010 1:29 pm
Location: Quebec, Canada

Re: Clase GETBTN

Postby karinha » Wed May 25, 2016 8:15 pm

No és la BTNGET.PRG? GETBTN.PRG no conozco.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7795
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Clase GETBTN

Postby karinha » Wed May 25, 2016 8:16 pm

Code: Select all  Expand view

*-- PROGRAM FILE -------------------------------------------------------
*  Application: Addon for FiveWin
*  Description: TBtnGet - Colored TGet class with button
*    File Name: tbtnget.prg
*       Author: Ricardo Ramirez       Tester: Ricardo Ramirez
* Date created: 1998-01-01            Date updated: þ2001-03-26
* Time created: 8:17:12PM             Time updated: þ16:028:17M
*    Copyright: (c) 1998-2000 by Punto-Co
*
 * $Id: btnget.prg,v 1.4 2001/08/10 18:12:21 RRamirez Exp $
*
* Compliments of:
*  George Georguiev
*-----------------------------------------------------------------------

#include "FiveWin.ch"

#define GWL_STYLE         -16
#define GWL_EXSTYLE       -20
#define DS_3DLOOK           4
#define SM_CYVSCROLL       20

CLASS TBtnGet FROM TGet

   DATA   bAction, cResName, oBtn, lBtnORBmp
   DATA   nClrPFoText, nClrPFoPane, nClrDef
   DATA   nBmpWidth, bTmpValid
   DATA   nClrFocusText, nClrFocusPane // added. There was erased from FW 2.2c

   METHOD ClassName() INLINE "TGET"

   METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, ;
               bValid, nClrFore, nClrBack, oFont, lDesign, oCursor, ;
               lPixel, cMsg, lUpdate, bWhen, lCenter, lRight, bChanged,;
               lReadOnly, lPassword, lNoBorder, nHelpId, cResName, ;
               bAction, lSpinner, bUp, bDown, bMin, bMax, nBmpWidth ) ;
               CONSTRUCTOR

   METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, ;
               nClrFore, nClrBack, oFont, oCursor, cMsg, lUpdate, ;
               bWhen, bChanged, lReadOnly, lSpinner, bUp, bDown, bMin, ;
               bMax, cResName, bAction ) CONSTRUCTOR

   METHOD Default()
   METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
   METHOD SetIniClr()
   METHOD Move()
   METHOD CalcDims( nTop, nLeft, nWidth, nHeight )

END CLASS

METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, bValid,;
            nClrFore, nClrBack, oFont, lDesign, oCursor, lPixel, cMsg,;
            lUpdate, bWhen, lCenter, lRight, bChanged, lReadOnly,;
            lPassword, lNoBorder, nHelpId, cResName, bAction, lSpinner,;
            bUp, bDown, bMin, bMax, nBmpWidth ) CLASS TBtnGet

   Super:New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, cPict, ;
            bValid, nClrFore, nClrBack, oFont, lDesign, oCursor, ;
            lPixel, cMsg, lUpdate, bWhen, lCenter, lRight, bChanged, ;
            lReadOnly, lPassword, lNoBorder, nHelpId, lSpinner,;
            bUp, bDown, bMin, bMax )

   DEFAULT nBmpWidth := 17

   ::nStyle := nOr( ::nStyle, ES_MULTILINE )

   ::bAction   := bAction
   ::cResName  := cResName
   ::lBtnORBmp := .F.
   ::nBmpWidth := nBmpWidth
   ::SetIniClr()

Return Self

METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, nClrFore,;
                 nClrBack, oFont, oCursor, cMsg, lUpdate, bWhen, ;
                 bChanged, lReadOnly, lSpinner, bUp, bDown, bMin, ;
                 bMax, cResName, bAction, nBmpWidth ) CLASS TBtnGet

   Super:ReDefine( nId, bSetGet, oWnd, nHelpId, cPict, bValid, ;
                 nClrFore, nClrBack, oFont, oCursor, cMsg, lUpdate, ;
                 bWhen, bChanged, lReadOnly, lSpinner, bUp, bDown, ;
                 bMin, bMax )

   DEFAULT nBmpWidth := 22

   ::nStyle    := nOr(::nStyle, ES_MULTILINE )
   ::bAction   := bAction
   ::cResName  := cResName
   ::lBtnORBmp := .F.
   ::nBmpWidth := nBmpWidth

   ::SetIniClr()

   SetWindowLong( ::hWnd, GWL_STYLE, nOr( GetWindowLong( ::hWnd, GWL_STYLE ) , ES_MULTILINE ) )

Return Self

METHOD Default() CLASS TBtnGet
   local nRectLen, l3Dlook
   Local nTop, nLeft, nWidth, nHeight

   IF empty( ::bAction )
      Return Nil
   ENDIF

   //MSGINFO( GetWindowLong( ::oWnd:hWnd, GWL_STYLE ))

   IF !lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), ES_MULTILINE )
      //MsgStop("Sorry, but you need to define the ID " + ltrim( str( ::nId ) ) + " as MULTILINE ")
   endif

   if lAnd( GetWindowLong( ::hWnd, GWL_STYLE ) , ES_MULTILINE )
      //MsgInfo("Si soy")
   else
      //MsgInfo("no soy")
   Endif

   //SetWindowLong( ::hWnd, GWL_EXSTYLE, nOr( GetWindowLong( ::hWnd, GWL_EXSTYLE ) , ES_MULTILINE ) )

   nRectLen := ::CalcDims( @nTop, @nLeft, @nWidth, @nHeight )

   ::oBtn := TBtnDown():New( nTop, nLeft, nWidth, nHeight, ;
                 ::cResName,, ::cResName,, {|| Self:SetFocus(), ;
                 eval( ::bAction ) }, Self,"",, .F., .F.,"", ,, , .f. )

   ::bKeyDown        := { | nKey | IIF( nKey == VK_F7, ;
                            eval( ::bAction ), "" ) }
   ::oBtn:bGotFocus  := {|| ::bTmpValid := ::bValid, ::bValid := nil, ;
                            ::oWnd:nLastKey := 0 }
   ::oBtn:bLostFocus := {|| ::bValid := ::bTmpValid }

   GetBtn( ::hWnd, nRectLen )

Return Nil

METHOD SetIniClr() CLASS TBtnGet

   ::nClrFocusText := nRGB( 000, 000, 000 )
   ::nClrFocusPane := nRGB( 243, 250, 200 )
   ::nClrPFoText   := ::nClrText
   ::nClrPFoPane   := ::nClrPane
   //
   ::bGotFocus  := {|| ::SetColor( ::nClrFocusText, ::nClrFocusPane) }
   ::bLostFocus := {|| ::SetColor( ::nClrPFoText  , ::nClrPFoPane  ) }

Return Self

METHOD Move( nTop, nLeft, nWidth, nHeight, lRepaint ) CLASS TBtnGet
   Local nRectLen

   Super:Move( nTop, nLeft, nWidth, nHeight, lRepaint )

   IF ::oBtn != Nil

      nRectLen := ::CalcDims( @nTop, @nLeft, @nWidth, @nHeight )
      ::oBtn:Move( nTop, nLeft, nWidth, nHeight )

   ENDIF

Return Nil

METHOD CalcDims( nTop, nLeft, nWidth, nHeight ) CLASS TBtnGet
   Local nRectLen

   nRectLen := ::nBmpWidth + 4

   IF lAnd( GetWindowLong( ::oWnd:hWnd, GWL_STYLE ), DS_3DLOOK )
      IF empty( ::cResName )
         nLeft   := ::nWidth() - 16
         nWidth  := 12
      else
         nLeft   := ::nWidth() - 26
         nWidth  := 22
      endif
      nTop    := 0
      nHeight := ::nHeight() - 4
   else
      IF empty( ::cResName )
         nLeft   := ::nWidth() - 15
         nWidth  := 14
      Else
         nLeft   := ::nWidth() - 25
         nWidth  := 24
      ENDIF
      nTop    := 1
      nHeight := ::nHeight() - 2
   ENDIF

   IF empty( ::cResName )
      nRectLen -= 9
   endif

   if ::oVScroll != Nil
      nLeft  -= GetSysMetrics( SM_CYVSCROLL )
      nLeft++
   endif

Return nRectLen
 


João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7795
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Clase GETBTN

Postby karinha » Wed May 25, 2016 8:18 pm

João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
User avatar
karinha
 
Posts: 7795
Joined: Tue Dec 20, 2005 7:36 pm
Location: São Paulo - Brasil

Re: Clase GETBTN

Postby Antonio Linares » Wed May 25, 2016 8:39 pm

regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42069
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain


Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 85 guests