CWindow Examples

[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Header files for imported files
%USEGLCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "GlCtx.inc"     ' // GLCtx control

%IDC_GLCTX = 1001

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Specify the clear value for the depth buffer
   glClearDepth 1.0!
   ' Specify the value used for depth-buffer comparisons
   glDepthFunc %GL_LESS
   ' Enable depth comparisons and update the depth buffer
   glEnable %GL_DEPTH_TEST
   ' Select smooth shading
   glShadeModel %GL_SMOOTH

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

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' Select the projection matrix
   glMatrixMode %GL_PROJECTION
   ' Reset the projection matrix
   glLoadIdentity
   ' Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
   ' Select the model view matrix
   glMatrixMode %GL_MODELVIEW
   ' Reset the model view matrix
   glLoadIdentity

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

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   ' Reset the view
   glLoadIdentity

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

   ' // Sample code

   glTranslatef -1.5!, 0.0!, -6.0!       ' Move left 1.5 units and into the screen 6.0

   glBegin %GL_TRIANGLES                 ' Drawing using triangles
      glColor3f   1.0!, 0.0!, 0.0!       ' Set the color to red
      glVertex3f  0.0!, 1.0!, 0.0!       ' Top
      glColor3f   0.0!, 1.0!, 0.0!       ' Set the color to green
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glColor3f   0.0!, 0.0!, 1.0!       ' Set the color to blue
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glTranslatef 3.0!,0.0!,0.0!           ' Move right 3 units

   glColor3f 0.5!, 0.5!, 1.0!            ' Set the color to blue one time only
   glBegin %GL_QUADS                     ' Draw a quad
      glVertex3f -1.0!, 1.0!, 0.0!       ' Top left
      glVertex3f  1.0!, 1.0!, 0.0!       ' Top right
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Done drawing the quad

   ' // Required: force execution of GL commands in finite time
   glFlush

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

' ========================================================================================
' 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 CWindow class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow OpenGL Graphic Control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 380
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a GDI+ aware graphic control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddGlCtx(pWindow.hwnd, %IDC_GLCTX, "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   

   ' // Render the scene
   SetupScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   ResizeScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   DrawScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_GLCTX), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Header files for imported files
%USEGLCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "GlCtx.inc"     ' // GLCtx control

%IDC_GLCTX = 1001

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Specify the clear value for the depth buffer
   glClearDepth 1.0!
   ' Specify the value used for depth-buffer comparisons
   glDepthFunc %GL_LESS
   ' Enable depth comparisons and update the depth buffer
   glEnable %GL_DEPTH_TEST
   ' Select smooth shading
   glShadeModel %GL_SMOOTH

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

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' Select the projection matrix
   glMatrixMode %GL_PROJECTION
   ' Reset the projection matrix
   glLoadIdentity
   ' Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
   ' Select the model view matrix
   glMatrixMode %GL_MODELVIEW
   ' Reset the model view matrix
   glLoadIdentity

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

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   ' Reset the view
   glLoadIdentity

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

   ' // Sample code

   glTranslatef -1.5!, 0.0!, -6.0!       ' Move left 1.5 units and into the screen 6.0

   glBegin %GL_TRIANGLES                 ' Drawing using triangles
      glColor3f   1.0!, 0.0!, 0.0!       ' Set the color to red
      glVertex3f  0.0!, 1.0!, 0.0!       ' Top
      glColor3f   0.0!, 1.0!, 0.0!       ' Set the color to green
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glColor3f   0.0!, 0.0!, 1.0!       ' Set the color to blue
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glTranslatef 3.0!,0.0!,0.0!           ' Move right 3 units

   glColor3f 0.5!, 0.5!, 1.0!            ' Set the color to blue one time only
   glBegin %GL_QUADS                     ' Draw a quad
      glVertex3f -1.0!, 1.0!, 0.0!       ' Top left
      glVertex3f  1.0!, 1.0!, 0.0!       ' Top right
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Done drawing the quad

   ' // Required: force execution of GL commands in finite time
   glFlush

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

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

   ' // Set process DPI aware
   SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow OpenGL Graphic Control (High DPI)", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 380
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a GDI+ aware graphic control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddGlCtx(pWindow.hwnd, %IDC_GLCTX, "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   

   ' // Render the scene
   SetupScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   ResizeScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   DrawScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_GLCTX), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
            ' // Resize and render the OpenGL scene
            ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
            DrawScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Header files for imported files
%USEGLCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "GlCtx.inc"     ' // GLCtx control

%IDC_GLCTX = 1001

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Specify the clear value for the depth buffer
   glClearDepth 1.0!
   ' Specify the value used for depth-buffer comparisons
   glDepthFunc %GL_LESS
   ' Enable depth comparisons and update the depth buffer
   glEnable %GL_DEPTH_TEST
   ' Select smooth shading
   glShadeModel %GL_SMOOTH

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

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' Select the projection matrix
   glMatrixMode %GL_PROJECTION
   ' Reset the projection matrix
   glLoadIdentity
   ' Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
   ' Select the model view matrix
   glMatrixMode %GL_MODELVIEW
   ' Reset the model view matrix
   glLoadIdentity

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

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   ' Reset the view
   glLoadIdentity

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

   ' // Sample code

   glTranslatef -1.5!, 0.0!, -6.0!       ' Move left 1.5 units and into the screen 6.0

   glBegin %GL_TRIANGLES                 ' Drawing using triangles
      glColor3f   1.0!, 0.0!, 0.0!       ' Set the color to red
      glVertex3f  0.0!, 1.0!, 0.0!       ' Top
      glColor3f   0.0!, 1.0!, 0.0!       ' Set the color to green
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glColor3f   0.0!, 0.0!, 1.0!       ' Set the color to blue
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glTranslatef 3.0!,0.0!,0.0!           ' Move right 3 units

   glColor3f 0.5!, 0.5!, 1.0!            ' Set the color to blue one time only
   glBegin %GL_QUADS                     ' Draw a quad
      glVertex3f -1.0!, 1.0!, 0.0!       ' Top left
      glVertex3f  1.0!, 1.0!, 0.0!       ' Top right
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Done drawing the quad

   ' // Required: force execution of GL commands in finite time
   glFlush

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

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow OpenGL Graphic Control Stretchable", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 380
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a GDI+ aware graphic control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddGlCtx(pWindow.hwnd, %IDC_GLCTX, "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   GlCtx_SetStretchable hCtl, %TRUE

   

   ' // Render the scene
   SetupScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   ResizeScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   DrawScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG


   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_GLCTX), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
            ' // Resize and render the OpenGL scene
            ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
            DrawScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE ONCE "CWindow.inc"
#INCLUDE ONCE "glu.inc"

$WindowCaption = "OpenGL Template"

%GL_WINDOWWIDTH  = 640         ' Window width
%GL_WINDOWHEIGHT = 480         ' Window height
%GL_BITSPERPEL   = 16          ' Color resolution in bits per pixel
%GL_DEPTHBITS    = 16          ' Depth of the depth (z-axis) buffer

GLOBAL hDC AS LONG             ' Device context handle

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' // Specify the clear value for the depth buffer
   glClearDepth 1.0!
   ' // Specify the value used for depth-buffer comparisons
   glDepthFunc %GL_LESS
   ' // Enable depth comparisons and update the depth buffer
   glEnable %GL_DEPTH_TEST
   ' // Select smooth shading
   glShadeModel %GL_SMOOTH

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

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' // Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' // Select the projection matrix
   glMatrixMode %GL_PROJECTION
   ' // Reset the projection matrix
   glLoadIdentity
   ' // Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
   ' // Select the model view matrix
   glMatrixMode %GL_MODELVIEW
   ' // Reset the model view matrix
   glLoadIdentity

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

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   ' // Reset the view
   glLoadIdentity

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

   glTranslatef -1.5!, 0.0!, -6.0!       ' Move left 1.5 units and into the screen 6.0

   glBegin %GL_TRIANGLES                 ' Drawing using triangles
      glColor3f   1.0!, 0.0!, 0.0!       ' Set the color to red
      glVertex3f  0.0!, 1.0!, 0.0!       ' Top
      glColor3f   0.0!, 1.0!, 0.0!       ' Set the color to green
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glColor3f   0.0!, 0.0!, 1.0!       ' Set the color to blue
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glTranslatef 3.0!,0.0!,0.0!           ' Move right 3 units

   glColor3f 0.5!, 0.5!, 1.0!            ' Set the color to blue one time only
   glBegin %GL_QUADS                     ' Draw a quad
      glVertex3f -1.0!, 1.0!, 0.0!       ' Top left
      glVertex3f  1.0!, 1.0!, 0.0!       ' Top right
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Done drawing the quad


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

' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

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

' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

   SELECT CASE AS LONG vKeyCode

      CASE %VK_ESCAPE
         ' // Quit if Esc key pressed
         SendMessage hwnd, %WM_CLOSE, 0, 0

   END SELECT

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

' =======================================================================================
' Processes mouse clicks and movement
' Parameters:
' * hwnd      = Window hande
' * wMsg      = Windows message
' * wKeyState = Indicates whether various virtual keys are down.
'               MK_CONTROL    The CTRL key is down.
'               MK_LBUTTON    The left mouse button is down.
'               MK_MBUTTON    The middle mouse button is down.
'               MK_RBUTTON    The right mouse button is down.
'               MK_SHIFT      The SHIFT key is down.
'               MK_XBUTTON1   Windows 2000/XP: The first X button is down.
'               MK_XBUTTON2   Windows 2000/XP: The second X button is down.
' * x         = x-coordinate of the cursor
' * y         = y-coordinate of the cursor
' =======================================================================================
SUB ProcessMouse (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)

   SELECT CASE wMsg

      CASE %WM_LBUTTONDOWN

      CASE %WM_LBUTTONUP

      CASE %WM_MOUSEMOVE

   END SELECT

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

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

   LOCAL  hwnd        AS DWORD
   LOCAL  wcex        AS WNDCLASSEX
   LOCAL  msg         AS tagMSG
   LOCAL  rc          AS RECT
   LOCAL  bDone       AS LONG
   LOCAL  nLeft       AS LONG
   LOCAL  nTop        AS LONG
   LOCAL  nWidth      AS LONG
   LOCAL  nHeight     AS LONG
   LOCAL  dwStyle     AS DWORD
   LOCAL  dwStyleEx   AS DWORD
   STATIC vKeyCode    AS LONG
   STATIC bKeyDown    AS LONG
   LOCAL  t           AS DOUBLE
   LOCAL  t0          AS DOUBLE
   LOCAL  fps         AS DOUBLE
   LOCAL  nFrames     AS LONG
   LOCAL  dm          AS DEVMODE
   LOCAL  bFullScreen AS LONG
   LOCAL  lResult     AS LONG

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

' // Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
             "Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
   SELECT CASE lResult
      CASE %IDCANCEL : EXIT FUNCTION
      CASE %IDYES    : bFullScreen = %TRUE
      CASE %IDNO     : bFullScreen = %FALSE
   END SELECT

   ' // Window size
   nWidth  = %GL_WINDOWWIDTH
   nHeight = %GL_WINDOWHEIGHT

   IF bFullScreen THEN
      ' // Change display settings
      dm.dmSize       = SIZEOF(dm)
      dm.dmPelsWidth  = nWidth
      dm.dmPelsHeight = nHeight
      dm.dmBitsPerPel = %GL_BITSPERPEL
      dm.dmFields     = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
      IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
   END IF

   ' // Window styles
   IF ISFALSE bFullScreen THEN
      dwStyle = %WS_OVERLAPPEDWINDOW
      dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
   ELSE
      dwStyle = %WS_POPUP
      dwStyleEx = %WS_EX_APPWINDOW
   END IF

   ' // Create the window
   hwnd = pWindow.CreateWindow(%NULL, $WindowCaption, nLeft, nTop, nWidth, nHeight, dwStyle, dwStyleEx, CODEPTR(WndProc))
   ' // Don't erase nackground
   pWindow.ClassStyle = %CS_DBLCLKS
   '// Black brush
   pWindow.Brush = %BLACK

   ' // Retrieve the coordinates of the window's client area
   GetClientRect hwnd, rc
   ' // Initialize the new OpenGl window
   SetupScene hwnd, rc.Right - rc.Left, rc.Bottom - rc.Top

   ' // Show the window
   ShowWindow hwnd, nCmdShow
   UpdateWindow hwnd

   DO UNTIL bDone

      ' // Windows message pump
      DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
         IF msg.message = %WM_QUIT THEN
            bDone = %TRUE
         ELSE
            IF msg.message = %WM_KEYDOWN THEN
               vKeyCode = msg.wParam
               bKeyDown = %TRUE
            ELSEIF msg.message = %WM_KEYUP THEN
               vKeyCode = msg.wParam
               bKeyDown = %FALSE
            END IF
            TranslateMessage msg
            DispatchMessage msg
         END IF
      LOOP

#IF %DEF(%UNICODE)
      LOCAL szCaption AS WSTRINGZ * 256
#ELSE
      LOCAL szCaption AS ASCIIZ * 256
#ENDIF
      IF ISFALSE bFullScreen THEN
         ' // Get time and mouse position
         t = INT(TIMER)
         ' // Calculate and display FPS (frames per second)
         IF t > t0 OR nFrames = 0 THEN
            fps = nFrames \ (t - t0)
            wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
            SetWindowText hwnd, szCaption
            t0 = t
            nFrames = 0
         END IF
         nFrames = nFrames + 1
      END IF

      ' // Draw the scene
      DrawScene hwnd, nWidth, nHeight
      ' // Exchange the front and back buffers
      SwapBuffers hDC

      ' // Process the keystrokes
      IF vKeyCode THEN
         ProcessKeystrokes hwnd, vKeyCode, bKeyDown
         vKeyCode = 0
      END IF

   LOOP

   ' // Retore defaults
   IF bFullScreen THEN
      ChangeDisplaySettings BYVAL %NULL, 0
      ShowCursor %TRUE
   END IF

   FUNCTION = msg.wParam

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

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

   LOCAL  pf  AS LONG
   LOCAL  pfd AS PIXELFORMATDESCRIPTOR
   STATIC hRC AS LONG

   SELECT CASE wMsg

      CASE %WM_SYSCOMMAND

         ' // Disable the Windows screensaver
         IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION

         ' // Close the window
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_CREATE

         ' // Retrieve the device context handle
         hDC = GetDC(hwnd)

         ' // Fill the PIXELFORMATDESCRIPTOR structure
         pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)   ' Size of the structure
         pfd.nVersion        = 1                               ' Version number
         pfd.dwFlags         = %PFD_DRAW_TO_WINDOW _           ' Format must support window
                               OR %PFD_SUPPORT_OPENGL _        ' Format must support OpenGL
                               OR %PFD_DOUBLEBUFFER            ' Format must support double buffering
         pfd.iPixelType      = %PFD_TYPE_RGBA                  ' Request an RGBA format
         pfd.cColorBits      = %GL_BITSPERPEL                  ' Number of color bitplanes in each color buffer
         pfd.cRedBits        = 0                               ' Number of red bitplanes in each RGBA color buffer.
         pfd.cRedShift       = 0                               ' Shift count for red bitplanes in each RGBA color buffer.
         pfd.cGreenBits      = 0                               ' Number of green bitplanes in each RGBA color buffer.
         pfd.cGreenShift     = 0                               ' Shift count for green bitplanes in each RGBA color buffer.
         pfd.cBlueBits       = 0                               ' Number of blue bitplanes in each RGBA color buffer.
         pfd.cBlueShift      = 0                               ' Shift count for blue bitplanes in each RGBA color buffer.
         pfd.cAlphaBits      = 0                               ' Number of alpha bitplanes in each RGBA color buffer
         pfd.cAlphaShift     = 0                               ' Shift count for alpha bitplanes in each RGBA color buffer.
         pfd.cAccumBits      = 0                               ' Total number of bitplanes in the accumulation buffer.
         pfd.cAccumRedBits   = 0                               ' Number of red bitplanes in the accumulation buffer.
         pfd.cAccumGreenBits = 0                               ' Number of gree bitplanes in the accumulation buffer.
         pfd.cAccumBlueBits  = 0                               ' Number of blue bitplanes in the accumulation buffer.
         pfd.cAccumAlphaBits = 0                               ' Number of alpha bitplanes in the accumulation buffer.
         pfd.cDepthBits      = %GL_DEPTHBITS                   ' Depth of the depth (z-axis) buffer.
         pfd.cStencilBits    = 0                               ' Depth of the stencil buffer.
         pfd.cAuxBuffers     = 0                               ' Number of auxiliary buffers.
         pfd.iLayerType      = %PFD_MAIN_PLANE                 ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.bReserved       = 0                               ' Number of overlay and underlay planes.
         pfd.dwLayerMask     = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.dwVisibleMask   = 0                               ' Transparent color or index of an underlay plane.
         pfd.dwDamageMask    = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.

         ' // Find a matching pixel format
         pf = ChoosePixelFormat(hDC, pfd)
         IF ISFALSE pf THEN
            MessageBox hwnd, "Can't find a suitable pixel format", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Set the pixel format
         IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
            MessageBox hwnd, "Can't set the pixel format", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Create a new OpenGL rendering context
         hRC = wglCreateContext(hDC)
         IF ISFALSE hRC THEN
            MessageBox hwnd, "Can't create an OpenGL rendering context", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Make it current
         IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
            MessageBox hwnd, "Can't activate the OpenGL rendering context", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         EXIT FUNCTION

      CASE %WM_DESTROY
         ' // Clear resources
         Cleanup hwnd
         ' // Release the device and rendering contexts
         wglMakeCurrent hDC, 0
         ' // Make the rendering context no longer current
         wglDeleteContext hRC
         ' // Release the device context
         ReleaseDC hwnd, hDC
         ' // Post an WM_QUIT message
         PostQuitMessage 0
         EXIT FUNCTION

      CASE %WM_SIZE
         ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
         EXIT FUNCTION

      CASE %WM_LBUTTONDOWN, %WM_LBUTTONUP, %WM_MOUSEMOVE
         ProcessMouse hwnd, wMsg, wParam, LO(WORD, lParam), HI(WORD, lParam)
         EXIT FUNCTION

   END SELECT

   ' // Call the default window procedure to process unhandled messages
   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USERICHEDIT = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

%IDC_RICHEDIT = 101

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow with a resizable RichEdit control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a rich edit control without coordinates (it will be resized in WM_SIZE, below)
   pWindow.AddRichEdit(pWindow.hwnd, %IDC_RICHEDIT, "RichEdit box", 0, 0, 0, 0)

   ' // Add a button without coordinates (it will be resized in WM_SIZE, below)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)

   

   ' // Force reizing
   pWindow.Resize

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the controls
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_RICHEDIT), 100, 50, pWindow.ClientWidth - 200, pWindow.ClientHeight - 150, %TRUE
            pWIndow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

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

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow with Run File Dialog", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add buttons
   pWindow.AddButton(pWindow.hwnd, %IDOK, "&Start", 0, 0, 75, 23)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)


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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)

            CASE %IDOK
               AfxRunFileDialog hwnd, 0, "", "Run File Dialog", "", 0' %RFF_NOSEPARATEMEM
               EXIT FUNCTION

            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      ' // Process the RFN_VALIDATE notification message
      CASE %WM_NOTIFY
         LOCAL hr AS LONG
         LOCAL ptnmhdr AS NMHDR PTR
         LOCAL ptnmrfd AS NM_RUNFILEDLG PTR
         ptnmhdr = lParam
         SELECT CASE @ptnmhdr.code
            CASE %RFN_VALIDATE
               ptnmrfd = lParam
               LOCAL wszPath AS WSTRINGZ * %MAX_PATH
               wszPath = @ptnmrfd.@lpDirectory & @ptnmrfd.@lpFile
               hr = MessageBox(BYVAL hwnd, "Run the file " & wszPath, "", _
                               %MB_YESNOCANCEL OR %MB_ICONQUESTION OR %MB_APPLMODAL)
               SELECT CASE hr
                  CASE %IDYES : FUNCTION = %RF_OK
                  CASE %IDNO  : FUNCTION = %RF_RETRY
                  CASE ELSE   : FUNCTION = %RF_CANCEL
               END SELECT
               EXIT FUNCTION
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDOK), pWindow.ClientWidth - 195, pWindow.ClientHeight - 35, 75, 23, %TRUE
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

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

' ========================================================================================
' SDK open file dialog.
' ========================================================================================
SUB SdkSaveFileDialog (BYVAL hwnd AS DWORD)

   LOCAL i                AS LONG
   LOCAL nCount           AS LONG
   LOCAL dwStyle          AS DWORD
   LOCAL bstrInitialDir   AS WSTRING
   LOCAL bstrFileSpec     AS WSTRING
   LOCAL bstrDefExtension AS WSTRING
   LOCAL bstrFilter       AS WSTRING
   LOCAL bstrPath         AS WSTRING
   LOCAL bstrFile         AS WSTRING

   bstrInitialDir = CURDIR$
   bstrFileSpec = "*.BAS;*.INC"
   bstrDefExtension = "BAS"
   bstrFilter  = "PB Code Files (*.BAS)|*.BAS|"
   bstrFilter += "PB Include Files (*.INC)|*.INC|"
   bstrFilter += "All Files (*.*)|*.*"
   dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_ALLOWMULTISELECT

   IF AfxSaveFileDialog(hwnd, "", bstrFileSpec, bstrInitialDir, bstrFilter, bstrDefExtension, dwStyle) THEN
      bstrPath = bstrInitialDir & bstrFileSpec
      MSGBOX bstrPath
   END IF

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

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow with Save File Dialog", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add buttons
   pWindow.AddButton(pWindow.hwnd, %IDOK, "&Start", 0, 0, 75, 23)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)

   

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)

            CASE %IDOK
               SdkSaveFileDialog(hwnd)
               EXIT FUNCTION

            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDOK), pWindow.ClientWidth - 195, pWindow.ClientHeight - 35, 75, 23, %TRUE
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE ONCE "CWindow.inc"           ' // CWindow class
#INCLUDE ONCE "ProgressBarCtrl.inc"   ' // Progress bar wrappers

%IDC_START = 1001
%IDC_STATUSBAR = 1002
%IDC_PROGRESSBAR = 1003

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "Status bar with progress bar", 0, 0, 400, 200, 0, 0, CODEPTR(WindowProc))

   ' // Center the window
   pWindow.CenterWindow

   ' // Add a button
   pWindow.AddButton(pWindow.hwnd, %IDC_START, "&Start", 20, 20, 75, 23)

   ' // Add a status bar
   LOCAL hStatusbar AS DWORD
   hStatusbar = pWindow.AddStatusBar(pWindow.hwnd, %IDC_STATUSBAR, "", 0, 0, 0, 0)
   pWindow.SetStatusbarPartsBySize(hStatusbar, "160, -1")

   ' // Add a progress bar to the status bar
   LOCAL hProgressBar AS DWORD
   hProgressBar = pWindow.AddProgressBar(hStatusbar, %IDC_PROGRESSBAR, "", 0, 2, 160, 18)
   ' // Set the range
   ProgressBar_SetRange32(hProgressBar, 0, 100)
   ' // Set the initial position
   ProgressBar_SetPos(hProgressBar, 0)

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE %IDC_START
               ' // Retrieve the handle to the progress bar.
               LOCAL hProgressBar AS DWORD
               hProgressBar = GetDlgItem(GetDlgItem(hwnd, %IDC_STATUSBAR), %IDC_PROGRESSBAR)
               ' *** Test code ***
               ' // Sets the step increment.
               ProgressBar_SetStep(hProgressBar, 1)
               ' // Draws the bar.
               LOCAL i AS LONG
               FOR i = 1 TO 100
                  ' // Advances the current position for a progress bar by the step
                  ' // increment and redraws the bar to reflect the new position.
                  ProgressBar_StepIt(hProgressBar)
                  SLEEP 10
               NEXT
               ' // Clears the bar by reseting its position to 0.
               ProgressBar_SetPos(hProgressBar, 0)
         END SELECT

      CASE %WM_SIZE
         ' // Gets the handle of the status bar
         LOCAL hStatusBar AS DWORD
         hStatusBar = GetDlgItem(hwnd, %IDC_STATUSBAR)
         ' // Resizes it
         SendMessage hStatusBar, %WM_SIZE, wParam, lParam
         ' // Redraws it
         InvalidateRect hStatusBar, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_TabCtrl.pbtpl
' Contents: Template - CWindow with a tab control
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"        ' // CWindow class
#INCLUDE ONCE "TabCtrl.inc"        ' // Tab control wrappers
#INCLUDE ONCE "ComboBoxCtrl.inc"   ' // Combo box control wrappers
#INCLUDE ONCE "ListBoxCtrl.inc"    ' // List box control wrappers

' // Control identifiers
%IDC_TAB       = 1001
%IDC_EDIT1     = 1002
%IDC_EDIT2     = 1003
%IDC_BTNSUBMIT = 1004
%IDC_COMBO     = 1005
%IDC_LISTBOX   = 1006

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow with a Tab control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Change the class style to remove flicker
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize 470, 280
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a Tab control
   LOCAL hTab AS DWORD
   hTab = pWindow.AddTab(pWindow.hwnd, %IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 20)

   ' // Add tab pages
   LOCAL pTabPage1, pTabPage2, pTabPage3 AS IWindow
   pTabPage1 = pWindow.InsertTabPage(hTab, 0, "Tab 1", -1, 0, 0, CODEPTR(TabPage1_WndProc))
   pTabPage2 = pWindow.InsertTabPage(hTab, 1, "Tab 2", -1, 0, 0, CODEPTR(TabPage2_WndProc))
   pTabPage3 = pWindow.InsertTabPage(hTab, 2, "Tab 3", -1, 0, 0, CODEPTR(TabPage3_WndProc))

   ' // Add controls to the first page
   pWindow.AddLabel(pTabPage1.hwnd, -1, "First name", 15, 15, 121, 21)
   pWindow.AddLabel(pTabPage1.hwnd, -1, "Last name", 15, 50, 121, 21)
   pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT1, "", 165, 15, 186, 21)
   pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT2, "", 165, 50, 186, 21)
   pWindow.AddButton(pTabPage1.hwnd, %IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, %BS_DEFPUSHBUTTON)

   ' // Add controls to the 2nd page
   LOCAL hComboBox AS DWORD
   hComboBox = pTabPage2.AddComboBox(pTabPage2.hwnd, %IDC_COMBO, "", 20, 20, 191, 105)

   ' // Add controls to the 3rd page
   LOCAL hListBox AS DWORD
   hListBox = pTabPage3.AddListBox(pTabPage3.hwnd, %IDC_LISTBOX, "", 15, 20, 161, 120)

   ' // Fill the controls with some data
   LOCAL i AS LONG
   FOR i = 1 TO 9
      Combobox_AddString hComboBox, "Item" & STR$(i)
      ListBox_AddString hListBox,  "Item" & STR$(i)
   NEXT
   ComboBox_SetCurSel hComboBox, 0
   ListBox_SetCurSel hListBox, 0

   ' // Display the first tab page
   ShowWindow pTabPage1.hwnd, %SW_SHOW
   ' // Set the focus to the first tab
   TabCtrl_SetCurFocus hTab, 0

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

      CASE %WM_NOTIFY

         LOCAL nPage AS DWORD         ' // Page number
         LOCAL pTabPage AS IWindow    ' // Tab page object reference
         LOCAL tci AS TCITEM          ' // TCITEM structure

         LOCAL ptnmhdr AS NMHDR PTR   ' // Information about a notification message
         ptnmhdr = lParam
         SELECT CASE @ptnmhdr.idFrom
            CASE %IDC_TAB
               SELECT CASE @ptnmhdr.code
                  CASE %TCN_SELCHANGE
                     ' // Show the selected page
                     nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
                     tci.mask = %TCIF_PARAM
                     TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
                     IF tci.lParam THEN
                        pTabPage = Ptr2Obj(tci.lParam)
                        IF ISOBJECT(pTabPage) THEN
                           ShowWindow pTabPage.hwnd, %SW_SHOW
                           pTabPage = NOTHING
                        END IF
                     END IF
                  CASE %TCN_SELCHANGING
                     ' // Hide the current page
                     nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
                     tci.mask = %TCIF_PARAM
                     TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
                     IF tci.lParam THEN
                        pTabPage = Ptr2Obj(tci.lParam)
                        IF ISOBJECT(pTabPage) THEN
                           ShowWindow pTabPage.hwnd, %SW_HIDE
                           pTabPage = NOTHING
                        END IF
                     END IF
               END SELECT

         END SELECT

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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

' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDC_BTNSUBMIT
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  MSGBOX "Submit"
                  EXIT FUNCTION
               END IF
         END SELECT

   END SELECT

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

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

' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hBrush AS DWORD
   LOCAL rc AS RECT
   LOCAL tlb AS LOGBRUSH

   SELECT CASE uMsg

      CASE %WM_ERASEBKGND
         GetClientRect hWnd, rc
         ' Create custom brush
         tlb.lbStyle = %BS_SOLID
         tlb.lbColor = &H00CB8734???
         tlb.lbHatch = 0
         hBrush = CreateBrushIndirect(tlb)
         ' Erase background
         FillRect wParam, rc, hBrush
         DeleteObject hBrush
         FUNCTION = %TRUE
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Tab page 3 window procedure
' ========================================================================================
FUNCTION TabPage3_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hBrush AS DWORD
   LOCAL rc AS RECT
   LOCAL tlb AS LOGBRUSH

   SELECT CASE uMsg

      CASE %WM_ERASEBKGND
         GetClientRect hWnd, rc
         ' Create custom brush
         tlb.lbStyle = %BS_SOLID
         tlb.lbColor = %GREEN
         tlb.lbHatch = 0
         hBrush = CreateBrushIndirect(tlb)
         ' Erase background
         FillRect wParam, rc, hBrush
         DeleteObject hBrush
         FUNCTION = %TRUE
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

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

%IDC_TOOLBAR    = 1001

%IDM_CUT        = 28000
%IDM_COPY       = 28001
%IDM_PASTE      = 28002
%IDM_UNDO       = 28003
%IDM_REDOW      = 28004
%IDM_DELETE     = 28005
%IDM_FILENEW    = 28006
%IDM_FILEOPEN   = 28007
%IDM_FILESAVE   = 28008
%IDM_PRINTPRE   = 28009
%IDM_PROPERTIES = 28010
%IDM_HELP       = 28011
%IDM_FIND       = 28012
%IDM_REPLACE    = 28013
%IDM_PRINT      = 28014

' ========================================================================================
' Create the toolbar
' ========================================================================================
FUNCTION CreateToolBar (BYVAL pWindow AS IWindow) AS DWORD

   ' // Add a toolbar
   LOCAL hToolBar AS DWORD
   hToolBar = pWindow.AddToolBar(pWindow.hwnd, %IDC_TOOLBAR, "", 0, 0, 0, 0, _
              %WS_VISIBLE OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR %CCS_TOP OR %WS_BORDER OR %TBSTYLE_FLAT)

   ' // Add a bitmap with the button images
   LOCAL ttbab AS TBADDBITMAP
   ttbab.hInst = %HINST_COMMCTRL
   IF pWindow.IsProcessDPIAware THEN
      ttbab.nId = %IDB_STD_LARGE_COLOR
   ELSE
      ttbab.nId = %IDB_STD_SMALL_COLOR
   END IF
   ToolBar_AddBitmap hToolBar, 15, ttbab

   ' // Add buttons to the toolbar
   Toolbar_AddButton hToolBar, %STD_CUT, %IDM_CUT
   Toolbar_AddButton hToolBar, %STD_COPY, %IDM_COPY
   Toolbar_AddButton hToolBar, %STD_PASTE, %IDM_PASTE
   Toolbar_AddButton hToolBar, %STD_DELETE, %IDM_DELETE
   ToolBar_AddSeparator hToolBar
   Toolbar_AddButton hToolBar, %STD_UNDO, %IDM_UNDO
   Toolbar_AddButton hToolBar, %STD_REDOW, %IDM_REDOW
   ToolBar_AddSeparator hToolBar
   Toolbar_AddButton hToolBar, %STD_FILENEW, %IDM_FILENEW
   Toolbar_AddButton hToolBar, %STD_FILEOPEN, %IDM_FILEOPEN
   Toolbar_AddButton hToolBar, %STD_FILESAVE, %IDM_FILESAVE
   Toolbar_AddButton hToolBar, %STD_PRINTPRE, %IDM_PRINTPRE
   ToolBar_AddSeparator hToolBar
   Toolbar_AddButton hToolBar, %STD_FIND, %IDM_FIND
   Toolbar_AddButton hToolBar, %STD_REPLACE, %IDM_REPLACE
   ToolBar_AddSeparator hToolBar
   Toolbar_AddButton hToolBar, %STD_PROPERTIES, %IDM_PROPERTIES
   Toolbar_AddButton hToolBar, %STD_PRINT, %IDM_PRINT
   ToolBar_AddSeparator hToolBar
   Toolbar_AddButton hToolBar, %STD_HELP, %IDM_HELP

   ' // Size the toolbar
   ToolBar_AutoSize hToolBar

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

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow with a toolbar", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Disable background erasing
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client siz
   pWindow.SetClientSize 600, 350
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a button without coordinates (it will be reiszed in WM_SIZE, below)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)

   ' // Add the toolbar
   CreateToolBar pWindow

   

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

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

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

           CASE %IDM_CUT
               MSGBOX "Cut button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_COPY
               MSGBOX "Copy button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_PASTE
               MSGBOX "Paste button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_UNDO
               MSGBOX "Undo button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_REDOW
               MSGBOX "Redo button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_DELETE
               MSGBOX "Delete button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_FILENEW
               MSGBOX "File New button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_FILEOPEN
               MSGBOX "File Open button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_FILESAVE
               MSGBOX "File Save button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_PRINTPRE
               MSGBOX "Print Preview button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_PROPERTIES
               MSGBOX "Properties button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_HELP
               MSGBOX "Help button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_FIND
               MSGBOX "Find button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_REPLACE
               MSGBOX "Replace button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

            CASE %IDM_PRINT
               MSGBOX "Print button clicked"
               FUNCTION = %FALSE
               EXIT FUNCTION

         END SELECT

      CASE %WM_SYSCOLORCHANGE
         ' // Forward this message to common controls so that they will
         ' // be properly updated when the user changes the color settings.
         SendMessage GetDlgItem(hWnd, %IDC_TOOLBAR), %WM_SYSCOLORCHANGE, wParam, lParam

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Update the size and position of the Toolbar control
            ToolBar_AutoSize GetDlgItem(hWnd, %IDC_TOOLBAR)
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEWEBBROWSER = 1            ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Identifier
%IDC_WEBBROWSER = 101

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "AddWebBrowser Template", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client siz
   pWindow.SetClientSize 600, 350
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a WebBrowser control
   LOCAL hCtl AS DWORD
   LOCAL bstrURL AS WSTRING

   ' // You can pass a URL
   bstrURL = "http://www.jose.it-berater.org/smfforum/index.php"

   ' // or a path to an Active document file (Excel, Word or PDF)
'   bstrURL = EXE.Path$ & "Test.xls"              ' <-- change me!
'   bstrURL = EXE.Path$ & "JetSQL.doc"            ' <-- change me!
'   bstrURL = EXE.Path$ & "COMCollections.pdf"    ' <-- change me!

   ' // or a fragment of HTML code (remember to always start with "MSHTML:")
'   bstrURL = "MSHTML:<HTML><BODY>This is a line of text</BODY></HTML>"

   ' // or a web page (remember to always start with "MSHTML:")
'   LOCAL s AS WSTRING
'   LOCAL bstrName AS WSTRING

'   S =  "MSHTML:<?xml version=""1.0""?>"
'   s += "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" & $CRLF
'   s += "<html xmlns=""http://www.w3.org/1999/xhtml"">" & $CRLF
'   s += "<head>" & $CRLF
'   s += "<title>Image Test</title>" & $CRLF
'   s += "</head>" & $CRLF
'   s += "<body scroll=" & $DQ & "auto" & $DQ & " style=" & $DQ & "MARGIN: 0px 0px 0px 0px" & $DQ & " >" & $CRLF
'   bstrName = EXE.Path$ & "Ciutat_de_les_Arts_i_de_les_Ciencies_02.jpg"
'   s += "<img src=" & $DQ & bstrName & $DQ & " alt=" & $DQ & bstrName & $DQ & " title=" & $DQ & bstrName & $DQ & " "
'   s += "/>" & $CRLF
'   s += "</body>" & $CRLF
'   s += "</html>" & $CRLF
'   bstrURL = s

   ' // Create the control
   hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrURL, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   

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

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEWEBBROWSER = 1            ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Identifier
%IDC_WEBBROWSER = 101

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "AddWebBrowser Template", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 350
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a WebBrowser control
   LOCAL hCtl AS DWORD
   LOCAL bstrHTML AS WSTRING

   ' // Script to display the picture
   bstrHTML  = "MSHTML:" & $CRLF
   bstrHTML += "<body scroll='auto' style='margin: 0px 0px 0px 0px'>" & $CRLF
   bstrHTML += "<img src='http://celeb-world.net/d/4134-2/nicolekidman3.jpg' border='0' width='100%'></img>"
   bstrHTML += "</body>"

   ' // Script to display the picture centered
'   bstrHTML  = "MSHTML:" & $CRLF
'   bstrHTML += "<body scroll='auto' style='margin: 0px 0px 0px 0px'>" & $CRLF
'   bstrHTML += "<center>" & $CRLF
'   bstrHTML += "<img src='http://celeb-world.net/d/4134-2/nicolekidman3.jpg' border='0' height='100%'></img>"
'   bstrHTML += "</center>" & $CRLF
'   bstrHTML += "</body>"

   ' // Create the control
   hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrHTML, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   ' // Note: Right click with the mouse to activate the options menu

   

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

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEWEBBROWSER = 1            ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Identifier
%IDC_WEBBROWSER = 101

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "AddWebBrowser Template: Image hyperlink", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 400, 260
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a WebBrowser control
   LOCAL hCtl AS DWORD
   LOCAL bstrHTML AS WSTRING

   ' // Script to display the hyperlink
   bstrHTML  = "MSHTML:" & $CRLF
   bstrHTML += "<body scroll='no' style='margin: 0px 0px 0px 0px'>" & $CRLF
   bstrHTML += "<a href='http://www.jose.it-berater.org/smfforum/index.php' target='_blank'>" & _
               "<img src='http://www.jose.it-berater.org/webpages_images/h_2.jpg' width='100%' height='100%' alt='Jose Roca Software'></a>"
   bstrHTML += "</body>"

   ' // Create the control
   hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrHTML, NOTHING, 45, 45, 311, 170)

   ' // Note: Right click with the mouse to activate the options menu

   

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

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEWEBBROWSER = 1            ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Identifier
%IDC_WEBBROWSER = 1001

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "AddWebBrowser Template: Google Map", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 700, 500
   ' // Center the window
   pWindow.CenterWindow
   ' Web Browser zoom
   IF pWindow.IsProcessDPIAware THEN pWindow.WBZoom = 100 * pWindow.rxRatio

   ' // Build the html script
   LOCAL s AS WSTRING
   LOCAL cx, cy AS DOUBLE
   LOCAL zoom AS LONG
   cx = 39.47#
   cy = 0.28#
   zoom = 7

   s  = "<!DOCTYPE html>"
   s += "<html>"
   s += "<head>"
   s += "<meta name='viewport' content='initial-scale=1.0, user-scalable=no' />"
   s += "<style type='text/css'>" & $CRLF
   s += "html { height: 100% }" & $CRLF
   s += "  body { height: 100%; margin: 0px; padding: 0px }" & $CRLF
   s += "  #map_canvas { height: 100% }" & $CRLF
   s += "</style>" & $CRLF
   s += "<script type='text/javascript'" & $CRLF
   s += "    src='http://maps.google.com/maps/api/js?sensor=false'>" & $CRLF
   s += "</script>" & $CRLF
   s += "<script type='text/javascript'>" & $CRLF
   s += "  function initialize() {" & $CRLF
   s += "    var latlng = new google.maps.LatLng(" & FORMAT$(cx) & "," & FORMAT$(cy) & ");" & $CRLF
   s += "    var myOptions = {" & $CRLF
   s += "      zoom: " & FORMAT$(zoom) & "," & $CRLF
   s += "      center: latlng," & $CRLF
   s += "      mapTypeId: google.maps.MapTypeId.ROADMAP" & $CRLF
   s += "    };" & $CRLF
   s += "    var map = new google.maps.Map(document.getElementById('map_canvas')," & $CRLF
   s += "        myOptions);" & $CRLF
   s += "  }" & $CRLF
   s += "</script>" & $CRLF
   s += "</head>" & $CRLF
   s += "<body scroll='no' onload='initialize()'>" & $CRLF
   s += "  <div id='map_canvas' style='width:100%; height:100%'></div>" & $CRLF
   s += "</body>" & $CRLF
   s += "</html>" & $CRLF

   ' // Save the script as a temporary file
   LOCAL bstrTempFileName AS WSTRING
   bstrTempFileName = AfxSaveTempFile(s, "", "TMP", "html", 1)

   ' // Create the WebBrowser control with the embedded map
   pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrTempFileName, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   

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

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEWEBBROWSER = 1            ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Identifier
%IDC_WEBBROWSER = 101

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

   ' // Set process DPI aware
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "AddWebBrowser Template: Virtual Earth Map", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 700, 500
   ' // Center the window
   pWindow.CenterWindow
   ' // Set the web browser zoom
   IF pWindow.IsProcessDPIAware THEN pWindow.WBZoom = 100 * pWindow.rxRatio

   ' // Build the html script
   LOCAL s AS WSTRING
   LOCAL cx, cy AS DOUBLE
   LOCAL zoom AS LONG
   cx = -6.89186#
   cy = 107.59987#
   zoom = 8

   s  = "<!DOCTYPE html>" & $CRLF
   s += "<html>" & $CRLF
   s += "<head>" & $CRLF
   s += "   <title>Virtual Earth Map</title>" & $CRLF
   s += "   <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & $CRLF
   s += "   <script type='text/javascript' src='http://dev.virtualearth.net/mapcontrol/mapcontrol.ashx?v=6'>" & $CRLF
   s += "   </script>" & $CRLF
   s += "   <script type='text/javascript'>" & $CRLF
   s += "      var map = null;" & $CRLF
   s += "      var dyCodeCoord = new VELatLong(" & FORMAT$(cx) & ", " & FORMAT$(cy) & ");" & $CRLF
   s += "      function GetMap()" & $CRLF
   s += "         {" & $CRLF
   s += "            map = new VEMap('myMap');" & $CRLF
   s += "            map.LoadMap(dyCodeCoord," & FORMAT$(zoom) & ");" & $CRLF
   s += "         }" & $CRLF
   s += "   </script>" & $CRLF
   s += "   <style type='text/css'>" & $CRLF
   s += "      .map" & $CRLF
   s += "      {" & $CRLF
   s += "         position: absolute;" & $CRLF
   s += "         top: 0;" & $CRLF
   s += "         left: 0;" & $CRLF
   s += "         width: 100%;" & $CRLF
   s += "         height: 100%;" & $CRLF
   s += "      }" & $CRLF
   s += "   </style>" & $CRLF
   s += "</head>" & $CRLF
   s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px' onload='GetMap();'>" & $CRLF
   s += "<body>" & $CRLF
   s += "   <div id='myMap' class='map'>" & $CRLF
   s += "   </div>" & $CRLF
   s += "</body>" & $CRLF
   s += "</html>" & $CRLF

   ' // Save the script as a temporary file
   LOCAL bstrTempFileName AS WSTRING
   bstrTempFileName = AfxSaveTempFile(s, "", "TMP", "html", 1)

   ' // Create the WebBrowser control with the embedded map
   pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrTempFileName, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   

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

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
         END IF

      CASE %WM_DESTROY
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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