!**************************************************************************\
!*  plgblt.f90 -- sample program demonstrating the new PlgBlt() API.
!*
!*  design:  There is one main window with one dialog box stretched to fill
!*   the top of it.  The parameters for the plgblt painted into the main
!*   window are stored in the entry fields of this dialog box.  The user
!*   may change these values and see the effect on the blt.
!*
!*  It is best to use the Developer Studio to create this program, using the project supplied
!*
!*  If this is built as a project or by compiling each unit, use the following switches:
!*    df /winapp /c plgblt.f90
!*
!**************************************************************************/

use dfwina
use trackin
include 'plgblt.fi'
include 'bitmap.fi'
end

!**************************************************************************\
!*
!*  function:  WinMain()
!*
!*  input parameters:  c.f. generic sample
!*
!**************************************************************************/
integer*4 function WinMain(hInstance, hPrevInstance,lpCmdLine,nCmdShow)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain
!DEC$ ENDIF
use dfwina
use trackin
use plgbltin
include 'plgblt.fi'

integer*4 hInstance
integer*4 hPrevInstance
integer*4 lpCmdLine
integer*4 nCmdShow

type (T_MSG)        mesg
type (T_RECT)       rect1
integer*4         haccel
type (T_WNDCLASS)   wc
character*100     lpszClassName, lpszMenuName, lpszIconName


    LPCMDLINE = LPCMDLINE

!     Check for previous instance.  If none, then register class.
   lpszClassName ="plgblt"C
   lpszMenuName ="plgbltMenu"C
   lpszIconName = "plgbltIcon"C
   if (hPrevInstance == 0) then
      wc%style = 0
      wc%lpfnWndProc = LOC(MainWndProc)
      wc%cbClsExtra = 0
      wc%cbWndExtra = 0
      wc%hInstance = hInstance
      wc%hIcon = LoadIcon(hInstance, LOC(lpszIconName))
      wc%hCursor = LoadCursor(NULL, IDC_ARROW)
      wc%hbrBackground = GetStockObject(LTGRAY_BRUSH)
      wc%lpszMenuName =  LOC(lpszMenuName)
      wc%lpszClassName = LOC(lpszClassName)
      if (RegisterClass(wc) == 0) then
         WinMain = FALSE
         return
      end if
   end if  ! class registered o.k.
! Create the main window.  Return false if CreateWindow() fails
   hInst = hInstance
   hwndMain = CreateWindowEx(0,                                      &
      lpszClassName,                                            &
      lpszClassName,                                            &
      IOR(INT(WS_OVERLAPPEDWINDOW),INT(WS_CLIPCHILDREN)),            &
      CW_USEDEFAULT,                                                 &
      CW_USEDEFAULT,                                                 &
      CW_USEDEFAULT,                                                 &
      CW_USEDEFAULT,                                                 &
      NULL,                                                          &
      NULL,                                                          &
      hInstance,                                                     &
      NULL)
   if (hwndMain == 0) then
      WinMain = FALSE
      return
   end if
   !  create the top dialog as a child of the main window. */
   hwndDlg = CreateDialogParam (hInst, LOC("plgbltDlg"C), hwndMain, LOC(DlgProc), 0)

   !* Send main window a WM_SIZE message so that it will size the top
   !*  dialog correctly.
   !*
   i = GetClientRect (hwndMain, rect1)
   i = SendMessage (hwndMain, WM_SIZE, 0, (rect1%right - rect1%left))
   i = ShowWindow (hwndDlg, SW_SHOW)
   i = ShowWindow(hwndMain, nCmdShow)
   ! get global handle to the menu
   ! Load the accelerator table that provides clipboard support. */
   haccel = LoadAccelerators (hInst, LOC("bltAccel"C))

   do while (GetMessage(mesg,NULL, 0,0) .neqv. .FALSE.)
      if (TranslateAccelerator(hwndMain, haccel, mesg) == 0) then
         if (IsDialogMessage (hwndDlg, mesg) .neqv. .TRUE.) then
            i = DispatchMessage(mesg)
         end if
      end if

   ! if no messages, and we are spinning, then post spin message. */
      if ((PeekMessage (mesg, hwndMain, 0,0, PM_NOREMOVE) .eqv. .FALSE.) .and. (nSpin .ne. 0)) then
         i = PostMessage (hwndMain, WM_SPIN, 0,0)
      end if
   end do

!* Return the value from PostQuitMessage
   WinMain = mesg%wParam
   return
end

!**************************************************************************\
!*
!*  function:  MainWndProc()
!*
!*  input parameters:  normal window procedure parameters.
!*
!*  There are 6 different HDCs used for the main window (in addition to the
!*   temporary one returned from BeginPaint).  There are two for each of the
!*   three thirds of the window.  The first one contains the bitmap.  The
!*   second one is for the track object and is stored in the TRACKOBJECT
!*   structure.
!*
!*  global variables:
!*   hwndDlg - dialog with entry fields containing parameters.
!*   ptoDest, ptoSrc, ptoMask - pointers to the direct manipulation objects
!*   hdcDest, hdcSrc, hdcMask - HDCs for the 3 sub regions of the window.
!*   hbmSrc, hbmMask          - bitmap handles for source and mask.
!**************************************************************************/
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
use dfwina
use trackin
use plgbltin

interface
integer function About    (HWND, UINT, WPARAM, LPARAM)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_About@16' :: About
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'About' :: About
!DEC$ ENDIF
integer*4 HWND , UINT , WPARAM ,  LPARAM
end function
end interface

interface
recursive subroutine doTrackObject(pto, mesg, hwnd, lParam)
!DEC$ ATTRIBUTES REFERENCE :: pto
use trackin
type (TrackObject)  pto
integer*4 mesg
integer*4 hwnd
integer*4 lParam
end subroutine doTrackObject
end interface

integer*4            hwnd, message, wParam, lParam
integer*4            miniWidth
type (T_RECT)        rect1
integer*4            hPenGrid, hPenSeparator
integer*4            hMenu, hrgn, hdc
type (T_PAINTSTRUCT) ps
type (T_POINT)       lpPoint(3)
integer              XSrc, YSrc, nWidth, nHeight, XMask, YMask
integer*4            sccess
type (T_RECT)        cliprect
integer*4            hbmCompat, hbmOld
integer*4            hdcCompat
integer*4            X(4),Y(4)
integer*4            Xmin, Ymin, Xmax, Ymax
integer*4            hbm
type (T_BITMAP)      bm
type (T_XFORM)       x1
real                 M11, M12, M21, M22
integer*4            nSteps
type (T_POINT)       pivot
type (T_POINT)       lpRgnErase(4), lpRgnBmp(4)
logical*4            l1
integer*4            hrgnErase, hrgnBmp
save                 miniWidth, rect1, hPenGrid, hPenSeparator

   select case (message)

      !**********************************************************************\
      !*  WM_CREATE
      !*
      !* Get three new HDCs, then create three new track objects.
      !*  Each track object has different allowed tracking modes.
      !*  Finally create two pens for drawing later on.
      !**********************************************************************/
      case (WM_CREATE)
         hdcSrc  = GetDC (hwnd)
         hdcDest = GetDC (hwnd)
         hdcMask = GetDC (hwnd)
         call doTrackObject (ptoDest, TROB_NEW, hwnd,0)
         ptoDest%allowedModes = TMALL
         call doTrackObject (ptoSrc , TROB_NEW, hwnd,0)
         ptoSrc%allowedModes = IOR(TMMOVE,TMSIZEXY )
         call doTrackObject (ptoMask , TROB_NEW, hwnd,0)
         ptoMask%allowedModes = TMMOVE

         hPenGrid      = CreatePen (PS_SOLID, 1, GRIDCOLOR)
         hPenSeparator = CreatePen (PS_SOLID,2*SEPARATORWIDTH,#01000000)
         hMenu = GetMenu (hwnd)

         i = CheckMenuItem(hMenu, IDM_SPINTOPLEFT, MF_CHECKED)
         i = CheckMenuItem(hMenu, IDM_SPINOFF    , MF_CHECKED)

         nSpin = FALSE

      !**********************************************************************\
      !*  WM_DESTROY
      !*
      !* Complement of WM_CREATE.  Free up all of the HDCs, send all of the
      !*  track objects their delete messages, delete the pens,
      !*  then call PostQuitMessage.
      !**********************************************************************/
      case (WM_DESTROY)
         i = ReleaseDC (hwnd, hdcSrc )
         i = ReleaseDC (hwnd, hdcDest)
         i = ReleaseDC (hwnd, hdcMask)
         call doTrackObject (ptoDest, TROB_DELETE, hwnd,0)
         call doTrackObject (ptoSrc , TROB_DELETE, hwnd,0)
         call doTrackObject (ptoMask, TROB_DELETE, hwnd,0)

         i = DeleteObject(hPenGrid)
         i = DeleteObject(hPenSeparator)

         call PostQuitMessage(0)
      !**********************************************************************\
      !*  WM_SIZE
      !*
      !* Stretch the top dialog to fill the width of the main window.
      !* Adjust the viewport origins of the 6 HDCs.
      !* Set the clip regions of the 6 HDCs.
      !**********************************************************************/
      case (WM_SIZE)
         i = SetWindowPos (hwndDlg, NULL, 0,0, INT4(LOWORD(lParam)) ,DIALOGHEIGHT, 0)
         i = GetClientRect (hwndMain, rect1)
         miniWidth = rect1%right/3

         i = SetViewportOrgEx (hdcDest,0, DIALOGHEIGHT, NULL_POINT)
         i = SetViewportOrgEx (ptoDest%hdc, 0, DIALOGHEIGHT, NULL_POINT)
         i = SetViewportOrgEx (hdcSrc, miniWidth,   DIALOGHEIGHT, NULL_POINT)
         i = SetViewportOrgEx (ptoSrc%hdc, miniWidth,DIALOGHEIGHT,NULL_POINT)
         i = SetViewportOrgEx (hdcMask, 2*miniWidth, DIALOGHEIGHT, NULL_POINT)
         i = SetViewportOrgEx (ptoMask%hdc,2*miniWidth,DIALOGHEIGHT,NULL_POINT)

         ptoDest%rectClip%left    = 0
         ptoDest%rectClip%top     = DIALOGHEIGHT
         ptoDest%rectClip%right   = miniWidth-2*SEPARATORWIDTH
         ptoDest%rectClip%bottom  = rect1%bottom

         hrgn = CreateRectRgnIndirect (ptoDest%rectClip)
         i = SelectClipRgn (hdcDest,      hrgn)
         i = SelectClipRgn (ptoDest%hdc, hrgn)
         i = DeleteObject (hrgn)

         ptoSrc%rectClip%left    = miniWidth
         ptoSrc%rectClip%top     = DIALOGHEIGHT
         ptoSrc%rectClip%right   = 2*miniWidth-2*SEPARATORWIDTH
         ptoSrc%rectClip%bottom  = rect1%bottom
         hrgn = CreateRectRgnIndirect (ptoSrc%rectClip)
         i = SelectClipRgn (hdcSrc, hrgn)
         i = SelectClipRgn (ptoSrc%hdc,  hrgn)
         i = DeleteObject (hrgn)
         ptoMask%rectClip%left    = 2*miniWidth
         ptoMask%rectClip%top     = DIALOGHEIGHT
         ptoMask%rectClip%right   = 3*miniWidth
         ptoMask%rectClip%bottom  = rect1%bottom
         hrgn = CreateRectRgnIndirect (ptoMask%rectClip)
         i = SelectClipRgn (hdcMask,      hrgn)
         i = SelectClipRgn (ptoMask%hdc, hrgn)
         i = DeleteObject (hrgn)
         i = SendMessage (hwndDlg, WM_PUTUPLPOINTS, hdcDest,LOC(ptoDest))
         i = SendMessage (hwndDlg, WM_PUTUPSRCRECT, hdcSrc,LOC(ptoSrc))
         i = SendMessage (hwndDlg, WM_PUTUPMASKPT,  hdcMask,LOC(ptoMask))
         ! repaint the whole window.
         i = InvalidateRect (hwnd, NULL_RECT,.TRUE.)
         MainWndProc = FALSE
         return

     !**********************************************************************\
     !*  WM_PAINT
     !*
     !* miniWidth, rect -- set by WM_SIZE message.
     !*
     !* First shift the viewport origin down so that 0,0 is the top left
     !*  most visible point (out from underneath the top dialog).  Second,
     !*  draw the grid with wider lines on the axes.  Finally, read the
     !*  values out of the top dialog, do elementary validation, and then
     !*  try to call plgblt() with the values.
     !**********************************************************************/
      case (WM_PAINT)
         hdc = BeginPaint(hwnd, ps)
         ! Draw Separator lines for the three miniareas
         i = SelectObject(hdc, hPenSeparator)
         i = MoveToEx (hdc,   miniWidth-SEPARATORWIDTH,0, NULL_POINT)
         i = LineTo   (hdc,   miniWidth-SEPARATORWIDTH, rect1%bottom)
         i = MoveToEx (hdc, 2*miniWidth-SEPARATORWIDTH,0, NULL_POINT)
         i = LineTo   (hdc, 2*miniWidth-SEPARATORWIDTH, rect1%bottom)

         ! Grid the HDCs
         i = SelectObject(hdcSrc, hPenGrid)
         call DrawGrids (hdcSrc, miniWidth, rect1%bottom)
         i = SelectObject(hdcMask, hPenGrid)
         call DrawGrids (hdcMask, miniWidth, rect1%bottom)

         ! Draw bitmaps if any, then draw track objects over them.
         if (hbmSrc .ne. 0) then
            call DrawBitmap (hdcSrc, hbmSrc)
         end if
         if (hbmMask .ne. 0) then
            call DrawBitmap (hdcMask, hbmMask)
         end if
         call doTrackObject (ptoSrc , TROB_PAINT, hwnd, 0)
         call doTrackObject (ptoMask, TROB_PAINT, hwnd, 0)

         ! paint the left third of the window.
         i = SendMessage (hwnd, WM_PLGBLT, 0,0)
         i = EndPaint (hwnd, ps)
         MainWndProc = FALSE
         return
      !**********************************************************************\
      !*  WM_PLGBLT
      !*
      !* WM_USER message.  This paints the left third of the window.  It
      !*  is called on the WM_PAINT message.  It is separated out here because
      !*  it is common for just the plgblt() to need to be called and not the
      !*  whole window painted.
      !**********************************************************************/
      case (WM_PLGBLT)

         call doTrackObject (ptoSrc , TROB_PAINT, hwnd, 0)
         call doTrackObject (ptoMask, TROB_PAINT, hwnd, 0)

         i  = GetClipBox (hdcDest, cliprect)
         i = FillRect (hdcDest, cliprect, GetClassLong (hwnd, GCL_HBRBACKGROUND))

         i = SelectObject(hdcDest, hPenGrid)
         call DrawGrids (hdcDest, miniWidth, rect1%bottom)

         if (IsWindow(hwndDlg) .eqv. .TRUE.) then
            ! Grab points out of the dialog entry fields.
            lpPoint(1)%x = GetDlgItemInt(hwndDlg, DID_P1X, LOC(sccess), .TRUE.)
            lpPoint(1)%y = GetDlgItemInt(hwndDlg, DID_P1Y, LOC(sccess), .TRUE.)
            lpPoint(2)%x = GetDlgItemInt(hwndDlg, DID_P2X, LOC(sccess), .TRUE.)
            lpPoint(2)%y = GetDlgItemInt(hwndDlg, DID_P2Y, LOC(sccess), .TRUE.)
            lpPoint(3)%x = GetDlgItemInt(hwndDlg, DID_P3X, LOC(sccess), .TRUE.)
            lpPoint(3)%y = GetDlgItemInt(hwndDlg, DID_P3Y, LOC(sccess), .TRUE.)

            XSrc = GetDlgItemInt(hwndDlg, DID_XSRC, LOC(sccess), .TRUE.)
            YSrc = GetDlgItemInt(hwndDlg, DID_YSRC, LOC(sccess), .TRUE.)
            nWidth = GetDlgItemInt(hwndDlg, DID_WIDTH, LOC(sccess), .TRUE.)
            nHeight = GetDlgItemInt(hwndDlg, DID_HEIGHT, LOC(sccess),.TRUE.)
            XMask = GetDlgItemInt(hwndDlg, DID_XMASK, LOC(sccess), .TRUE.)
            YMask = GetDlgItemInt(hwndDlg, DID_YMASK, LOC(sccess), .TRUE.)
            i = PlgBlt (hdcDest,lpPoint(1), hdcSrc, XSrc, YSrc, nWidth, nHeight,&
                  hbmMask, XMask, YMask)
         end if

         call doTrackObject (ptoSrc , TROB_PAINT, hwnd, 0)
         call doTrackObject (ptoMask, TROB_PAINT, hwnd, 0)
      !**********************************************************************\
      !*  WM_LBUTTONDOWN & WM_RBUTTONDOWN
      !* On button down messages, hittest on the track object, and if
      !*  it returns true, then send these messages to the track object%
      !**********************************************************************/
      case (WM_RBUTTONDOWN,WM_LBUTTONDOWN)
         call doTrackObject(ptoDest, TROB_HITTEST, hwnd, lParam)
         if (glob_hittest == 1) then
            call doTrackObject(ptoDest, message, hwnd, lParam)
         else
            call doTrackObject(ptoSrc, TROB_HITTEST, hwnd, lParam)
            if (glob_hittest == 1) then
               call doTrackObject(ptoSrc, message, hwnd, lParam)
            else
               call doTrackObject(ptoMask, TROB_HITTEST, hwnd, lParam)
               if (glob_hittest == 1) then
                  call doTrackObject(ptoMask, message, hwnd, lParam)
               end if
            end if
         end if

      !**********************************************************************\
      !*    WM_LBUTTONUP & WM_RBUTTONDOWN & MW_MOUSEMOVE
      !* If the track object is in a "tracking mode" then send it these messages.
      !*  If the transform dialog is not minimized, fill it with numbers.
      !*  If the mouse dialog is not minimized, fill it with numbers.
      !**********************************************************************/
      case (WM_RBUTTONUP,WM_LBUTTONUP)
         ! user action complete.  Force PlgBlt() update. */
         i = PostMessage (hwndMain, WM_PLGBLT, 0,0)
         if (ptoDest%Mode .ne. 0) then
            call doTrackObject(ptoDest, message, hwnd, lParam)
            i = SendMessage(hwndDlg,WM_PUTUPLPOINTS,hdcDest,LOC(ptoDest))
         end if
         if (ptoSrc%Mode .ne. 0) then
            call doTrackObject(ptoSrc, message, hwnd, lParam)
            i = SendMessage (hwndDlg, WM_PUTUPSRCRECT, hdcSrc,LOC(ptoSrc))
         end if
         if (ptoMask%Mode .ne. 0) then
            call doTrackObject(ptoMask, message, hwnd, lParam)
            i = SendMessage (hwndDlg, WM_PUTUPMASKPT, hdcMask, LOC(ptoMask))
         end if
         !WM_LBUTTONUP

      case (WM_MOUSEMOVE)
         if (ptoDest%Mode .ne. 0) then
            call doTrackObject(ptoDest, message, hwnd, lParam)
            i = SendMessage(hwndDlg,WM_PUTUPLPOINTS,hdcDest,LOC(ptoDest))
         end if
         if (ptoSrc%Mode .ne. 0) then
            call doTrackObject(ptoSrc, message, hwnd, lParam)
            i = SendMessage (hwndDlg, WM_PUTUPSRCRECT, hdcSrc,LOC(ptoSrc))
         end if
         if (ptoMask%Mode .ne. 0) then
            call doTrackObject(ptoMask, message, hwnd, lParam)
            i = SendMessage (hwndDlg, WM_PUTUPMASKPT, hdcMask, LOC(ptoMask))
         end if
      !**********************************************************************\
      !*  WM_SETFOCUS
      !*
      !* The main window should never have the focus.  Set it back
      !*  to the top dialog.
      !**********************************************************************/
      case (WM_SETFOCUS)
         i = SetFocus (hwndDlg)
         MainWndProc = 0
         return

      !**********************************************************************\
      !*  Menu item support.
      !*
      !**********************************************************************/
      case (WM_COMMAND)
         select case (INT4(LOWORD(wParam)) )
         !******************************************************************\
         !*  WM_COMMAND, IDM_COPY
         !*
         !* Create a new bitmap, copy the destination HDC bits into it,
         !*  and send the new bitmap to the clipboard.
         !******************************************************************/
            case (IDM_COPY)
               do i = 1, 3
                  X(i) = GetDlgItemInt(hwndDlg, DID_P1X + 2*i, LOC(sccess), .TRUE.)
                  Y(i) = GetDlgItemInt(hwndDlg, DID_P1Y + 2*i, LOC(sccess), .TRUE.)
               end do

               X(4) = (X(2) - X(1)) + X(3)
               Y(4) = (Y(3) - Y(1)) + Y(2)
               Xmin = X(1)
               Xmax = X(1)
               Ymin = X(1)
               Ymax = Y(1)

               do i = 2, 4
                  if (X(i) < Xmin) then
                     Xmin = X(i)
                  else
                     Xmin = Xmin
                  end if
                  if (Y(i) < Ymin) then
                     Ymin = Y(i)
                  else
                     Ymin = Ymin
                  end if
                  if (X(i) > Xmax) then
                     Xmax = X(i)
                  else
                     Xmax = Xmax
                  end if
                  if (Y(i) > Ymax) then
                     Ymax = Y(i)
                  else
                     Ymax = Ymax
                  end if
               end do
               nWidth = Xmax - Xmin
               nHeight = Ymax - Ymin
               hdcCompat = CreateCompatibleDC(hdcDest)
               hbmCompat = CreateCompatibleBitmap (hdcDest, nWidth, nHeight)
               hbmOld = SelectObject(hdcCompat,hbmCompat)
               i = BitBlt (hdcCompat, 0,0,nWidth, nHeight, hdcDest, Xmin,Ymin, SRCCOPY )
               i = SelectObject(hdcCompat,hbmOld)
               i  = DeleteDC(hdcCompat)
               i = OpenClipboard (hwnd)
               i = SetClipboardData (CF_BITMAP,hbmCompat)
               i = CloseClipboard ()
               i = DeleteObject (hbmCompat)
            !*****************************************************************\
            !*  WM_COMMAND, IDM_PASTE
            !*
            !* Get bitmap handle from clipboard, create a new bitmap, draw
            !*  the clipboard bitmap into the new one, and store the new
            !*  handle in the global hbmSrc.
            !******************************************************************/
            case (IDM_PASTE)
               i = OpenClipboard (hwnd)
               hbm = GetClipboardData (CF_BITMAP)
               if (hbm .ne. 0 ) then
                  i = DeleteObject (hbmSrc)
                  i = GetObject (hbm, 24, LOC(bm))
                  hdcCompat = CreateCompatibleDC(hdcDest)
                  hbmCompat = CreateCompatibleBitmap (hdcDest, bm%bmWidth,bm%bmHeight)
                  hbmOld = SelectObject(hdcCompat,hbmCompat)
                  call DrawBitmap (hdcCompat, hbm)
                  i = SelectObject(hdcCompat,hbmOld)
                  i = DeleteDC(hdcCompat)
                  hbmSrc = hbmCompat
                  i = InvalidateRect (hwnd, ptoSrc%rectClip, .TRUE.)
                  i = InvalidateRect (hwnd, ptoDest%rectClip, .TRUE.)
               end if
               i = CloseClipboard ()
            !******************************************************************\
            !*  WM_COMMAND, IDM_BOTH
            !*
            !* Post a COPY and PASTE command message to this window so that with
            !*  one key stroke the user can copy the DEST image into the clipboard,
            !*  paste it down into the SRC hdc and cause the blt%
            !******************************************************************/
            case (IDM_BOTH)
               i = PostMessage (hwnd, WM_COMMAND, MAKELONG (INT2(IDM_COPY) , INT2(1)), 0)
               i = PostMessage (hwnd, WM_COMMAND, MAKELONG (INT2(IDM_PASTE), INT2(1)), 0)
            !******************************************************************\
            !*  WM_COMMAND, IDM_MODE_*
            !*
            !* manage mutually exclusive menu.
            !*  call SetStretchBltMode() for the global destination hdc.
            !******************************************************************/
            case (IDM_MODE_BLACKONWHITE)
               hMenu = GetMenu (hwnd)
               i  = CheckMenuItem(hMenu, IDM_MODE_BLACKONWHITE, MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_COLORONCOLOR, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_WHITEONBLACK, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_HALFTONE    , MF_UNCHECKED)
               i = SetStretchBltMode (hdcDest,BLACKONWHITE)
               i = SendMessage (hwndMain, WM_PLGBLT, 0,0)
               MainWndProc = 0
               return
            case (IDM_MODE_COLORONCOLOR)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_MODE_BLACKONWHITE, MF_UNCHECKED)
               i  = CheckMenuItem(hMenu, IDM_MODE_COLORONCOLOR, MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_WHITEONBLACK, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_HALFTONE    , MF_UNCHECKED)
               i = SetStretchBltMode (hdcDest,COLORONCOLOR)
               i = SendMessage (hwndMain, WM_PLGBLT, 0,0)
               MainWndProc = 0
               return
            case (IDM_MODE_WHITEONBLACK)
               hMenu = GetMenu (hwnd)
               i  = CheckMenuItem(hMenu, IDM_MODE_BLACKONWHITE, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_COLORONCOLOR, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_WHITEONBLACK, MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_HALFTONE    , MF_UNCHECKED)
               i = SetStretchBltMode (hdcDest,WHITEONBLACK)
               i = SendMessage (hwndMain, WM_PLGBLT, 0,0)
               MainWndProc = 0
               return
            case (IDM_MODE_HALFTONE)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_MODE_BLACKONWHITE, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_COLORONCOLOR, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_WHITEONBLACK, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_MODE_HALFTONE    , MF_CHECKED)
               i = SetStretchBltMode (hdcDest,HALFTONE)
               i = SendMessage (hwndMain, WM_PLGBLT, 0,0)
               MainWndProc = 0
               return
            !******************************************************************\
            !*  WM_COMMAND, IDM_SPIN*
            !*
            !* manage mutually exclusive menu.
            !*
            !******************************************************************/
            case (IDM_SPINOFF)
               hMenu = GetMenu (hwnd)
               i  = CheckMenuItem(hMenu, IDM_SPINOFF, MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN5  , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN10 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN30 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN60 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN90 , MF_UNCHECKED)
               nSpin = FALSE
               i = SendMessage (hwndMain, WM_PLGBLT, 0,0)
               MainWndProc = 0
               return

            case (IDM_SPIN5)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINOFF, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN5  , MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN10 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN30 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN60 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN90 , MF_UNCHECKED)
               nSpin = 5
               MainWndProc = 0
               return

            case (IDM_SPIN10)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINOFF, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN5  , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN10 , MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN30 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN60 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN90 , MF_UNCHECKED)
               nSpin = 10
               MainWndProc = 0
               return

            case (IDM_SPIN30)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINOFF, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN5  , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN10 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN30 , MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN60 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN90 , MF_UNCHECKED)
               nSpin = 30
               MainWndProc = 0
               return

            case (IDM_SPIN60)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINOFF, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN5  , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN10 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN30 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN60 , MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN90 , MF_UNCHECKED)
               nSpin = 60
               MainWndProc = 0
               return

            case (IDM_SPIN90)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINOFF, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN5  , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN10 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN30 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN60 , MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPIN90 , MF_CHECKED)
               nSpin = 90
               MainWndProc = 0
               return

            case (IDM_FLIPONCE)
               nSpin = 90
               i = SendMessage (hwndMain, WM_SPIN, 0,0)
               nSpin = FALSE
               MainWndProc = 0
               return

            case (IDM_SPINTOPLEFT)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINTOPLEFT, MF_CHECKED)
               i = CheckMenuItem(hMenu, IDM_SPINCENTER , MF_UNCHECKED)
               MainWndProc = 0
               return

            case (IDM_SPINCENTER)
               hMenu = GetMenu (hwnd)
               i = CheckMenuItem(hMenu, IDM_SPINTOPLEFT, MF_UNCHECKED)
               i = CheckMenuItem(hMenu, IDM_SPINCENTER , MF_CHECKED)
               MainWndProc = 0
               return
            !******************************************************************\
            !*  WM_COMMAND, DID_NEW*
            !*
            !* menu equivalents for buttons on top dialog.  Just pass along
            !*  WM_COMMAND messages to the dialog.
            !*
            !******************************************************************/
            case (DID_NEWSRC,DID_NEWMASK)
               i = SendMessage (hwndDlg, message, wParam, lParam)
               MainWndProc = 0
               return
            !******************************************************************\
            !*  WM_COMMAND, IDM_ABOUT
            !*
            !******************************************************************/
            case (IDM_ABOUT)
               i  = DialogBoxParam (hInst, LOC("aboutBox"C), hwnd, LOC(About), 0)
               MainWndProc = 0
               return
         end select  ! end switch
         !******************************************************************\
         !*  WM_SPIN
         !*
         !* Set up a transform to modify the destination points.
         !*  (Note that the transform in hdcDest remains the identity.)
         !*  Loop through, reblitting to the transformed points.
         !*  Erase behind the old bitmap by keeping track of the region uncovered.
         !*
         !******************************************************************/
      case (WM_SPIN)
         ! validate the dialog on top with the parameters in it. */
         if (IsWindow(hwndDlg) .eqv. .FALSE.) then
            MainWndProc = 0
            return
         end   if

         ! Grab points out of the dialog entry fields.
         lpPoint(1)%x = GetDlgItemInt(hwndDlg, DID_P1X, LOC(sccess), .TRUE.)
         lpPoint(1)%y = GetDlgItemInt(hwndDlg, DID_P1Y, LOC(sccess), .TRUE.)
         lpPoint(2)%x = GetDlgItemInt(hwndDlg, DID_P2X, LOC(sccess), .TRUE.)
         lpPoint(2)%y = GetDlgItemInt(hwndDlg, DID_P2Y, LOC(sccess), .TRUE.)
         lpPoint(3)%x = GetDlgItemInt(hwndDlg, DID_P3X, LOC(sccess), .TRUE.)
         lpPoint(3)%y = GetDlgItemInt(hwndDlg, DID_P3Y, LOC(sccess), .TRUE.)
         XSrc = GetDlgItemInt(hwndDlg, DID_XSRC, LOC(sccess), .TRUE.)
         YSrc = GetDlgItemInt(hwndDlg, DID_YSRC, LOC(sccess), .TRUE.)
         nWidth = GetDlgItemInt(hwndDlg, DID_WIDTH, LOC(sccess), .TRUE.)
         nHeight = GetDlgItemInt(hwndDlg, DID_HEIGHT, LOC(sccess), .TRUE.)
         XMask = GetDlgItemInt(hwndDlg, DID_XMASK, LOC(sccess), .TRUE.)
         YMask = GetDlgItemInt(hwndDlg, DID_YMASK, LOC(sccess), .TRUE.)

        ! get an HDC we can use to play with transforms.
         hdc = GetDC (hwnd)
         i = SetGraphicsMode (hdc, GM_ADVANCED)

        ! check menu check to pivot on top-left corner, or pivot on center. */
         hMenu = GetMenu (hwnd)

         if (IAND(GetMenuState(hMenu, IDM_SPINCENTER, MF_BYCOMMAND), MF_CHECKED) .ne. 0) then
            pivot%x = (lpPoint(2)%x +lpPoint(3)%x)/2
            pivot%y = (lpPoint(2)%y +lpPoint(3)%y)/2
         else
            pivot%x = lpPoint(1)%x
            pivot%y = lpPoint(1)%y
         end if

      !* nSpin contains values reflecting the number of degrees per step%
      !*  fill in the number of steps required (360 / nSpin), and fill in
      !*  the precomputed transformation matrices.
      !*
         select case (nSpin)
            case (5)
               nSteps = 72
               M11 = 0.9961946980917
               M22 = 0.9961946980917
               M12 = -0.08715574274766
               M21 = 0.08715574274766
            case (10)
               nSteps = 36
               M11 = 0.984808
               M22 = 0.984808
               M12 = -0.173648
               M21 = 0.173648
            case (30)
               nSteps = 12
               M11 = 0.866025
               M22 = 0.866025
               M12 = -0.5
               M21 = 0.5
            case (60)
               nSteps = 6
               M11 = 0.5
               M22 = 0.5
               M12 = -0.866025
               M21 = 0.866025
            case (90)
               nSteps = 4
               M11 = 0.0
               M22 = 0.0
               M12 = -1.0
               M21 = 1.0
            case default
               i = MessageBox (hwnd, "nSpin invalid."C, "Internal app error"C, MB_ICONHAND)
               MainWndProc = 0
               return
         end select  ! end switch nSpin

! translate objects from pivot point to origin.
         x1%eM11 = 1.0
         x1%eM12 = 0.0
         x1%eM21 = 0.0
         x1%eM22 = 1.0
         x1%eDx = -pivot%x
         x1%eDy = -pivot%y
         i = ModifyWorldTransform (hdc, x1, MWT_RIGHTMULTIPLY)

! rotate object about origin.
         x1%eM11 = M11
         x1%eM12 = M12
         x1%eM21 = M21
         x1%eM22 = M22
         x1%eDx = 0.0
         x1%eDy = 0.0
         i = ModifyWorldTransform (hdc, x1, MWT_RIGHTMULTIPLY)

! translate objects back to pivot point.
         x1%eM11 = 1.0
         x1%eM12 = 0.0
         x1%eM21 = 0.0
         x1%eM22 = 1.0
         x1%eDx = pivot%x
         x1%eDy = pivot%y
         i = ModifyWorldTransform (hdc, x1, MWT_RIGHTMULTIPLY)

! fill in initial region for erasure... the region containing bmp
         lpRgnErase(1) = lpPoint(1)
         lpRgnErase(2) = lpPoint(2)
         lpRgnErase(4) = lpPoint(3)
         lpRgnErase(3)%x =  lpPoint(2)%x - lpPoint(1)%x
         lpRgnErase(3)%x =lpRgnErase(3)%x + lpPoint(3)%x - lpPoint(1)%x
         lpRgnErase(3)%x =lpRgnErase(3)%x + lpPoint(1)%x
         lpRgnErase(3)%y =  lpPoint(2)%y - lpPoint(1)%y
         lpRgnErase(3)%y =lpRgnErase(3)%y + lpPoint(3)%y - lpPoint(1)%y
         lpRgnErase(3)%y =lpRgnErase(3)%y + lpPoint(1)%y

        ! loop through transforming the points on each step.
         do i= 0, nSteps-1
            hrgnErase = CreatePolygonRgn (lpRgnErase(1), 4, ALTERNATE)
         ! TRANSFORM the lpPoint() destination extent points
            i1 = LPtoDP (hdc, lpPoint(1), 3)
         ! create a region containing the new bitmap extents
            lpRgnBmp(1) = lpPoint(1)
            lpRgnBmp(2) = lpPoint(2)
            lpRgnBmp(4) = lpPoint(3)
            lpRgnBmp(3)%x =  lpPoint(2)%x - lpPoint(1)%x
            lpRgnBmp(3)%x =lpRgnBmp(3)%x + lpPoint(3)%x - lpPoint(1)%x
            lpRgnBmp(3)%x =lpRgnBmp(3)%x + lpPoint(1)%x
            lpRgnBmp(3)%y =  lpPoint(2)%y - lpPoint(1)%y
            lpRgnBmp(3)%y =lpRgnBmp(3)%y + lpPoint(3)%y - lpPoint(1)%y
            lpRgnBmp(3)%y =lpRgnBmp(3)%y + lpPoint(1)%y
            hrgnBmp = CreatePolygonRgn (lpRgnBmp(1), 4, ALTERNATE)

            ! subtract the new bitmap extents region from the erasure region.
            i1 = CombineRgn (hrgnErase, hrgnErase, hrgnBmp, RGN_DIFF)
            ! while we are here, get points ready for the next loop erasure
            lpRgnErase(1) = lpPoint(1)
            lpRgnErase(2) = lpPoint(2)
            lpRgnErase(4) = lpPoint(3)
            lpRgnErase(3)%x =  lpPoint(2)%x - lpPoint(1)%x
            lpRgnErase(3)%x =lpRgnErase(3)%x + lpPoint(3)%x - lpPoint(1)%x
            lpRgnErase(3)%x =lpRgnErase(3)%x + lpPoint(1)%x
            lpRgnErase(3)%y =  lpPoint(2)%y - lpPoint(1)%y
            lpRgnErase(3)%y = lpRgnErase(3)%y +lpPoint(3)%y - lpPoint(1)%y
            lpRgnErase(3)%y = lpRgnErase(3)%y +lpPoint(1)%y
  !**********************************************************/
            i1 = PlgBlt (hdcDest, lpPoint(1), hdcSrc, XSrc, YSrc, nWidth, nHeight,&
                           hbmMask, XMask, YMask)
  !**********************************************************/

    ! need to flush graphics buffer, or regions are erased
    !  before the bitmap is drawn.
    !
            i1 = GdiFlush()
        ! erase the newly uncovered region. */
            l1 = FillRgn (hdcDest, hrgnErase, INT(BACKGROUNDBRUSH ))
            i1 = DeleteObject (hrgnErase)
            i1 = DeleteObject (hrgnBmp)
         end do ! end for loop
! because of roundoff error, the 'nSteps'th rotation will not
!  always bring the parallelogram around to the 0th position.
!  So we special case the last position, and do one more erase.
!  Try commenting this out, and see the little glitches left
!  on the screen if this comment is unclear.
!
         lpRgnErase(1) = lpPoint(1)
         lpRgnErase(2) = lpPoint(2)
         lpRgnErase(4) = lpPoint(3)
         lpRgnErase(3)%x =  lpPoint(2)%x - lpPoint(1)%x
         lpRgnErase(3)%x = lpRgnErase(3)%x +lpPoint(3)%x - lpPoint(1)%x
         lpRgnErase(3)%x = lpRgnErase(3)%x +lpPoint(1)%x
         lpRgnErase(3)%y =  lpPoint(2)%y - lpPoint(1)%y
         lpRgnErase(3)%y = lpRgnErase(3)%y +lpPoint(3)%y - lpPoint(1)%y
         lpRgnErase(3)%y = lpRgnErase(3)%y +lpPoint(1)%y
         hrgnErase = CreatePolygonRgn (lpRgnErase(1), 4, ALTERNATE)
         lpPoint(1)%x = GetDlgItemInt(hwndDlg, DID_P1X, LOC(sccess), .TRUE.)
         lpPoint(1)%y = GetDlgItemInt(hwndDlg, DID_P1Y, LOC(sccess), .TRUE.)
         lpPoint(2)%x = GetDlgItemInt(hwndDlg, DID_P2X, LOC(sccess), .TRUE.)
         lpPoint(2)%y = GetDlgItemInt(hwndDlg, DID_P2Y, LOC(sccess), .TRUE.)
         lpPoint(3)%x = GetDlgItemInt(hwndDlg, DID_P3X, LOC(sccess), .TRUE.)
         lpPoint(3)%y = GetDlgItemInt(hwndDlg, DID_P3Y, LOC(sccess), .TRUE.)
         lpRgnBmp(1) = lpPoint(1)
         lpRgnBmp(2) = lpPoint(2)
         lpRgnBmp(4) = lpPoint(3)
         lpRgnBmp(3)%x =  lpPoint(2)%x - lpPoint(1)%x
         lpRgnBmp(3)%x =lpRgnBmp(3)%x + lpPoint(3)%x - lpPoint(1)%x
         lpRgnBmp(3)%x = lpRgnBmp(3)%x +lpPoint(1)%x
         lpRgnBmp(3)%y =  lpPoint(2)%y - lpPoint(1)%y
         lpRgnBmp(3)%y = lpRgnBmp(3)%y +lpPoint(3)%y - lpPoint(1)%y
         lpRgnBmp(3)%y = lpRgnBmp(3)%y +lpPoint(1)%y
         hrgnBmp = CreatePolygonRgn (lpRgnBmp(1), 4, ALTERNATE)
         i = CombineRgn (hrgnErase, hrgnErase, hrgnBmp, RGN_DIFF)
         i = FillRgn (hdcDest, hrgnErase, GetStockObject(LTGRAY_BRUSH))
         i = DeleteObject (hrgnErase)
         i = DeleteObject (hrgnBmp)
         i = ReleaseDC (hwnd, hdc)
         MainWndProc = 0  ! end WM_SPIN message
         return

      case default
         MainWndProc = DefWindowProc(hwnd, message, wParam, lParam)
         return
   end select  ! end switch

   MainWndProc = 0
   return
end
