• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

GDI: CombineRgn Function

Started by José Roca, August 22, 2011, 12:33:16 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

José Roca

 
Cursor following eyes. Demonstrates the use of the CombineRgn funciton.


' ########################################################################################
' Cursor following eyes.
' Adaptation of the version posted by In Cairns in 2001.
' http://www.powerbasic.com/support/forums/Forum7/HTML/001222.html
' Adapted by José Roca, August 2011.
' ########################################################################################

' CSED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "Eyes", 0, 0, 300, 300, %WS_POPUP, %WS_EX_CONTROLPARENT, CODEPTR(WindowProc))
   ' // Change the background color
   pWindow.Brush = %COLOR_WINDOW + 1
   ' // Center the window
   pWindow.CenterWindow

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL  rc        AS RECT
   LOCAL  ps        AS PAINTSTRUCT
   LOCAL  hPen      AS DWORD
   LOCAL  hPenOld   AS DWORD
   LOCAL  hBrush    AS DWORD
   LOCAL  hBrushOld AS DWORD
   LOCAL  hDC       AS DWORD
   LOCAL  hRgn1     AS DWORD
   LOCAL  hRgn2     AS DWORD
   LOCAL  cPt       AS POINT

   STATIC hBmp      AS DWORD
   STATIC hBmpOld   AS DWORD
   STATIC hMemDC    AS DWORD
   STATIC offSetL   AS POINT
   STATIC offSetR   AS POINT
   STATIC oldCPt    AS POINT
   STATIC hTimer    AS DWORD

   SELECT CASE wMsg

      CASE %WM_CREATE

         ' // Draws the eyeballs
         hDC = GetDC(hWnd)
         BeginPath(hDC)
         Ellipse(hdc, 0, 0, 50, 50)
         Ellipse(hdc, 55, 0, 105, 50)
         EndPath(hDC)

         hRgn1 = PathToRegion(hDC)
         GetRgnBox(hRgn1, rc)
         hRgn2 = CreateRectRgnIndirect(rc)
         CombineRgn(hRgn2, hRgn2, hRgn1, %RGN_AND)
         DeleteObject(hRgn1)

         ' // Creates a memory bitmap
         hMemDC  = CreateCompatibleDC(%NULL)
         hBmp    = CreateCompatibleBitmap(hDC, 34, 34)
         hBmpOld = SelectObject(hMemDC, hBmp)

         ' // Releases the device context
         ReleaseDC(hWnd, hDC)

         ' // Draws the eyeball iris/pupil
         hPen = CreatePen(%PS_SOLID, 1, %BLACK)
         hBrush = CreateSolidBrush(%BLUE)
         hPenOld = SelectObject(hMemDC, hPen)
         hBrushOld = SelectObject(hMemDC, hBrush)
         PatBlt(hMemDC, 0, 0, 34, 34, %WHITENESS)
         Ellipse(hMemDC, 0, 0, 34, 34)
         DeleteObject(SelectObject(hMemDC, hBrushOld))
         hBrush = CreateSolidBrush(%BLACK)
         hBrushOld = SelectObject(hMemDC, hBrush)
         Ellipse(hMemDC, 12, 12, 20, 20)
         DeleteObject (SelectObject(hMemDC, hPenOld) )
         DeleteObject (SelectObject(hMemDC, hBrushOld) )

         SetWindowRgn(hWnd, hRgn2, 1)
         GetWindowRect(hWnd, rc)
         SetWindowPos(hWnd, %HWND_TOPMOST, 0, 0, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop, %SWP_NOMOVE)
         ' // Set a timer for checking cursor movements
         hTimer = SetTimer(hWnd, 1, 50, %NULL)

         EXIT FUNCTION

      CASE %WM_PAINT
'         ps.fErase = 0
         hdc = BeginPaint(hWnd, ps)
         ' // Draw eyeballs
         BitBlt(hdc, 8 + offsetL.x, 8 + offsetL.y, 105, 50, hMemDC, 0, 0, %SRCCOPY)
         BitBlt(hdc, 63 + offsetR.x, 8 + offsetR.y, 105, 50, hMemDC, 0, 0, %SRCCOPY)
         ' // Draw outsides
         hPen = CreatePen(%PS_SOLID, GetSystemMetrics(%SM_CXBORDER) + 2, &H0)
         hPenOld = SelectObject(hdc, hPen)
         Arc(hdc, 0, 0, 50, 50, 0, 0, 0, 0)
         Arc(hdc, 55, 0, 105, 50, 0, 0, 0, 0)
         DeleteObject (SelectObject (hdc, hPenOld))
         EndPaint(hWnd, ps)
         EXIT FUNCTION

      CASE %WM_TIMER
         GetCursorPos cPt
         IF cPt <> oldCpt THEN
            GetWindowRect(hWnd, rc)
            CalculateOffset(rc, offsetL, cPt, 25, 25)
            CalculateOffset(rc, offsetR, cPt, 75, 25)
            oldCpt = cPt
            InvalidateRect(hWnd, BYVAL %NULL, 1)
         END IF
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDOK, %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_DESTROY
         KillTimer(hWnd, 1)
         DeleteObject(SelectObject (hMemDC, hBmpOld))
         DeleteObject(hMemDC)
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Calculate offset.
' ========================================================================================
SUB CalculateOffset(BYREF rc AS RECT, BYREF eOffset AS POINT, _
                    BYREF cPt AS POINT, BYVAL xOffset AS LONG, BYVAL yOffset AS LONG)

   LOCAL ePt      AS POINT
   LOCAL distance AS POINT
   LOCAL tRatio   AS LONG

   ' // Find current centre of given eye
   ePt.X = rc.nLeft + xOffset
   ePt.y = rc.nTop + yOffset

   ' // Determine offset from cursor
   distance.X = cPt.X - ePt.X
   distance.Y = cPt.Y - ePt.Y

   ' // If within rotation of eye, zero the offset
   IF ABS(distance.X) < 10 AND ABS(distance.Y) < 10 THEN
      eOffset.X = 0 : eOffset.Y = 0
   ELSE
      ' // Calculate ratio for offset distance calculations
      tRatio = INT(SQR( (distance.X * distance.X) + (distance.Y * distance.Y) ) / 10)
      ' // Convert to eye offset
      eOffset.X = INT(distance.X / tRatio)
      eOffset.Y = INT(distance.Y / tRatio)
   END IF

END SUB
' ========================================================================================