Module CT1 use PearsonGlobals use IFWINTY Integer(4),Parameter,Public:: Red(5) = (/ 255, 248, 255, 224, 125 /) Integer(4),Parameter,Public:: Grn(5) = (/ 255, 248, 248, 255, 255 /) Integer(4),Parameter,Public:: Blu(5) = (/ 255, 220, 255, 255, 125 /) Integer(4),Parameter,Public:: IDC(5) = (/ IDC_COLOR1, IDC_COLOR2, IDC_COLOR3, & IDC_COLOR4, IDC_COLOR5 /) type (T_RECT),Save,public:: myRect Integer(HANDLE),Save,public:: hDC Integer(HANDLE),Save,public:: hWnd Integer(HANDLE),Save,public:: myBrush Integer(4),Save,public:: ndx, r, g, b, srgb End Module CT1 !=====================================================================>>> Subroutine DoColor() ! Copyright (c) (2016) ! 3/13/2016 5:30:45 PM use ifwin use iflogm use user32 use gdi32 use kernel32 use ifqwin Use PearsonGlobals Use CT1 Implicit None Integer(4):: i, j, id integer(DWORD):: ret, iret Logical:: lret character(100):: myBuffer integer(BOOL):: bret Type (dialog):: mDlg External DoMyColor lret = DlgInit(IDD_BKCOLOR, mDlg) If (lret == .FALSE.) Then ! ret = MessageBox(0, "DlgInit failed to launch IDD_BKCOLOR"C, MB_OK) return End If bret = CheckRadioButton(mDlg%HWND, IDC_COLOR1, IDC_COLOR5, IDC_COLOR1) lret = DlgSetSub (mDlg, IDC_COLOR1, DoMyColor) lret = DlgSetSub (mDlg, IDC_COLOR2, DoMyColor) lret = DlgSetSub (mDlg, IDC_COLOR3, DoMyColor) lret = DlgSetSub (mDlg, IDC_COLOR4, DoMyColor) lret = DlgSetSub (mDlg, IDC_COLOR5, DoMyColor) lret = DlgSetSub (mDlg, IDC_OK2, DoMyColor) lret = DlgSetSub (mDlg, IDC_NOTOK, DoMyColor) r = Red(5) g = Grn(5) b = Blu(5) srgb = Ior(Ior(Ishft(r,32), Ishft(g,16)),b) myBrush = CreateSolidBrush(srgb) hWnd = GetDlgItem(mDlg%HWND, IDC_PICTURE) ! may need to add to right and bottom 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 bret = DeleteObject(ghBrushWhite) ghBrushWhite = myBrush iret = DlgModal(mDlg) Call DlgUnInit(mDlg) Return End Subroutine DoColor !=====================================================================>>> Subroutine DoMyColor (dlg, control_name, callback_type) ! Copyright (c) (2016) ! 3/13/2016 5:30:45 PM use ifwin use user32 use gdi32 use kernel32 use zData use PearsonGlobals Use CT1 Implicit None TYPE (dialog), intent(in):: dlg INTEGER,Intent(IN):: control_name INTEGER,Intent(in):: callback_type integer(UINT):: uStatus Integer(HANDLE):: hwDlg Integer(BOOL):: bret hwDlg = Dlg%HWND hWnd = hwDlg Select Case (control_name) !============================================================================= Case (IDC_COLOR1) !============================================================================= uStatus = IsDlgButtonChecked(hwDlg, IDC_COLOR1) if (uStatus == BST_CHECKED) Then r = Red(1) g = Grn(1) b = Blu(1) srgb = Ior(Ior(Ishft(r,32), Ishft(g,16)),b) myBrush = CreateSolidBrush(srgb) ndx = 1 bret = InvalidateRect(hWnd, myRect, TRUE) bret = FillRect(hDC, myRect, myBrush) bret = UpdateWindow(hWnd) End If Return !============================================================================= Case (IDC_COLOR2) !============================================================================= uStatus = IsDlgButtonChecked(hwDlg, IDC_COLOR2) if (uStatus == BST_CHECKED) Then r = Red(2) g = Grn(2) b = Blu(2) srgb = Ior(Ior(Ishft(r,32), Ishft(g,16)),b) myBrush = CreateSolidBrush(srgb) ndx = 2 bret = InvalidateRect(hWnd, myRect, TRUE) bret = FillRect(hDC, myRect, myBrush) bret = UpdateWindow(hWnd) End If Return !============================================================================= Case (IDC_COLOR3) !============================================================================= uStatus = IsDlgButtonChecked(hwDlg, IDC_COLOR3) if (uStatus == BST_CHECKED) Then r = Red(3) g = Grn(3) b = Blu(3) srgb = Ior(Ior(Ishft(r,32), Ishft(g,16)),b) myBrush = CreateSolidBrush(srgb) ndx = 3 bret = InvalidateRect(hWnd, myRect, TRUE) bret = FillRect(hDC, myRect, myBrush) bret = UpdateWindow(hWnd) End If Return !============================================================================= Case (IDC_COLOR4) !============================================================================= uStatus = IsDlgButtonChecked(hwDlg, IDC_COLOR4) if (uStatus == BST_CHECKED) Then r = Red(4) g = Grn(4) b = Blu(4) srgb = Ior(Ior(Ishft(r,32), Ishft(g,16)),b) myBrush = CreateSolidBrush(srgb) ndx = 4 bret = InvalidateRect(hWnd, myRect, TRUE) bret = FillRect(hDC, myRect, myBrush) bret = UpdateWindow(hWnd) End If Return !============================================================================= Case (IDC_COLOR5) !============================================================================= uStatus = IsDlgButtonChecked(hwDlg, IDC_COLOR5) if (uStatus == BST_CHECKED) Then r = Red(5) g = Grn(5) b = Blu(5) srgb = Ior(Ior(Ishft(r,32), Ishft(g,16)),b) myBrush = CreateSolidBrush(srgb) ndx = 5 bret = InvalidateRect(hWnd, myRect, TRUE) bret = FillRect(hDC, myRect, myBrush) bret = UpdateWindow(hWnd) End If Return !============================================================================= Case (IDC_OK2) !============================================================================= bret = DeleteObject(ghBrushWhite) ghBrushWhite = myBrush bret = DeleteDC(hDC) hDC = GetDC(ghWndMain) if (hDC == NULL) Then Return End If bret = InvalidateRect(ghWndMain, Rectf, TRUE) bret = FillRect(hDC, Rectf, myBrush) bret = UpdateWindow(ghWndMain) bret = DeleteObject(ghBrushWhite) ghBrushWhite = myBrush bret = DeleteDC(hDC) ! ret = SendMessage( hwDlg, IDCANCEL, 0_UINT_PTR, 0_LONG_PTR ) bret = EndDialog(hwDlg, TRUE) ! Exit the dialog return !============================================================================= Case (IDC_NOTOK) ! This is really cancel !============================================================================= bret = DeleteObject(myBrush) bret = DeleteDC(hDC) ! ret = SendMessage( hwDlg, IDCANCEL, 0_UINT_PTR, 0_LONG_PTR ) bret = EndDialog(hwDlg, TRUE) ! Exit the dialog return end select Return End Subroutine DoMyColor