Binary Browser Colors

Category: Jose Roca

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
%UseWebBrowser = 1            ' // Use the WebBrowser control
#Include Once "CWindow.inc"   ' // CWindow class
 
%IDC_WebBrowser = 500
%IDC_Graphic    = 501
%ID_Timer       = 502
%IDC_Plus       = 503
%IDC_Minus      = 504
 
Global hDlg, hGraphic, hBrowser, hDCGraphic, hDCBrowser As Dword
Global bgrA, bgrB, TextColor, BGColor, BWTrigger, BWTriggerScaled As Long
 
Function PBMain
   Local pWindow As IWindow
   Dialog Default Font "Tahoma", 12, 1
   Dialog New Pixels, 0, "WebBrowser", , , 1000, 800, %WS_OverlappedWindow To hDlg
 
   Control Add Button, hDlg, %IDC_Plus, "+", 30,5,20,20
   Control Add Button, hDlg, %IDC_Minus, "-", 60,5,20,20
 
   pWindow = Class "CWindow"
'   hBrowser = pWindow.AddWebBrowserControl(hDlg, %IDC_WEBBROWSER, "http://www.garybeene.com",Nothing, 0, 0, 300,400)
   hBrowser = pWindow.AddWebBrowserControl(hDlg, %IDC_WEBBROWSER, "http://www.foxnews.com",Nothing, 5, 30, 300,400)
   hDCBrowser = GetDC(hBrowser)
 
   Control Add Graphic, hDlg, %IDC_Graphic, "", 200,30,300,400, %WS_Border
   Control Handle hDlg, %IDC_Graphic To hGraphic
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
   Graphic Get DC To hDCGraphic
 
   Dialog Show Modal hDlg, Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local w,h As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
'         Control Show State hDlg, %IDC_WebBrowser, %SW_Hide
'         ShowWindow hBrowser, %SW_Hide
         SetTimer hDlg, %ID_Timer, 50, %Null
         BWTrigger = 128
         BWTriggerScaled = BWTrigger * 65536
         TextColor = %Black
         BGColor = %White
         bgrA = Bgr(TextColor)
         bgrB = Bgr(BGColor)
 
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_Plus
               BWTrigger += 8 : If BWTrigger > 255 Then BWTrigger = 255
               BWTriggerScaled = BWTrigger * 65536
            Case %IDC_Minus
               BWTrigger -= 8 : If BWTrigger < 0 Then BWTrigger = 0
               BWTriggerScaled = BWTrigger * 65536
         End Select
 
      Case %WM_Size : WindowResize
 
      Case %WM_Timer
         CopyBrowserToGraphic
 
      Case %WM_Destroy
         ReleaseDC(hDlg, hDCBrowser)
 
   End Select
End Function
 
Sub WindowResize
   Local w,h As Long
   Dialog Get Client hDlg To w,h
   Control Set Size hDlg, %IDC_WebBrowser, w/2-10,h-35
   Control Set Loc hDlg, %IDC_Graphic, w/2+5, 30
   Control Set Size hDlg, %IDC_Graphic, w/2-10, h-35
End Sub
 
Sub CopyBrowserToGraphic
   Local w,h As Long, bmp$
 
   Control Get Size hDlg, %IDC_WebBrowser To w,h
   BitBlt hDCGraphic, 0,0,w,h, hDCBrowser, 0,0, %SrcCopy
 
   Graphic Get Bits To bmp$
   ConvertToBinaryColorsD(bmp$)
   Graphic Set Bits bmp$
 
   Graphic ReDraw
End Sub
 
Sub ConvertToBinaryColorsD(bmp$)     'Dixon post #49
   Local w,h,p,iColor,R,G,B As Long
   'get width/height of image
   w = Cvl(bmp$,1) : h = Cvl(bmp$,5) : p = StrPtr(bmp$)+8
   'get string position of coordinates and modify the string at that position
   For p = p  To  p + 4 * w * h  Step 4
      B = Peek(Byte, p) : G = PeekByte, p+1) : R = Peek(Byte, p+2)
      iColor =  19595 * R + 38470 * G + 7471 * R    'these are the same coefficients but *65536, scaled the same as the trigger value was
      If iColor < BWtriggerScaled Then Poke Long,p, bgrA Else Poke Long, p, bgrB
   Next i
End Sub
 
 


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm