! ***************************************************************************
!*
!*    FUNCTION: ChooseColorHookProc(HWND, UINT, UINT, LONG)
!*
!*    PURPOSE:  Processes messages for ChooseColor common dialog box
!*
!*    COMMENTS:
!*
!*        This hook procedure simply prompts the user whether or not they
!*        want to change the color.  if they choose YES, the color of the
!*        text will be changed and the dialog will be dismissed.  If they
!*        choose NO, the color will not be changed and the user will be
!*        returned to the dialog
!*
!*    RETURN VALUES:
!*        TRUE - User chose 'Yes' from the "Are you sure message box".
!*        FALSE - User chose 'No' return to the dialog box.
!*
!***************************************************************************

integer*4 function ChooseColorHookProc(hDlg,message,wParam,lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS :'_ChooseColorHookProc@16' :: ChooseColorHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS :'ChooseColorHookProc' :: ChooseColorHookProc
!DEC$ ENDIF
use cmndlgin

interface
integer*4 function MainWndProc( hWnd, message, wParam, lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16':: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF
integer  hWnd , message , wParam, lParam
end function
end interface

interface
integer function About(hDlg, message, wParam, lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_About@16':: About
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'About' :: About
!DEC$ ENDIF
integer  hDlg, message, wParam, lParam
end function
end interface

interface
integer function EnterNew(hDlg, message, wParam, lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_EnterNew@16':: EnterNew
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'EnterNew' :: EnterNew
!DEC$ ENDIF
integer hDlg , message  , wParam  , lParam
end function
end interface

interface
integer function FileOpenHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_FileOpenHookProc@16':: FileOpenHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'FileOpenHookProc' :: FileOpenHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function FileSaveHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_FileSaveHookProc@16':: FileSaveHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'FileSaveHookProc' :: FileSaveHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function ChooseFontHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ChooseFontHookProc@16':: ChooseFontHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'ChooseFontHookProc' :: ChooseFontHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function FindTextHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_FindTextHookProc@16':: FindTextHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'FindTextHookProc' :: FindTextHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function ReplaceTextHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ReplaceTextHookProc@16':: ReplaceTextHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'ReplaceTextHookProc' :: ReplaceTextHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function PrintDlgHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_PrintDlgHookProc@16':: PrintDlgHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'PrintDlgHookProc' :: PrintDlgHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function PrintSetupHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_PrintSetupHookProc@16':: PrintSetupHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'PrintSetupHookProc' :: PrintSetupHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface

interface
integer function InitApplication( hInstance )
integer hInstance
end function
end interface

interface
integer function InitInstance(hInstance, nCmdShow)
integer hInstance, nCmdShow
end function
end interface

interface
integer function OpenNewFile( hWnd )
integer hWnd
end function
end interface

interface
integer function SaveToFile( hWnd )
integer hWnd
end function
end interface

interface
integer function SaveAs( hWnd )
integer hWnd
end function
end interface

interface
subroutine SearchFile( LPFINDREPLACE )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_SearchFile@4' :: SearchFile
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'SearchFile' :: SearchFile
!DEC$ ENDIF
integer*4 LPFINDREPLACE
end subroutine
end interface

interface
integer function ChooseNewFont( hWnd )
integer*4 hWnd
end function
end interface

interface
integer function ChooseNewColor( hWnd )
integer*4 hWnd
end function
end interface

interface
subroutine PrintFile( hWnd )
integer hWnd
end subroutine
end interface

interface
subroutine CallFindText( hWnd )
integer hWnd
end subroutine
end interface

interface
subroutine CallReplaceText( hWnd )
integer hWnd
end subroutine
end interface

interface
subroutine ProcessCDError(dwErrorCode, hWnd)
integer dwErrorCode, hWnd
end subroutine
end interface


integer hDlg    !  window handle of the dialog box
integer message  !   type of message
integer wParam   !  message-specific information
integer lParam
character*100     lpszMessage, lpszHeader

lparam = lparam

   select case (message)
      case (WM_COMMAND)
         if (LOWORD(wParam) == IDOK) then
            lpszMessage = "Are you sure you want to change the color?"C
            lpszHeader = "Information"C
            if (MessageBox( hDlg, &
               lpszMessage,&
               lpszHeader, MB_YESNO ) == IDYES ) then
            end if
         ChooseColorHookProc =TRUE
         return
      end if
   end select
   ChooseColorHookProc =FALSE
end


! ***************************************************************************
!*
!*    FUNCTION: ChooseNewColor(HWND)
!*
!*    PURPOSE:  Invokes common dialog function to chose a new color.
!*
!*    COMMENTS:
!*        This function initializes the CHOOSECOLOR structure for any
!*        mode the user chooses: standard, using a hook or using a
!*        customized template.  It then calls the ChooseColor()
!*        common dialog function.
!*
!*    RETURN VALUES:
!*        TRUE - A new color was chosen.
!*        FALSE - No new color was chosen.
!*
!***************************************************************************
integer*4 function ChooseNewColor( hWnd )
use cmndlgin

integer hWnd

interface
integer function ChooseColorHookProc( hDlg, message, wParam,  lParam)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ChooseColorHookProc@16':: ChooseColorHookProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'ChooseColorHookProc' :: ChooseColorHookProc
!DEC$ ENDIF
integer hDlg, message, wParam, lParam
end function
end interface


integer dwColor
integer dwCustClrs(16)
integer fSetColor
integer i

   fSetColor =FALSE


   do i = 1, 15
!      dwCustClrs(i) = RGB( INT1(255), INT1(255), INT1(255))
      dwCustClrs(i) = RGB( INT1(-1), INT1(-1), INT1(-1))
   end do
   dwColor = RGB( INT1(0), INT1(0), INT1(0) )
   chsclr%lStructSize = 36
   chsclr%hwndOwner = hWnd
   chsclr%hInstance = hInst
   chsclr%rgbResult = dwColor
   chsclr%lpCustColors = LOC(dwCustClrs)
   chsclr%lCustData = 0

   select case( wMode )
      case (IDM_HOOK, IDM_CUSTOM)
         chsclr%Flags = IOR(CC_PREVENTFULLOPEN , CC_ENABLEHOOK)
         chsclr%lpfnHook = LOC(ChooseColorHookProc)
         chsclr%lpTemplateName = NULL

      case (IDM_STANDARD)
         chsclr%Flags = CC_PREVENTFULLOPEN
         chsclr%lpfnHook = NULL
         chsclr%lpTemplateName = NULL
   end select

   fSetColor = ChooseColor( chsclr )
   if ( fSetColor .ne. 0) then
      crColor = chsclr%rgbResult
      ChooseNewColor=.TRUE.
   else
      call ProcessCDError(CommDlgExtendedError(), hWnd )
      ChooseNewColor=.FALSE.
   end   if
end

! ***************************************************************************
!*
!*    FUNCTION: ProcessCDError(DWORD)
!*
!*    PURPOSE:  Processes errors from the common dialog functions.
!*
!*    COMMENTS:
!*
!*        This function is called whenever a common dialog function
!*        fails.  The CommonDialogExtendedError() value is passed to
!*        the function which maps the error value to a string table.
!*        The string is loaded and displayed for the user.
!*
!*    RETURN VALUES:
!*        void.
!*
!***************************************************************************
subroutine ProcessCDError( dwErrorCode, hWnd)
use cmndlgin

integer         dwErrorCode, hWnd
integer         wStringID
character*256   buf


   select case(dwErrorCode)
      case (CDERR_DIALOGFAILURE)
         wStringID=IDS_DIALOGFAILURE

      case (CDERR_STRUCTSIZE)
         wStringID=IDS_STRUCTSIZE

      case (CDERR_INITIALIZATION)
         wStringID=IDS_INITIALIZATION

      case (CDERR_NOTEMPLATE)
         wStringID=IDS_NOTEMPLATE

      case (CDERR_NOHINSTANCE)
         wStringID=IDS_NOHINSTANCE

      case (CDERR_LOADSTRFAILURE)
         wStringID=IDS_LOADSTRFAILURE

      case (CDERR_FINDRESFAILURE)
         wStringID=IDS_FINDRESFAILURE

      case (CDERR_LOADRESFAILURE)
         wStringID=IDS_LOADRESFAILURE

      case (CDERR_LOCKRESFAILURE)
         wStringID=IDS_LOCKRESFAILURE

      case (CDERR_MEMALLOCFAILURE)
         wStringID=IDS_MEMALLOCFAILURE

      case (CDERR_MEMLOCKFAILURE)
         wStringID=IDS_MEMLOCKFAILURE

      case (CDERR_NOHOOK)
         wStringID=IDS_NOHOOK

      case (PDERR_SETUPFAILURE)
         wStringID=IDS_SETUPFAILURE

      case (PDERR_PARSEFAILURE)
         wStringID=IDS_PARSEFAILURE

      case (PDERR_RETDEFFAILURE)
         wStringID=IDS_RETDEFFAILURE

      case (PDERR_LOADDRVFAILURE)
         wStringID=IDS_LOADDRVFAILURE

      case (PDERR_GETDEVMODEFAIL)
         wStringID=IDS_GETDEVMODEFAIL

      case (PDERR_INITFAILURE)
         wStringID=IDS_INITFAILURE

      case (PDERR_NODEVICES)
         wStringID=IDS_NODEVICES

      case (PDERR_NODEFAULTPRN)
         wStringID=IDS_NODEFAULTPRN

      case (PDERR_DNDMMISMATCH)
         wStringID=IDS_DNDMMISMATCH

      case (PDERR_CREATEICFAILURE)
         wStringID=IDS_CREATEICFAILURE

      case (PDERR_PRINTERNOTFOUND)
         wStringID=IDS_PRINTERNOTFOUND

      case (CFERR_NOFONTS)
         wStringID=IDS_NOFONTS

      case (FNERR_SUBCLASSFAILURE)
         wStringID=IDS_SUBCLASSFAILURE

      case (FNERR_INVALIDFILENAME)
         wStringID=IDS_INVALIDFILENAME

      case (FNERR_BUFFERTOOSMALL)
         wStringID=IDS_BUFFERTOOSMALL


      case (0)   ! User may have hit CANCEL or we got a *very* random error
         return
      case default
         wStringID=IDS_UNKNOWNERROR
   end select

   i = LoadString(NULL, wStringID, buf, len(buf))
   i = MessageBox(hWnd, buf, ""C, MB_OK)
   return
end
