vb有趣小程序

       整人的小程序，会弹出对话框提示：快说我是猪，不输入的在线商城源码怎么用话会在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对比两幅的问题！！！

       '我只会靠对应像素颜色是否相同判断(可以判断找茬，但两副尺寸要求严格对应)，下拉更多源码如果你说的是图像匹配就相当复杂了~

       '新建窗体，添加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