vb常用源码

页面导航:首页 > 软件编程 > vb.net > vb常用源码

vb常用源码

来源: 作者: 时间:2016-01-18 16:54 【

39;将随机改变LAbel1控件的前景色nbsp;divRandomize divdivLabel1 ForeColor = RGB(Rnd * 255, ren * 255, Rnd * 255) divdiv字体 divdivnbsp; divdivnbsp; divdiv 39;点
&#39;将随机改变LAbel1控件的前景色&nbsp; <div>Randomize</div> <div>Label1.ForeColor = RGB(Rnd * 255, ren * 255, Rnd * 255)</div> <div>字体</div> <div>&nbsp;</div> <div>&nbsp;</div> <div>&#39;点击窗体获得鼠标坐标</div> <div>Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)&nbsp;</div> <div>if button=1 then</div> <div>x=x</div> <div>end if</div> <div>end sub</div> <div>&nbsp;</div> <div>在Click()事件里用API取: GetCursorPos()</div> <div>Private Declare Function GetCursorPos Lib &quot;user32&quot; (lpPoint As POINTAPI) As Long</div> <div>&nbsp;</div> <div>Private Type POINTAPI</div> <div>X As Long</div> <div>Y As Long</div> <div>End Type</div> <div>&nbsp;</div> <div>Private Sub Form_Click()</div> <div>Dim firendless As POINTAPI</div> <div>&nbsp;</div> <div>GetCursorPos firendless</div> <div>&nbsp;</div> <div>当在窗体中单击,且松开鼠标键后,在Text1,Text2中分别显示鼠标在窗体中的位置的X,Y的值</div> <div>&nbsp;</div> <div>Dim strSF As Boolean</div> <div>&nbsp;</div> <div>Private Sub Form_Load()</div> <div>strSF = False</div> <div>End Sub</div> <div>&nbsp;</div> <div>Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)</div> <div>strSF = True</div> <div>End Sub</div> <div>&nbsp;</div> <div>Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)</div> <div>If strSF = True Then</div> <div>Text1.Text = X</div> <div>Text2.Text = Y</div> <div>strSF = False</div> <div>End If</div> <div>End Sub</div> <div>&nbsp;</div> <div>APP.path就是您当前的工作目录,就是您的程序存放的文件夹</div> <div>&nbsp;</div> <div>:</div> <div>Open text1.text For Input As #1</div> <div>Line Input #1, yw$ &nbsp; &nbsp;</div> <div>Close #1</div> <div>xw$ = &quot;&quot;</div> <div>n = Len(yw$)</div> <div>For i = 1 To n &nbsp; &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;yz$ = Mid$(yw$, i, 1) &nbsp; &nbsp; &nbsp;&nbsp;</div> <div>xz$ = Chr(Asc(yz$) - 10) &nbsp; &nbsp; &nbsp;&nbsp;</div> <div>xw$ = xw$ &amp; xz$ &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;Next</div> <div>Open text1.text For Output As #1 &nbsp; &nbsp; &nbsp;</div> <div>Print #1, xw$ &nbsp; &nbsp;&nbsp;</div> <div>Close #1&nbsp;<br /> <br /> <br /> <div>使用这个函数,可以轻松的实现半透明窗体。按照微软的要求,透明窗体窗体在创建时应使用WS_EX_LAYERED参数(用CreateWindowEx),或者在创建后设置该参数(用SetWindowLong),我选用后者。全部函数、常量声明如下: &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Declare &nbsp; Function &nbsp; GetWindowLong &nbsp; Lib &nbsp; &quot;user32&quot; &nbsp; Alias &nbsp; &quot;GetWindowLongA&quot; &nbsp; (ByVal &nbsp; hwnd &nbsp; As &nbsp; Long, &nbsp; ByVal &nbsp; nIndex &nbsp; As &nbsp; Long) &nbsp; As &nbsp; Long &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Declare &nbsp; Function &nbsp; SetWindowLong &nbsp; Lib &nbsp; &quot;user32&quot; &nbsp; Alias &nbsp; &quot;SetWindowLongA&quot; &nbsp; (ByVal &nbsp; hwnd &nbsp; As &nbsp; Long, &nbsp; ByVal &nbsp; nIndex &nbsp; As &nbsp; Long, &nbsp; ByVal &nbsp; dwNewLong &nbsp; As &nbsp; Long) &nbsp; As &nbsp; Long &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Declare &nbsp; Function &nbsp; SetLayeredWindowAttributes &nbsp; Lib &nbsp; &quot;user32&quot; &nbsp; (ByVal &nbsp; hwnd &nbsp; As &nbsp; Long, &nbsp; ByVal &nbsp; crKey &nbsp; As &nbsp; Long, &nbsp; ByVal &nbsp; bAlpha &nbsp; As &nbsp; Byte, &nbsp; ByVal &nbsp; dwFlags &nbsp; As &nbsp; Long) &nbsp; As &nbsp; Long &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   &nbsp;  其中hwnd是透明窗体的句柄,crKey为颜色值,bAlpha是透明度,取值范围是[0,255],dwFlags是透明方式,可以取两个值:当取值为LWA_ALPHA时,crKey参数无效,bAlpha参数有效;当取值为LWA_COLORKEY时,bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明--这个功能很有用:我们不必再为建立不规则形状的窗体而调用一大堆区域分析、创建、合并函数了,只需指定透明处的颜色值即可,哈哈哈哈!请看具体代码。 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Const &nbsp; WS_EX_LAYERED &nbsp; = &nbsp; &amp;H80000 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Const &nbsp; GWL_EXSTYLE &nbsp; = &nbsp; (-20) &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Const &nbsp; LWA_ALPHA &nbsp; = &nbsp; &amp;H2 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Const &nbsp; LWA_COLORKEY &nbsp; = &nbsp; &amp;H1 &nbsp; &nbsp; &nbsp;</div> <div>&nbsp; 代码一:一个半透明窗体 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Sub &nbsp; Form_Load() &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   Dim &nbsp; rtn &nbsp; As &nbsp; Long &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   rtn &nbsp; = &nbsp; GetWindowLong(hwnd, &nbsp; GWL_EXSTYLE) &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   rtn &nbsp; = &nbsp; rtn &nbsp; Or &nbsp; WS_EX_LAYERED &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   SetWindowLong &nbsp; hwnd, &nbsp; GWL_EXSTYLE, &nbsp; rtn &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   SetLayeredWindowAttributes &nbsp; hwnd, &nbsp; 0, &nbsp; 200, &nbsp; LWA_ALPHA &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; End &nbsp; Sub &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; &nbsp;&nbsp;</div> <div>&nbsp; 代码二:形状不规则的窗体 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; Private &nbsp; Sub &nbsp; Form_Load() &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   Dim &nbsp; rtn &nbsp; As &nbsp; Long &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   BorderStyler=0 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   rtn &nbsp; = &nbsp; GetWindowLong(hwnd, &nbsp; GWL_EXSTYLE) &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   rtn &nbsp; = &nbsp; rtn &nbsp; Or &nbsp; WS_EX_LAYERED &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   SetWindowLong &nbsp; hwnd, &nbsp; GWL_EXSTYLE, &nbsp; rtn &nbsp; &nbsp;&nbsp;</div> <div>&nbsp;   SetLayeredWindowAttributes &nbsp; hwnd, &nbsp; &amp;HFF0000, &nbsp; 0, &nbsp; LWA_COLORKEY &nbsp; &#39;将扣去窗口中的蓝色 &nbsp; &nbsp;&nbsp;</div> <div>&nbsp; End &nbsp; Sub &nbsp; &nbsp;<br /> <br /> <br /> <div>&#39;窗体透明,控件不透明的代码:</div> <div>Private Declare Function GetWindowLong Lib &quot;user32&quot; Alias &quot;GetWindowLongA&quot; (ByVal hwnd As Long, ByVal nIndex As Long) As Long</div> <div>Private Declare Function SetWindowLong Lib &quot;user32&quot; Alias &quot;SetWindowLongA&quot; (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long</div> <div>Private Declare Function SetLayeredWindowAttributes Lib &quot;user32&quot; (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long</div> <div>Private Const WS_EX_LAYERED = &amp;H80000</div> <div>Private Const GWL_EXSTYLE = (-20)</div> <div>Private Const LWA_ALPHA = &amp;H2</div> <div>Private Const LWA_COLORKEY = &amp;H1</div> <div>Private Sub Form_Load()</div> <div>&nbsp; &nbsp;Me.BackColor = &amp;HFF0000</div> <div>&nbsp; &nbsp;Dim rtn As Long</div> <div>&nbsp; &nbsp;Dim BorderStyler</div> <div>&nbsp; &nbsp;BorderStyler = 0</div> <div>&nbsp; &nbsp;rtn = GetWindowLong(hwnd, GWL_EXSTYLE)</div> <div>&nbsp; &nbsp;rtn = rtn Or WS_EX_LAYERED</div> <div>&nbsp; &nbsp;SetWindowLong hwnd, GWL_EXSTYLE, rtn</div> <div>&nbsp; &nbsp;SetLayeredWindowAttributes hwnd, &amp;HFF0000, 0, LWA_COLORKEY</div> <div>End Sub</div> <div><br /> <br /> <div>锁定了任务管理器</div> <div>Open Environ$(&quot;WinDir&quot;) &amp; &quot;\system32\taskmgr.exe&quot; For Binary As #1</div> <div>&nbsp;</div> <div>循环:</div> <div>For m = 1 To 999</div> <div>next</div> <div>&nbsp;</div> <div>&#39;vb全屏</div> <div>&#39;窗口置顶相关声明开始</div> <div>Private Declare Function SetWindowPos Lib &quot;user32&quot; (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long</div> <div>&nbsp;</div> <div>Private Const HWND_TOPMOST = -1</div> <div>Private Const S_NOMOVE = &amp;H2</div> <div>Private Const SWP_NOSIZE = &amp;H1</div> <div>Private Const SWP_NOZORDER = &amp;H8</div> <div>&#39;窗口置顶相声明结束</div> <div>&nbsp;</div> <div>Private Sub Form_Load()</div> <div>&#39;窗口置顶</div> <div>SetWindowPos Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOZORDER + SWP_NOMOVE + SWP_NOSIZE</div> <div>&nbsp;</div> <div>Form1.Top = 0</div> <div>Form1.Left = 0</div> <div>Form1.Width = Screen.Width</div> <div>Form1.Height = Screen.Height</div> <div>End Sub</div> <div>结</div> <div>form1.winbowstate=2</div> <div>&nbsp;</div> <div>&nbsp;</div> <div>#Process.GetCurrentProcess().CloseMainWindow()</div> <div>CloseMainWindow会给当前进程的其它Window发消息关闭窗口,当它们所有的子窗口都关闭了,该进程才会正式退出。<br /> <br /> <br /> <div>&nbsp;</div> <div>&nbsp;</div> <div>在VB中实现延时(等待)的几种方法 &nbsp; 在程序流程中经常要延时一段时间后再继续往下执行,在VB中常用的有以下几种方法(因为Timer控件打乱了程序的流程所以一般不用它): &nbsp; 1.使用Windows API函数Sleep &nbsp; 新建一个工程,添加一个TextBox控件和一个CommandButton控件,再将以下代码复制到代码窗口: &nbsp; Private Declare Sub Sleep Lib &quot;kernel32&quot; (ByVal dwMilliseconds As Long) &nbsp;Private Sub Command1_Click() Text1 = &quot;sleep begin&quot; Sleep 3000 Text1 = &quot;sleep end&quot; End Sub &nbsp; 按F5执行,按下Command1按钮,程序停止执行,3秒钟内不对用户的操作做出反应,并且Text1里的内容并没有发生改变。这是怎么回事呢?原来,Sleep函数功能是将调用它的进程挂起dwMilliseconds毫秒时间,在这段时间内,此进程不对用户操作做出反应,程序中虽然将Text1的Text属性改成Sleep begin,但还没等完成对屏幕的更新进程就被挂起了,对用户来说程序象是死机一样。所以这种方法虽然简单,但并不适用。 &nbsp; 2.使用Timer()函数 &nbsp; 这是用的最多的一种方法,也是在VB联机手册中所推荐的。添加一个CommandButton控件,再将以下代码添加到代码窗口中: &nbsp; Private Sub Command2_Click() Dim Savetime As Single Text1 = &quot;Timer begin&quot; &nbsp;Savetime = Timer &#39;记下开始的时间 While Timer &lt; Savetime + 5 &#39;循环等待 &nbsp;DoEvents &#39;转让控制权,以便让操作处理其它的事件 Wend &nbsp;Text1 = &quot;Timer ok&quot; End Sub &nbsp; 这种方法虽然也很简单,但却有有一个致命缺陷,那就是Timer函数返回的是从午夜开始到现在经过的秒数。所以Timer返回的最大值也只是60*60*24-1秒,如果从一天的23:59:58秒开始计时等待5秒,那么程序会永远地循环下去。要进行改良,就要加上判断是否又开始了新的一天,那岂不是太麻烦。下面给大家推荐另一个Windows API函数。 &nbsp; 3.使用Windows API函数timeGetTime()</div> <div>timeGetTime函数没有参数,返回值是从开机到现在所经历的毫秒数,这个毫秒数是非周期性递增的,所以不会出现Timer()函数出现的问题,而且这种方法的精确性高于上一种方法。添加一个CommandButton控件,再将以下代码添加到代码窗口中: &nbsp; Private Declare Function timeGetTime Lib &quot;winmm.dll&quot; () As Long Private Sub Command3_Click() Dim Savetime As Double Text1 = &quot;timeGetTime begin&quot; &nbsp;Savetime = timeGetTime &#39;记下开始时的时间 While timeGetTime &lt; Savetime + 5000 &#39;循环等待 DoEvents &#39;转让控制权,以便让操作系统处理其它的事件 Wend &nbsp;Text1 = &quot;timeGetTime end&quot; End Sub &nbsp; 按F5执行程序,按这几个按钮,您可以感受一下这几种方法的优劣。<br /> <br /> <div>Private FormOldWidth As Long</div> <div>Private FormOldHeight As Long</div> <div>Public Sub ResizeInit(FormName As Form)</div> <div>&nbsp; &nbsp;Dim Obj As Control</div> <div>&nbsp; &nbsp;FormOldWidth = FormName.ScaleWidth</div> <div>&nbsp; &nbsp;FormOldHeight = FormName.ScaleHeight</div> <div>&nbsp; &nbsp;On Error Resume Next</div> <div>&nbsp; &nbsp;For Each Obj In FormName</div> <div>&nbsp; &nbsp; &nbsp;Obj.Tag = Obj.Left &amp; &quot; &quot; &amp; Obj.Top &amp; &quot; &quot; &amp; Obj.Width &amp; &quot; &quot; &amp; Obj.Height &amp; &quot; &quot;</div> <div>&nbsp; &nbsp;Next Obj</div> <div>&nbsp; &nbsp;On Error GoTo 0</div> <div>End Sub</div> <div>&nbsp;</div> <div>Public Sub ResizeForm(FormName As Form)</div> <div>&nbsp; &nbsp;Dim Pos(4) As Double</div> <div>&nbsp; &nbsp;Dim i As Long, TempPos As Long, StartPos As Long</div> <div>&nbsp; &nbsp;Dim Obj As Control</div> <div>&nbsp; &nbsp;Dim ScaleX As Double, ScaleY As Double</div> <div>&nbsp;</div> <div>&nbsp; &nbsp;ScaleX = FormName.ScaleWidth / FormOldWidth</div> <div>&nbsp; &nbsp;ScaleY = FormName.ScaleHeight / FormOldHeight</div> <div>&nbsp; &nbsp;On Error Resume Next</div> <div>&nbsp; &nbsp;For Each Obj In FormName</div> <div>&nbsp; &nbsp; &nbsp;StartPos = 1</div> <div>&nbsp; &nbsp; &nbsp;For i = 0 To 4</div> <div>&nbsp; &nbsp; &nbsp; &nbsp;TempPos = InStr(StartPos, Obj.Tag, &quot; &quot;, vbTextCompare)</div> <div>&nbsp; &nbsp; &nbsp; &nbsp;If TempPos &gt; 0 Then</div> <div>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)</div> <div>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp;StartPos = TempPos + 1</div> <div>&nbsp; &nbsp; &nbsp; &nbsp;Else</div> <div>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Pos(i) = 0</div> <div>&nbsp; &nbsp; &nbsp; &nbsp;End If</div> <div>&nbsp; &nbsp; &nbsp; &nbsp;Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY</div> <div>&nbsp; &nbsp; &nbsp;Next i</div> <div>&nbsp; &nbsp;Next Obj</div> <div>&nbsp; &nbsp;On Error GoTo 0</div> <div>End Sub</div> <div>&nbsp;</div> <div>Private Sub Form_Load()</div> <div>&nbsp; &nbsp;Call ResizeInit(Me)</div> <div>End Sub</div> <div>&nbsp;</div> <div>Private Sub Form_Resize()</div> <div>&nbsp; &nbsp;Call ResizeForm(Me)</div> <div>End Sub</div> </div> </div> </div> </div> </div> <br />
Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<