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

Unicode popup help

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

  • PBWin Unicode popup help

    The following is an update to some 19 year old code I wrote to handle problems with missing hhctrl.ocx in Win95. Now the problem is that hhctrl.ocx seems to have problem with unicode characters, so time to update it again. Will be interesting to see what will needed to update 20 years from now..
    Click image for larger version

Name:	PopuHelp.jpg
Views:	56
Size:	10.6 KB
ID:	800993
    '
    Code:
    '====================================================================
    ' There has been some samples posted on how to use hhctrl.ocx for
    ' context sensitive popup help, but unfortunately, that also means
    ' using a control that wasn't available in Win95 (plus it's MS bloat..)
    '
    ' Following is similar popup help, by code. It pops up a transparent
    ' dialog, draws info "label" + shadow and looks pretty much the same.
    ' Advantage is, you won't have to answer support questions on why your
    ' popup help doesn't work in your user's Win95 systems.. (and definitely
    ' leaner on memory than MS's 380KB ocx, that gives same result.. :)
    '
    ' For use in your own code, copy/paste HelpPopup and HelpPopupProc.
    ' Those two procedure could also be placed in their own include file
    ' for easy access in any code.
    ' See DlgProc - %WM_HELP for how to use.
    '
    ' Public Domain by Borje Hagsten, September 2001.
    ' Updated to handle unicode characters, 15 Oct, 2020
    
    '====================================================================
    ' Declares
    '--------------------------------------------------------------------
    #COMPILE EXE
    #DIM ALL
    '--------------------------------------------------------------------
    '%UNICODE = 1  ' even works without %UNICODE being defined..
    #INCLUDE "WIN32API.INC"
    #INCLUDE "RICHEDIT.INC"
    '--------------------------------------------------------------------
    %ID_RICHEDIT = 40
    %ID_CB1    = %WM_USER + 200
    %ID_CTXHLP = %WM_USER + 210
     
    '====================================================================
    ' Main entrance - create dialog and controls, etc
    '--------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
      LOCAL hDlg AS LONG
     
      DIALOG NEW 0, "Popup help demo",,, 147, 50, _
                 %WS_CAPTION OR %WS_SYSMENU OR %DS_CONTEXTHELP, 0 TO hDlg
     
      CONTROL ADD BUTTON,  hDlg, %IDOK,     "&Ok",      4,  4,  70, 14
      CONTROL ADD BUTTON,  hDlg, %IDCANCEL, "&Cancel", 74,  4,  70, 14
      CONTROL ADD COMBOBOX, hDlg, %ID_CB1, , 4, 22, 140, 100, %CBS_DROPDOWNLIST
      CONTROL ADD LABEL, hDlg, 333, "Click on question mark..", 4, 38, 140, 12, %SS_CENTER
     
      DIALOG SHOW MODAL hDlg CALL DlgProc
    END FUNCTION
     
    '====================================================================
    ' Main callback
    '--------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc() AS LONG
      SELECT CASE CB.MSG
      CASE %WM_COMMAND
          SELECT CASE LOWRD(CB.WPARAM)
          CASE %IDOK
              IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN BEEP
    
          CASE %IDCANCEL
              IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN DIALOG END CBHNDL
          END SELECT
    
      CASE %WM_HELP ' WM_HELP handles question mark click + following click on a control.
         LOCAL lphi AS HELPINFO POINTER
         lphi = CB.LPARAM
          SELECT CASE @lphi.iCtrlId  'Send these on to HelpPopup sub.
          CASE %IDOK     : HelpPopup CB.HNDL, "Press Ok to beep.. " + $CRLF + _
                                     "Unicode: " + CHR$$(256, 257, 258, 259, 260)  ' <- try unicode charactes
          CASE %IDCANCEL : HelpPopup CB.HNDL, "Press Cancel to close dialog. " + $CRLF + _
                                     "Unicode: " + CHR$$(261, 262, 263, 264, 265)
          CASE %ID_CB1   : HelpPopup CB.HNDL, "ComboBox, listing everything I know about MS Windows.. " + $CRLF + _
                                     "Unicode: " + CHR$$(266, 267, 268, 269, 270)
          END SELECT
    
      END SELECT
    END FUNCTION
     
    
    '====================================================================
    ' Show help popup dialog. Note - dialog will be bigger than text-part,
    ' because we want to draw bottom/right "shadow" for nice 3-D effect.
    '--------------------------------------------------------------------
    SUB HelpPopup(BYVAL hParent AS LONG, wsTxt AS WSTRING)
      LOCAL hDlg AS DWORD
    
      DIALOG NEW hParent, "",,, 107, 28, %WS_POPUP TO hDlg
    
      LoadLibrary("msftedit.dll")
      CONTROL ADD "RichEdit50W", hDlg, %ID_RICHEDIT, wsTxt, 1, 1, 104, 25, %WS_CHILD OR %ES_MULTILINE
      CONTROL SEND hDlg, %ID_RICHEDIT, %EM_SETEVENTMASK, 0, %ENM_REQUESTRESIZE
      CONTROL SEND hDlg, %ID_RICHEDIT, %EM_SETBKGNDCOLOR, 0, GetSysColor(%COLOR_INFOBK)
     
      DIALOG SHOW MODAL hDlg CALL HelpPopupProc
     
    END SUB
     
    '====================================================================
    ' Help popup's callback procedure. Here info text + shadow is drawn, etc.
    '--------------------------------------------------------------------
    CALLBACK FUNCTION HelpPopupProc
      LOCAL I, J AS LONG, rc AS RECT, ps AS PAINTSTRUCT, _
            pt AS POINTAPI, fr AS FORMATRANGE, rq AS REQRESIZE PTR
    
      SELECT CASE CBMSG
      CASE %WM_INITDIALOG
          CONTROL POST CB.HNDL, %ID_RICHEDIT, %EM_REQUESTRESIZE, 0, 0
          SetCapture CB.HNDL  ' While it is visible..
    
      CASE %WM_NOTIFY  ' Get the notification - @rq.rc. will contain what we need
         rq = CB.LPARAM
         IF @rq.hdr.code = %EN_REQUESTRESIZE THEN  ' resize dialog to text
             GetCursorPos pt
             @rq.rc.nRight  = @rq.rc.nRight - @rq.rc.nLeft + 20 ' width + shadow area
             @rq.rc.nBottom = @rq.rc.nBottom - @rq.rc.nTop + 18 ' height + shadow area
    
             MoveWindow GetDlgItem(CBHNDL, %ID_RICHEDIT), 0, 0, _
                          @rq.rc.nRight, @rq.rc.nBottom, 1
    
             SetWindowPos CBHNDL, 0, pt.x - @rq.rc.nRight / 2, pt.y + 10, _
                                     @rq.rc.nRight, @rq.rc.nBottom, %SWP_NOZORDER
         END IF
    
      CASE %WM_ERASEBKGND : FUNCTION = 1 ' Make dialog transparent
     
      CASE %WM_PAINT
          BeginPaint CB.HNDL, ps
            GetClientRect CB.HNDL, rc  'get size
    
            'DRAW BOTTOM SHADOW
            FOR I = rc.nBottom - 7 TO rc.nBottom
               IF I MOD 2 = 0 THEN
                  FOR J = 7 TO rc.nRight STEP 2
                     SetPixelV ps.hDC, J, I, GetSysColor(%COLOR_3DDKSHADOW)
                  NEXT
               ELSE
                  FOR J = 6 TO rc.nRight STEP 2
                     SetPixelV ps.hDC, J, I, GetSysColor(%COLOR_3DDKSHADOW)
                  NEXT
               END IF
            NEXT
     
            'DRAW RIGHT SHADOW
            FOR I = 6 TO rc.nBottom - 8
               IF I MOD 2 THEN
                  FOR J = rc.nRight - 7 TO rc.nRight STEP 2
                     SetPixelV ps.hDC, J, I, GetSysColor(%COLOR_3DDKSHADOW)
                  NEXT
               ELSE
                  FOR J = rc.nRight - 6 TO rc.nRight STEP 2
                     SetPixelV ps.hDC, J, I, GetSysColor(%COLOR_3DDKSHADOW)
                  NEXT
               END IF
            NEXT
    
            ' DRAW BACKGROUND AND FRAME
            rc.nRight  = rc.nRight - 6
            rc.nBottom = rc.nBottom - 6
            FillRect ps.hDC, rc, GetSysColorBrush(%COLOR_INFOBK)
            FrameRect ps.hDC, rc, GetSysColorBrush(%COLOR_INFOTEXT)
    
            ' FORMAT TEXT
            fr.hdc = ps.hDC
            fr.hdcTarget = ps.hDC
            fr.chrg.cpMin = 0
            fr.chrg.cpMax = -1
            fr.rc.nLeft   = MulDiv(10, 1440, GetDeviceCaps(ps.hDC, %LOGPIXELSX)) '10 pixel left/right margins
            fr.rc.nRight  = MulDiv(rc.nRight - 10, 1440, GetDeviceCaps(ps.hDC, %LOGPIXELSX))
            fr.rc.nTop    = MulDiv(6, 1440, GetDeviceCaps(ps.hDC, %LOGPIXELSY))  '6 pixel top margin
            fr.rc.nBottom = MulDiv(rc.nBottom, 1440, GetDeviceCaps(ps.hDC, %LOGPIXELSY)) 'bottom don't need margin
            fr.rcPage = fr.rc
            CONTROL SEND CB.HNDL, %ID_RICHEDIT, %EM_FORMATRANGE, 1, VARPTR(fr) ' this "draws" text..
            CONTROL SEND CB.HNDL, %ID_RICHEDIT, %EM_FORMATRANGE, 0, 0          ' clear catched info
         EndPaint CB.HNDL, ps
    
      ' CLOSE POPUP HELP
      ' Are these enough? Think so - at least dialog seems to close on all events.
      CASE %WM_KEYDOWN, %WM_KEYUP, %WM_CHAR, %WM_SYSKEYDOWN, %WM_SYSKEYUP, %WM_HOTKEY, _
           %WM_LBUTTONDOWN, %WM_RBUTTONDOWN, %WM_MBUTTONDOWN
          ReleaseCapture
          DIALOG END CB.HNDL
     
      END SELECT
    END FUNCTION
    '
Working...
X