Picture Control Revisited

[Brooks_Van_Horn]

I read the previous thread and it was closed so I'm restarting it. I deliberately chose not to use ColorPicker cpommon dialog because rarely does the color I've picked look good on the full screen. So I created a small 'color picker' where I have a few radio buttons that I've selected and a fairly large picture object. Thinking that I would have a bigger area to see a color. Here is the basis of my code:

      myRect%left = 104
      myRect%top = 12
      myRect%bottom = 96
      myRect%right = 78
      bret = MapDialogRect(hWnd, myRect)
      hDC = GetDC(hWnd)
      if (hDC == NULL) Then
         bret = DeleteObject(myBrush)
         Return
      End If
      iret = FillRect(hDC, myRect, myBrush)    ! this should fill the picture control

where myBrush is created using the RGB values from the dialog radiobutton. I've included the full subroutine and callback as an attachment and a pdf of the dialog. Nothing really happens in the color dialog and I want to understand what I've done wrong to not get a color in the rectangular picture control.

Thanks,

Brooks

[IanH · Accepted solution]

If I understand what you have done sufficiently, the "picture control" has its own painting code, that will be called whenever the picture control receives WM_PAINT.  That painting code will simply obliterate any drawing that you may have done in your dialog procedure. 

Typically you would create your own custom "colour swatch" control (assuming there isn't already something that can do a similar job) - it doesn't have to be very complicated - just something that has some way of being told a current colour and then responds to WM_PAINT by filling its window with that colour; or you would subclass/reconfigure an existing control and modify it to do the job (perhaps you could use a static control and respond in the dialog to the WM_CTLCOLORSTATIC message); or you would customise the dialog template for the existing colour picker dialog to give it a bigger colour swatch area (you would have the same controls, just laid out differently).

(Looking at the type of control that the existing colour picker dialog uses for the colour swatches may be useful.)

[Brooks_Van_Horn]

Thanks, didn'y think of that. It seems trivky but I think I can pull it off.

Brooks

[Paul_Curtis]

! Performs drawing of a color swatch. A color swatch is implemented
! as an owner-drawn button, and this subroutine is called in response
! to a WM_DRAWITEM message. The argument is the lParam of WM_DRAWITEM,
! which points to a DRAWITEMSTRUCT object.
SUBROUTINE DrawColorSwatch (dis, color)
    IMPLICIT NONE
    INTEGER, INTENT(IN)            :: color
	INTEGER						   :: rval
    TYPE(T_RECT)                   :: clientRect
    
    TYPE(T_DRAWITEMSTRUCT),INTENT(INOUT)  :: dis

    rval = GetClientRect (dis%hwndItem, clientRect)
	CALL fill_rectangle (dis%hDc, color, clientRect)
	
END SUBROUTINE DrawColorSwatch

[Brooks_Van_Horn]

Paul,

Is this routine part of the dlg proc or part of winmainproc?

Brooks

[Paul_Curtis]

Here is the relevent code from the proc for the dialog (not the main Winproc).  Interestingly, IVF does not allow passing lParam directly as an argument with the pointer assigned in the subroutine.  The "color" value is an integer which has modular scope (so not defined here).

INTEGER FUNCTION BkgndDialogProc(hwnd, msg, wParam, lParam) RESULT(res)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_BkgndDialogProc@16' :: BkgndDialogProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'BkgndDialogProc' :: BkgndDialogProc
!DEC$ ENDIF
    IMPLICIT NONE

    INTEGER(HANDLE),  INTENT(IN)   :: hwnd
    INTEGER(UINT),    INTENT(IN)   :: msg
    INTEGER(fWPARAM), INTENT(IN)   :: wParam
    INTEGER(fLPARAM), INTENT(IN)   :: lParam

    INTEGER                        :: rval
    INTEGER(HANDLE)                :: hwndControl
    INTEGER                        :: controlId
    INTEGER                        :: code

    TYPE(T_DRAWITEMSTRUCT)         :: dis
    POINTER(lParam, dis)

    res = DefaultDialogProc(hwnd, msg, wParam, lParam)

    SELECT CASE (msg)

    ! ... many other CASEs 
    
    CASE (WM_DRAWITEM)
        controlId = wParam
        IF (controlId == IDC_BACKGROUND_COLOR) THEN
            CALL DrawColorSwatch (dis, color)
            res = 1
        END IF

    END SELECT
    
END FUNCTION BkgndDialogProc

[Steven_L_Intel1]

Paul, would you please elaborate on your comment regarding passing lparam? I didn't understand it.

[Paul_Curtis]

Steve,

DrawColorSwatch() is realized as a (tiny) subroutine because the overall program uses this in multiple places.  My initial code for DrawColorSwatch() received lParam as an (integer, intent:in) argument, exactly as received from Windows, and made the POINTER(lParam, dis) association in the subroutine, but IVF objected to that, whereas the method shown in my post, passing the WinAPI type associated in the calling routine, works fine.  Don't know why, seemed a bit strange, but I stopped worrying when I got it to work.

Regards,

Paul

[Steven_L_Intel1]

Ah - the integer (Cray) pointer statement.  A pointer can be a dummy argument - I just tried that. The pointee cannot be a dummy argument. Can you show me a small source that exhibits the problem?

[Paul_Curtis]

Steve,

The commented code lines show how this routine was originally coded, where lParam becomes the locDIS argument; did not work.

! Performs drawing of a color swatch. A color swatch is implemented
! as an owner-drawn button, and this subroutine is called in response
! to a WM_DRAWITEM message. The argument is the lParam of WM_DRAWITEM,
! which points to a DRAWITEMSTRUCT object.
!SUBROUTINE DrawColorSwatch (locDIS, color)
SUBROUTINE DrawColorSwatch (dis, color)
    IMPLICIT NONE
    !INTEGER(fLPARAM), INTENT(IN)   :: locDIS
    INTEGER, INTENT(IN)            :: color
	INTEGER						   :: rval
    TYPE(T_RECT)                   :: clientRect
    
    TYPE(T_DRAWITEMSTRUCT),INTENT(INOUT)  :: dis
    !POINTER(locDIS, dis)
    
    !   dummy assignment to fool the compiler's unused-variables checker
    !rval = locDIS

    rval = GetClientRect (dis%hwndItem, clientRect)
	CALL fill_rectangle (dis%hDc, color, clientRect)
	
END SUBROUTINE DrawColorSwatch

[Steven_L_Intel1]

The commented out code compiles for me. What went wrong? I wonder if you had an extra (or missing) level of indirection when you passed lparam. Windows passes it in by value - you might have supplied it as the address of a data structure (seems like it here). If you didn't accept it by value but then just passed what you got by reference you'd have an extra indirection.

[Paul_Curtis]

Yes, you're probably correct as to the extra level of indirection.  My code always compiles ;), but does not always run as expected; in this case it crashed since Windows did not find a DIS at (address) locDIS.  At any rate, I found an easy solution and moved on.