vb中如何使一个窗口unload后,再显示?

xinyi 2000-07-28 03:20:00
现在我的一个工程中"~只有一个~"窗口,如何使一个窗口unload后(即施放所有对象),从新load显示
...全文
263 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
weity 2000-08-03
  • 打赏
  • 举报
 回复
程序已经不在 内存里面 你有方法把她在调出来??
不行的
不过 你的意思好像是要刷新form 是不是?
如果是 只要写一个初始化的函数即可了
如果不是 请说明用途!
shines77 2000-08-03
  • 打赏
  • 举报
 回复
这样一个窗体完全Unload以后还能load吗，白痴！！！
lczddd 2000-08-03
  • 打赏
  • 举报
 回复
本窗体unload后，所有的一切都将从内存中释放，而模块中不可能有动作发生，我想知道你的意图是什么？
xinyi 2000-08-02
  • 打赏
  • 举报
 回复
请大家理解我提问的意思！！！
如果象lumine和vicsue所说的unload后，整个应用程序将结束
lczddd没有满足我的条件
tyro是否能说的详细一点
lczddd 2000-08-02
  • 打赏
  • 举报
 回复
用两个窗口form1,form2，其中form1有两个按钮cmd1,cmd2
cmd1_click
form2.show
end ...
cmd2_click
unload form2
end ...
无言无忌 2000-08-01
  • 打赏
  • 举报
 回复
Unload之后,可以用Show方法再现窗口,但无法保存上次的数据.
如果只是想窗口暂时不可见的话可用Form1.Hide,要再现时用Form1.Show.
Tyro 2000-07-28
  • 打赏
  • 举报
 回复
在一个模块中处理！
知行职场-雷曼 2000-07-28
  • 打赏
  • 举报
 回复
unload form1
from1.show
再谈VB制作不规则窗口
由于使用了一些新的函数，本程序必须在Windows2000下运行。 Option Explicit Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Public Const RGN_OR = 2 Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long Public Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) 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 Const BITMAP_SIZE = 24 '=Len(BITMAP) Dim bmByte() As Byte Public Declare Function ReleaseCapture Lib "user32" () As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const HTCAPTION = 2 Public Const WM_NCLBUTTONDOWN = &HA1; Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Public Const WS_EX_LAYERED = &H80000; Public Const GWL_EXSTYLE = (-20) Public Const LWA_ALPHA = &H2; Public Const LWA_COLORKEY = &H1; Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull) Dim X As Long, Y As Long Dim Rgn1 As Long, Rgn2 As Long Dim SPos As Long, EPos As Long Dim bm As BITMAP Dim hbm As Long Dim Wid As Long, Hgt As Long Dim xoff As Long, yoff As Long '获取窗体背景图片尺寸 hbm = hForm.Picture GetObjectAPI hbm, Len(bm), bm Wid = bm.bmWidth Hgt = bm.bmHeight With hForm .ScaleMode = vbPixels xoff = (.ScaleX(.Width, vbTwips, vbPixels) - .ScaleWidth) / 2 yoff = .ScaleY(.Height, vbTwips, vbPixels) - .ScaleHeight - xoff '改变窗体尺寸 .Width = (Wid + xoff * 2) * Screen.TwipsPerPixelX .Height = (Hgt + xoff + yoff) * Screen.TwipsPerPixelY End With ReDim bmByte(1 To Wid, 1 To Hgt) GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) '获取图像数组 '如果没有传入transColor参数，则用第一个像素作为透明色 If transColor = vbNull Then transColor = bmByte(1, 1) Rgn1 = CreateRectRgn(0, 0, 0, 0) For Y = 1 To Hgt '逐行扫描 X = 0 Do X = X + 1 While (bmByte(X, Y) = transColor) And (X < Wid) X = X + 1 '跳过是透明色的点 Wend SPos = X While (bmByte(X, Y) <> transColor) And (X < Wid) X = X + 1 '跳过不是透明色的点 Wend EPos = X - 1 '这一段是合并区域 If SPos <= EPos Then Rgn2 = CreateRectRgn(SPos - 1 + xoff, Y - 1 + yoff, EPos + xoff, Y + yoff) CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR DeleteObject Rgn2 End If Loop Until X >= Wid Next Y SetWindowRgn hForm.hwnd, Rgn1, True '设定窗体形状区域 DeleteObject Rgn1 End Sub Option Explicit Private Sub Form_DblClick() Unload Me End Sub Private Sub Form_Load() 'Me.Show Dim t As Single Dim rtn As Long rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, 192, LWA_ALPHA '半透明 'SetLayeredWindowAttributes hwnd, &H0;, 0, LWA_COLORKEY '去除透明色 t = Timer If Me.Picture <> 0 Then Call SetAutoRgn(Me) ', 0) End If 'MsgBox "运行时间：" & Timer - t & "秒", vbInformation End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then ReleaseCapture SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& End If End Sub
VB试题.doc
VB试题.doc 一、 填空题 1.ＶＢ中若要产生一消息框，可用__msgbox__函数来实现。 2．常量是指在程序运行过程中， 其值不能改变 的量。 3．整数类型数据分别包括整型和 长整型 数据。 ４、在ＶＢ集成开发环境中，运行应用程序的方法有三种：一是_单击“运行 ”菜单下的启动_；二是_单击工具栏上的启动按钮；三是_按Ｆ5键 。 ５、在ＶＢ中若要让某对对象获取焦点，则可通过__ Setfocus_方法来实现。 6．列表框（ListBox控件）显示 项目列表 ，用户可从中选择一个或多个项目。 7．框架（Frame控件）可以用来 对其它控件 进行分组，以便于用户识别，主要用于为单选按钮分组。 ８、在ＶＢ中，用来描述对象外部特征的量称之为对象的_属性__。 ９、为使某窗口中的命令按钮“取消(C)”具有如下特性：按“Alt＋C”键或按 “ESC” 键，均可代替用鼠标单击该按钮的操作，应设置该按钮的Caption属性值为_取消(&C)___，并且设置其_ Cancel__属性值为__ True__。 10、在过程内用_ Static__声明的变量为静态变量，在执行一个过程结束时，过程中所用到的 Static变量的值会保留，下次再调用此过程时，变量的初值是上次调用结束时被保留的值。 11、在模块文件中的声明部分用Global或__ Dim__关键字声明的变量为全局变量。 12、在模块文件中的声明部分用__ Dim__或__ Private__定义的变量为模块级变量。 13．计时器控件通过定期激活Timer事件，使得Timer控件 可以每隔一个时间段 就执行一次Timer事件中的代码。 14．要获得滚动条的当前位置，可以访问通过 Value 属性来实现。 15．关闭正在运行的VB窗口将自动触发的事件是 Unload 。 二、选择题 1．工程文件的扩展名是（ B ）。 A．vbg B.vbp C.vbw D.vbl 2.在以下窗体中没有采用的控件是（ B ）。 A.文本框 B 垂直滚动条 C．框架 D 命令按钮 3．滚动条控件（如图所示）的Largechange属性所设置的是（ A ） A． 单击滚动条和滚动箭头之间的区域时，滚动条控件Value属性值的改变量 B． 滚动条中滚动块的最大移动位置 C． 滚动条中滚动块的最大移动范围 D． 滚动条控件无该属性 4、用于从字符串左边截取字符的函数是（　A　） Ａ、Ltrim( )　　Ｂ、Trim( )　　Ｃ、Left( )　　Ｄ、Instr( ) 5、可获得当前系统日期的函数是（　A　）
VB6.0动态加载ActiveX控件漫谈
VB6.0动态加载ActiveX控件漫谈 深圳 罗汉军 罗德昌 熟悉VB的朋友对使用ActiveX控件一定不会陌生，众多控件极大地方便了编程， 但唯一的缺陷是不能动态加载控件，必须在设计时通过引用，将控件放置在窗体上。 VB6.0已能够解决该问题，只是帮助中没有明确说明，并且没有描述到一些关键功 能，由于以前的版本中可以动态创建进程外服务：如果对象是外部可创建的，可在 Set 语句中用 New 关键字、CreateObject 或 GetObject 从部件外面将对象引用赋予变 量。 如果对象是从属对象，则需使用高层对象的方法，在 Set 语句中指定一个对象引 用： Dim xlApp1 As Excel.Application Set xlApp1 = New Excel.Application 或 Dim xlApp As Object '定义存放引用对象的变量。 Set xlApp = CreateObject("excel.application") xlApp.Visible = True ---- 这些语法很容易造成误导，以为动态加载ActiveX控件也是此方法，可能有朋 友也象我一样利用CreateObject尝试了无数次，却无功而返，不知微软公司是出于何种 考虑，动态加载ActiveX控件是扩展控件集合的方式实现，通过实际摸索，终于就如 何实现动态ActiveX控件找出了一条切实可行的方法，下面以一个具体的实例来详细说 明。 一、ActiveX控件 ---- ActiveX 控件是 Visual Basic 工具箱的扩充部分。使用 ActiveX 控件的方 法与使用其它标准内装的控件，如 CheckBox 控件，完全一样。在程序中加入 ActiveX 控件后，它将成为开发和运行环境的一部分，并为应用程序提供新的功能。 ---- ActiveX 部件通过客户端/服务器关系与应用程序— 及与部件相互之间— 交 互作用。客户端是使用部件功能的应用程序代码或部件。服务器是部件及其关联的对象。 例如，假设应用程序使用 ActiveX 控件来提供一个标准的雇员窗体，供公司的多种 应用程序使用。提供雇员窗体的 ActiveX 控件就是服务器，使用这个控件的应用程序 就是服务器的客户端。 二、加载方法 ---- VB6.0中对Controls 集合进行了扩展，以前版本中Controls 集合在窗体上列 举出已加载的控件，这在迭代过程中是很有用的。Controls 集合标识一个叫做 Controls的内在窗体级变量。如果忽略可选的 object 所在处的整数，则关键字 Controls 必须包括在内。我们通常在窗口中使用如下代码： Text1.Text="Hello, world" 其实也可以使用如下代码达到同一目的： Controls(1).Text="Hello, world" ---- 在VB6.0中除了原来的Clear、Remove 方法外(很奇怪，为什么微软在VB5.0中 只提供这两种方法，而没有提供Add方法，因为没有Add，这两种方法也就没什么用处)， 增加了Add方法，该方法就是用于动态加载控件的： Controls.Add(progid as String, Name as String); progid： ActiveX部件的ProgID，如："VB.CheckBox"； Name：ActiveX部件加载后的名称，如： "MyCheckBox"； 若要在窗体上添加一个名为MyButton的按钮，可以使用： dim oControl as Object '窗体级变量 注意：这里声明为Object对象类型 Private Sub LoadControl() Set oControl = Controls.Add ("VB.CommandButton", "MyButton") oControl.Left = 10 oControl.Top = 10 oControl.Visible = True '使控件可见 End Sub ---- 这是VB6.0的标准语法，它在例程中也是如此演示的，不过该方法虽然现实了 控件的动态加载，按钮显示在窗体上，可以象普通按钮一样按下去，但加载的控件不能 预先设计响应事件代码，如：事件Sub MyButton_Click()将是非法的，当然，可以将要 响应的事件封装在控件内部。就编程的观点来看该方法没什么大的用处，开发ActiveX 控件的目的是为了资源共享，为了被其他开发人员利用，所以要提供必要的事件接口， 显然利用该方法不行，通过分析VBControls等相关对象，找出VBControlExtender对象 与EventInfo相结合能提供事件陷井捕捉，VBControlExtender对象对动态添加控件特 别有用，它提供了一套通用的属性、方法、事件给开发人员，它的一个突出特点是能编 程设计控件的事件，熟习类编程的朋友对带事件的对象声明一定不会陌生： ---- Dim WithEvents objElemt as CElemtVBControlExtender也不例外，声明的 语法一样，只不过它有个特殊的事件ObjectEvent(Info As EventInfo)，它能捕捉到对 象使用RaiseEvent产生的所有事件，EventInfo数据结构映射了事件的名称、参数个数 和参数的值。VBControlExtender和 EventInfo相结合，采用Select Case 就可以预先 将不同类对象的事件放置一起，各自独立运作。将上面的代码改写一下就能提供Click 事件了： ---- Dim WithEvents oControl As VBControlExtender '带事件声明声明之后您 就可以在代码窗口的左上角的对象下拉框中发现该对象出现了，也就是说，该对象有了 事件或方法了，它的事件有DragDrop，DragOver ，LostFocus ，GotFocus ， ObjectEvent和Validate，其中ObjectEvent是通用的事件捕捉。 Private Sub LoadControl() Set oControl = Controls.Add ("VB. CommandButton", "MyButton") oControl.Visible = True End Sub Private Sub oControl_ObjectEvent(Info As EventInfo) Select Case Info.Name Case "Click" 'Click事件 '您可以添加处理Click事件代码 MsgBox "您按了MyButton!" Case Else ' 其他事件 ' Handle unknown events here. End Select End Sub ---- 当然对微软提供的标准控件能采用该方法添加，大家都不会怀疑，但自己开 发的控件也能吗？答案是肯定的，我们可以用一个实际的例子进行说明。 三、实例描述 ---- 假设一个本地网络的监控系统，需要在原理图与实物示意图间切换，原理图 包括组网结构、传输资源、监控主机等，而实物示意图包括路由器、设备、采集器等， 当然两种图的事件要一致，如双击某个设备图形将显示给设备的实时数据等，为了简化 维护，将原理图与实物示意图封装成ActiveX控件，由于每种图需要加载许多图形控 件，消耗资源较大，不能同时加载，需要将其分解为两个控件，在切换时首先卸载一个 控件，然后加载另一个控件，所以要实现动态加载ActiveX控件。 ---- 原理图控件为--Theory.ocx ，对应工程为CTheory； ---- 实物图控件为---Fact.ocx ，对应工程为CFact； ---- 注意：为了简化，在设计控件时不设置许可证关键字。 ---- 实物图控件上的图形对象可以被拖动，拖动后的位置信息通过事件 ChangePosition来通知拥有该控件的窗体，以便下次加载能显示在最后位置，实物 图和原理图控件都有双击事件完成的工作相同，其他事件此处忽略。 ---- 四、具体示例 ---- 1、准备工作 ---- 对控件Theory.ocx 、Fact.ocx 进行注册(利用Regsvr32.exe注册)； ---- 建立窗体frmTest.frm ，在窗体上放置按钮cmdLoadOcx—“原理图” ---- 2、声明窗体级变量与加载函数LoadControl Dim WithEvents oControl As VBControlExtender '地图仿真控件对象 Dim mblnTheory As Boolean '是否显示原理图 Private Function LoadControl(intType As Integer) If Not oControl Is Nothing Then '首先判断对象是否存在，若存在则卸载 Controls.Remove("MapView") '卸载控件，此操作非常重要 End If If intType = 0 Then Set oControl = Controls.Add ("CTheory. Theory", "MapView") Else Set oControl = Controls.Add ("CFact.Fact", "MapView") End If oControl.Height = 3500 oControl.Width = 6500 oControl.Top = 100 oControl.Visible = True End Function Private Sub Form_Load() mblnTheory = True End Sub ---- 3、为按钮cmdLoadOcx编写代码 Private Sub cmdLoadOCX_Click() If mblnTheory Then Call LoadControl(0) mblnTheory = False cmdLoadOCX.Caption = "实物图" Else Call LoadControl(1) mblnTheory = True cmdLoadOCX.Caption = "原理图" End If End Sub ---- 4、为事件ChangePosition编写代码 Private Sub oControl_ObjectEvent (Info As EventInfo) Select Case Info.Name Case "ChangePosition" MsgBox CStr(Info.EventParamters.Item( 1).Value) + ":" + _ CStr(Info.EventParamters.Item(2).Value) Case "DbClick" '双击处理代码 Case Else ' End Select End Sub ---- 注意： EventInfo的参数EventParamters集合中是以1开始的，一般来说，微 软新的集合一般是以1开始的，而旧的是以0开始的，如RdoErrors.Item(0)。 ---- 5、关闭窗口前卸载控件 Private Sub Form_Unload(Cancel As Integer) Controls.Remove("MapView") Set oControl = Nothing End Sub ---- 6、特别注意 ---- 通过Controls.Add方法添加的ActiveX控件一定不能在该工程中有该控件的任 何引用，否则系统将出错。 四、小结 ---- 通过使用动态加载ActiveX控件使用庞大的应用程序变得很小，将不同的 ActiveX控件进行各种组合，使应用程序更加灵活多变，如您的应用系统要处理三十种门禁， 而某个具体的用户可能只有一种或两种门禁，根本没必要首先将所有门禁包含到应用 中，可将各个门禁独立封装，只安装注册需要的组件，就象Windows的自定义安装一样。 微软的未来技术基础是分布式的组件技术(DCOM)，将会把代码的重用发挥得淋漓尽致。 您不妨试一试动态加载，也许会产生令您惊喜的效果！ ---- 本代码在Win98、VB6.0(英文版)上编译、运行。
VB 6.0 AscW将汉字转换为Unicode字符代码.rar
本源码演示VB 6.0 如何将汉字转换为Unicode字符代码，在窗口中输入汉字，单击按钮，即可将汉字转换为Unicode字符，其实这个实现起来也比较简单，用VB内置函数AscW即可实现，代码的编写可参考如下： 　　Private Sub Command1_Click() 　　 Text2.Text = AscW(Text1) 　　End Sub 　　Private Sub Command2_Click() 　　 Unload Me 　　End Sub
vb程序屏幕飘雪！！！
'源代码 Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 'GetDC()功能是获取指定窗体的设备场景的句柄(hDC),用参数0则可以获取整个屏幕的场景句柄 Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long 'GetPixel用于取得场景(这里是整个屏幕)中某点的颜色值 Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long 'SetPixel用于设置场景(这里是整个屏幕)中某点的颜色值 Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long '释放由GetDC()获取的设备场景句柄，否则可能造成系统锁死 Private Declare Function InvalidateRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) '清理窗口雪花 Private Type POINTAPI '定义坐标点结构 x As Long y As Long End Type Private Type RECT '定义“区域”数据结构，但实际上并没有用到，因为仅需在函数InvalidateRect中传递一个空的RECT参数 left As Long top As Long right As Long bottom As Long End Type Dim rect1 As RECT Private Const ScrnWidth = 1024 '屏幕宽度(单位:像素) Private Const ScrnHight = 768 '屏幕高度(单位:像素) Private Const SnowCol = &HFEFFFE '雪花颜色 Private Const SnowColDown = &HFFFFFF '积雪颜色 Private Const SnowColDuck = &HFFDDDD '深色积雪颜色 Private Const SnowNum = 500 '同一时间飘动的雪花数量 Dim hDC1 As Long '存储桌面窗口设备句柄 Dim pData(SnowNum) As POINTAPI '存储每个雪花的位置信息 Dim pColor(SnowNum) As Long '存储画出雪花前屏幕原来的颜色 Dim Vx As Integer '雪花总体水平飘行速度 Dim Vy As Integer '雪花总体垂直下落速度 Dim PVx As Integer '单个雪花实际水平飘行速度 Dim PVy As Integer '单个雪花实际垂直飘行速度 '初始化雪花位置 Private Sub InitP(i As Integer) pData(i).x = Rnd() * ScrnWidth pData(i).y = Rnd() * 2 pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y) '取得屏幕原来的颜色值 End Sub '取得某一点与周围点的对比度，确定是否在此位置堆积雪花 Private Function GetContrast(i As Integer) As Long Dim ColorCmp As Long '存储用作对比的点的颜色值 Dim tempR As Long '存储CorlorCmp的红色部分，下同 Dim tempG As Long Dim tempB As Long Dim Slope As Integer '存储雪花飘落方向:Vx/Vy '计算雪花飘落方向 If PVy <> 0 Then Slope = PVx / PVy Else Slope = 2 End If '根据雪花飘落方向决定取哪一点作对比点， '若PVx/PVy在-1到1之间，即Slope=0，就取正下面的象素点 '若PVx/PVy>1，取右下方的点，PVx/PVy<-1则取左下方 If Slope = 0 Then ColorCmp = GetPixel(hDC1, pData(i).x, pData(i).y + 1) Else If Slope > 1 Then ColorCmp = GetPixel(hDC1, pData(i).x + 1, pData(i).y + 1) Else ColorCmp = GetPixel(hDC1, pData(i).x - 1, pData(i).y + 1) End If End If '确定当前位置没有与另一个雪花重叠，否则返回0，用于防止由于不同雪花重叠造成雪花乱堆 If ColorCmp = SnowCol Then GetContrast = 0 Exit Function End If '分别获取ColorCmp与对比点的蓝、绿、红部分的差值 tempB = Abs((ColorCmp And &HFF0000) - (pColor(i) And &HFF0000)) / &H10000 tempG = Abs((ColorCmp And &HFF00&) - (pColor(i) And &HFF00&)) / &H100& tempR = Abs((ColorCmp And &HFF&) - (pColor(i) And &HFF&)) '返回对比度值 GetContrast = (tempR + tempG + tempB) / 3 End Function '画出一帧，即重画所有雪花位置一次 Private Sub DrawP() Dim i As Integer For i = 0 To SnowNum '防止雪花重叠造成干扰 If pColor(i) <> SnowCol Then '还原上一个位置的颜色 SetPixel hDC1, pData(i).x, pData(i).y, pColor(i) End If '设置新的位置，i Mod 3用于将雪花分为三类采用不同速度，以便形成层次感 PVx = Rnd() * 2 - 1 + Vx * (i Mod 3) PVy = Vy * (i Mod 3 + 1) pData(i).x = pData(i).x + PVx pData(i).y = pData(i).y + PVy '取得新位置原始颜色值，用于下一步雪花飘过时恢复此处颜色 pColor(i) = GetPixel(hDC1, pData(i).x, pData(i).y) '如果获取颜色失败，表明雪花已飘出屏幕，重新初始化 If pColor(i) = -1 Then InitP i Else '否则若雪花没有重叠 If pColor(i) <> SnowCol Then '若对比度较小(即不能堆积),就画出雪花 'Rnd()>0.3用于防止某些连续而明显的边界截获所有雪花 If Rnd() > 0.3 Or GetContrast(i) < 50 Then SetPixel hDC1, pData(i).x, pData(i).y, SnowCol '否则表明找到明显的边界，画出堆积的雪，并初始化以便画新的雪花 Else SetPixel hDC1, pData(i).x, pData(i).y - 1, SnowColDuck SetPixel hDC1, pData(i).x - 1, pData(i).y, SnowColDuck SetPixel hDC1, pData(i).x + 1, pData(i).y, SnowColDown InitP i End If End If End If Next End Sub Private Sub Form_Load() Dim j As Integer Me.Caption = "桌面飘雪" '设置窗口标题 '设置计时器，Timer1用于画单帧，Timer2用于风向变化 Timer1.Enabled = True Timer1.Interval = 10 Timer2.Enabled = True Timer2.Interval = 2000 Randomize '初始化随机数种子 hDC1 = GetDC(0) '获取桌面窗口设备场景句柄 '初始化整个屏幕 For j = 0 To SnowNum pData(j).x = Rnd() * ScrnWidth pData(j).y = Rnd() * ScrnHight pColor(j) = GetPixel(hDC1, pData(j).x, pData(j).y) Next End Sub Private Sub Form_Unload(Cancel As Integer) ReleaseDC 0, hDC1 '释放桌面窗口设备句柄 InvalidateRect 0, rect1, 0 '清除所有雪花，恢复桌面 End Sub Private Sub Timer1_Timer() DrawP '画出一帧 End Sub Private Sub Timer2_Timer() '改变风向 Vx = Rnd() * 4 - 2 Vy = Rnd() + 2 End Sub '完，最后，需要两个Timer：Timer1、Timer2。
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章