【117源码】【出口申报系统源码】【wifi打电话源码】hsr 源码
1.vb有趣小程序
2.VB对比两幅的问题！！！
3.弹出来的 确定框 怎么制作呀？
vb有趣小程序
整人的小程序，会弹出对话框提示：快说我是猪，不输入的117源码话会在1分钟之内自动关机，输入的话，当让会被笑话啦，呵呵
将以下文字粘贴到记事本上后将后缀名改为:vbe,然后双击即可!(里面的那些词语可以自行修改)，经测试肯定可以使用。
on error resume next
dim WSHshellA
set WSHshellA = wscript.createobject("wscript.shell")
WSHshellA.run "cmd.exe /c shutdown -r -t -c ""说[我是猪]，不说[我是猪]，不信，试试···"" ",0 ,true
dim a
do while(a <> "我是猪")
a = inputbox ("说[我是猪],就不关机，快撒，出口申报系统源码说 ""[我是猪]"" ","说不说","不说",,)
msgbox chr() + chr() + chr() + a,0,"MsgBox"
loop
msgbox chr() + chr() + chr() + "早说就行了嘛"
dim WSHshell
set WSHshell = wscript.createobject("wscript.shell")
WSHshell.run "cmd.exe /c shutdown -a",0 ,true
msgbox chr() + chr() + chr() + "承认就好了嘛"
阻止关机的方法:按键盘上的Win键+R键，在出来的窗口中输入:shutdown -a 再按回车即可取消关机命令。
VB对比两幅的问题！！！
'我只会靠对应像素颜色是否相同判断(可以判断找茬，但两副尺寸要求严格对应)，wifi打电话源码如果你说的是图像匹配就相当复杂了~
'新建窗体，添加picture1(0),picture1(1),picture2,command1,hscroll1
'以下保存在模块中：
Public Declare Function SetStretchBltMode Lib "gdi" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Public Const STRETCH_HALFTONE = 4
Public Declare Function StretchBlt Lib "gdi" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Declare Function GetOpenFileName Lib "comdlg.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Declare Function GetBitmapBits Lib "gdi" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Function SetBitmapBits Lib "gdi" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Sub CopyMemory Lib "kernel" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetObject Lib "gdi" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'以下保存在窗体中
Dim bit1() As Byte, bit2() As Byte, bit3() As Byte
Private Sub Form_Load()
Me.ScaleMode = 3 '像素模式
Picture1(0).ScaleMode = 3
Picture1(0).Move , , ,
Picture1(0).AutoRedraw = True
Picture1(0).Print "基准图像(双击选择)"
Picture1(1).Move , , ,
Picture1(1).AutoRedraw = True
Picture1(1).Print "输入图像(双击选择)" & vbCrLf & vbTab & "点击对比按钮该图像与基准图像相同部分变暗，不同部分亮显。" & vbCrLf & "单击右键还原上次对比前输入。"
Command1.Move , , ,
Command1.Caption = "对比：阀值"
Command1.Tag = 0
Command1.Default = True
HScroll1.Move , , ,
HScroll1.Max =
HScroll1.Value =
Picture2.ScaleMode = 3
Picture2.AutoSize = True
Picture2.AutoRedraw = True
Picture2.Visible = False
End Sub
Private Sub HScroll1_Change()
If Command1.Tag = 1 Then SetBitmapBits Picture1(1).Image, UBound(bit2), bit2(1) '还原上次对比前
Command1.Caption = "对比：阀值" & HScroll1.Value
End Sub
Private Sub Picture1_DblClick(Index As Integer)
filenam = openfile
If filenam <> "" Then
Picture2.Picture = LoadPicture(filenam)
SetStretchBltMode Picture1(Index).hdc, 4
StretchBlt Picture1(Index).hdc, 0, 0, , , Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, vbSrcCopy
Picture1(Index).Refresh
End If
End Sub
Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And Index = 1 And Command1.Tag = 1 Then SetBitmapBits Picture1(1).Image, UBound(bit2), bit2(1)
End Sub
Private Sub Command1_Click()
getbit Picture1(0).Image, bit1()
getbit Picture1(1).Image, bit2()
ReDim bit3(1 To UBound(bit2))
CopyMemory bit3(1), bit2(1), UBound(bit2)
For i = 1 To UBound(bit1) Step 4
If Abs(CInt(bit1(i)) - CInt(bit2(i))) <= HScroll1.Value And Abs(CInt(bit1(i + 1)) - CInt(bit2(i + 1))) <= HScroll1.Value And Abs(CInt(bit1(i + 2)) - CInt(bit2(i + 2))) <= HScroll1.Value Then
bit3(i) = 0.2 * bit2(i) 'b
bit3(i + 1) = 0.2 * bit2(i + 1) 'g
bit3(i + 2) = 0.2 * bit2(i + 2) 'r
n = n + 1
End If
Next
r = Round( * n / UBound(bit1), 2)
Me.Caption = "相似度：" & r & "%" & IIf(r = , "（一样）", "（不一样）")
SetBitmapBits Picture1(1).Image, UBound(bit3), bit3(1)
Command1.Tag = 1
End Sub
Function getbit(ByVal hbmp As Long, ByRef bit() As Byte)
Dim picinfo As BITMAP
GetObject hbmp, Len(picinfo), picinfo
ReDim bit(1 To picinfo.bmHeight * picinfo.bmWidth * 4)
GetBitmapBits hbmp, UBound(bit), bit(1)
End Function
Function openfile() As String
Dim ofn As OPENFILENAME
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = hWnd
ofn.hInstance = App.hInstance
ofn.lpstrFilter = "PICTURE FILE ONLY" & Chr(0) & "*.jpg;*.bmp;*.gif" & Chr(0)
ofn.lpstrFile = Space()
ofn.nMaxFile =
ofn.lpstrFileTitle = Space()
ofn.nMaxFileTitle =
ofn.lpstrTitle = "打开"
ofn.flags =
If GetOpenFileName(ofn) Then openfile = ofn.lpstrFile
End Function
弹出来的 确定框 怎么制作呀？
这要用Visual Basic编程制作窗体。不知道你看不看的懂
当然也可以使用API函数制作椭圆型的、三角型的席位玩具版源码窗体，还可以制作窗体。下面我给大家介绍一种制作文字、字符窗体的方法，希望能对你有所帮助。
要想制作文字窗体就要用到WINDOWS的几个API函数，首先我们来看看这几个函数的功能：
1、 GetPixel (ByVal hdc As Long,客户要网站源码 ByVal x As Long, ByVal y As Long) 函数
函数功能：取得一个像素的RGB值
参数：hdc ，设备场景的句柄
x,y ，逻辑坐标中的点
2： CreateRectRgn (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
函数功能：创建一个由点X1，Y1和X2，Y2描述的矩形区域
参数：x1,y1，矩形左上角X，Y坐标
x2,y2，矩形右下角X，Y坐标
3：Private Declare Function CombineRgn Lib "gdi" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
函数功能：将两个区域组合为一个新区域
参数：hDestRgn，结果区域句柄
hSrcRgn1，源区域1
hSrcRgn2，源区域2
nCombineMode，合并模式
4：Declare Function SetWindowRgn Lib "user" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
函数功能：设置窗口的区域
参数：hWnd ，窗口句柄
hRgn，将设置的区域的句柄
bRedraw ，是否立即重画窗口
在文字窗体的设计中应当先是选定一种屏蔽色作为窗体的背景色（当然这种颜色应当是窗体
图形中所没有的颜色），然后利用了一个字符数组，将设计好的图形存储在里面，之后将图形输
出在窗体上。最后用GetPixel函数扫描窗体上已经输出字符的区域，将窗体上与屏蔽色不同的区
域标记出来，并且用CreateRectRgn函数创建成矩形区域，再将它们用CombineRgn函数合并成一
个区域，之后用SetWindowRgn函数设置窗体区域并生成窗体。
属性设置：新建一个窗体（CAPTION->"制作文字窗体";NAME=FORM1;AUTOREDRAW->TRUE;
SCALEMODE->1;BACKCOLOR->屏蔽色)窗体字体和前景色可根据需要设置,也可以在代码中设置。
以下是程序源代码：
------------- API函数声明---------------------
Option Explicit
Private Declare Function CombineRgn Lib "gdi" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi" (ByVal hdc Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
-------------常量-------------
Const RGN_OR = 2
------------- 变量-------------
Dim oldx As Integer
Dim oldy As Integer
Dim rgn As Long
Dim MaskColor As Long
Private Sub Form_Load()
MaskColor=Form1.BackColor
CreateForm
End Sub
'-------生成文字窗体-------
Public Sub CreateForm()
Const max = 5 '字符行数即窗体图形数组的最大值
Dim graphics(max) As String '存储窗体图形
Dim X As Long
Dim Y As Long
Dim count As Long '相同像素数
Dim curpixels As Long '当前检查像素
Dim temp As Long
Dim textheight As Long '扫描区域的高度
Dim textwidth As Long '扫描区域的宽度
Dim i As Integer
Dim maxwidth As Long '窗体的最大宽度
Me.CurrentX = 0
Me.CurrentY = 0
'-------初始化窗体图形，可根据自己的需要设计出多种样式-------------
graphics(0) = " ★"
graphics(1) = " ★★"
graphics(2) = " ◎▲◎"
graphics(3) = " ★★★★"
graphics(4) = " ★■■■★"
graphics(5) = "哈哈文字窗体 "
'--------输出窗体图形------------
maxwidth = Me.textwidth(graphics(0))
For i = 0 To max
If Me.textwidth(graphics(i)) >= maxwidth Then
maxwidth = Me.textwidth(graphics(i))
End If
textheight = textheight + Me.textheight(graphics(i))
'-----设置图形颜色-----------
If i Mod 2 = 0 Then
Me.ForeColor = vbBlue
Else
Me.ForeColor = vbRed
End If
Me.Print graphics(i)
'-----根据文字大小自动缩放窗体------
If Me.Height < textheight Then
Me.Height = textheight +
End If
If Me.Width < maxwidth Then
Me.Width = maxwidth +
End If
Next i
textheight = Int(textheight / )
textwidth = Int(maxwidth / )
RGN = CreateRectRgn(0, 0, 0, 0) '创建空区域
For Y = 0 To textheight - 1
count = 0
For X = 0 To textwidth - 1
curpixels = GetPixel(Form1.hdc, X, Y)
If X >= textwidth - 1 And count > 0 Then
temp = CreateRectRgn(X + Int((Me.Width - Me.ScaleWidth) \ ) - count, Y + Int((Me.Height - Me.ScaleHeight) \ ) - Int((Me.Width - Me.ScaleWidth) \ ), X + Int((Me.Width - Me.ScaleWidth) \ ), Y + Int((Me.Height - Me.ScaleHeight) \ ) - Int((Me.Width - Me.ScaleWidth) \ ) + 1) '创建区域
CombineRgn RGN, RGN, temp, RGN_OR '合并两个区域
DeleteObject temp
End If
If curpixels <> MaskColor Then
count = count + 1
Else
If count > 0 Then
temp = CreateRectRgn(X + Int((Me.Width - Me.ScaleWidth) \ ) - count, Y + Int((Me.Height - Me.ScaleHeight) \ ) - Int((Me.Width - Me.ScaleWidth) \ ), X + Int((Me.Width - Me.ScaleWidth) \ ), Y + Int((Me.Height - Me.ScaleHeight) \ ) - Int((Me.Width - Me.ScaleWidth) \ ) + 1)
CombineRgn RGN, RGN, temp, RGN_OR
DeleteObject temp
End If
count = 0
End If
Next X
Next Y
SetWindowRgn Me.hwnd, RGN, True '设置窗体区域
End Sub
Private Sub Form_DblClick()
End
End Sub
'-----移动窗体代码------
Private Sub form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
oldx = X
oldy = Y
End If
End Sub
Private Sub form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X <> oldx Or Y <> oldy Then
Form1.Left = Form1.Left + (X - oldx)
Form1.Top = Form1.Top + (Y - oldy)
End If
End If
End Sub