[ ERLEDIGT ] Home button für eigenen Browser ?

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

[ ERLEDIGT ] Home button für eigenen Browser ?

Beitrag von udg »

Hallo,
heute habe ich ein wenig an meinem Browser-Test gebastelt und dachte einen "homebutton" kein Problem.
Naja wie immer, für mich doch.

Global gebe ich an: http://www.google.de

wenn ich nun auf eine andere Seite browse und dann oben auf "home" klicke, möchte ich, dass das Webgadget wieder die Startseite, in diesem Fall "google.de" anzeigt.

jemand eine Idee?


danke

Code: Alles auswählen

;{ Keyboard Shortcut Enumerations
Enumeration 1
  #OLECMDID_OPEN
  #OLECMDID_NEW
  #OLECMDID_SAVE
  #OLECMDID_SAVEAS
  #OLECMDID_SAVECOPYAS
  #OLECMDID_PRINT
  #OLECMDID_PRINTPREVIEW
  #OLECMDID_PAGESETUP
  #OLECMDID_SPELL
  #OLECMDID_PROPERTIES
  #OLECMDID_CUT
  #OLECMDID_COPY
  #OLECMDID_PASTE
  #OLECMDID_PASTESPECIAL
  #OLECMDID_UNDO
  #OLECMDID_REDO
  #OLECMDID_SELECTALL
  #OLECMDID_CLEARSELECTION
  #OLECMDID_ZOOM
  #OLECMDID_GETZOOMRANGE
  #OLECMDID_UPDATECOMMANDS
  #OLECMDID_REFRESH
  #OLECMDID_STOP
  #OLECMDID_HIDETOOLBARS
  #OLECMDID_SETPROGRESSMAX
  #OLECMDID_SETPROGRESSPOS
  #OLECMDID_SETPROGRESSTEXT
  #OLECMDID_SETTITLE
  #OLECMDID_SETDOWNLOADSTATE
  #OLECMDID_STOPDOWNLOAD
EndEnumeration

Enumeration 0
  #OLECMDEXECOPT_DODEFAULT
  #OLECMDEXECOPT_PROMPTUSER
  #OLECMDEXECOPT_DONTPROMPTUSER
  #OLECMDEXECOPT_SHOWHELP
EndEnumeration
;}
Enumeration
  #Window_0

EndEnumeration
Enumeration
  ;Main Window
    #Window_0
    
  ;PopUp Window aus Prozedur  
    #MainForm

  ; Main Gadgets 
    #Btn_Exit
    #Image_Exit_Normal
    #Image_Exit_Red
    #Editor_Gadget
    #MausArea
    #Font_MausArea
    #Btn_Save
    #Font_Btn_Save
    #Font_Editor_Gadget
    #Btn_OpenBrowserGadget
    
    ;WebGadget
      #WebGadget
      #Btn_CloseWebGadget
      #Font_Btn_CloseWebGadget
      #Btn_Reload
      #Font_Btn_Reload
      #Btn_Nav_Back
      #Font_Btn_Nav_Back
      #Btn_Nav_Frwd
      #Font_Btn_Nav_Frwd
      #Show_Current_Url
      #Font_Current_Url
      #Btn_Start_Browsing
      #Btn_Home
      #Font_Start_Browsing
      #Separater
      #ProgressBar
EndEnumeration
;Included Images
DataSection
  Image_Exit_Normal:
  ; exit_normal.png
  ;{ Size = 328 bytes
  Data.l $474E5089,$0A1A0A0D,$0D000000,$52444849,$22000000,$17000000,$00000208,$3A959601,$0000001D,$59487009,$0E000073,$0E0000C3
  Data.l $6FC701C3,$000064A8,$4449FA00,$9C785441,$FFFFF963,$6012033F,$19B75081,$F9915418,$647970AA,$74582CF5,$06865162,$1DF61450
  Data.l $C0722860,$812C8721,$AC164CCF,$071228A2,$BD9F12FA,$9CEA8864,$50E12E8F,$7E589554,$519B0A3A,$E13BF3AA,$0763C6DE,$76129F1E
  Data.l $2CF41517,$ED344F2B,$4D8AAF9C,$781EA70A,$07A09040,$CF4B200F,$5D1B8740,$2F9624F4,$5A69DF9B,$33A18CBE,$610C4B0A,$00D403D7
  Data.l $3BF3924C,$62CAB0A3,$BCACB3D7,$EEA7BE6D,$4A8CA46D,$11240F58,$5380D560,$A8307E0F,$DE9190F5,$0E86B1C8,$6B708C76,$76F96580
  Data.l $17CF2A89,$E2190B6D,$11D5A3E7,$C1C6B454,$1B7B75D7,$D7310ED0,$20EC122A,$D9601ACD,$7E3C5BBD,$46507CFE,$912B7A04,$60910F14
  Data.l $C3A7300D,$A287130B,$40DAC4F9,$809435AA,$000D65E1,$754D2247,$528F5DE3,$00000000,$444E4549,$826042AE
  Image_Exit_Normal_End:
  ;}
  Image_Exit_Red:
  ; exit_red.png
  ;{ Size = 326 bytes
  Data.l $474E5089,$0A1A0A0D,$0D000000,$52444849,$22000000,$17000000,$00000208,$3A959601,$0000001D,$59487009,$0E000073,$0E0000C3
  Data.l $6FC701C3,$000064A8,$4449F800,$9C785441,$AEC33963,$580480CE,$03371420,$FE6457C3,$B23CB857,$3A2C167A,$034328B1,$92550A28
  Data.l $C5CCEE19,$812C8721,$AC164CCF,$221228A2,$28706F1B,$D1D13C33,$E3789740,$C57C691F,$A33609E3,$39D59FCE,$781D844F,$5DD84A7C
  Data.l $7323D054,$1D7BC6E5,$A4D8AF8D,$0781EA70,$F07A0904,$0CF4B200,$45D1B874,$CA95F18F,$B43B3AB3,$96AE187B,$C594C79C,$01A807AE
  Data.l $EACF2498,$8F6093B4,$67E595CC,$23710FFB,$7AC25465,$AB008920,$F07A9C06,$87AD4183,$8E46F48C,$63B07435,$2C035B84,$476FC5CB
  Data.l $2E5D54BE,$D67750CF,$ACAD157F,$50BED379,$8ED000FC,$481D2F87,$6B3483B0,$F8B76580,$1CB3BADD,$F4088CA0,$1E293196,$601AC122
  Data.l $70D7874E,$DE35FC6F,$9073AF10,$6EC18126,$B735000D,$24470847,$00009783,$45490000,$42AE444E
  Data.b $60,$82
  Image_Exit_Red_End:
  ;}
EndDataSection

;Image Plugins
  UsePNGImageDecoder()

Define Event
Global WebObject.IWebBrowser2

;Home ,Startseite
Global Url.s="http://www.google.de"
;{
Procedure RegConvertRegKeyToTopKeyAndKeyName(Key.s)
 
  Shared topKey,KeyName.s
 
  temp.s=StringField(Key,1,"\")
  temp=UCase(temp)
  Select temp
    Case "HKEY_CLASSES_ROOT"
      topKey=#HKEY_CLASSES_ROOT
    Case "HKEY_CURRENT_USER"
      topKey=#HKEY_CURRENT_USER
    Case "HKEY_LOCAL_MACHINE"
      topKey=#HKEY_LOCAL_MACHINE
    Case "HKEY_USERS"
      topKey=#HKEY_USERS
    Case "HKEY_CURRENT_CONFIG"
      topKey=#HKEY_CURRENT_CONFIG
  EndSelect
 
  PositionSlash=FindString(Key,"\",1)
  KeyName.s=Right(Key,(Len(Key)-PositionSlash))
 
EndProcedure

ProcedureDLL RegSetValue(Key.s, ValueName.s, Value.s, Type, ComputerName.s) ; Sets a Value
 
  ;Type can be #REG_SZ / #REG_DWORD / #REG_BINARY / #REG_EXPAND_SZ
  ;For REG_BINARY type use Hexa value as String
  ;Returns 1 if successful or 0 if it fails
 
  Shared RegWow64.l,RegEx,topKey,KeyName.s
  RegConvertRegKeyToTopKeyAndKeyName(Key)
 
  If ComputerName = "."
    If RegEx
      GetHandle = RegOpenKeyEx_(topKey,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey)
    Else
      GetHandle = RegOpenKey_(topKey,KeyName,@hKey)
    EndIf
  Else
    lReturnCode = RegConnectRegistry_(ComputerName,topKey,@lhRemoteRegistry)
    If RegEx
      GetHandle = RegOpenKeyEx_(lhRemoteRegistry,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey)
    Else
      GetHandle = RegOpenKey_(lhRemoteRegistry,KeyName,@hKey)
    EndIf
  EndIf
 
  If GetHandle = #ERROR_SUCCESS
    lpcbData = 255
    lpData.s = Space(255)
   
    Select Type
       
      Case #REG_EXPAND_SZ
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_EXPAND_SZ, @Value, Len(Value) + 1)
       
      Case #REG_SZ
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_SZ, @Value, Len(Value) + 1)
       
      Case #REG_DWORD
        lValue = Val(Value)
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @lValue, 4)
       
      Case #REG_BINARY
        LenBuffer=Len(Value)/2
        *RegBuffer=AllocateMemory(LenBuffer)
        For n=0 To LenBuffer-1
          OctetHexa.s=Mid(Value,(n*2)+1,2)
          Octet=Val("$"+OctetHexa)
          PokeB(*RegBuffer+n,Octet)
        Next
        GetHandle= RegSetValueEx_(hKey,ValueName,0,#REG_BINARY,*RegBuffer,LenBuffer)
        FreeMemory(*RegBuffer)
       
    EndSelect
   
    RegCloseKey_(hKey)
    ergebnis = 1
    ProcedureReturn ergebnis
  Else
    RegCloseKey_(hKey)
    ergebnis = 0
    ProcedureReturn ergebnis
  EndIf
EndProcedure

ProcedureDLL RegCreateKey(Key.s, ComputerName.s)
 
  ;It create subkey if KeyPath don't exist
  ;Returns 1 if successful or 0 if it fails
 
  Shared RegWow64.l,RegEx,topKey,KeyName.s
 
  RegConvertRegKeyToTopKeyAndKeyName(Key) 
  lpSecurityAttributes.SECURITY_ATTRIBUTEs
 
  If ComputerName = "."
    If RegEx
      GetHandle = RegCreateKeyEx_(topKey,KeyName,0,0,#REG_OPTION_NON_VOLATILE,#KEY_ALL_ACCESS|RegWow64,@lpSecurityAttributes,@hNewKey,@GetHandle)
    Else
      GetHandle = RegCreateKey_(topKey,KeyName,@hNewKey)
    EndIf
  Else
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If RegEx
      GetHandle = RegCreateKeyEx_(lhRemoteRegistry,KeyName,0,0,#REG_OPTION_NON_VOLATILE,#KEY_ALL_ACCESS|RegWow64,@lpSecurityAttributes,@hNewKey,@GetHandle)
    Else
      GetHandle = RegCreateKey_(lhRemoteRegistry,KeyName,@hNewKey)
    EndIf
  EndIf
 
  If GetHandle = #ERROR_SUCCESS
    GetHandle = RegCloseKey_(hNewKey)
    CreateKey = #True
  Else
    CreateKey = #False
  EndIf
  ProcedureReturn CreateKey
EndProcedure

ProcedureDLL RegCreateKeyValue(Key.s,ValueName.s,Value.s,Type,ComputerName.s) ; Creates a Key and a Value in a Single Command
 
  ;Type can be #REG_SZ or #REG_DWORD
  ;Returns 1 if successful or 0 if it fails
 
  RegCreateKey(Key,ComputerName)
  ProcedureReturn RegSetValue(Key,ValueName,Value,Type,ComputerName)
EndProcedure
;- Read current URL
Procedure NavigationCallback(Gadget, NewUrl.s)
   
  If NewUrl <> Url
    SetGadgetText(#Show_Current_Url, NewUrl)
    Url = NewUrl 
  EndIf
 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure SuppressJavaScriptErrorMessages(WebGadget)
 
  Protected MyWebGadget.IWebBrowser2
 
  MyWebGadget = GetWindowLongPtr_(GadgetID(#Webgadget), #GWL_USERDATA)
  MyWebGadget\put_Silent(#True) ; Suppress JavaScript error messages.
 
EndProcedure

Procedure MainFormShow()
 hwnd = OpenWindow(#MainForm, 0, 0, 1024, 768,"WebGadget HTML5 compatible",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
  SetWindowColor(#MainForm, RGB(48, 103, 140))
  
    StringGadget(#Show_Current_Url, 130, 5, 500, 20, Url, #PB_String_BorderLess)
    SetGadgetColor(#Show_Current_Url, #PB_Gadget_FrontColor, RGB(243, 225, 208));TEXT FARBE
    SetGadgetColor(#Show_Current_Url, #PB_Gadget_BackColor, RGB(31, 77, 106)) ;TEXT Hintergrund FARBE
    SetGadgetFont(#Show_Current_Url, LoadFont(#Font_Current_Url, "Lucida", 10, #PB_Font_HighQuality)) ; Button Font

WebGadget(#Webgadget, 0, 35, 1024, 768, url)
   ProgressBarGadget(#ProgressBar, 5, 30, 1000, 3, 0, 0)
   SuppressJavaScriptErrorMessages(#Webgadget)
  
    ;- Keyboard Shortcuts hinzufügen
     WebObject.IWebBrowser2 = GetWindowLongPtr_(GadgetID(#WebGadget),#GWLP_USERDATA)
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_X,Asc("x"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_C,Asc("c"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_V,Asc("v"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_A,Asc("a"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_Z,Asc("z"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_Y,Asc("y"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_Shift|#PB_Shortcut_Z,Asc("y"))
     AddKeyboardShortcut(#MainForm, #PB_Shortcut_Return,Asc("Return"))
     SetGadgetAttribute(#WebGadget, #PB_Web_NavigationCallback, @NavigationCallback())
     

  ;- Btn Back
     TextGadget(#Btn_Nav_Back, 0, 4, 30, 20, "<",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Nav_Back, LoadFont(#Font_Btn_Nav_Back, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Nav_Back, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Nav_Back, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
      
  ;- Separator
     TextGadget(#Separater, 31, 8, 1, 14, "")
      SetGadgetColor(#Separater, #PB_Gadget_BackColor, RGB(31, 77, 106)) ;TEXT Hintergrund FARBE  
      
  ;- Btn Forward
     TextGadget(#Btn_Nav_Frwd, 32, 4, 30, 20, ">",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Nav_Frwd, LoadFont(#Font_Btn_Nav_Frwd, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Nav_Frwd, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Nav_Frwd, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
     
  ;- Btn Reload
     TextGadget(#Btn_Reload, 60, 4, 60, 20, "refresh",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Reload, LoadFont(#Font_Btn_Reload, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Reload, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Reload, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
      
  ;- Btn Start Browsing 
     TextGadget(#Btn_Start_Browsing, 635, 4, 20, 20, ">>",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Start_Browsing, LoadFont(#Font_Start_Browsing, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Start_Browsing, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Start_Browsing, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
      
  ;- Btn Home
     TextGadget(#Btn_Home, 680, 5, 50, 20, "home",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Home, LoadFont(#Font_Start_Browsing, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Home, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Home, #PB_Gadget_FrontColor, RGB(0, 0, 0))      ;TEXT FARBE
      
  ;- Btn Close WEbGadget Window
     TextGadget(#Btn_CloseWebGadget, 948, 4, 60, 20, "close",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_CloseWebGadget, LoadFont(#Font_Btn_CloseWebGadget, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_CloseWebGadget, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_CloseWebGadget, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
 
       WebObject\put_Silent(#True)
       WebObject\put_Left(#Editor_Gadget)
  
EndProcedure
Procedure Start()
  RegCreateKeyValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", GetFilePart(ProgramFilename()), "11001", #REG_DWORD, ".")
  MainFormShow() 
EndProcedure

; Kontextmenü für Editorgadget
Procedure WinCallback(hWnd, uMsg, wParam, lParam)
  Protected result = #PB_ProcessPureBasicEvents
  Select uMsg
    Case #WM_CONTEXTMENU
      If GadgetID(#Editor_Gadget) = wParam
        DisplayPopupMenu(#Editor_Gadget, WindowID(#Window_0))
      EndIf
      
    ;- Beide Fenster unabhängig voneinander mit Maus verschieben   
       Case #WM_LBUTTONDOWN
           SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
  EndSelect  
  ProcedureReturn result
EndProcedure
OpenWindow(#Window_0, 298, 150, 710, 535, "",#PB_Window_BorderLess);| #PB_Window_ScreenCentered
SetWindowColor(#Window_0, RGB(219, 219, 219))

; EXIT BUTTON NORMAL AND HOVER
  Define Exit_Normal = CatchImage(#Image_Exit_Normal, ?Image_Exit_Normal, ?Image_Exit_Normal_End - ?Image_Exit_Normal)
  Define Exit_Red = CatchImage(#Image_Exit_Red, ?Image_Exit_Red, ?Image_Exit_Red_End - ?Image_Exit_Red)
    br = ImageWidth(#Image_Exit_Normal)
    hh = ImageHeight(#Image_Exit_Red)
    ;  POSITION WEHRE TO PLACE ON SCREEN  
       CanvasGadget(#Btn_Exit, 676, -2, br, hh) 
       SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Normal))
    
; Button WebGadget
  ButtonGadget(#Btn_OpenBrowserGadget, 300, 50, 100, 50, "open Browser",#BS_FLAT)

; Button Speichern
  TextGadget(#Btn_Save, 300, 440, 100, 50, "Text speichern",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)  
    SetGadgetFont(#Btn_Save, LoadFont(#Font_Btn_Save, "Lucida", 8, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Btn_Save, #PB_Gadget_BackColor, RGB(178, 183, 184))  ;TEXT Hintergrund FARBE
    SetGadgetColor(#Btn_Save, #PB_Gadget_FrontColor, RGB(0, 0, 0));TEXT FARBE
    
; Editor Gadget    
  EditorGadget(#Editor_Gadget, 43, 150, 623, 250, #PB_Editor_WordWrap);,#PB_Editor_WordWrap
    SetGadgetText(#Editor_Gadget, "kopierten Website Text hier einfügen")
    SetGadgetFont(#Editor_Gadget, LoadFont(#Font_Editor_Gadget, "Lucida", 10, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Editor_Gadget, #PB_Gadget_FrontColor, RGB(193, 0, 85));TEXT FARBE
  ; Entferne Rahmen um EditorGadget (Eingabefeld)
      SetWindowTheme_(GadgetID(#Editor_Gadget), @"", @"")
      SetWindowLongPtr_(GadgetID(#Editor_Gadget), #GWL_EXSTYLE, 0)
      SetWindowPos_(GadgetID(#Editor_Gadget), 0, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_FRAMECHANGED)
  
; Maus Area
  TextGadget(#MausArea, 0, 0, 676, 21, "   Haupt Fenster",#SS_CENTERIMAGE) ;x;y;länge;höhe,$340 = Value for Text Set vertically align
    SetGadgetColor(#MausArea, #PB_Gadget_FrontColor, RGB(246, 246, 246)) ;TEXT FARBE
    SetGadgetColor(#MausArea, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
    SetGadgetFont(#MausArea, LoadFont(#Font_MausArea, "Arial", 10, #PB_Font_HighQuality)) ; Button Font  
    
;- KontextMenü für EditorGadget deklarieren
      If CreatePopupMenu(#Editor_Gadget)
        MenuItem(1, "einfügen")
      EndIf
      SetWindowCallback(@WinCallback()) 
      
OpenWindow(#Window_0, 298, 150, 710, 535, "",#PB_Window_BorderLess);| #PB_Window_ScreenCentered
SetWindowColor(#Window_0, RGB(219, 219, 219))

; EXIT BUTTON NORMAL AND HOVER
  Define Exit_Normal = CatchImage(#Image_Exit_Normal, ?Image_Exit_Normal, ?Image_Exit_Normal_End - ?Image_Exit_Normal)
  Define Exit_Red = CatchImage(#Image_Exit_Red, ?Image_Exit_Red, ?Image_Exit_Red_End - ?Image_Exit_Red)
    br = ImageWidth(#Image_Exit_Normal)
    hh = ImageHeight(#Image_Exit_Red)
    ;  POSITION WEHRE TO PLACE ON SCREEN  
       CanvasGadget(#Btn_Exit, 676, -2, br, hh) 
       SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Normal))
    
; Button WebGadget
  ButtonGadget(#Btn_OpenBrowserGadget, 300, 50, 100, 50, "open Browser",#BS_FLAT)

; Button Speichern
  TextGadget(#Btn_Save, 300, 440, 100, 50, "Text speichern",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)  
    SetGadgetFont(#Btn_Save, LoadFont(#Font_Btn_Save, "Lucida", 8, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Btn_Save, #PB_Gadget_BackColor, RGB(178, 183, 184))  ;TEXT Hintergrund FARBE
    SetGadgetColor(#Btn_Save, #PB_Gadget_FrontColor, RGB(0, 0, 0));TEXT FARBE
    
; Editor Gadget    
  EditorGadget(#Editor_Gadget, 43, 150, 623, 250, #PB_Editor_WordWrap);,#PB_Editor_WordWrap
    SetGadgetText(#Editor_Gadget, "kopierten Website Text hier einfügen")
    SetGadgetFont(#Editor_Gadget, LoadFont(#Font_Editor_Gadget, "Lucida", 10, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Editor_Gadget, #PB_Gadget_FrontColor, RGB(193, 0, 85));TEXT FARBE
  ; Entferne Rahmen um EditorGadget (Eingabefeld)
      SetWindowTheme_(GadgetID(#Editor_Gadget), @"", @"")
      SetWindowLongPtr_(GadgetID(#Editor_Gadget), #GWL_EXSTYLE, 0)
      SetWindowPos_(GadgetID(#Editor_Gadget), 0, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_FRAMECHANGED)
  
; Maus Area
  TextGadget(#MausArea, 0, 0, 676, 21, "   Haupt Fenster",#SS_CENTERIMAGE) ;x;y;länge;höhe,$340 = Value for Text Set vertically align
    SetGadgetColor(#MausArea, #PB_Gadget_FrontColor, RGB(246, 246, 246)) ;TEXT FARBE
    SetGadgetColor(#MausArea, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
    SetGadgetFont(#MausArea, LoadFont(#Font_MausArea, "Arial", 10, #PB_Font_HighQuality)) ; Button Font  
    
;- KontextMenü für EditorGadget deklarieren
      If CreatePopupMenu(#Editor_Gadget)
        MenuItem(1, "einfügen")
      EndIf
      SetWindowCallback(@WinCallback()) 
      

Repeat
  Event = WaitWindowEvent()
  EventGadget = EventGadget()
  EventType = EventType()

   ; Kontextmenü auf Editorgadget freischalten
      Select event
          Case #PB_Event_Menu
            Select EventMenu()
              Case 1
                SetGadgetText(#Editor_Gadget,GetClipboardText())
            EndSelect
      EndSelect
      
    ;Inhalt aus EditorGadget in Datei speichern  
      If Event=#PB_Event_Gadget
        If EventGadget()= #Btn_Save
          ; Eingabe auslesen
            Text$= GetGadgetText(#Editor_Gadget)
            
          ; Speicherdialog aufrufen  
            File$=SaveFileRequester("Text speichern", "C:\info.txt ", "TXT FILE(*.txt)|*.txt", 0)   
            
          ; schreibe Datei  
            If CreateFile(1, File$)
               WriteStringN(1,Text$, #PB_Ascii)
               CloseFile(1)
            EndIf  
        EndIf    
     EndIf
Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #WebGadget
          Select EventType()
            Case #PB_EventType_DownloadStart
            Case #PB_EventType_DownloadProgress
              SetGadgetAttribute(#ProgressBar, #PB_ProgressBar_Maximum, GetGadgetAttribute(#WebGadget, #PB_Web_ProgressMax))
              SetGadgetState(#ProgressBar, GetGadgetAttribute(#WebGadget, #PB_Web_Progress))
            Case #PB_EventType_DownloadEnd
          EndSelect
      EndSelect
  EndSelect 
;- Button Funktionen    
  If Event = #PB_Event_Gadget
    Select EventGadget()
          
      ;- BTN WebGadget
          Case #Btn_OpenBrowserGadget
          Start()

      ;- BTN CloseWebGadget     
          Case #Btn_CloseWebGadget
            UpdateWindow_(WindowID(#Window_0))
            CloseWindow(#MainForm)
            
      ;- Web Navigation - Back - Forward - Reload 
          Case #Btn_Nav_Back
            SetGadgetState(#WebGadget, #PB_Web_Back)
          Case #Btn_Nav_Frwd
            SetGadgetState(#WebGadget, #PB_Web_Forward)
          Case #Btn_Reload
            SetGadgetState(#WebGadget, #PB_Web_Refresh)
          Case #Btn_Start_Browsing
            SetGadgetText(#Webgadget, GetGadgetText(#Show_Current_Url))
          Case #Btn_Home
            ;? 
            
            
      ;- FUNKTION EXIT BUTTON    
          Case #Btn_Exit                 
            Select eventtype
              Case #PB_EventType_MouseEnter
                SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Red))
                 Case #PB_EventType_MouseLeave
                   SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Normal))
                   ;PROGRAM EXIT, IF CLICK ON EXIT BUTTON
                      Case #PB_EventType_LeftButtonDown
                      ;CLOSE ALL  
                        End
            EndSelect
        EndSelect
  EndIf

 ; KeyboardShortcuts
    Select Event
        
 ;-Begin Workaround für correctes Einfügen durch STRG+V ins EditorGadget
    ;dickes Danke an Derren       
     Case #PB_Event_Gadget
        If EventGadget()=#Editor_Gadget And EventType()=#PB_EventType_Focus
           If GetClipboardImage(#PB_Any)=0
             SetClipboardText(GetClipboardText())
          EndIf
       EndIf
;-End Workaround    

  ;WebObject\get_busy(@isBusy)
      Case #PB_Event_Menu
        Select EventMenu()
          Case 'x'
            WebObject\ExecWB(#OLECMDID_CUT,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
            
          Case 'c'
            WebObject\ExecWB(#OLECMDID_COPY,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
            
          Case 'v'
           SetGadgetText(#Editor_Gadget,GetClipboardText())
            
          Case 'a'
            WebObject\ExecWB(#OLECMDID_SELECTALL,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
            
          Case 'z'
            WebObject\ExecWB(#OLECMDID_UNDO,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
            
          Case 'y'
            WebObject\ExecWB(#OLECMDID_REDO,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
            
        EndSelect

    EndSelect  
             
  Until IsWindow(#Window_0)=0 And IsWindow(Fenster_ID)=0
Zuletzt geändert von udg am 06.02.2016 18:54, insgesamt 1-mal geändert.
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Home button für eigenen Browser ?

Beitrag von RSBasic »

Du kannst die Variable bzw. den String "Url.s" nicht verwenden, weil sich diese Variable im NavigationCallback ändert. Wenn du den Code...

Code: Alles auswählen

Procedure NavigationCallback(Gadget, NewUrl.s)
   
  If NewUrl <> Url
    SetGadgetText(#Show_Current_Url, NewUrl)
    Url = NewUrl
  EndIf
 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
unverändert lassen möchtest, dann erstelle einfach eine weitere globale Variable. Beispielsweise "HomeUrl.s", wie ich das hier gemacht habe:

Code: Alles auswählen

;{ Keyboard Shortcut Enumerations
Enumeration 1
  #OLECMDID_OPEN
  #OLECMDID_NEW
  #OLECMDID_SAVE
  #OLECMDID_SAVEAS
  #OLECMDID_SAVECOPYAS
  #OLECMDID_PRINT
  #OLECMDID_PRINTPREVIEW
  #OLECMDID_PAGESETUP
  #OLECMDID_SPELL
  #OLECMDID_PROPERTIES
  #OLECMDID_CUT
  #OLECMDID_COPY
  #OLECMDID_PASTE
  #OLECMDID_PASTESPECIAL
  #OLECMDID_UNDO
  #OLECMDID_REDO
  #OLECMDID_SELECTALL
  #OLECMDID_CLEARSELECTION
  #OLECMDID_ZOOM
  #OLECMDID_GETZOOMRANGE
  #OLECMDID_UPDATECOMMANDS
  #OLECMDID_REFRESH
  #OLECMDID_STOP
  #OLECMDID_HIDETOOLBARS
  #OLECMDID_SETPROGRESSMAX
  #OLECMDID_SETPROGRESSPOS
  #OLECMDID_SETPROGRESSTEXT
  #OLECMDID_SETTITLE
  #OLECMDID_SETDOWNLOADSTATE
  #OLECMDID_STOPDOWNLOAD
EndEnumeration

Enumeration 0
  #OLECMDEXECOPT_DODEFAULT
  #OLECMDEXECOPT_PROMPTUSER
  #OLECMDEXECOPT_DONTPROMPTUSER
  #OLECMDEXECOPT_SHOWHELP
EndEnumeration
;}
Enumeration
  #Window_0

EndEnumeration
Enumeration
  ;Main Window
    #Window_0
   
  ;PopUp Window aus Prozedur 
    #MainForm

  ; Main Gadgets
    #Btn_Exit
    #Image_Exit_Normal
    #Image_Exit_Red
    #Editor_Gadget
    #MausArea
    #Font_MausArea
    #Btn_Save
    #Font_Btn_Save
    #Font_Editor_Gadget
    #Btn_OpenBrowserGadget
   
    ;WebGadget
      #WebGadget
      #Btn_CloseWebGadget
      #Font_Btn_CloseWebGadget
      #Btn_Reload
      #Font_Btn_Reload
      #Btn_Nav_Back
      #Font_Btn_Nav_Back
      #Btn_Nav_Frwd
      #Font_Btn_Nav_Frwd
      #Show_Current_Url
      #Font_Current_Url
      #Btn_Start_Browsing
      #Btn_Home
      #Font_Start_Browsing
      #Separater
      #ProgressBar
EndEnumeration
;Included Images
DataSection
  Image_Exit_Normal:
  ; exit_normal.png
  ;{ Size = 328 bytes
  Data.l $474E5089,$0A1A0A0D,$0D000000,$52444849,$22000000,$17000000,$00000208,$3A959601,$0000001D,$59487009,$0E000073,$0E0000C3
  Data.l $6FC701C3,$000064A8,$4449FA00,$9C785441,$FFFFF963,$6012033F,$19B75081,$F9915418,$647970AA,$74582CF5,$06865162,$1DF61450
  Data.l $C0722860,$812C8721,$AC164CCF,$071228A2,$BD9F12FA,$9CEA8864,$50E12E8F,$7E589554,$519B0A3A,$E13BF3AA,$0763C6DE,$76129F1E
  Data.l $2CF41517,$ED344F2B,$4D8AAF9C,$781EA70A,$07A09040,$CF4B200F,$5D1B8740,$2F9624F4,$5A69DF9B,$33A18CBE,$610C4B0A,$00D403D7
  Data.l $3BF3924C,$62CAB0A3,$BCACB3D7,$EEA7BE6D,$4A8CA46D,$11240F58,$5380D560,$A8307E0F,$DE9190F5,$0E86B1C8,$6B708C76,$76F96580
  Data.l $17CF2A89,$E2190B6D,$11D5A3E7,$C1C6B454,$1B7B75D7,$D7310ED0,$20EC122A,$D9601ACD,$7E3C5BBD,$46507CFE,$912B7A04,$60910F14
  Data.l $C3A7300D,$A287130B,$40DAC4F9,$809435AA,$000D65E1,$754D2247,$528F5DE3,$00000000,$444E4549,$826042AE
  Image_Exit_Normal_End:
  ;}
  Image_Exit_Red:
  ; exit_red.png
  ;{ Size = 326 bytes
  Data.l $474E5089,$0A1A0A0D,$0D000000,$52444849,$22000000,$17000000,$00000208,$3A959601,$0000001D,$59487009,$0E000073,$0E0000C3
  Data.l $6FC701C3,$000064A8,$4449F800,$9C785441,$AEC33963,$580480CE,$03371420,$FE6457C3,$B23CB857,$3A2C167A,$034328B1,$92550A28
  Data.l $C5CCEE19,$812C8721,$AC164CCF,$221228A2,$28706F1B,$D1D13C33,$E3789740,$C57C691F,$A33609E3,$39D59FCE,$781D844F,$5DD84A7C
  Data.l $7323D054,$1D7BC6E5,$A4D8AF8D,$0781EA70,$F07A0904,$0CF4B200,$45D1B874,$CA95F18F,$B43B3AB3,$96AE187B,$C594C79C,$01A807AE
  Data.l $EACF2498,$8F6093B4,$67E595CC,$23710FFB,$7AC25465,$AB008920,$F07A9C06,$87AD4183,$8E46F48C,$63B07435,$2C035B84,$476FC5CB
  Data.l $2E5D54BE,$D67750CF,$ACAD157F,$50BED379,$8ED000FC,$481D2F87,$6B3483B0,$F8B76580,$1CB3BADD,$F4088CA0,$1E293196,$601AC122
  Data.l $70D7874E,$DE35FC6F,$9073AF10,$6EC18126,$B735000D,$24470847,$00009783,$45490000,$42AE444E
  Data.b $60,$82
  Image_Exit_Red_End:
  ;}
EndDataSection

;Image Plugins
  UsePNGImageDecoder()

Define Event
Global WebObject.IWebBrowser2

;Home ,Startseite
Global Url.s="http://www.google.de"
Global HomeUrl.s=Url
;{
Procedure RegConvertRegKeyToTopKeyAndKeyName(Key.s)
 
  Shared topKey,KeyName.s
 
  temp.s=StringField(Key,1,"\")
  temp=UCase(temp)
  Select temp
    Case "HKEY_CLASSES_ROOT"
      topKey=#HKEY_CLASSES_ROOT
    Case "HKEY_CURRENT_USER"
      topKey=#HKEY_CURRENT_USER
    Case "HKEY_LOCAL_MACHINE"
      topKey=#HKEY_LOCAL_MACHINE
    Case "HKEY_USERS"
      topKey=#HKEY_USERS
    Case "HKEY_CURRENT_CONFIG"
      topKey=#HKEY_CURRENT_CONFIG
  EndSelect
 
  PositionSlash=FindString(Key,"\",1)
  KeyName.s=Right(Key,(Len(Key)-PositionSlash))
 
EndProcedure

ProcedureDLL RegSetValue(Key.s, ValueName.s, Value.s, Type, ComputerName.s) ; Sets a Value
 
  ;Type can be #REG_SZ / #REG_DWORD / #REG_BINARY / #REG_EXPAND_SZ
  ;For REG_BINARY type use Hexa value as String
  ;Returns 1 if successful or 0 if it fails
 
  Shared RegWow64.l,RegEx,topKey,KeyName.s
  RegConvertRegKeyToTopKeyAndKeyName(Key)
 
  If ComputerName = "."
    If RegEx
      GetHandle = RegOpenKeyEx_(topKey,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey)
    Else
      GetHandle = RegOpenKey_(topKey,KeyName,@hKey)
    EndIf
  Else
    lReturnCode = RegConnectRegistry_(ComputerName,topKey,@lhRemoteRegistry)
    If RegEx
      GetHandle = RegOpenKeyEx_(lhRemoteRegistry,KeyName,0,#KEY_ALL_ACCESS|RegWow64,@hKey)
    Else
      GetHandle = RegOpenKey_(lhRemoteRegistry,KeyName,@hKey)
    EndIf
  EndIf
 
  If GetHandle = #ERROR_SUCCESS
    lpcbData = 255
    lpData.s = Space(255)
   
    Select Type
       
      Case #REG_EXPAND_SZ
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_EXPAND_SZ, @Value, Len(Value) + 1)
       
      Case #REG_SZ
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_SZ, @Value, Len(Value) + 1)
       
      Case #REG_DWORD
        lValue = Val(Value)
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @lValue, 4)
       
      Case #REG_BINARY
        LenBuffer=Len(Value)/2
        *RegBuffer=AllocateMemory(LenBuffer)
        For n=0 To LenBuffer-1
          OctetHexa.s=Mid(Value,(n*2)+1,2)
          Octet=Val("$"+OctetHexa)
          PokeB(*RegBuffer+n,Octet)
        Next
        GetHandle= RegSetValueEx_(hKey,ValueName,0,#REG_BINARY,*RegBuffer,LenBuffer)
        FreeMemory(*RegBuffer)
       
    EndSelect
   
    RegCloseKey_(hKey)
    ergebnis = 1
    ProcedureReturn ergebnis
  Else
    RegCloseKey_(hKey)
    ergebnis = 0
    ProcedureReturn ergebnis
  EndIf
EndProcedure

ProcedureDLL RegCreateKey(Key.s, ComputerName.s)
 
  ;It create subkey if KeyPath don't exist
  ;Returns 1 if successful or 0 if it fails
 
  Shared RegWow64.l,RegEx,topKey,KeyName.s
 
  RegConvertRegKeyToTopKeyAndKeyName(Key)
  lpSecurityAttributes.SECURITY_ATTRIBUTEs
 
  If ComputerName = "."
    If RegEx
      GetHandle = RegCreateKeyEx_(topKey,KeyName,0,0,#REG_OPTION_NON_VOLATILE,#KEY_ALL_ACCESS|RegWow64,@lpSecurityAttributes,@hNewKey,@GetHandle)
    Else
      GetHandle = RegCreateKey_(topKey,KeyName,@hNewKey)
    EndIf
  Else
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If RegEx
      GetHandle = RegCreateKeyEx_(lhRemoteRegistry,KeyName,0,0,#REG_OPTION_NON_VOLATILE,#KEY_ALL_ACCESS|RegWow64,@lpSecurityAttributes,@hNewKey,@GetHandle)
    Else
      GetHandle = RegCreateKey_(lhRemoteRegistry,KeyName,@hNewKey)
    EndIf
  EndIf
 
  If GetHandle = #ERROR_SUCCESS
    GetHandle = RegCloseKey_(hNewKey)
    CreateKey = #True
  Else
    CreateKey = #False
  EndIf
  ProcedureReturn CreateKey
EndProcedure

ProcedureDLL RegCreateKeyValue(Key.s,ValueName.s,Value.s,Type,ComputerName.s) ; Creates a Key and a Value in a Single Command
 
  ;Type can be #REG_SZ or #REG_DWORD
  ;Returns 1 if successful or 0 if it fails
 
  RegCreateKey(Key,ComputerName)
  ProcedureReturn RegSetValue(Key,ValueName,Value,Type,ComputerName)
EndProcedure
;- Read current URL
Procedure NavigationCallback(Gadget, NewUrl.s)
   
  If NewUrl <> Url
    SetGadgetText(#Show_Current_Url, NewUrl)
    Url = NewUrl
  EndIf
 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure SuppressJavaScriptErrorMessages(WebGadget)
 
  Protected MyWebGadget.IWebBrowser2
 
  MyWebGadget = GetWindowLongPtr_(GadgetID(#Webgadget), #GWL_USERDATA)
  MyWebGadget\put_Silent(#True) ; Suppress JavaScript error messages.
 
EndProcedure

Procedure MainFormShow()
 hwnd = OpenWindow(#MainForm, 0, 0, 1024, 768,"WebGadget HTML5 compatible",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
  SetWindowColor(#MainForm, RGB(48, 103, 140))
 
    StringGadget(#Show_Current_Url, 130, 5, 500, 20, Url, #PB_String_BorderLess)
    SetGadgetColor(#Show_Current_Url, #PB_Gadget_FrontColor, RGB(243, 225, 208));TEXT FARBE
    SetGadgetColor(#Show_Current_Url, #PB_Gadget_BackColor, RGB(31, 77, 106)) ;TEXT Hintergrund FARBE
    SetGadgetFont(#Show_Current_Url, LoadFont(#Font_Current_Url, "Lucida", 10, #PB_Font_HighQuality)) ; Button Font

WebGadget(#Webgadget, 0, 35, 1024, 768, url)
   ProgressBarGadget(#ProgressBar, 5, 30, 1000, 3, 0, 0)
   SuppressJavaScriptErrorMessages(#Webgadget)
 
    ;- Keyboard Shortcuts hinzufügen
     WebObject.IWebBrowser2 = GetWindowLongPtr_(GadgetID(#WebGadget),#GWLP_USERDATA)
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_X,Asc("x"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_C,Asc("c"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_V,Asc("v"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_A,Asc("a"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_Z,Asc("z"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_Y,Asc("y"))
     AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_Shift|#PB_Shortcut_Z,Asc("y"))
     AddKeyboardShortcut(#MainForm, #PB_Shortcut_Return,Asc("Return"))
     SetGadgetAttribute(#WebGadget, #PB_Web_NavigationCallback, @NavigationCallback())
     

  ;- Btn Back
     TextGadget(#Btn_Nav_Back, 0, 4, 30, 20, "<",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Nav_Back, LoadFont(#Font_Btn_Nav_Back, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Nav_Back, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Nav_Back, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
     
  ;- Separator
     TextGadget(#Separater, 31, 8, 1, 14, "")
      SetGadgetColor(#Separater, #PB_Gadget_BackColor, RGB(31, 77, 106)) ;TEXT Hintergrund FARBE 
     
  ;- Btn Forward
     TextGadget(#Btn_Nav_Frwd, 32, 4, 30, 20, ">",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Nav_Frwd, LoadFont(#Font_Btn_Nav_Frwd, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Nav_Frwd, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Nav_Frwd, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
     
  ;- Btn Reload
     TextGadget(#Btn_Reload, 60, 4, 60, 20, "refresh",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Reload, LoadFont(#Font_Btn_Reload, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Reload, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Reload, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
     
  ;- Btn Start Browsing
     TextGadget(#Btn_Start_Browsing, 635, 4, 20, 20, ">>",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Start_Browsing, LoadFont(#Font_Start_Browsing, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Start_Browsing, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Start_Browsing, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
     
  ;- Btn Home
     TextGadget(#Btn_Home, 680, 5, 50, 20, "home",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_Home, LoadFont(#Font_Start_Browsing, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_Home, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_Home, #PB_Gadget_FrontColor, RGB(0, 0, 0))      ;TEXT FARBE
     
  ;- Btn Close WEbGadget Window
     TextGadget(#Btn_CloseWebGadget, 948, 4, 60, 20, "close",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER)
      SetGadgetFont(#Btn_CloseWebGadget, LoadFont(#Font_Btn_CloseWebGadget, "Lucida", 10, #PB_Font_HighQuality))  ; Button Font
      SetGadgetColor(#Btn_CloseWebGadget, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
      SetGadgetColor(#Btn_CloseWebGadget, #PB_Gadget_FrontColor, RGB(0, 0, 0))  ;TEXT FARBE
 
       WebObject\put_Silent(#True)
       WebObject\put_Left(#Editor_Gadget)
 
EndProcedure
Procedure Start()
  RegCreateKeyValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", GetFilePart(ProgramFilename()), "11001", #REG_DWORD, ".")
  MainFormShow()
EndProcedure

; Kontextmenü für Editorgadget
Procedure WinCallback(hWnd, uMsg, wParam, lParam)
  Protected result = #PB_ProcessPureBasicEvents
  Select uMsg
    Case #WM_CONTEXTMENU
      If GadgetID(#Editor_Gadget) = wParam
        DisplayPopupMenu(#Editor_Gadget, WindowID(#Window_0))
      EndIf
     
    ;- Beide Fenster unabhängig voneinander mit Maus verschieben   
       Case #WM_LBUTTONDOWN
           SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
  EndSelect 
  ProcedureReturn result
EndProcedure
OpenWindow(#Window_0, 298, 150, 710, 535, "",#PB_Window_BorderLess);| #PB_Window_ScreenCentered
SetWindowColor(#Window_0, RGB(219, 219, 219))

; EXIT BUTTON NORMAL AND HOVER
  Define Exit_Normal = CatchImage(#Image_Exit_Normal, ?Image_Exit_Normal, ?Image_Exit_Normal_End - ?Image_Exit_Normal)
  Define Exit_Red = CatchImage(#Image_Exit_Red, ?Image_Exit_Red, ?Image_Exit_Red_End - ?Image_Exit_Red)
    br = ImageWidth(#Image_Exit_Normal)
    hh = ImageHeight(#Image_Exit_Red)
    ;  POSITION WEHRE TO PLACE ON SCREEN 
       CanvasGadget(#Btn_Exit, 676, -2, br, hh)
       SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Normal))
   
; Button WebGadget
  ButtonGadget(#Btn_OpenBrowserGadget, 300, 50, 100, 50, "open Browser",#BS_FLAT)

; Button Speichern
  TextGadget(#Btn_Save, 300, 440, 100, 50, "Text speichern",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER) 
    SetGadgetFont(#Btn_Save, LoadFont(#Font_Btn_Save, "Lucida", 8, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Btn_Save, #PB_Gadget_BackColor, RGB(178, 183, 184))  ;TEXT Hintergrund FARBE
    SetGadgetColor(#Btn_Save, #PB_Gadget_FrontColor, RGB(0, 0, 0));TEXT FARBE
   
; Editor Gadget   
  EditorGadget(#Editor_Gadget, 43, 150, 623, 250, #PB_Editor_WordWrap);,#PB_Editor_WordWrap
    SetGadgetText(#Editor_Gadget, "kopierten Website Text hier einfügen")
    SetGadgetFont(#Editor_Gadget, LoadFont(#Font_Editor_Gadget, "Lucida", 10, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Editor_Gadget, #PB_Gadget_FrontColor, RGB(193, 0, 85));TEXT FARBE
  ; Entferne Rahmen um EditorGadget (Eingabefeld)
      SetWindowTheme_(GadgetID(#Editor_Gadget), @"", @"")
      SetWindowLongPtr_(GadgetID(#Editor_Gadget), #GWL_EXSTYLE, 0)
      SetWindowPos_(GadgetID(#Editor_Gadget), 0, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_FRAMECHANGED)
 
; Maus Area
  TextGadget(#MausArea, 0, 0, 676, 21, "   Haupt Fenster",#SS_CENTERIMAGE) ;x;y;länge;höhe,$340 = Value for Text Set vertically align
    SetGadgetColor(#MausArea, #PB_Gadget_FrontColor, RGB(246, 246, 246)) ;TEXT FARBE
    SetGadgetColor(#MausArea, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
    SetGadgetFont(#MausArea, LoadFont(#Font_MausArea, "Arial", 10, #PB_Font_HighQuality)) ; Button Font 
   
;- KontextMenü für EditorGadget deklarieren
      If CreatePopupMenu(#Editor_Gadget)
        MenuItem(1, "einfügen")
      EndIf
      SetWindowCallback(@WinCallback())
     
OpenWindow(#Window_0, 298, 150, 710, 535, "",#PB_Window_BorderLess);| #PB_Window_ScreenCentered
SetWindowColor(#Window_0, RGB(219, 219, 219))

; EXIT BUTTON NORMAL AND HOVER
  Define Exit_Normal = CatchImage(#Image_Exit_Normal, ?Image_Exit_Normal, ?Image_Exit_Normal_End - ?Image_Exit_Normal)
  Define Exit_Red = CatchImage(#Image_Exit_Red, ?Image_Exit_Red, ?Image_Exit_Red_End - ?Image_Exit_Red)
    br = ImageWidth(#Image_Exit_Normal)
    hh = ImageHeight(#Image_Exit_Red)
    ;  POSITION WEHRE TO PLACE ON SCREEN 
       CanvasGadget(#Btn_Exit, 676, -2, br, hh)
       SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Normal))
   
; Button WebGadget
  ButtonGadget(#Btn_OpenBrowserGadget, 300, 50, 100, 50, "open Browser",#BS_FLAT)

; Button Speichern
  TextGadget(#Btn_Save, 300, 440, 100, 50, "Text speichern",#SS_CENTERIMAGE|#SS_NOTIFY|#SS_CENTER) 
    SetGadgetFont(#Btn_Save, LoadFont(#Font_Btn_Save, "Lucida", 8, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Btn_Save, #PB_Gadget_BackColor, RGB(178, 183, 184))  ;TEXT Hintergrund FARBE
    SetGadgetColor(#Btn_Save, #PB_Gadget_FrontColor, RGB(0, 0, 0));TEXT FARBE
   
; Editor Gadget   
  EditorGadget(#Editor_Gadget, 43, 150, 623, 250, #PB_Editor_WordWrap);,#PB_Editor_WordWrap
    SetGadgetText(#Editor_Gadget, "kopierten Website Text hier einfügen")
    SetGadgetFont(#Editor_Gadget, LoadFont(#Font_Editor_Gadget, "Lucida", 10, #PB_Font_HighQuality)) ; Button Font
    SetGadgetColor(#Editor_Gadget, #PB_Gadget_FrontColor, RGB(193, 0, 85));TEXT FARBE
  ; Entferne Rahmen um EditorGadget (Eingabefeld)
      SetWindowTheme_(GadgetID(#Editor_Gadget), @"", @"")
      SetWindowLongPtr_(GadgetID(#Editor_Gadget), #GWL_EXSTYLE, 0)
      SetWindowPos_(GadgetID(#Editor_Gadget), 0, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_FRAMECHANGED)
 
; Maus Area
  TextGadget(#MausArea, 0, 0, 676, 21, "   Haupt Fenster",#SS_CENTERIMAGE) ;x;y;länge;höhe,$340 = Value for Text Set vertically align
    SetGadgetColor(#MausArea, #PB_Gadget_FrontColor, RGB(246, 246, 246)) ;TEXT FARBE
    SetGadgetColor(#MausArea, #PB_Gadget_BackColor, RGB(48, 103, 140))  ;TEXT Hintergrund FARBE
    SetGadgetFont(#MausArea, LoadFont(#Font_MausArea, "Arial", 10, #PB_Font_HighQuality)) ; Button Font 
   
;- KontextMenü für EditorGadget deklarieren
      If CreatePopupMenu(#Editor_Gadget)
        MenuItem(1, "einfügen")
      EndIf
      SetWindowCallback(@WinCallback())
     

Repeat
  Event = WaitWindowEvent()
  EventGadget = EventGadget()
  EventType = EventType()

   ; Kontextmenü auf Editorgadget freischalten
      Select event
          Case #PB_Event_Menu
            Select EventMenu()
              Case 1
                SetGadgetText(#Editor_Gadget,GetClipboardText())
            EndSelect
      EndSelect
     
    ;Inhalt aus EditorGadget in Datei speichern 
      If Event=#PB_Event_Gadget
        If EventGadget()= #Btn_Save
          ; Eingabe auslesen
            Text$= GetGadgetText(#Editor_Gadget)
           
          ; Speicherdialog aufrufen 
            File$=SaveFileRequester("Text speichern", "C:\info.txt ", "TXT FILE(*.txt)|*.txt", 0)   
           
          ; schreibe Datei 
            If CreateFile(1, File$)
               WriteStringN(1,Text$, #PB_Ascii)
               CloseFile(1)
            EndIf 
        EndIf   
     EndIf
Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #WebGadget
          Select EventType()
            Case #PB_EventType_DownloadStart
            Case #PB_EventType_DownloadProgress
              SetGadgetAttribute(#ProgressBar, #PB_ProgressBar_Maximum, GetGadgetAttribute(#WebGadget, #PB_Web_ProgressMax))
              SetGadgetState(#ProgressBar, GetGadgetAttribute(#WebGadget, #PB_Web_Progress))
            Case #PB_EventType_DownloadEnd
          EndSelect
      EndSelect
  EndSelect
;- Button Funktionen   
  If Event = #PB_Event_Gadget
    Select EventGadget()
         
      ;- BTN WebGadget
          Case #Btn_OpenBrowserGadget
          Start()

      ;- BTN CloseWebGadget     
          Case #Btn_CloseWebGadget
            UpdateWindow_(WindowID(#Window_0))
            CloseWindow(#MainForm)
           
      ;- Web Navigation - Back - Forward - Reload
          Case #Btn_Nav_Back
            SetGadgetState(#WebGadget, #PB_Web_Back)
          Case #Btn_Nav_Frwd
            SetGadgetState(#WebGadget, #PB_Web_Forward)
          Case #Btn_Reload
            SetGadgetState(#WebGadget, #PB_Web_Refresh)
          Case #Btn_Start_Browsing
            SetGadgetText(#Webgadget, GetGadgetText(#Show_Current_Url))
          Case #Btn_Home
            SetGadgetText(#Webgadget, HomeUrl)
           
           
      ;- FUNKTION EXIT BUTTON   
          Case #Btn_Exit                 
            Select eventtype
              Case #PB_EventType_MouseEnter
                SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Red))
                 Case #PB_EventType_MouseLeave
                   SetGadgetAttribute(#Btn_Exit, #PB_Canvas_Image, ImageID(#Image_Exit_Normal))
                   ;PROGRAM EXIT, IF CLICK ON EXIT BUTTON
                      Case #PB_EventType_LeftButtonDown
                      ;CLOSE ALL 
                        End
            EndSelect
        EndSelect
  EndIf

 ; KeyboardShortcuts
    Select Event
       
 ;-Begin Workaround für correctes Einfügen durch STRG+V ins EditorGadget
    ;dickes Danke an Derren       
     Case #PB_Event_Gadget
        If EventGadget()=#Editor_Gadget And EventType()=#PB_EventType_Focus
           If GetClipboardImage(#PB_Any)=0
             SetClipboardText(GetClipboardText())
          EndIf
       EndIf
;-End Workaround   

  ;WebObject\get_busy(@isBusy)
      Case #PB_Event_Menu
        Select EventMenu()
          Case 'x'
            WebObject\ExecWB(#OLECMDID_CUT,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
           
          Case 'c'
            WebObject\ExecWB(#OLECMDID_COPY,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
           
          Case 'v'
           SetGadgetText(#Editor_Gadget,GetClipboardText())
           
          Case 'a'
            WebObject\ExecWB(#OLECMDID_SELECTALL,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
           
          Case 'z'
            WebObject\ExecWB(#OLECMDID_UNDO,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
           
          Case 'y'
            WebObject\ExecWB(#OLECMDID_REDO,#OLECMDEXECOPT_DONTPROMPTUSER,0,0)
           
        EndSelect

    EndSelect 
             
  Until IsWindow(#Window_0)=0 And IsWindow(Fenster_ID)=0
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
udg
Beiträge: 566
Registriert: 20.06.2013 23:27

Re: Home button für eigenen Browser ?

Beitrag von udg »

RSBasic hat geschrieben:Du kannst die Variable bzw. den String "Url.s" nicht verwenden, weil sich diese Variable im NavigationCallback ändert. Wenn du den Code...

Code: Alles auswählen

Procedure NavigationCallback(Gadget, NewUrl.s)
   
  If NewUrl <> Url
    SetGadgetText(#Show_Current_Url, NewUrl)
    Url = NewUrl
  EndIf
 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Aha,

ich hatte gedacht, ich kann den Wert "URL" mit meinem Button einfach übernehmen,
so:

Code: Alles auswählen

Case #Btn_Home
SetGadgetText(#Webgadget, Url)
das hat jedoch nicht funktioniert.

Jetzt wo Du mir erklärst, dass es im Callback steht, verstehe ich, dass es nicht gehen konnte.


Danke vielmals
PB v5.43 LTS + v6.02 LTS | Windows 7 x86 + 11 x64 - Gforce RTX 4090 - AMD Ryzen 9 5900X 12-Core Processor 4.2 GHz - 64,0 GB RAM,
ASUSTEK TUF Gaming X570 Plus
ASUS ROG Thor-1200P Platinum (1200W, Aura Sync, OLED Display, 0dB-Cooling)
1x 1 TByte Samsung MZ-V7S500BW 970 EVO Plus 1 TB NVMe M.2 Internal SSD
1x 2 TByte Samsung MZ-V7S2T0BW 970 EVO Plus 2 TB NVMe M.2 Internal SSD
von BiSONTE!. Kauft Hardware gern bei ihm.
Monitor:
LG 38GL950G-B 95 (38 Zoll) Ultragear Curved 21: 9 UltraWide QHD IPS
Antworten