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