module1.bas

内似于WINDOWS的画比工具的VB程序

Attribute VB_Name = "Module1"
Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_SETDESKWALLPAPER = 20

Private Declare Function SelectObject& Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long)
Private Declare Function ExtFloodFill& Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long)
Private Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
Private Const FLOODFILLBORDER& = 0
Private Const FLOODFILLSURFACE& = 1
Private Const SRCCOPY& = &HCC0020
Private Const PS_SOLID& = 0
Private selColor As OLE_COLOR

Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal nxpos As Long, ByVal nypos As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal colorref As Long) As Long

Public RRR
Public Curcolor
Public Curbkcolor
Public Selectx1
Public Selecty1
Public Selectx2
Public Selecty2
Public Selected As Byte
Public Stored As Byte
Public Huabi
Public ook
Public Danse_r As Byte
Public Danse_g As Byte
Public Danse_b As Byte
Public Kuosan As Long
Public Zhuandanse_fa As Long
Public Quchu_Beijin As Long
Public Quchu_Mubiao As Long
Public Quchu_Fanwei As Single


Public ARRY(1 To 16) As Integer
Public hbitmap&
Public oldbrush&
Public newbrush&
Public thiscolor&
Public dl
Public neww

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
Public XYPOINT() As POINTAPI
Dim cn As Long

'图像显示属性,长的设定
Public Function large(ByVal a, ByVal b)
large = a
If a > b Then large = a
If b > a Then large = b

End Function
'图像显示属性,短的设定
Public Function small(ByVal a, ByVal b)
small = a
If a < b Then small = a
If b < a Then small = b

End Function
'LINE的显示
Public Sub lshow()
Form1.Line2.Visible = True
Form1.Line3.Visible = True
Form1.Line4.Visible = True
Form1.Line5.Visible = True
End Sub
'LINE的隐藏
Public Sub lhide()
Form1.Line2.Visible = False
Form1.Line3.Visible = False
Form1.Line4.Visible = False
Form1.Line5.Visible = False
Selected = 0
End Sub
'画图
Public Sub pic_paint(a_color, X, Y)
oldbrush& = SelectObject(Form1.Picture1.hDC, newbrush)
Form1.Picture1.ForeColor = a_color
thiscolor = Form1.Picture1.Point(X, Y)
dl = ExtFloodFill(Form1.Picture1.hDC, X, Y, thiscolor, FLOODFILLSURFACE)   '*********
dl = SelectObject(Form1.Picture1.hDC, oldbrush)
End Sub

'特效处理-反色
Public Sub chu_li(suan_fa$)
Dim xxx, xwidth, yyy, yheight, maxval, ly, curval, hh, xx, yy
Dim c1, c2, r1, g1, b1, r2, g2, b2, rr, gg, bb, void, setr1, setg1, setb1
setr1 = (Quchu_Beijin And &HFF)
setg1 = (Quchu_Beijin And 65280) / 256
setb1 = (Quchu_Beijin And &HFF0000) / 65536
Screen.MousePointer = 11


Form5.Picture1.PaintPicture Form1.Picture1.Image, 0, 0, , , 0, 0, Form1.Picture1.Width, Form1.Picture1.Height, &HCC0020
Form6.Visible = True


If Selected = 1 Then
xxx = small(Selectx1, Selectx2)
xwidth = Abs(Selectx2 - Selectx1)
yyy = small(Selecty1, Selecty2)
yheight = Abs(Selecty2 - Selecty1)
maxval = xwidth + 1
ly = large(Selecty1, Selecty2)
Form6.HScroll1.Max = maxval
curval = 0
hh = Int(maxval / 30) + 1
For xx = xxx To large(Selectx1, Selectx2)
For yy = yyy To ly
''''''''''''''''''''''''''''''
Select Case suan_fa$

Case "fanse"
c1 = GetPixel(Form5.Picture1.hDC, xx, yy)
r1 = (c1 And &HFF)
g1 = (c1 And 65280) / 256
b1 = (c1 And &HFF0000) / 65536
rr = 256 - r1
gg = 256 - g1
bb = 256 - b1
void = SetPixel(Form1.Picture1.hDC, xx, yy, RGB(rr, gg, bb))
End Select
'''''''''''''''''''''''''''''''
Next yy
curval = curval + 1
If curval / hh = Int(curval / hh) Then Form6.HScroll1.Value = curval
Next xx
Form1.Picture1.Refresh
End If
If Selected = 0 Then
maxval = Form1.Picture1.Width + 1
hh = Int(maxval / 30) + 1
ly = Form1.Picture1.Height
Form6.HScroll1.Max = maxval
curval = 0
For xx = 1 To Form1.Picture1.Width
For yy = 1 To ly
''''''''''''''''
Select Case suan_fa$
Case "fanse"
c1 = GetPixel(Form5.Picture1.hDC, xx, yy)
r1 = (c1 And &HFF)
g1 = (c1 And 65280) / 256
b1 = (c1 And &HFF0000) / 65536
rr = 256 - r1
gg = 256 - g1
bb = 256 - b1
void = SetPixel(Form1.Picture1.hDC, xx, yy, RGB(rr, gg, bb))
End Select
''''''''''''''''''
Next yy
curval = curval + 1
If curval / hh = Int(curval / hh) Then Form6.HScroll1.Value = curval
Next xx
Form1.Picture1.Refresh

End If


Form6.Visible = False
Screen.MousePointer = 0

End Sub