Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Gradient Button example

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Gradient Button example

    I could not find one so here it is.

    Code:
    'SED_PBWIN
    
    #COMPILE EXE
    #DIM ALL
    #DEBUG ERROR ON
    #INCLUDE "WIN32API.INC"
    
    
    SUB DrawGradient (BYVAL hDC AS DWORD)
       LOCAL rectFill AS RECT
       LOCAL rectClient AS RECT
       LOCAL fStep AS SINGLE
       LOCAL hBrush AS DWORD
       LOCAL lOnBand AS LONG
    
       GetClientRect WindowFromDC(hDC), rectClient
       fStep = rectClient.nbottom / 200
    
       FOR lOnBand = 0 TO 199
          SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
          hBrush = CreateSolidBrush(RGB((255 - lOnBand), (255 - lOnBand), (255 - lOnBand)))
          Fillrect hDC, rectFill, hBrush
          DeleteObject hBrush
       NEXT
    END SUB
    
    
    ' *********************************************************************************************
    ' Main
    ' *********************************************************************************************
    FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
    
       LOCAL hWndMain AS dword
       LOCAL hCtl AS DWORD
       LOCAL hFont AS DWORD
       LOCAL wcex AS WndClassEx
       LOCAL szClassName AS ASCIIZ * 80
       LOCAL rc AS RECT
       LOCAL szCaption AS asciiz * 255
       LOCAL nLeft AS LONG
       LOCAL nTop AS LONG
       LOCAL nWidth AS LONG
       LOCAL nHeight AS LONG
    
       hFont = GetStockObject(%ANSI_VAR_FONT)
    
       ' Register the window class
       szClassName        = "MyClassName"
       wcex.cbSize        = SIZEOF(wcex)
       wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
       wcex.lpfnWndProc   = CODEPTR(WndProc)
       wcex.cbClsExtra    = 0
       wcex.cbWndExtra    = 0
       wcex.hInstance     = hInstance
       wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
       wcex.hbrBackground = %COLOR_3DFACE + 1
       wcex.lpszMenuName  = %NULL
       wcex.lpszClassName = VARPTR(szClassName)
       wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
       wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
       RegisterClassEx wcex
    
       ' Window caption
       szCaption = "SDK Main Window"
    
       ' Retrieve the size of the working area
       SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(rc), 0
    
       ' Calculate the position and size of the window
       nWidth  = (((rc.nRight - rc.nLeft)) + 2) * 0.25   ' 75% of the client screen width
       nHeight = (((rc.nBottom - rc.nTop)) + 2) * 0.20   ' 70% of the client screen height
       nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
       nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)
    
       ' Create a window using the registered class
       hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                                 szClassName, _                    ' window class name
                                 szCaption, _                      ' window caption
                                 %WS_OVERLAPPEDWINDOW OR _
                                 %WS_CLIPCHILDREN, _               ' window style
                                 nLeft, _                          ' initial x position
                                 nTop, _                           ' initial y position
                                 nWidth, _                         ' initial x size
                                 nHeight, _                        ' initial y size
                                 %NULL, _                          ' parent window handle
                                 0, _                              ' window menu handle
                                 hInstance, _                      ' program instance handle
                                 BYVAL %NULL)                      ' creation parameters
    
       hCtl = CreateWindowEx(0, "BUTTON", "&Ok", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP Or %BS_OWNERDRAW, _
              0, 0, 0, 0, hWndMain, %IDOK, hInstance, BYVAL %NULL)
       IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0
    
    
       ' Show the window
       ShowWindow hWndMain, nCmdShow
       UpdateWindow hWndMain
    
       ' Message handler loop
       LOCAL Msg AS tagMsg
       WHILE GetMessage(Msg, %NULL, 0, 0)
          IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN
             TranslateMessage Msg
             DispatchMessage Msg
          END IF
       WEND
    
       FUNCTION = msg.wParam
    
    END FUNCTION
    ' *********************************************************************************************
    
    ' *********************************************************************************************
    ' Main Window procedure
    ' *********************************************************************************************
    FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
      Local hOldFnt As Dword, szText As Asciiz * 128
      Local dis As DRAWITEMSTRUCT Ptr, hPen As Dword, hBrush As Dword
      LOCAL rc AS RECT
    
       SELECT CASE wMsg
    
    
          Case %WM_DRAWITEM
               dis = lParam
             if @dis.CtlId = %IDOK then               
               rc = @dis.rcItem
               If (@dis.itemState And %ODS_SELECTED) Then
                  DrawGradient(@dis.hDc)
                  DrawEdge @dis.hDc, rc, %EDGE_SUNKEN     , %BF_RECT      
               Else
                  DrawGradient(@dis.hDc)
                  DrawEdge @dis.hDc, rc, %EDGE_RAISED    , %BF_RECT      
               End If
       
               SetBkMode @dis.hDc, %Transparent
               SetTextColor @dis.hDc, rgb(200,255,0)
       
               SendMessage @dis.hWndItem, %WM_GETTEXT, SizeOf(szText), VarPtr(szText)
               DrawText @dis.hDc, szText, Len(szText), rc, %DT_CENTER Or %DT_VCENTER Or %DT_SINGLELINE
               Function = %True
             end if
             
             
             
          CASE %WM_SIZE
             IF wParam <> %SIZE_MINIMIZED THEN
                GetClientRect hWnd, rc
                MoveWindow GetDlgItem(hWNd, %IDOK),  65, 35, 120, 43, %TRUE
             END IF
    
          CASE %WM_COMMAND
             ' -------------------------------------------------------
             ' Messages from controls and menu items are handled here.
             ' -------------------------------------------------------
             SELECT CASE LOWRD(wParam)
    
                CASE %IDOK
                   IF HIWRD(wParam) = %BN_CLICKED THEN
                      SendMessage hWnd, %WM_DESTROY, wParam, lParam
                      FUNCTION = 0
                   END IF
    
    
             END SELECT
    
    
    
          CASE %WM_SYSCOMMAND
             ' Capture this message and send a WM_CLOSE message
             IF (wParam AND &HFFF0) = %SC_CLOSE THEN
                SendMessage hWnd, %WM_CLOSE, wParam, lParam
                EXIT FUNCTION
             END IF
    
    
    
          CASE %WM_DESTROY
             ' ---------------------------------------------------------------------------
             ' Is sent when program ends - a good place to delete any created objects and
             ' store settings in file for next run, etc. Must send PostQuitMessage to end
             ' properly in SDK-style dialogs. The PostQuitMessage function sends a WM_QUIT
             ' message to the program's (thread's) message queue, and then WM_QUIT causes
             ' the GetMessage function to return zero in WINMAIN's message loop.
             ' ---------------------------------------------------------------------------
             PostQuitMessage 0    ' This function closes the main window
             FUNCTION = 0         ' by sending zero to the main message loop
             EXIT FUNCTION
    
       END SELECT
    
       FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
    
    END FUNCTION
    ' *********************************************************************************************
    Steve Miltiadous

  • #2
    DDT copy of Steve Miltiadous gradient button

    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    
    %IDD_DIALOG1  =  101
    %IDC_BUTTON1  = 1001
    '-----------------------------------------------------------
    SUB DrawGradient (BYVAL hDC AS DWORD)
       LOCAL rectFill AS RECT
       LOCAL rectClient AS RECT
       LOCAL fStep AS SINGLE
       LOCAL hBrush AS DWORD
       LOCAL lOnBand AS LONG
    
       GetClientRect WindowFromDC(hDC), rectClient
       fStep = rectClient.nbottom / 200
    
       FOR lOnBand = 0 TO 199
          SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
          hBrush = CreateSolidBrush(RGB((255 - lOnBand), (255 - lOnBand), (255 - lOnBand)))
          Fillrect hDC, rectFill, hBrush
          DeleteObject hBrush
       NEXT
    END SUB
    '--------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
      LOCAL hOldFnt AS DWORD, szText AS ASCIIZ * 128
      LOCAL dis AS DRAWITEMSTRUCT PTR, hPen AS DWORD, hBrush AS DWORD
      LOCAL rc AS RECT
    
        SELECT CASE AS LONG CBMSG
          CASE %WM_INITDIALOG
          CASE %WM_DRAWITEM
              BEEP
               dis = CBLPARAM
             IF @dis.CtlId = %IDC_BUTTON1 THEN
               rc = @dis.rcItem
               IF (@dis.itemState AND %ODS_SELECTED) THEN
                  DrawGradient(@dis.hDc)
                  DrawEdge @dis.hDc, rc, %EDGE_SUNKEN     , %BF_RECT
               ELSE
                  DrawGradient(@dis.hDc)
                  DrawEdge @dis.hDc, rc, %EDGE_RAISED    , %BF_RECT
               END IF
    
               SetBkMode @dis.hDc, %Transparent
               SetTextColor @dis.hDc, &H404040
    
               SendMessage @dis.hWndItem, %WM_GETTEXT, SIZEOF(szText), VARPTR(szText)
               DrawText @dis.hDc, szText, LEN(szText), rc, %DT_CENTER OR %DT_VCENTER OR %DT_SINGLELINE
               FUNCTION = %True
             END IF
    
          CASE %WM_SIZE
             IF CBWPARAM <> %SIZE_MINIMIZED THEN
                GetClientRect CBHNDL, rc
                MoveWindow GetDlgItem(CBHNDL, %IDC_BUTTON1),  0, 0, rc.nright, rc.nbottom, %TRUE
             END IF
    
          CASE %WM_COMMAND
             SELECT CASE LOWRD(CBWPARAM)
                CASE %IDC_BUTTON1
                     BEEP
             END SELECT
       END SELECT
    END FUNCTION
    '------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
        LOCAL hDlg  AS DWORD
    
        DIALOG NEW hParent, "DDT GradBn", 65, 35, 120, 43, %ws_sysmenu, TO hDlg
        CONTROL ADD BUTTON,  hdlg, %IDC_BUTTON1, "Button1", _
                        0, 0, 120, 43, _
                        %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_OWNERDRAW
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
        FUNCTION = lRslt
    END FUNCTION
    '======================================================================
    FUNCTION PBMAIN()
        ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION

    Comment


    • #3
      Small text offset effect enhancement... (replace code block)

      Code:
      CASE %WM_DRAWITEM
                 dis = lParam
               IF @dis.CtlId = %IDOK THEN
                 rc = @dis.rcItem
                 IF (@dis.itemState AND %ODS_SELECTED) THEN
                    DrawGradient(@dis.hDc)
                    DrawEdge @dis.hDc, rc, %EDGE_SUNKEN     , %BF_RECT
                    '--offset text for better effects when depressed...
                    rc.nRight  = rc.nRight -4
                    rc.nbottom = rc.nBottom-4
                 ELSE
                    DrawGradient(@dis.hDc)
                    DrawEdge @dis.hDc, rc, %EDGE_RAISED    , %BF_RECT
                 END IF
                    '--Draw Text, grab text from button name...
                    oldBkMode = SetBkMode(@dis.hDc, %Transparent)
                    oldTxtClr = SetTextColor( @dis.hDc, RGB(200,255,0))
                    SendMessage @dis.hWndItem, %WM_GETTEXT, SIZEOF(szText), VARPTR(szText)
                    DrawText @dis.hDc, szText, LEN(szText), rc, %DT_CENTER OR %DT_VCENTER OR %DT_SINGLELINE
                    SetBkMode @dis.hDc, oldBkMode
                    SetTextColor @dis.hDc,oldTxtClr
                 FUNCTION = %True
               END IF
      Also, see "Ownerdraw button tip" that you can apply to Steve's excellent demo...
      http://www.powerbasic.com/support/fo...ML/000841.html
      Best regards
      Jules
      www.rpmarchildon.com

      Comment


      • #4
        add color

        ...add color coding:

        Code:
        '-----------------------------------------------------------
        SUB DrawGradient (BYVAL hDC AS DWORD, red AS LONG, green AS LONG, blue AS LONG)
           LOCAL rectFill AS RECT
           LOCAL rectClient AS RECT
           LOCAL fStep AS SINGLE
           LOCAL hBrush AS DWORD
           LOCAL lOnBand AS LONG
        
           GetClientRect WindowFromDC(hDC), rectClient
           fStep = rectClient.nbottom / 200
        
           FOR lOnBand = 0 TO 199
              SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
              hBrush = CreateSolidBrush(RGB((red - lOnBand), (green - lOnBand), (blue- lOnBand)))
              Fillrect hDC, rectFill, hBrush
              DeleteObject hBrush
           NEXT
        END SUB
        and change WM_DRAWITEM handler to call it (works with DDT eg above)

        Code:
              CASE %WM_DRAWITEM
                   dis = CBLPARAM
                 IF @dis.CtlId = %IDC_BUTTON1 THEN
                   rc = @dis.rcItem
                   IF (@dis.itemState AND %ODS_SELECTED) THEN
                      DrawGradient(@dis.hDc, &HFF, &H50, &HA0)
                      DrawEdge @dis.hDc, rc, %EDGE_SUNKEN     , %BF_RECT
                      '--offset text for better effects when depressed...
                      rc.nRight  = rc.nRight -4
                      rc.nbottom = rc.nBottom-4
                   ELSE
                      DrawGradient(@dis.hDc, &HFF, &HFF, &HFF)
                      DrawEdge @dis.hDc, rc, %EDGE_RAISED    , %BF_RECT
                   END IF
                      '--Draw Text, grab text from button name...
                      oldBkMode = SetBkMode(@dis.hDc, %Transparent)
                      oldTxtClr = SetTextColor( @dis.hDc, RGB(200,255,0))
                      SendMessage @dis.hWndItem, %WM_GETTEXT, SIZEOF(szText), VARPTR(szText)
                      DrawText @dis.hDc, szText, LEN(szText), rc, %DT_CENTER OR %DT_VCENTER OR %DT_SINGLELINE
                      SetBkMode @dis.hDc, oldBkMode
                      SetTextColor @dis.hDc,oldTxtClr
                   FUNCTION = %True
                 END IF

        Comment

        Working...
        X