home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Muscles_Dr2211729192011.psc / BrushLine.bas < prev    next >
BASIC Source File  |  2011-09-19  |  4KB  |  106 lines
  1. Attribute VB_Name = "BrushLine"
  2.  
  3. '
  4. Option Explicit
  5.  
  6. Public Type POINTAPI
  7.     X              As Long
  8.     Y              As Long
  9. End Type
  10.  
  11. Public poi         As POINTAPI
  12.  
  13.  
  14. Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  15. Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  16.  
  17. Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  18. Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  19. Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  20. Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  21. Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  22.  
  23. Public Declare Function Arc Lib "gdi32" (ByVal hdc As Long, _
  24.                                          ByVal xInizioRettangolo As Long, _
  25.                                          ByVal yInizioRettangolo As Long, _
  26.                                          ByVal xFineRettangolo As Long, _
  27.                                          ByVal yFineRettangolo As Long, _
  28.                                          ByVal xInizioArco As Long, _
  29.                                          ByVal yInizioArco As Long, _
  30.                                          ByVal xFineArco As Long, _
  31.                                          ByVal yFineArco As Long) As Long
  32.  
  33. Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  34.  
  35. Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  36. Public Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  37.  
  38. Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  39. Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  40. Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  41.  
  42. Private Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
  43.  
  44.  
  45. 'Declare Function Arc Lib "gdi32.dll" (ByVal HDC As Long, ByVal X1 As Long, _
  46.  ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, _
  47.  ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
  48.  
  49. Public PrevColor   As Long
  50. Public PrevWidth   As Long
  51.  
  52.  
  53. Public Sub SetBrush(ByVal hdc As Long, ByVal PenWidth As Long, ByVal PenColor As Long)
  54.  
  55.  
  56.     DeleteObject (SelectObject(hdc, CreatePen(vbSolid, PenWidth, PenColor)))
  57.     'kOBJ = SelectObject(hDC, CreatePen(vbSolid, PenWidth, PenColor))
  58.     'SetBrush = kOBJ
  59.  
  60.  
  61. End Sub
  62.  
  63.  
  64.  
  65. Public Sub FastLine(ByRef hdc As Long, ByRef x1 As Long, ByRef y1 As Long, _
  66.                     ByRef x2 As Long, ByRef y2 As Long, ByRef w As Long, ByRef Color As Long)
  67. Attribute FastLine.VB_Description = "disegna line veloce"
  68.  
  69.     Dim poi        As POINTAPI
  70.  
  71.     'SetBrush hdc, W, color
  72.     'If color <> PrevColor Or w <> PrevWidth Then
  73.     DeleteObject (SelectObject(hdc, CreatePen(vbSolid, w, Color)))
  74.     '    PrevColor = color
  75.     '    PrevWidth = w
  76.     'End If
  77.  
  78.     MoveToEx hdc, x1, y1, poi
  79.     LineTo hdc, x2, y2
  80.  
  81. End Sub
  82.  
  83. Sub MyCircle(ByRef hdc As Long, ByRef X As Long, ByRef Y As Long, ByRef R As Long, w As Long, Color)
  84.     Dim XpR        As Long
  85.  
  86.     'If color <> PrevColor Or w <> PrevWidth Then
  87.     DeleteObject (SelectObject(hdc, CreatePen(vbSolid, w, Color)))
  88.     '    PrevColor = color
  89.     '    PrevWidth = w
  90.     'End If
  91.  
  92.     XpR = X + R
  93.  
  94.     Arc hdc, X - R, Y - R, XpR, Y + R, XpR, Y, XpR, Y
  95.  
  96. End Sub
  97.  
  98.  
  99. Public Sub bLOCK(ByRef hdc As Long, X As Long, Y As Long, w As Long, Color As Long)
  100.  
  101.     DeleteObject (SelectObject(hdc, CreatePen(vbSolid, 1, Color)))
  102.  
  103.     Rectangle hdc, X, Y, X + w, Y + w
  104.  
  105. End Sub
  106.