Thick Line

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
'http://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm
#Compiler PBWin 10
#Compile Exe
#Dim All
 
#Debug Error On
#Debug Display On
 
%Unicode = 1
#Include "Win32API.inc"
 
Enum Equates Singular
   IDC_Graphic = 500
   IDM_Clear
End Enum
 
Global hDlg,hContext As Dword, GLMode, C(),LastX,LastY As Long, bmp$
 
Function PBMain() As Long
   Dialog New Pixels, 0, "PowerBASIC",300,300,500,500, %WS_OverlappedWindow To hDlg
   Control Add Graphic, hDlg, %IDC_Graphic, "",  10,10,500,500
   Graphic Attach hDlg, %IDC_Graphic
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local x,y,w,h,i As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         'graphic stuff
         Graphic Set Overlap
         Graphic Width 10
         Graphic Color %White
         Graphic Clear
         Graphic Get Bits To bmp$
         'context menu
         Menu New PopUp To hContext
         Menu Add String, hContext, "Clear", %IDM_Clear, %MF_Enabled
         'array to hold Graphic color data
         Control Get Size hDlg, %IDC_Graphic To w,h
         ReDim C(w-1,h-1) At StrPtr(bmp$)+8
         LastX = -1
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDM_Clear
               Graphic Clear %White
               Graphic Get Bits To bmp$
               Control Get Size hDlg, %IDC_Graphic To w,h
               ReDim C(w-1,h-1) At StrPtr(bmp$)+8
         End Select
      Case %WM_ContextMenu
         x = Lo(Integer,Cb.LParam) : y = Hi(Integer, Cb.LParam)
         TrackPopupMenu hContext, %TPM_LeftAlign, x, y, 0, Cb.Hndl, ByVal 0
      Case %WM_LButtonDblClk
         GLMode = GLMode Xor 1  'GLMode 1=Graphic Line  0=Simulate Graphic Line
         Graphic Get Bits To bmp$
         Control Get Size hDlg, %IDC_Graphic To w,h
         ReDim C(w-1,h-1) At StrPtr(bmp$)+8
      Case %WM_LButtonDown
         SetCapture hDlg
      Case %WM_MouseMove
         If GetCapture() = hDlg Then
            x = Lo(Integer,Cb.LParam)
            y = Hi(Integer,Cb.LParam)
            If LastX = -1 Then LastX = x : LastY = y
            If GLMode Then
               'Graphic Line
               Graphic Line (LastX,LastY)-(x,y), %Red
            Else
               'Simulate Graphic Line
               DrawPath LastX,LastY,x,y,10,Bgr(%Red)
               Graphic Set Bits bmp$
            End If
            LastX = x : LastY = y
         End If
      Case %WM_LButtonUp
         ReleaseCapture
         LastX = -1
   End Select
End Function
 
Sub DrawPath(x0 As Long, y0 As Long, x1 As Long, y1 As Long, W As Long, clr As Long)
   Local i,iMin,iMax As Long
   DrawLine x0,y0,x1,y1, clr   '<--- C() needs BGR colors
   iMax = W\2
   iMin = iMax - W
   For i = iMin-1 To iMax+1 : DrawLine x0,y0-i,x1,y1-i, clr : Next i
End Sub
 
Sub DrawLine(ByVal x0 As Long, ByVal y0 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal clr As Long)
   Local e,e2,x,y,dx,dy,sx,sy,D As Long
   dx = Abs(x1-x0)
   dy = Abs(y1-y0)
   If x0 < x1 Then sx=1 Else sx=-1
   If y0 < y1 Then sy=1 Else sy=-1
   e = dx-dy
 
   Do
     C(x0,y0) = clr
     If x0 = x1 And y0 = y1 Then Exit Loop
     e2 = 2*e
     If e2 > -dy Then
       e = e - dy
       x0 = x0 + sx
     End If
     If e2 <  dx Then
       e = e + dx
       y0 = y0 + sy
     End If
   Loop
End Sub
 
'gbs_01288
'Date: 05-11-2013

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