CrossHairs

Category: Drawing

Date: 03-28-2012

Return to Index


 
'Credit: Borje Hagsten
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
%USEMACROS = 1
#Include "WIN32API.INC"
 
Function PBMain () As Long
   Local hDlg As Dword
   Dialog New 0, "Click and draw..",,, 220, 140, %WS_Caption Or %WS_SysMenu, 0 To hDlg
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_LButtonDown
         DrawDottedLines CbHndlLo(Word, CbLParam), Hi(Word, CbLParam)
      Case %WM_MouseMove
         If (Cb.WParam And %MK_LBUTTON) Then
            DrawDottedLines CbHndlLo(Word, CbLParam), Hi(Word, CbLParam)
         End If
      Case %WM_LButtonUp
         DrawDottedLines CbHndl, 0, 0  ' zeros for wipe out only
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IdCancel
               If Cb.CtlMsg = %BN_Clicked Or Cb.CtlMsg = 1 Then Dialog End Cb.Hndl
         End Select
   End Select
End Function
 
Sub DrawDottedLines(hWnd As Dword, x%, y%)
   ' Draw vertical/horizontal dotted lines in given window
   Local hDC As Dword, rca,rcb As RECT
   Static rc1,rc2 As RECT
 
   hDC = GetDC(hWnd)
   rca.nLeft    = -1  ' draw left/top lines outside visible area
   rca.nTop     = -1
   rca.nRight   = x%
   rca.nBottom  = y%
   DrawFocusRect hDC, rca
   If rc1.nRight Or rc1.nBottom Then
      DrawFocusRect hDC, rc1  ' wipe out previous lines
   End If
 
   rcb.nLeft    = x%-1  ' draw left/top lines outside visible area
   rcb.nTop     = y%-1
   rcb.nRight   = 5000
   rcb.nBottom  = 5000
   DrawFocusRect hDC, rcb
   If rc2.nRight Or rc2.nBottom Then
      DrawFocusRect hDC, rc2  ' wipe out previous lines
   End If
   ReleaseDc hWnd, hDC
   rc2 = rca  ' store for next wipe out
   rc1 = rcb
End Sub
 
'gbs_00871
'Date: 03-10-2012


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