FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin for Harbour/xHarbour Free FafiButton Class with FWH
Posts: 169
Joined: Mon Feb 25, 2008 02:42 AM
Free FafiButton Class with FWH
Posted: Wed Apr 22, 2009 12:14 PM
Friends ! Please report if you get errors

Hi ! Antonio ,

This is my first Class create by FWH
I used NEWALPHABLEND from Mr. Toninho. Thank's

I can't use cTooltips, and how to create command line with @10,10 FafiButton ect....
Please Help !

Code (fw): Select all Collapse
#include "fivewin.ch"

PROCEDURE Main

  local oRect, oDlg

  oRect := array(5)
  define brush oBrush COLOR CLR_BLUE
  
  define dialog oDlg from 1,1 to 400,600 pixel transparent BRUSH oBrush

  define font oFont name "arial" size 0,-20 bold

  nRow     := 2
  nCol     := 2
  nWidth   := 50
  nHeight  := 50
  
  bAction := { || MsgAlert("action") }
  
  cCaption := "Caption"+CRLF+"Hello"
     
  define bitmap oBmp file "world.bmp"
  
  oRect := TFafiButton():New(oDlg, nRow,nCol,nWidth,nHeight,"Hello",{ || .t. }, cCaption, oBmp )
  
  oRect:cToolTip := "Hello"

  ACTIVATE DIALOG oDlg CENTERED


RETURN



#define LTGRAY_BRUSH        1
#define RT_BITMAP           2

#define OPAQUE              2
#define TRANSPARENT         1

#define COLOR_BTNFACE      15
#define COLOR_BTNSHADOW    16
#define COLOR_BTNHIGHLIGHT 20

#define NO_FOCUSWIDTH      25
#define GWL_STYLE         -16

#define TME_LEAVE           2
#define WM_MOUSELEAVE     675

#define DT_CENTER           1
#define DT_VCENTER          4
#define DT_WORDBREAK       16

#ifdef __XPP__
   #define Super ::TControl
   #define New _New
#endif

#define LAYOUT_CENTER  0
#define LAYOUT_TOP     1
#define LAYOUT_LEFT    2
#define LAYOUT_BOTTOM  3
#define LAYOUT_RIGHT   4

#define DST_BITMAP      4
#define DSS_UNION      16
#define DSS_DISABLED   32
#define DSS_MONO      128


CLASS TFafiButton FROM TControl
   
   CLASSDATA lRegistered AS LOGICAL
      
   DATA   lProcessing AS LOGICAL INIT .f.      
   
   DATA   bAction
   
   DATA   cPaint   
   
   DATA   lMOver // mouse is over it
   
   DATA   lSudah 
   
   DATA   lPressed
   
   DATA   lWorking, lBtnUp,lBtnDown
   
   DATA   lBorder AS LOGICAL INIT .t.
   
   DATA   oAlphaImage 
   
   METHOD New(oWnd,nTop,nLeft,nWidth,nHeight,cMsg,bAction,cCaption,oAlphaImage) CONSTRUCTOR

   METHOD LButtonDown( nRow, nCol ) 
      
   METHOD GotFocus( hCtlLost )

   METHOD Initiate( hDlg )
      
   METHOD Click()   

   METHOD LostFocus()
      
   METHOD Paint()   
      
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0   
      
   METHOD LButtonUp( nRow, nCol )
      
   METHOD MouseMove( nRow, nCol, nKeyFlags )      
   
   METHOD HandleEvent( nMsg, nWParam, nLParam )

   METHOD MouseLeave( nRow, nCol, nFlags )
      

ENDCLASS




METHOD New(oWnd,nTop,nLeft,nWidth,nHeight,cMsg,bAction,cCaption,oAlphaImage) CLASS TFafiButton
   
   DEFAULT cMsg := " ", nWidth := 20, nHeight := 20, oWnd := GetWndDefault(), bAction := { || .t. }
   
   * Default class from Tcontrol
   
   ::nId       = ::GetNewId()
   ::nStyle    = nOR( WS_CHILD, WS_VISIBLE )
   ::nId       = ::GetNewId()
   ::oWnd      = oWnd
   ::cMsg      = cMsg
   ::nTop      = nTop
   ::nLeft     = nLeft
   ::nBottom   = nTop + nHeight - 1
   ::nRight    = nLeft + nWidth - 1
   ::cPaint    = "NORMAL"
   ::bAction   = bAction
   ::cCaption  = cCaption
   ::oAlphaImage = oAlphaImage
   
   ::lMOver    = .F.
   ::lSUdah    = .F.
   
   ::lPressed  = .f.
   ::lWorking  = .f.
   ::lBtnDown  = .f.
   
   ::l97Look   = .t.
   ::lBorder   = .t.
   ::oFont     := oFont   
   
   
   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )
   
   if ! Empty( oWnd:hWnd )
      ::Create( "STATIC" )
      ::SetColor( CLR_YELLOW, CLR_BLUE )
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif
   
return self

//----------------------------------------------------------------------------//

METHOD GotFocus( hCtlLost ) CLASS TFafiButton
return Super:GotFocus()


METHOD LostFocus() CLASS TFafiButton
return Super:LostFocus()


//----------------------------------------------------------------------------//

METHOD LButtonDown( nRow, nCol ) CLASS TFafiButton
   
   ::cPaint := "CLICKED"
   
   
   ::lWorking = .t.
   ::lBtnUp   = .f.

   SetFocus( ::hWnd )    // To let the main window child control
   SysRefresh()          // process its valid

   if GetFocus() == ::hWnd
      ::lCaptured = .t.
      ::lPressed  = .t.
      ::Capture()
      ::Refresh() 
   endif

   ::lWorking = .f.

   if ::lBtnUp
      ::LButtonUp( nRow, nCol )
      ::lBtnUp = .f.
   endif
   
   
return 0

//----------------------------------------------------------------------------//

METHOD LButtonUp( nRow, nCol )  CLASS TFafiButton

   local oWnd
   local lClick := IsOverWnd( ::hWnd, nRow, nCol )

   if ::bLButtonUp != nil
      Eval( ::bLButtonUp, nRow, nCol)
   endif

   ::lBtnUp  = .t.

   if ! ::lWorking
      if ::lCaptured
         ::lCaptured = .f.
         ReleaseCapture()
         if ! ::lPressed
            if ::lBtnDown
               ::lPressed = .t.
               ::Refresh()
            endif
         else
            if ! ::lBtnDown
               ::lPressed = .f.
               ::Refresh()
            endif
         endif
         
         if lClick
            ::Click()
            ::cPaint := "NORMAL"
            ::Refresh()
         endif
         
      endif
   endif

return 0




METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TFafiButton
   
   if ! ::lMOver
      ::lMOver = .T.
      ::Refresh(.f.)
   endif   
   
   ::oWnd:SetMsg( ::cMsg )
   
   if ::lMover
      if !::lSudah
         ::cPaint := "OVER"
      endif   
      ::lSudah := .t.
   endif
   
   TrackMouseEvent( ::hWnd, TME_LEAVE )
   
return 0

METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TFafiButton
   
   if nMsg == WM_MOUSELEAVE
      return ::MouseLeave( nHiWord( nLParam ), nLoWord( nLParam ), nWParam )
   endif

return Super:HandleEvent( nMsg, nWParam, nLParam )  

//----------------------------------------------------------------------------//

METHOD MouseLeave( nRow, nCol, nFlags ) CLASS TFafiButton
   
   ::cPaint := "NORMAL"
   ::lMOver := .F.
   ::lSudah := .f.
   ::Refresh(.f.)
   
return nil 


METHOD Paint() CLASS TFafiButton
   
      
      if ::cPaint == "NORMAL"
      
      Gradient( ::hDC, { 2, 2, ::nHeight / 2, ::nWidth - 2 },;
              nRGB( 255, 253, 222 ),;
              nRGB( 255, 231, 151 ), .T. ) 
      
      Gradient( ::hDC, { ::nHeight / 2, 2, ::nHeight - 3 , ::nWidth - 2 },;
                nRGB( 255, 231, 151 ),;
              nRGB( 255, 253, 222 ), .T. ) 
      
      NEWALPHABLEND( ::hDC, ::oAlphaImage:hBitmap, ::nTop, ::nLeft, 128 )
      
      
      endif
      
      if ::cPaint == "OVER"
   
           Gradient( ::hDC, { 0, 0, ::nHeight, ::nWidth },;
                nRGB( 255, 253, 222 ),;
                nRGB( 255, 231, 151 ), .T. ) 
                
           NEWALPHABLEND( ::hDC, ::oAlphaImage:hBitmap, ::nTop, ::nLeft, 255 )     
         
      endif
      
                   
      if ::cPaint == "CLICKED"
         
         Gradient( ::hDC, { 2, 2, ::nHeight - 2, ::nWidth - 2 },;
                    nRGB( 255, 215, 84 ) ,;
                   nRGB( 255, 233, 162 ), .T. )                         
                   
         NEWALPHABLEND( ::hDC, ::oAlphaImage:hBitmap, ::nTop, ::nLeft, 0 )               
                   
      endif   
      
      nClr = If( IsWindowEnabled( ::hWnd ), ::nClrText, CLR_HGRAY )
         SetTextColor( ::hDC, nClr )
         nTop = 2 * ( ::nHeight / 3 ) + If( ::lPressed, 1, 0 ) + If( At( CRLF, ::cCaption ) == 0, 5, 0 ) 
         SetBkMode( ::hDC, 1 )
         hOldFont = SelectObject( ::hDC, ::oWnd:oFont:hFont )         
         DrawText( ::hDC, ::cCaption,;
                   { nTop - 5, If( ::lPressed, 1, 0 ), nTop + ::nHeight / 3, ::nWidth + If( ::lPressed, 1, 0 ) },;
                   nOr( DT_VCENTER, DT_CENTER, DT_WORDBREAK ) )
         SelectObject( ::hDC, hOldFont )          
         
   
   
return nil   

METHOD Initiate( hDlg ) CLASS TFafiButton

   local uValue 
   
   ::SetColor( ::nClrtext, ::nClrPane )

   uValue = Super:Initiate( hDlg )   
   
   DEFAULT ::cCaption := GetWindowText( ::hWnd )
   
return uValue

METHOD Click() CLASS TFafiButton

   if ! ::lProcessing
      ::lProcessing = .t.

      if ::bAction != nil
          Eval( ::bAction, Self )
      endif

      Super:Click()         // keep it here, the latest!
      ::lProcessing = .f.
   endif

return nil



//----------------------------------------------------------------------------//


// Alphablend platform independent
// works in all windows versions
// <!-- e --><a href="mailto:Toninho@fwi.com.br">Toninho@fwi.com.br</a><!-- e -->
// Ver 1.05 - Apr 2009

#pragma BEGINDUMP

#include "windows.h"
#include "hbapi.h"

//------------------------------------------------------------------------------------------------------------------//

WORD DibNumColors( void * pv );

HPALETTE CreateDIBPalette( HGLOBAL hDIB );

HANDLE DibFromBitmap( HBITMAP, DWORD, WORD, HPALETTE );

BOOL DibDraw( HDC hDC, HGLOBAL hDib, WORD wCol, WORD wRow, HPALETTE hPalette, WORD wWidth, WORD wHeight, DWORD dwRop );

static WORD PaletteSize( void * pv )
{
    LPBITMAPINFOHEADER lpbi = ( LPBITMAPINFOHEADER ) pv;

    WORD NumColors = DibNumColors( lpbi );

    if( lpbi->biSize == sizeof( BITMAPCOREHEADER ) )
    {
       return ( WORD )( NumColors * sizeof( RGBTRIPLE ) );
    }
    else
    {
       return ( WORD )( NumColors * sizeof( RGBQUAD ) );
    }
}

//------------------------------------------------------------------------------------------------------------------//

void DrawNewAlpha( HDC hDC1, HBITMAP hBitmap1, int iRow, int iCol, int alpha )
{
   HDC hDC2;

   HANDLE hDib1, hDib2;

   unsigned char * uc1;
   unsigned char * uc2;

   unsigned long a1, a2;

   unsigned int i1;

   LPBITMAPINFO lpbmi1, lpbmi2;

   HBITMAP hBitmap2, hBmpOld;

   BITMAP bm;

   hDC2 = CreateCompatibleDC( hDC1 );

   GetObject( ( HGDIOBJ ) hBitmap1, sizeof( BITMAP ), ( LPSTR ) &bm );

   hBitmap2 = CreateCompatibleBitmap( hDC1, bm.bmWidth, bm.bmHeight );

   hBmpOld = ( HBITMAP ) SelectObject( hDC2, hBitmap2 );

   BitBlt( hDC2, 0, 0, bm.bmWidth, bm.bmHeight, hDC1, iCol, iRow, SRCCOPY );

   //---------------------------------------------------------------------------------------------------------------//

   hDib1 = DibFromBitmap( hBitmap1, 0, 32, ( HPALETTE ) 0 );
   hDib2 = DibFromBitmap( hBitmap2, 0, 32, ( HPALETTE ) 0 );

   lpbmi1 = ( LPBITMAPINFO ) GlobalLock( hDib1 );
   lpbmi2 = ( LPBITMAPINFO ) GlobalLock( hDib2 );

   uc1 = ( LPBYTE ) lpbmi1 + ( WORD ) lpbmi1->bmiHeader.biSize + PaletteSize( lpbmi1 );
   uc2 = ( LPBYTE ) lpbmi2 + ( WORD ) lpbmi2->bmiHeader.biSize + PaletteSize( lpbmi2 );

   //---------------------------------------------------------------------------------------------------------------//

   for( i1 = 3; i1 <= lpbmi1->bmiHeader.biSizeImage; i1 += 4 )
   {
        a1 = uc1[ i1 ];

        if( a1 != 0 )
        {
            a1 = alpha * ( ( uc1[ i1 ] * 100 ) / 255 ) / 100;

            a2 = 255 - a1;

            uc2[ i1 - 3 ] = ( uc1[ i1 - 3 ] * a1 ) + ( uc2[ i1 - 3 ] * a2 ) >> 8;
            uc2[ i1 - 2 ] = ( uc1[ i1 - 2 ] * a1 ) + ( uc2[ i1 - 2 ] * a2 ) >> 8;
            uc2[ i1 - 1 ] = ( uc1[ i1 - 1 ] * a1 ) + ( uc2[ i1 - 1 ] * a2 ) >> 8;

        }
   }

   DibDraw( hDC1, hDib2, iCol, iRow, 0, 0, 0, 0 );

   //---------------------------------------------------------------------------------------------------------------//

   GlobalUnlock( hDib1 );
   GlobalUnlock( hDib2 );

   GlobalFree( hDib1 );
   GlobalFree( hDib2 );

   SelectObject( hDC2, hBmpOld );

   DeleteObject( hBitmap2 );

   DeleteDC( hDC2 );
}

//------------------------------------------------------------------------------------------------------------------//

HB_FUNC( NEWALPHABLEND )
{
   DrawNewAlpha( ( HDC )  hb_parnl( 1 ), ( HBITMAP ) hb_parnl( 2 ), hb_parni( 3 ), hb_parni( 4 ), hb_parni( 5 ) );
}

//------------------------------------------------------------------------------------------------------------------//

#pragma ENDDUMP


Regards
Fafi
Posts: 883
Joined: Tue Oct 11, 2005 11:57 AM
Re: Free FafiButton Class with FWH
Posted: Wed Apr 22, 2009 12:46 PM

Thanks for your work...

I'll try it as soon as possible...

Greetings.

From Chile
Adolfo

;-) Ji,ji,ji... buena la cosa... "all you need is code"

http://www.xdata.cl - Desarrollo Inteligente
----------
Asus TUF F15, 32GB Ram, 2 * 1 TB NVME M.2, GTX 1650
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Free FafiButton Class with FWH
Posted: Wed Apr 22, 2009 02:25 PM

Fafi,

> how to create command line with @10,10 FafiButton ect....

Please review FiveWin.ch for many examples :-)

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 169
Joined: Mon Feb 25, 2008 02:42 AM
Re: Free FafiButton Class with FWH
Posted: Thu Apr 23, 2009 03:11 AM
Loach wrote:Mr Fafi, when the program can't find the "world.bmp", it make a GPF error.


Mr. Loach..
Find in FWH bitmap directory.. c:\fwh85\bitmaps\AlphaBmp\world.bmp

Antonio,
I tried with samples on fivewin.ch, always get error

Please someone help me ! to create command fafibutton. Thank's

Regards
Fafi
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: Free FafiButton Class with FWH
Posted: Thu Apr 23, 2009 04:39 AM
Mr.Fafi,

ToolTip not functioning

Code (fw): Select all Collapse
oRect := TFafiButton():New(oDlg, nRow,nCol,nWidth,nHeight,"Hello",{ || .t. }, cCaption, oBmp )
oRect:cToolTip := "Hello"

Regards

Anser
Posts: 41
Joined: Thu Dec 22, 2005 07:39 AM
Re: Free FafiButton Class with FWH
Posted: Thu Apr 23, 2009 06:43 AM
fafi wrote:
Mr. Loach..
Find in FWH bitmap directory.. c:\fwh85\bitmaps\AlphaBmp\world.bmp
Fafi

It's clearly, Mr Fafi, but I mean something like:
Code (fw): Select all Collapse
      if ::oAlphaImage:hBitmap<>0
          NEWALPHABLEND( ::hDC, ::oAlphaImage:hBitmap, ::nTop, ::nLeft, 128 )
      endif

before each call of NEWALPHABLEND. In this case program doesn't make errors, and if bmp file is not found, just don't display it on button.
Best regards!

Sergey (Loach) Abelev

fwh 9.04/xHarbour 1.2.1 (Rev. 6406)/Bcc55

Continue the discussion