Full Screen Black and Whitee

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
 
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
 
%ID_Timer = 500
 
Global hDlg, hBMP, hDC As Dword, bmp$
Global wDeskTop, hDeskTop As Long
Global bwTrigger, bwTriggerScaled, bgrA, bgrB, TextColor, BGColor As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0,  "Colors",,,400,100,  %WS_OverlappedWindow + %CS_HRedraw  + %CS_VRedraw To hDlg
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         TextColor = %White 'Yellow
         BGColor   = %Black '%Blue
         bwTrigger = 196
         bgrA = Bgr(TextColor)
         bgrB = Bgr(BGColor)
         BWTriggerScaled = BWTrigger * 65536
 
         Dialog Show State hDlg, %SW_Minimize
         CreateMemoryBitmap
         SetTimer hDlg, %ID_Timer,1000, ByVal %Null
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IdCancel : Dialog End hDlg
         End Select
      Case %WM_Timer
         Dialog Set Text hDlg, Time$
         ConvertBMP
 
   End Select
End Function
 
Sub CreateMemoryBitmap
   Desktop Get Size To wDeskTop, hDeskTop
   Graphic Bitmap New wDeskTop, hDeskTop To hBmp
   Graphic Attach hBMP, 0
   Graphic Get DC To hDC
End Sub
 
Sub ConvertBMP
   Local hDCDeskTop As Dword
 
   hDCDeskTop = GetDC(%Null)
   BitBlt hDC, 0,0,wDeskTop,hDeskTop, hDCDeskTop, 0,0, %SrcCopy
 
   Graphic Get Bits To bmp$
   'ConvertToGrayScale
   ConvertToBinaryColorsD
   Graphic Set Bits bmp$
 
   BitBlt hDCDeskTop, 0,0,wDeskTop,hDeskTop, hDC, 0,0, %SrcCopy
   ReleaseDC(%Null, hDCDeskTop)
 
End Sub
 
Sub ConvertToGrayScale
   Local r,g,b,w,h,i,iColor As Long, bp As Byte Ptr, p As Long Ptr
   'get width/height of image
   w = Cvl(bmp$,1)
   h = Cvl(bmp$,5)
   bp = StrPtr(bmp$)+8
   p = bp
 
   'get string position of coordinates and modify the string at that position
   For i = 1 To w*h
      B = @bp                      'string BGR bytes positions are 0-R-G-B
      Incr bp : G = @bp
      Incr bp : R = @bp
      Incr bp : Incr bp
      iColor = 0.299*R + 0.587*G + 0.114*B  'create gray component
      @p = Bgr(iColor,iColor,iColor)        'modify string at that position
      Incr p
   Next i
End Sub
 
Sub ConvertToBinaryColorsD      '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 = Peek( Byte, 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