?? module1.bas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -