'===========================================================================
' Subject: URL CUSTOM CONTROL                 Date: 09-16-99 (17:37)       
'  Author: Dave Navarro, Jr.                  Code: PBDLL                  
'  Origin: dave@powerbasic.com              Packet: PBDLL.ABC
'===========================================================================
'==============================================================================
'
'  URL custom control
'  Copyright (c) 1999 PowerBASIC, Inc.
'  Written by Dave Navarro, Jr. (dave@powerbasic.com)
'
'  Allows you to create a dialog with a PBURL32 control in it.  It displays
'  any text up to a semi-colon and use the specified URL after it to launch
'  a web browser.
'
'==============================================================================

'------------------------------------------------------------------------------
'
' To use this control from your own code, simply $INCLUDE this file after
' WIN32API.INC and call InitUrlCtrl from WinMain or LibMain to initialize
' the custom control and make it available.
'
' Using DDT add the line:
'
' CONTROL ADD "PBURL32", id, "http://www.powerbasic.com", x, y, width, height, %WS_CHILD OR %WS_VISIBLE
'
' Be sure to change "id", "x", "y", "width", and "height" to the correct
' values.  The %WS_CHILD and %WS_VISIBLE styles are required.
'
' When your dialog is displayed, the URL will be in the desired location
' in blue.  When you click on it, it will launch your browser with the
' specified URL.
'

GLOBAL hCurHand  AS LONG
GLOBAL hCurArrow AS LONG

'------------------------------------------------------------------------------
'
' This is the code for the custom control itself.
'
FUNCTION UrlProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG

  STATIC zText    AS ASCIIZ * 128
  STATIC hDC      AS LONG
  STATIC tRect    AS RECT
  STATIC LpPaint  AS PaintStruct
  STATIC x        AS LONG
  STATIC hBrush   AS LONG
  STATIC hFont    AS LONG
  STATIC lf       AS LOGFONT
  STATIC TxtColor AS LONG
  STATIC TxtBack  AS LONG
  STATIC sz       AS SIZEL

  SELECT CASE wMsg

    '** Get the colors and create a brush for the background
    CASE %WM_CREATE
      TxtColor = %BLUE
      TxtBack  = GetSysColor(%COLOR_3DFACE)
      hBrush   = CreateSolidBrush(TxtBack)

    '** Add an underline to the default dialog font
    CASE %WM_SETFONT
      hFont = wParam
      GetObject hFont, SIZEOF(lf), BYVAL VARPTR(lf)
      lf.lfUnderline = 1
      hFont = CreateFontIndirect(lf)
      FUNCTION = 0
      EXIT FUNCTION

    CASE %WM_MOUSEMOVE
      GetWindowText hWnd, zText, 128
      zText = EXTRACT$(zText,";")
      hDC = GetDC(hWnd)
      SelectObject hDC, hFont
      GetTextExtentPoint32 hDC, zText, LEN(zText), sz
      ReleaseDC hWnd, hDC
      IF (LOWRD(lParam) > sz.cx) OR (HIWRD(lParam) > sz.cy) THEN
        SetCursor hCurArrow
      ELSE
        SetCursor hCurHand
      END IF

    '** If the left mouse button is clicked, we're in business
    CASE %WM_LBUTTONDOWN
      GetWindowText hWnd, zText, 128
      x = INSTR(zText, ";")
      zText = MID$(zText, x + 1)
      ShellExecute BYVAL %NULL, "open", zText, BYVAL %NULL, BYVAL %NULL, %SW_SHOWNORMAL
      FUNCTION = 0
      EXIT FUNCTION

    '** Display the URL in the dialog
    CASE %WM_PAINT
      GetWindowText hWnd, zText, 128
      zText = EXTRACT$(zText, ";")
      hDC = BeginPaint(hWnd, LpPaint)
        SelectObject hDC, hFont
        GetClientRect hWnd, tRect
        SetBkMode hDC, %TRANSPARENT
        SetTextColor hDC, TxtColor
        DrawText hDC, zText, -1, tRect, %DT_SINGLELINE
      EndPaint hWnd, LpPaint
      FUNCTION = 0
      EXIT FUNCTION

    '** Draw the background
    CASE %WM_ERASEBKGND
      hDC = wParam
      GetClientRect hWnd, tRect
      FillRect hDC, tRect, hBrush
      FUNCTION = 1
      EXIT FUNCTION

  END SELECT

  '* Default processing for other messages.
  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION

FUNCTION InitUrlCtrl() AS LONG

  LOCAL wc          AS WNDCLASS
  LOCAL szClassName AS ASCIIZ * 10
  LOCAL hLib        AS LONG
  LOCAL z           AS ASCIIZ * 260

  '---Load the cursor
  GetWindowsDirectory z, SIZEOF(z)
  z = z & "\winhlp32.exe"

  hCurArrow = LoadCursor(%NULL, BYVAL %IDC_ARROW)

  hLib = LoadLibrary(z)
  IF hLib THEN
    hCurHand = LoadCursor(hLib, BYVAL 106)
    FreeLibrary hLib
  END IF

  '---If we couldn't get the hand cursor from WINHLP then use an arrow
  IF ISFALSE hCurHand THEN
    hCurHand = hCurArrow
  END IF

  '---Register control window class.
  szClassName      = "PBURL32"
  wc.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_GLOBALCLASS
  wc.lpfnWndProc   = CODEPTR(UrlProc)
  wc.cbClsExtra    = 0
  wc.cbWndExtra    = 0    ' 4 pre allocated bytes at offset %GWL_USERDATA
  wc.hInstance     = GetModuleHandle(BYVAL %NULL)
  wc.hIcon         = %NULL
  wc.hCursor       = %NULL
  wc.hbrBackground = %COLOR_WINDOW + 1
  wc.lpszMenuName  = %NULL
  wc.lpszClassName = VARPTR(szClassName)

  FUNCTION = RegisterClass(wc)

END FUNCTION