api.bas

电脑编程技巧和源码。很不错的。

Attribute VB_Name = "Module1"
Const MILLICMETERCELL = 26.45836  '每一个像素点相当于多少微米

Public Const BLACKNESS = &H42
Public Const WHITENESS = &HFF0062
Public Const DSTINVERT = &H550009
Public Const MERGECOPY = &HC000CA
Public Const MERGEPAINT = &HBB0226
Public Const NOTSRCCOPY = &H330008
Public Const NOTSRCERASE = &H1100A6
Public Const PATCOPY = &HF00021
Public Const PATINVERT = &H5A0049
Public Const PATPAINT = &HFB0A09

Public Const SRCAND = &H8800C6
Public Const SRCCOPY = &HCC0020
Public Const SRCERASE = &H440328
Public Const SRCINVERT = &H660046
Public Const SRCPAINT = &HEE0086


Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Public Type PALETTEENTRY
        peRed As Byte
        peGreen As Byte
        peBlue As Byte
        peFlags As Byte
End Type

Public Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type

Public Type LOGPALETTE
        palVersion As Integer
        palNumEntries As Integer
        palPalEntry(1) As PALETTEENTRY
End Type

Public Type Size
        cx As Long
        cy As Long
End Type



 Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
 Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
 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
 Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
 Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
 Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
 Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
 Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 Public Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
 Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
 Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal HBrush As Long) As Long
 Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
 Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
 Public Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
 Public Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
 Public Declare Function GetPaletteEntries Lib "gdi32" (ByVal hPalette As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
 Public Declare Function GetBitmapDimensionEx Lib "gdi32" (ByVal hBitmap As Long, lpDimension As Size) As Long
 Public Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long



'返回两者中较小的一个
Public Function Min(ByVal a As Integer, ByVal b As Integer) As Integer
    Min = IIf(a > b, b, a)
End Function

'返回两者中较大的一个
Public Function Max(ByVal a As Integer, ByVal b As Integer) As Integer
    Max = IIf(a > b, a, b)
End Function

'取色彩中的Red的值
Public Function GetRed(ByVal n As Long) As Integer
   GetRed = n Mod 256&
End Function

'取色彩中的Green的值
Public Function GetGreen(ByVal n As Long) As Integer
   GetGreen = (n \ 256&) Mod 256&
End Function

'取色彩中的Blue的值
Public Function GetBlue(ByVal n As Long) As Integer
   GetBlue = n \ 65536
End Function

'取字符串中有多少个字符
Public Function Strlen(ByVal s As String) As Integer
  Dim i As Integer
  n = Len(s)
  
  For i = 1 To n
    If Asc(Mid$(s, i, 1)) < 0 Then n = n + 1
  Next i
  
  Strlen = n

End Function

'获取位图的宽度
Public Function GetPictureWidth(ByVal p As Picture) As Integer

  GetPictureWidth = Int(p.Width / MILLICMETERCELL + 0.5)
   
   
End Function

'获取位图的高度
Public Function GetPictureHeight(ByVal p As Picture) As Integer

   GetPictureHeight = Int(p.Height / MILLICMETERCELL + 0.5)
   
End Function
'获取渐变色彩值
'入口参数：SrcColor 原色彩
'          Steps 步骤数
'          CurStep 当前的步子
'          DstColor 目标色彩
'返回值：当月前的色彩值
Public Function GetTrienColor(ByVal scrColor As Long, ByVal dstColor As Long, ByVal Steps As Integer, ByVal curStep As Integer) As Long
  Dim sR, sG, sB, dR, dG, dB As Integer
  
  sR = GetRed(scrColor)
  sG = GetGreen(scrColor)
  sB = GetBlue(scrColor)
  
  dR = GetRed(dstColor)
  dG = GetGreen(dstColor)
  dB = GetBlue(dstColor)
  
  sR = sR + curStep * (dR - sR) / Steps
  sG = sG + curStep * (dG - sG) / Steps
  sB = sB + curStep * (dB - sB) / Steps
  GetTrienColor = RGB(sR, sG, sB)
End Function