PureBoard

Code: Alles auswählen

; Basis von infratec - SetBrowserEmulation() von Kiffi

Enumeration
  #StatusBar
  #ButtonBack
  #ButtonNext
  #ButtonStop
  #ButtonGo
  #GadgetURL
  #FrameGadget
  #WebGadget
EndEnumeration  

  Procedure NavigationCallback(Gadget, Url$) 
      SetGadgetText(#GadgetURL, GetGadgetText(#WebGadget))
      ProcedureReturn #True 
  EndProcedure 


Procedure WebGadgetKeepQuiet(Status)
  Define browser.IWebBrowser2
  browser = GetWindowLongPtr_(GadgetID(#WebGadget), #GWL_USERDATA)
  If browser: browser\put_Silent(Status): EndIf 
EndProcedure

Procedure SetBrowserEmulation() ; muß pro Exe nur einmal aufgerufen werden.
  
  ; https://msdn.microsoft.com/en-us/library/ee330730(v=vs.85).aspx
  
  Protected IEVersion.s = "2AF9" ; setting the desired IE-Version (see below)
  
  ; 11001 (0x2AF9) IE11. Webpages are displayed in IE11 edge mode, regardless of the declared !DOCTYPE directive. Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
  ; 11000 (0x2AF8) IE11. Webpages containing standards-based !DOCTYPE directives are displayed in IE11 edge mode. Default value for IE11.
  ; 10001 (0x2711) IE10. Webpages are displayed in IE10 Standards mode, regardless of the !DOCTYPE directive.
  ; 10000 (0x2710) IE10. Webpages containing standards-based !DOCTYPE directives are displayed in IE10 Standards mode. Default value for IE 10.
  ;  9999 (0x270F) IE9.  Webpages are displayed in IE9 Standards mode, regardless of the declared !DOCTYPE directive. Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
  ;  9000 (0x2328) IE9.  Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode. Default value for IE 9. Important  In IE 10, Webpages containing standards-based !DOCTYPE directives are displayed in IE10 Standards mode.
  ;  8888 (0x22B8) IE8.  Webpages are displayed in IE8 Standards mode, regardless of the declared !DOCTYPE directive. Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
  ;  8000 (0x1F40) IE8.  Webpages containing standards-based !DOCTYPE directives are displayed in IE8 mode. Default value for IE 8 Important  In IE 10, Webpages containing standards-based !DOCTYPE directives are displayed in IE10 Standards mode.
  ;  7000 (0x1B58) IE7.  Webpages containing standards-based !DOCTYPE directives are displayed in IE7 Standards mode. Default value for applications hosting the WebBrowser Control. 
  
  Protected RegistryString.s
  Protected TempRegFile.s
  Protected FF
  
  RegistryString = "Windows Registry Editor Version 5.00" + #CRLF$ +
                   "" + #CRLF$ +
                   "[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION]" + #CRLF$ +
                   Chr(34) + GetFilePart(ProgramFilename()) + Chr(34) + "=dword:" + IEVersion + #CRLF$
  
  TempRegFile = GetTemporaryDirectory() + "SetBrowserEmulation.reg"
  
  FF = CreateFile(#PB_Any, TempRegFile)
  
  If FF
    WriteString(FF, RegistryString)
    CloseFile(FF)
    RunProgram("regedit", "/s " + Chr(34) + TempRegFile + Chr(34), "", #PB_Program_Hide | #PB_Program_Wait)
    DeleteFile(TempRegFile)
    ProcedureReturn #True
  EndIf
  
EndProcedure

Procedure ResizeWebWindow()
  ResizeGadget(#WebGadget, #PB_Ignore, #PB_Ignore, WindowWidth(0), WindowHeight(0)-52)
  ResizeGadget(#GadgetURL, #PB_Ignore, #PB_Ignore, WindowWidth(0)-185, #PB_Ignore)
  ResizeGadget(#ButtonGo, WindowWidth(0)-25, #PB_Ignore, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#FrameGadget, #PB_Ignore, #PB_Ignore, WindowWidth(0), #PB_Ignore)
EndProcedure

SetBrowserEmulation()

If OpenWindow(0, 100, 200, 500, 300, "PureBasic MiniBrowser v1.0", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
  
  CreateStatusBar(#StatusBar, WindowID(0))
  AddStatusBarField(#PB_Ignore)
  StatusBarText(#StatusBar, 0, "Welcome to the world's smallest Browser ! :)", 0)
  
  ButtonGadget(#ButtonBack,   0, 0, 50, 25, "Back")
  ButtonGadget(#ButtonNext,  50, 0, 50, 25, "Next")
  ButtonGadget(#ButtonStop, 100, 0, 50, 25, "Stop")
  
  StringGadget(#GadgetURL, 155, 5, 0, 20, "https://www.google.com")
  
  ButtonGadget(#ButtonGo, 0, 0, 25, 25, "Go")
  
  FrameGadget(#FrameGadget, 0, 30, 0, 2, "", 2) ; Nice little separator
  
  If WebGadget(#WebGadget, 0, 31, 0, 0, "https://www.google.com")
    SetGadgetAttribute(#WebGadget, #PB_Web_NavigationCallback, @NavigationCallback())
  Else
    
    CompilerIf #PB_Compiler_OS = #PB_OS_Windows
      MessageRequester("Error", "ATL.dll not found", 0)
      
    CompilerElse ; Linux and OX uses Webkit
      MessageRequester("Error", "Webkit library not found", 0)
    CompilerEndIf
    
    End ; Quit
  EndIf
  
  AddKeyboardShortcut(0, #PB_Shortcut_Return, 0)
  
  ResizeWebWindow()
  
  
  SmartWindowRefresh(0,1)
  
  BindEvent(#PB_Event_SizeWindow,@ResizeWebWindow())
  
  WebGadgetKeepQuiet(#False)
  
  Repeat
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_Gadget
        
        Select EventGadget()
          Case #ButtonBack
            SetGadgetState(#WebGadget, #PB_Web_Back)
            
          Case #ButtonNext
            SetGadgetState(#WebGadget, #PB_Web_Forward)
            
          Case #ButtonStop
            SetGadgetState(#WebGadget, #PB_Web_Stop)
            
          Case #ButtonGo
            SetGadgetText(#WebGadget, GetGadgetText(#GadgetURL))
            
        EndSelect     
        
      Case #PB_Event_Menu ; We only have one shortcut
        SetGadgetText(#WebGadget, GetGadgetText(#GadgetURL))
        
    EndSelect
    
  Until Event = #PB_Event_CloseWindow
  
EndIf