User:Gerbrant/WikiCheck/WikiCheck frm.css

VERSION 4.00 Begin VB.Form WikiCheck BorderStyle    =   0  'None Caption        =   "Wikipedia Watchlist" ClientHeight   =   11985 ClientLeft     =   1185 ClientTop      =   1935 ClientWidth    =   17280 ControlBox     =   0   'False Height         =   12435 Icon           =   "WikiCheck.frx":0000 Left           =   1125 MaxButton      =   0   'False MinButton      =   0   'False ScaleHeight    =   799 ScaleMode      =   3  'Pixel ScaleWidth     =   1152 ShowInTaskbar  =   0   'False Top            =   1545 Width          =   17400 Begin VB.PictureBox Parts BorderStyle    =   0  'None Height         =   120 Left           =   120 ScaleHeight    =   8 ScaleMode      =   3  'Pixel ScaleWidth     =   8 TabIndex       =   4 Top            =   0 Visible        =   0   'False Width          =   120 End Begin VB.PictureBox AppBarCallBack BackColor      =   &H000000FF& Height         =   120 Left           =   0 ScaleHeight    =   60 ScaleWidth     =   60 TabIndex       =   3 Top            =   0 Visible        =   0   'False Width          =   120 End Begin VB.CommandButton Reboot Caption        =   "  Opnieuw starten  " Height         =   375 Left           =   9000 TabIndex       =   2 Top            =   120 Width          =   2535 End Begin SHDocVwCtl.WebBrowser WP      Height          =   11295 Left           =   3360 TabIndex       =   1 Top            =   600 Width          =   13815 ExtentX        =   24368 ExtentY        =   19923 ViewMode       =   0 Offline        =   0 Silent         =   0 RegisterAsBrowser=  0 RegisterAsDropTarget=  1 AutoArrange    =   0   'False NoClientEdge   =   0   'False AlignLeft      =   0   'False NoWebView      =   0   'False HideFileNames  =   0   'False SingleClick    =   0   'False SingleSelection =  0   'False NoFolders      =   0   'False Transparent    =   0   'False ViewID         =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}" Location       =   "" End Begin SHDocVwCtl.WebBrowser UI      Height          =   12015 Left           =   0 TabIndex       =   0 Top            =   0 Width          =   3195 ExtentX        =   5636 ExtentY        =   21193 ViewMode       =   0 Offline        =   0 Silent         =   0 RegisterAsBrowser=  0 RegisterAsDropTarget=  0 AutoArrange    =   0   'False NoClientEdge   =   0   'False AlignLeft      =   0   'False NoWebView      =   0   'False HideFileNames  =   0   'False SingleClick    =   0   'False SingleSelection =  0   'False NoFolders      =   0   'False Transparent    =   0   'False ViewID         =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}" Location       =   "" End End Attribute VB_Name = "WikiCheck" Attribute VB_Creatable = False Attribute VB_Exposed = False Option Explicit

Private Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type

Private Type AppBarData Size As Long hWnd As Long CallbackMessage As Long Edge As Long Rect As Rect Param As Long End Type

Private Declare Function SHAppBarMessage Lib "Shell32" (ByVal dwMessage As Long, pData As AppBarData) As Long

Private Declare Function OpenThemeData Lib "UXTheme" (ByVal hWnd As Long, ClassList As Byte) As Long Private Declare Function GetThemePartSize Lib "UXTheme" (ByVal hTheme As Long, ByVal hDC As Long, _   ByVal PartId As Long, ByVal StateId As Long, ByVal Rect As Long, ByVal SizeType As Long, Size As Long) As Long Private Declare Function DrawThemeBackground Lib "UXTheme" (ByVal hTheme As Long, ByVal hDC As Long, _   ByVal PartId As Long, ByVal StateId As Long, Rect As Long, ByVal ClipRect As Long) As Long Private Declare Function CloseThemeData Lib "UXTheme" (ByVal hTheme As Long) As Long

Private Declare Function DrawFrameControl Lib "User32" (ByVal hDC As Long, _   Rect As Long, ByVal FrameType As Long, ByVal State As Long) As Long

Dim AD As AppBarData

Dim CallBack As Object

Const setApp = "WikiCheck"

Private Sub AppBarCallBack_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim TPPX As Long, TPPY As Long With Screen TPPX = .TwipsPerPixelX TPPY = .TwipsPerPixelY End With With AD   With .Rect .Left = 0 .Top = 0 .Right = Screen.Width \ TPPX .Bottom = Screen.Height \ TPPY SHAppBarMessage 2, AD       .Right = .Left + Screen.Width \ (6 * TPPX) SHAppBarMessage 3, AD       DoEvents Left = .Left * TPPX Top = .Top * TPPY Width = (.Right - .Left) * TPPX Height = (.Bottom - .Top) * TPPY End With End With End Sub

Private Sub Form_Load Left = Screen.Width GenerateParts UI.Navigate2 App.Path & "\ui.html" End Sub

Private Sub Form_Resize UI.Move 0, 0, ScaleWidth, ScaleHeight End Sub

Private Sub Form_Unload(Cancel As Integer) SHAppBarMessage 1, AD End Sub

Private Sub Reboot_Click Form_Load End Sub

Private Sub UI_DocumentComplete(ByVal pDisp As Object, URL As Variant) pDisp.Document.Init Me ShowWindow End Sub

Private Sub WP_DocumentComplete(ByVal pDisp As Object, URL As Variant) If CallBack Is Nothing Then Exit Sub CallBack.call Nothing, pDisp End Sub

Sub OpenWebPage(URL As String, ByVal CB As Object) Set CallBack = CB WP.Navigate2 URL End Sub

Function GetSetting(Section As String, Key As String) As String GetSetting = VBA.GetSetting(setApp, Section, Key) End Function

Sub SaveSetting(Section As String, Key As String, Setting As String) VBA.SaveSetting setApp, Section, Key, Setting End Sub

Sub DeleteSetting(Section As String, Optional Key) VBA.DeleteSetting setApp, Section, Key End Sub

Sub Quit Unload Me End Sub

Private Sub ShowWindow Dim TPPX As Long, TPPY As Long With Screen TPPX = .TwipsPerPixelX TPPY = .TwipsPerPixelY End With With AD   .Size = Len(AD) .hWnd = AppBarCallBack.hWnd .CallbackMessage = 512 '257 SHAppBarMessage 0, AD   .Edge = 0 With .Rect .Left = 0 .Top = 0 .Right = Screen.Width \ TPPX .Bottom = Screen.Height \ TPPY SHAppBarMessage 2, AD       .Right = .Left + Screen.Width \ (6 * TPPX) Visible = False SHAppBarMessage 3, AD       DoEvents Left = .Left * TPPX Top = .Top * TPPY Width = (.Right - .Left) * TPPX Height = (.Bottom - .Top) * TPPY Visible = True End With End With End Sub

Private Sub GenerateParts Dim ClassList As Byte, Rect(1 To 4) As Long, DC As Long, Y As Long Dim hTheme As Long, hThemeE As Long, W As Long, H As Long, WE As Long, HE As Long, PW As Long ClassList = "Window" & vbNullChar:     On Error Resume Next:  hTheme = OpenThemeData(hWnd, ClassList(0)): On Error GoTo 0 ClassList = "ExplorerBar" & vbNullChar: On Error Resume Next: hThemeE = OpenThemeData(hWnd, ClassList(0)): On Error GoTo 0

If hTheme Then GetThemePartSize hTheme, DC, 18, 1, 0, 1, Rect(1) W = Rect(1) H = Rect(2) Else W = 16 H = 14 End If If hThemeE Then GetThemePartSize hThemeE, DC, 7, 1, 0, 1, Rect(1) WE = Rect(1) HE = Rect(2) Else WE = 16 HE = 16 End If

If W > WE Then PW = W Else PW = WE Parts.Move 0, 0, PW, H * 3 + HE * 6 Parts.AutoRedraw = True DC = Parts.hDC

Rect(1) = 0 Rect(3) = W DrawIcon hTheme, DC, 18, 1, Rect, H, 1, 0 DrawIcon hTheme, DC, 18, 2, Rect, H, 1, &H1000& DrawIcon hTheme, DC, 18, 3, Rect, H, 1, &H200& If hTheme Then CloseThemeData hTheme

Rect(3) = WE DrawIcon hThemeE, DC, 7, 1, Rect, HE, 3, 1 DrawIcon hThemeE, DC, 7, 2, Rect, HE, 3, &H1001& DrawIcon hThemeE, DC, 7, 3, Rect, HE, 3, &H201& DrawIcon hThemeE, DC, 6, 1, Rect, HE, 3, 0 DrawIcon hThemeE, DC, 6, 2, Rect, HE, 3, &H1000& DrawIcon hThemeE, DC, 6, 3, Rect, HE, 3, &H200& If hThemeE Then CloseThemeData hThemeE SavePicture Parts.Image, App.Path & "\parts.bmp" Parts.AutoRedraw = False Parts.BackColor = vbBlack

Const EB = "#ExitButton", AW = "{width:", AH = "px;height:", PA = "px}" Const Ho = ":hover", Ac = ":active", BP = "{background-position-y:-" Const Ex = ".Expand", Co = ".Collapse"

Open App.Path & "\parts.css" For Output As #1 Print #1, EB; AW; Format(W); AH; Format(H); PA; Print #1, EB; Ho; BP; Format(H); PA; Print #1, EB; Ac; BP; Format(H * 2); PA; Print #1, Ex; ","; Co; AW; Format(WE); AH; Format(HE); PA; Y = H * 3:  Print #1, Ex; BP; Format(Y); PA; Print #1, Ex; Ho; BP; Format(HE + Y); PA; Print #1, Ex; Ac; BP; Format(HE * 2 + Y); PA; Print #1, Co; BP; Format(HE * 3 + Y); PA; Print #1, Co; Ho; BP; Format(HE * 4 + Y); PA; Print #1, Co; Ac; BP; Format(HE * 5 + Y); PA; Print #1, ".Title,.TitleG{margin-left:"; Format(WE); PA; Close #1 End Sub

Private Sub DrawIcon(ByVal hTheme As Long, ByVal DC As Long, ByVal PartId As Long, ByVal StateId As Long, Rect As Long, ByVal H As Long, ByVal FrameType As Long, ByVal State As Long) Dim Y As Long Y = Rect(4): Rect(2) = Y: Y = Y + H: Rect(4) = Y If hTheme Then DrawThemeBackground hTheme, DC, PartId, StateId, Rect(1), 0 Else DrawFrameControl DC, Rect(1), FrameType, State End If End Sub