频繁LOAD,UNLOAD FORM 会造成FORM的PICTURE显示不出来,怎么办

zhaoming 2000-02-15 09:02:00
...全文
158 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
Firing_Sky 2000-02-15
  • 打赏
  • 举报
回复
同意dongdong的意见(可惜来晚了一步^_^)
dongdong 2000-02-15
  • 打赏
  • 举报
回复
通常不建议频繁使用LOAD和UNLOAD,如果窗体不使用较多的资源,可使用SHOW 和HIDE的方法,需要时SHOW 即可,反之,用HIDE 的隐藏,这样就不会出现你的问题。同时试试将窗体的AUTOREDRAW属性改为TRUE。
forgettor 2000-02-15
  • 打赏
  • 举报
回复
除了set xxx=nothing外,能不能用窗口或picturebox的refresh或repaint方法?
DOU 2000-02-15
  • 打赏
  • 举报
回复
在程序中将不用的资源释放,在Form_unload事件中将所有Form中的用new 创建的资源释放 set xxx = nothing
要求: 本次课程设计利用《软件设计基础-VB》课程中所学到的编程知识和编程技巧,完成具有一定难度和工作量的程序设计题目,帮助学生掌握编程、调试的基本技能,独立完成所布置的任务。 要求: 1、对系统进行功能需求分析 2、设计合理的数据结构和系统框架 3、界面设计美观、清楚、合理 4、编程简练,程序功能齐全,能正确运行 5、具有一定的创新性 6、说明书、流程图要清楚 7、课题完成后必须按要求提交课程设计报告 任务: 题目描述与功能要求 题目描述:“打冰雹”游戏是指从窗口顶部落下多个圆球表示的“冰雹”,用户使用鼠标来指引箭头表示的“枪”瞄准其中一个圆球,单击鼠标射击。如果打中圆球则加分,没打中减分。若累积有5个圆球一直未被击中而落到地面(用水平黑线表示),则失败。用户玩游戏的目标是尽量短的时间内得尽量多的分数,同时避免圆球落地。 功能要求:(1)设计图1.26(课本)所示的窗口界面。程序启动时,自动进入游戏状态,10个不同颜色的圆球从窗口顶部向下运动。用户使用鼠标指向其中一个圆球,然后单击。如果击中圆球则加1分,未击中则减1分,分数显示在“得分”文本框中。“所用时间”文本框中显示当前已用的时间。被击中的圆球立即消失,新的圆球从顶部落下。 (2)要求同时显示10个圆球,每个圆球的颜色和下落速度各不相同。窗口底部的箭头一直指向鼠标指针的方向。单击鼠标射击时,显示一条从箭头发出到达鼠标指针的直线表示子弹轨迹。 (3)程序共有4个难度等级,分别是“简单”、“中等”、“较难”和“高级”。默认的难受为“中等”。不同的等级对应不同的总体下落速度。在游戏过程中,随时可以通过“选择难度”组合框来改变难度级别。 (4)游戏开始时,提供的“能量”数是5。如果有一个圆球落到地面,则减1。当能量为0时,显示如图1.27所示的消息框。然后,程序自动将难度改为“简单”让用户重新开始,这时能量恢复为5,得分从0开始。 (5)圆球落地后立即消失,新的圆球从顶部落下,窗口上始终保持有10个圆球。 游戏过程中,当得分达到25时,显示如图1.28所示的提示;当得分达到50时,显示如图1.29所示的提示;当得分达到100时,显示如图1.30所示的提示,并自动将难度设为“较难”,当得分达到150时,自动将难度设为“高级”。 3.课程设计说明书 ⑴功能描述;本题目的程序设计由三个窗体组成。 窗口一:为开始界面,主要实现游戏的开始、退出以及游戏规则介绍功能。 窗体二:为游戏界面,内设置游戏进行,可通过对combol的选择改变难易程度。 窗体三:为结束界面,主要目的,提醒玩家通关成功 (2)详细设计 总体流程图: 各功能模块流程图: 窗体一:开始界面 窗体二:游戏界面 窗体四:结束界面 ⑷代码实现 本题目的程序设计由三个窗体组成。分别由五个Timer,五个TextBox,一个ComboBox,七个Line,十个shape十个Label,一个medio player等控件组成。窗体2为主要窗口,它的设计如下: 窗体2中控件列表 序号 控件名称 控件类型 功能 1 Label 标签 对文本框与组合框进行说明 作为提示,装饰界面 2 TextBox 文本框 显示程序运行的结果即得分Text1、剩余能量Text2、所用时间Text3(0)、Text3(1)、Text3(2)的数值 3 ComboBox 组合框 显示选择难度 4 Timer 定时器 在程序运行的过程中不断地累积时间,当达到给定的时间间隔时,自动地引发名为Timer的事件。Timer1控制冰雹下落的并通过combo-click选择不同的难程度掉冰雹的速度,timer2.timer3是记录玩游戏所用时间分别控制秒和毫秒 5 Picture 图片框 通过图片加载,装饰页面picture1是游戏中界面,picture2休息界面 6 Shape 形状 显示多种不同的形状,装饰窗体,这里即圆形 7 Line 直线 在窗体上显示一条直线。 Line2到Line7是做指针用的,Line1是作为冰雹没有打中落下去让冰雹消失 8 medieplayer 播放器 当鼠标击打冰雹时,放出声音 各窗体的代码介绍 form1—开始界面 作用:“进入应用程序”。 所用控件:4个标签,1个时钟,3个command 设计思路:用时钟控制label1的运动。单击command开始按钮可进入后面窗体,退出按钮可关闭窗体,帮助按钮查看游戏规则。 核心代码如下: 窗体1—开始界面 Private Sub Command1_Click() Form2.Show Unload Form1 Timer1.Enabled = True’开始按钮,控制游戏的开始 End S
VB电子相册 电子相册 1、数据库连接 Public conn As ADODB.Connection Public Sub conDB() Set conn = New ADODB.Connection conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & App.Path & "\data\pic.mdb" conn.Open End Sub 2、登录模块 Dim loginTimes As Integer Private rsmc As ADODB.Recordset Private rs As ADODB.Recordset Public userName As String Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdOK_Click() Call login End Sub Private Sub Form_Activate() Call conDB Set rsmc = New ADODB.Recordset rsmc.CursorLocation = adUseClient rsmc.Open "用户信息表", conn, 0, 1 'need to learn cbUserName.Clear While Not rsmc.EOF cbUserName.AddItem rsmc.Fields("用户名") rsmc.MoveNext Wend cbUserName.SetFocus tbPwd.Text = "" cbUserName.Refresh End Sub Private Sub Form_Unload(Cancel As Integer) conn.Close Set rs = Nothing End Sub Sub login() Dim strSql As String userName = "" If Trim(cbUserName.Text) = "" Then MsgBox "用户名不用为空,请选择用户名!", vbOKOnly + vbExclamation, "警告" cbUserName.SetFocus Else strSql = "select * from 用户信息表 where 用户名='" & Trim(cbUserName.Text) & "'" Set rs = New ADODB.Recordset rs.Open strSql, conn, 2, 2 If Trim(rs.Fields("密码")) = Trim(tbPwd.Text) Then rs.Close Me.Hide userName = Trim(cbUserName.Text) 'Load frmMain frmMain.Show Exit Sub Else MsgBox "密码不对,请重新输入!", vbOKOnly + vbExclamation, "警告" tbPwd.Text = "" tbPwd.SetFocus End If loginTimes = loginTimes + 1 If loginTimes = 3 Then MsgBox "密码错误已有3次,你不能进入系统!", vbOKOnly + vbQuestion, "提示" Unload Me End If End If End Sub 3、主模块 Private rs As ADODB.Recordset Dim stuNum As Integer Private Sub Form_Activate() Call conDB End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) conn.Close Set conn = Nothing End Sub Private Sub mnuAddPic_Click() frmAddPic.Show End Sub Private Sub mnuDeletePic_Click() frmDeletePic.Show End Sub Private Sub mnuShowpic_Click() frmShow.Show End Sub Private Sub mnuExit_Click() Unload Me End End Sub Private Sub mnuSMPic_Click() frmSMPic.Show End Sub Private Sub mnuUser_Click() Dim frm1 As New frmUser frm1.Show End Sub 4、显示图片模块 Dim str As String Dim rs As ADODB.Recordset Dim rsNum As Integer Dim nextNum As Integer Private Sub cbPic_Click() str = App.Path + "\" Set rs = New ADODB.Recordset Dim strConn As String strConn = "select * from pic where name='" + Trim(cbPic.Text) + "'" rs.Open strConn, conn, 0, 1 str = str + rs.Fields("address").Value 'MsgBox str Image1.Picture = LoadPicture(str) rs.Close End Sub Private Sub CmdNext_Click() nextNum = nextNum + 1 'MsgBox nextNum If nextNum > rsNum - 1 Then nextNum = 0 'MsgBox nextNum End If Dim temp As Integer temp = nextNum Set rs = New ADODB.Recordset rs.Open "pic", conn, 0, 1 ' rs.MoveFirst ' While Not rs.EOF And temp > 0 ' 'rs.MoveNext ' 'temp = temp - 1' ' Wend rs.Move (temp) str = App.Path + "\" str = str + rs.Fields("address").Value cbPic.Text = rs.Fields("name").Value Image1.Picture = LoadPicture(str) rs.Close End Sub Private Sub Form_Load() Call conDB str = App.Path + "\" nextNum = 0 Set rs = New ADODB.Recordset rs.Open "pic", conn, 0, 1 str = str + rs.Fields("address").Value Image1.Picture = LoadPicture(str) cbPic.Clear rsNum = 0 'MsgBox rsNum rs.MoveFirst While Not rs.EOF cbPic.AddItem rs.Fields("name") rsNum = rsNum + 1 rs.MoveNext Wend cbPic.Text = "tu1" rs.Close End Sub
由于使用了一些新的函数,本程序必须在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

7,759

社区成员

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

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