CWindow: YouTube example

José Roca · September 09, 2015, 11:06:33 AM

And the fun begins!


' ########################################################################################
' Microsoft Windows
' File: CW_YouTube_HDPI.fbtpl
' Contents: CWindow YouTube example (High DPI)
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2015 Jose 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.
' ########################################################################################
#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxWin.inc"

USING Afx.CWindowClass

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG


   END WinMain(GetModuleHandle(""), NULL, COMMAND(), SW_NORMAL)

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   FUNCTION = 0

   SELECT CASE AS CONST uMsg

      CASE WM_CREATE
         EXIT FUNCTION

      CASE WM_COMMAND
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the buttons
            DIM pWindow AS CWindow PTR
            pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
            pWindow->MoveWindow GetDlgItem(hwnd, 1001), 0, 0, pWindow->ClientWidth, pWindow->ClientHeight, TRUE
         END IF

    	CASE WM_DESTROY
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Build the YouTube script
' ========================================================================================
FUNCTION BuildYouTubeScript (BYVAL strCode AS STRING, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG) AS STRING

   ' // Build the URL
   DIM strURL AS STRING = "http://www.youtube.com/v/" & strCode

   ' // Build the web page. Remember to always start it with "MSHTML:".
   DIM s AS STRING
   s  = "MSHTML:<!DOCTYPE html>" & CHR(13, 10)
   s += "<html>" & CHR(13, 10)
   s += "<head>" & CHR(13, 10)
   s += "<meta http-equiv='MSThemeCompatible' content='Yes'>" & CHR(13, 10)
   s += "<title>YouTube video</title>" & CHR(13, 10)
   s += "" & CHR(13, 10)
   s += "</head>" & CHR(13, 10)
   s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
   s += "<object width=" & STR(nWidth) & " height=" & STR(nHeight) & ">" & _
        "<param name='movie' value=" & strURL & "</param>" & _
        "<embed src=" & strURL & _
        " type='application/x-shockwave-flash' width='100%' height='100%'>" & _
        "</embed></object>"
   s += "" & CHR(13, 10)
   s += "</body>" & CHR(13, 10)
   s += "" & CHR(13, 10)
   s += "</html>" & CHR(13, 10)

   FUNCTION = s

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

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow YouTube Test", @WndProc)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   DIM hLib AS ANY PTR
   hLib = DylibLoad("atl.dll")
   DIM AS SUB AtlAxWinInit
   AtlAxWinInit = DylibSymbol(hLib, "AtlAxWinInit")
   AtlAxWinInit()
   DIM strCode AS STRING = "_oAgkTwFRuM"   ' --> Change me: 11 character video code
   DIM s AS STRING = BuildYouTubeScript(strCode, pWindow.ClientWidth, pWindow.ClientHeight)
   pWindow.AddControl("AtlAxWin", pWindow.hWindow, 1001, s, 0, 0, 0, 0, WS_VISIBLE)

   FUNCTION = pWindow.DoEvents(nCmdShow)

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

PlanetSquires Forums

CWindow: YouTube example

José Roca