开发工具:
文件大小: 126kb
下载次数: 0
上传时间: 2010-05-16
详细说明: 美化皮肤和界面 '=======================窗体的三种状态======================== windowstate = 0 '默认窗体 WindowState = 1 '最小化 WindowState = 2 '最大化 '========================记录窗体信息========================= '定义全体变量 Dim MaxWindow As Boolean, myHeight As Integer, myWidth As Integer '记录相关信息 If MaxWindow = False Then myHeight = Form1.Height myWidth = Form1.Width WindowState = 2 MaxWindow = True Else WindowState = 0 Form1.Height = myHeight Form1.Width = myWidth MaxWindow = False End If '=======================按钮的三种状态========================= '按 下object控件时 Private Sub object_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Image1.Picture = LoadPicture(App.Path & "\Down.jpg") End Sub '移动object控件时 Private Sub object_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Image1.Picture = LoadPicture(App.Path & "\Move.jpg") End Sub '弹起object控件时 Private Sub object_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Image1.Picture = LoadPicture(App.Path & "\Normal.jpg") End Sub '=========================窗口的移动=========================== 'API函数定义 Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hwnd As Long, ByVal _ wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long '函数值定义 Private Const WM_SYSCOMMAND = &H112 Private Const SC_MOVE = &HF010& Private Const WM_NCLBUTTONDOWN = &HA1 Private Const HTCAPTION = 2 '当按下object控件时,开始移动窗口 Private Sub object_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& End Sub '================================半透明窗体========================= 'API函数定义 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long '函数值定义 Private Const WS_EX_LAYERED = &H80000 Private Const GWL_EXSTYLE = (-20) Private Const LWA_ALPHA = &H2 Private Const LWA_COLORKEY = &H1 '!XXXXXXXXXXXX!这里填写1~255,值数越大,透明度越低,255为不透明 Private Sub Form_Load() Dim rtn As Long rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, !XXXXXXXXXXXX!, LWA_ALPHA End Sub '=============================窗口的放置============================== 'API函数定义 Private Declare Function SetWindowPos& Lib "user32" (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) ' 窗口置前 Dim myval myval = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 3) '窗口正常 Dim myval myval = SetWindowPos(Form1.hwnd, -2, 0, 0, 0, 0, 3) '窗口置后 Dim myval myval = SetWindowPos(Form1.hwnd, 1, 0, 0, 0, 0, 3) ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台,提供交流渠道,下载内容来自于网络,除下载问题外,其它问题请自行百度。
- 本站已设置防盗链,请勿用迅雷、QQ旋风等多线程下载软件下载资源,下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载,请稍后再次尝试;或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎,请到消费记录里找到下载记录反馈给我们,经确认后退回积分.
- 如下载前有疑问,可以通过点击"提供者"的名字,查看对方的联系方式,联系对方咨询.