VB窗体美化
- 格式:doc
- 大小:68.50 KB
- 文档页数:4
【VB】利用VB做美化界面如果大家用过《Windows优化大师》,肯定会被它的界面所倾倒,其实利用ActiveSkin 就可以办到,甚至更好,但是如果要做的共享软件只是一个文件,在加上几个OCX累赘,似乎很是不好,看看VB是怎么利用别的东西来实现的吧。
首先新建一个EXE工程,再在窗体上拖几个Label控件,看看Label 的强大功能吧,原理就是利用Label来模拟一个按钮,但是首先要将Label控件的属性要调一下,Name: LblBtn,BorderStyle: 1,Appearance: 0,Alignment: 2,这样一个按钮的雏形就已经出来了,如果工程量很大,可以将多个Label控件的Name 属性设为一样的,对于按钮的识别就要靠识别Index属性了,为了方便起见,在进入到代码编辑窗口,输入以下代码:Private Const LBL_BACK_COLOR = &HE0E0E0 ’正常时Label控件的背景色Private Const LBL_WHEN_MOUSE_MOVE = &HC0C0C0 ’鼠标移动时Label的背景色Private Const LBL_WHEN_MOUSE_DOWN = &H808080 ’鼠标按下时Label的背景色再在Form的Load事件中输入以下内容Private Sub Form_Load()Dim Count As IntegerFor Count = 0 To 3 ’请将此出的3换成你的LblBtn数量的个数-1LblBtn(Count).BackColor=LBL_BACK_COLOR ’初始化LblBtn的背景Next CountEnd Sub然后再在LblBtn的MouseMove和MouseDown事件中来搞定剩余部分:Private Sub LblBtn_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)’当鼠标按在LblBtn上时LblBtn(Index).BackColor = LBL_WHEN_MOUSE_DOWN ’临时改变LblBtn背景颜色End SubPrivate Sub LblBtn_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)’鼠标在LblBtn上面移动时触发该事件Dim Count As IntegerDoEvents ’暂时将系统控制权教给系统If Button Then Exit Sub ’如果按钮被按下就退出该过程For Count = 0 To 3If Count <> Index Then ’如果按下的不是其它按钮LblBtn(Index).BackColor = LBL_BACK_COLOR ’将背景设为正常ElseLblBtn(Index).BackColor = LBL_WHEN_MOUSE_MOVE ’将背景设为鼠标移动的背景End IfNext CountEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single,Y As Single)Dim Count As IntegerDoEventsFor Count=0 To 3LblBtn(Count).BackColor=LBL_BACKCOLOR ’恢复背景Next CountEnd本来利用Windows的消息系统来完成这一“艰巨”的任务最简单,可问题就来了,Label 控件没有窗口句柄怎么办?可是此问题与题无关,写了会有骗稿费之:)OK,Label控件就讲到这里,在来说说TextBox控件,各位看关恐怕看惯了白颜色的背景,那么就换换颜色以养养俺们那和绵羊一样的眼睛(为什么说绵羊?俺也不知道),可是VB提供的RGB函数弄出来的颜色不是怎么好看,这里俺来教大家一个小Tip,RGB函数的Red,Green,Blue这三个参数若一样,则产生的颜色是灰度,当然越接近白颜色越好,但也不能让各位看不出来,俺建议TextBox的背景为RGB(235,235,235),各位还是实战一下,将一个TextBox拖到窗体上,属性设置如下Appearance 0BorderStyle 1MutilLine True千万不要设置ScrollBars属性,否则会影响效果在Form的Load事件中初始化TextBoxDim bkColor As LongPrivate Sub Form_Load()bkColor=RGB(235,235,235)Text1.BackColor=bkColorEnd Sub在Form和Text1的MouseMove事件中:Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single,Y As Single)Text1.BorderStyle = 0End SubPrivate Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single,Y As Single)DoEventsText1.BorderStyle = 1End Sub在按下F5试试是不是很Cool?可能各位看关玩过石器时代,一定会对里面的TextBox的效果感到很爽,VB还不是可以做到,有焦点的控件可以使用SetFocus方法来为其设置焦点,可是一个窗体上如果控件太多了,一个一个的用SetFocus是不是太傻了?这一节的主角就是--------API函数,首先声明:Private Type POINTAPIx As Longy As LongEnd TypePrivate Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As LongPrivate Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPrivate Declare Function SetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long但是这里的SetFocus会和控件的SetFocus会搞混淆,改改吧,Private Declare Function nSetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long只要Alias指向的接口是对的前面的函数名称简直就是摆设,在建立一个过程:Public Function sSetFocus() As LongDim CPos As POINTAPI,Successfull As Boolean,hWnd As LongDoEventsSuccessfull =GetCursorPos(CPos)If Not Successfull Then Exit Sub ’如果未成功则退出该过程hWnd=WindowFromPoint(CPos.x,CPos.y)sSetFocus=nSetFocus(hWnd)End Sub在窗体上放一个Timer控件,Interval 属性设为100,就是0.1秒,在Timer1控件的Timer事件中填入sSetFocus,在运行一下看看,效果怎么样?可是有的先生小姐要问了,TextBox难道就不能用ScrollBar吗?非也非也,选工程->部件->Microsoft Windows Common Controls-2 6.0 (SP3)就是你的答案,至于卷动TextBox就去研究SendMessage函数吧,否则又有骗稿费之嫌,如果想作绿色软件,不想用控件,可以用俺前面讲到的Label控件,利用字体 Webdings 来模拟ScrollBar,需要注意的是,如果模拟ScrollBar,上下左右箭头分别是5,6,3,4,别忘了把字体设为Webdings再来讲讲窗体的美化,其实将BorderStyle属性设为0就是很好的2D美化;)可是,这样一来,问题又来了,怎么办?凡事都要请API来帮忙,这里需要两个API,一下是该API的声明:Public Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" ()As Long 注释:这个API是用来解下鼠标的追踪器,关于他的过多用法以及详细介绍可以写信向俺咨询,还有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 ’表示非工作区左键按下原理很简单,卸下鼠标追踪器后向Form发送一个移动窗体的消息,其实做到这一点的方法很多,但俺个人认为这一种最简单,添加一个过程:Public Sub MoveForm(hWnd As Long)DoEventsReleaseCaptureSendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&End Sub在Form的MouseMove事件中:Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single,Y As Single)If Button=vbLeftButton Then MoveForm hWnd’如果按下鼠标左键就移动窗体End Sub台下的这位小姐又纳闷了,可是光秃秃的窗体没有了标题栏也不好看,俺要向这为小姐推荐俺的东东-ActiveX控件,ToolSign,需要的人可以写信给俺联系,该控件需要在代码编辑区域内添加一下代码:’一下声明是用在ToolSign的 AutoQuit属性的Public Const EXIT_FORCE = 2 ’注意,在VB中运行的时候如果选用此退出方式,VB也会退出Public Const EXIT_MESSAGE = 1 ’由操作系统发送关闭消息Public Const EXIT_CUSTOM = Not (EXIT_FORCE Or EXIT_MESSAGE)’自定义将其注册后在部件栏中把e-Dogkid Studio Tools Sign打钩,添加到工具箱中,双击加入到窗体中,在Form的Load事件中添加一下初始化代码:Private Sub Form_Load()With Sign1.AutoQuit = EXIT_CUSTOM.ParentsHWND = hWnd ’填了此属性可以直接用ToolSign来移动窗体而不需要前面的代码End WithEnd SubSign1的Click事件Private Sub Sign1_Click()End ’关闭程序End Sub在Form的Resize事件中添加一下代码:Private Sub Form_Resize()Sign1.Width = WidthEnd Sub如果想让窗体可以改变大小,可以修改一下属性Caption ""BorderStyle 2或5ControlBox False不知道各位看关见过爆炸试的窗体没有?,没有见过可以从俺要另外一个俺自己的ActiveX DLL,我的那个东东其实是给我的Software作运行库的,各位若不嫌弃,可以用用,注册后在工程->引用->e-Dogkid Runtime Library然后在窗体Load事件中输入:Private Sub Form_Load()Dim System As e_Dogkid_Runtime_Library.SystemSet System = New e_Dogkid_Runtime_Library.SystemShowSystem.BoomIt hDC, 60, Width, Height, Left, TopSet System = NothingEnd Sub。
vb 窗体特效2010年09月22日星期三 15:36关于用V B 制作不规则窗口的文章,在各种杂志报纸、网站上面也不知提过多少回了,我都有点不好意思再谈。
但是我们编程序不仅仅要实现功能,更要寻求最佳的实现方案。
本着这样的原则,让我们再来回顾一下这个老命题,也向大家介绍一下我的心得。
Windows 提供了一个API 函数SetWindowRgn,凭着这个函数,我们可以把窗口设置为任意形状。
问题在于,我们如何来获取所需的区域形状。
一般情况下,我们可以使用CreateEllipticRgn创建椭圆区域,CreateRectRgn创建矩形区域,CreateRoundRectRgn创建圆角矩形区域。
如果我们需要不规则的形状呢?那就可以使用CreatePolygonRgn。
可是这个函数需要的参数之一是包含整个不规则区域轮廓坐标点的数组,对于一个稍微复杂一点的形状就可能需要几百个坐标点,要获取和改动这些坐标点都是相当麻烦的。
有没有更为方便的方法呢?答案是肯定的。
(不然我在这儿瞎折腾什么?)原理是用一张图片作为窗体的背景,图片中有一种颜色是我们不需要的,称为透明色。
然后编程一行行地扫描图片,将透明色的点删去,而把有用的像素点合并成一块区域,如此便得到所需的形状了。
这个思路并不是我想出来的,《电脑爱好者》1999 年第21 期P56 上就有一篇用Delphi 实现的文章。
也许有许多VB 爱好者同我一样,希望能在VB 中实现这样的功能,却发现行扫描的速度奇慢,我最初实现的程序起码用了5 分钟才显示出窗体。
究其原因是我们选错了兵刃。
一开始我使用GetPixel 来获取每一点的颜色,这样每取一个点都需要通过设备上下文hdc 从图片中读取信息,这就是造成龟速的罪魁祸首了。
正确的方法是使用GetBitmapBits函数。
它可以将位图中每一点颜色信息一下子读到一个数组中,以后只要扫描这个数组就行了,这将极大地提高运行速度。
2010-11-02 22:45【转】vb界面美化vb界面如何美化一、网上搜索VB皮肤控件,一般为了更加美化都是做异性窗体,用图片做背景,然后去掉窗体边框,设置窗体颜色为透明,这个在这里就不详细说,还要加上拖动无边框窗体的代码,这样就可以了,至于其他按钮也可以用图片代替下面这个图片是我做的仿酷狗播放器,全是由图片构成的二、利用VB做美化界面如果大家用过《Windows优化大师》,肯定会被它的界面所倾倒,其实利用ActiveSkin 就可以办到,甚至更好,但是如果要做的共享软件只是一个文件,在加上几个OCX累赘,似乎很是不好,看看VB是怎么利用别的东西来实现的吧。
首先新建一个EXE工程,再在窗体上拖几个Label控件,看看Label 的强大功能吧,原理就是利用Label来模拟一个按钮,但是首先要将Label控件的属性要调一下,Name: LblBtn,BorderStyle: 1,Appearance: 0,Alignment: 2,这样一个按钮的雏形就已经出来了,如果工程量很大,可以将多个Label 控件的Name属性设为一样的,对于按钮的识别就要靠识别Index属性了,为了方便起见,在进入到代码编辑窗口,输入以下代码:Private Const LBL_BACK_COLOR =&HE0E0E0 ’正常时Label控件的背景色Private Const LBL_WHEN_MOUSE_MOVE =&HC0C0C0 ’鼠标移动时Label的背景色Private Const LBL_WHEN_MOUSE_DOWN =&H808080 ’鼠标按下时Label的背景色再在Form的Load事件中输入以下内容Private Sub Form_Load()Dim Count As IntegerFor Count =0 To 3 ’请将此出的3换成你的LblBtn数量的个数-1 LblBtn(Count).BackColor=LBL_BACK_COLOR ’初始化LblBtn的背景Next CountEnd Sub然后再在LblBtn的MouseMove和MouseDown事件中来搞定剩余部分:Private Sub LblBtn_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)’当鼠标按在LblBtn上时LblBtn(Index).BackColor =LBL_WHEN_MOUSE_DOWN ’临时改变LblBtn背景颜色End SubPrivate Sub LblBtn_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)’鼠标在LblBtn上面移动时触发该事件Dim Count As IntegerDoEvents ’暂时将系统控制权教给系统If Button Then Exit Sub ’如果按钮被按下就退出该过程For Count = 0 To 3If Count <> Index Then ’如果按下的不是其它按钮LblBtn(Index).BackColor =LBL_BACK_COLOR ’将背景设为正常ElseLblBtn(Index).BackColor =LBL_WHEN_MOUSE_MOVE ’将背景设为鼠标移动的背景End IfNext CountEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim Count As IntegerDoEventsFor Count=0 To 3LblBtn(Count).BackColor=LBL_BACKCOLOR ’恢复背景Next CountEnd本来利用Windows的消息系统来完成这一“艰巨”的任务最简单,可问题就来了,Label控件没有窗口句柄怎么办?可是此问题与题无关,写了会有骗稿费之:)OK,Label控件就讲到这里,在来说说TextBox控件,各位看关恐怕看惯了白颜色的背景,那么就换换颜色以养养俺们那和绵羊一样的眼睛(为什么说绵羊?俺也不知道),可是VB提供的RGB函数弄出来的颜色不是怎么好看,这里俺来教大家一个小Tip,RGB函数的Red,Green,Blue这三个参数若一样,则产生的颜色是灰度,当然越接近白颜色越好,但也不能让各位看不出来,俺建议TextBox的背景为RGB(235,235,235),各位还是实战一下,将一个TextBox拖到窗体上,属性设置如下Appearance 0BorderStyle 1MutilLine True千万不要设置ScrollBars属性,否则会影响效果在Form的Load事件中初始化TextBoxDim bkColor As LongPrivate Sub Form_Load()bkColor=RGB(235,235,235)Text1.BackColor=bkColorEnd Sub在Form和Text1的MouseMove事件中:Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Text1.BorderStyle = 0End SubPrivate Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)DoEventsText1.BorderStyle = 1End Sub在按下F5试试是不是很Cool?可能各位看关玩过石器时代,一定会对里面的TextBox的效果感到很爽,VB还不是可以做到,有焦点的控件可以使用SetFocus方法来为其设置焦点,可是一个窗体上如果控件太多了,一个一个的用SetFocus是不是太傻了?这一节的主角就是--------API函数,首先声明:Private Type POINTAPIx As Longy As LongEnd TypePrivate Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As LongPrivate Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function SetFocus Lib "user32" Alias "SetFocus" (ByValhwnd As Long) As Long但是这里的SetFocus会和控件的SetFocus会搞混淆,改改吧,Private Declare Function nSetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long只要Alias指向的接口是对的前面的函数名称简直就是摆设,在建立一个过程:Public Function sSetFocus() As LongDim CPos As POINTAPI,Successfull As Boolean,hWnd As LongDoEventsSuccessfull =GetCursorPos(CPos)If Not Successfull Then Exit Sub ’如果未成功则退出该过程hWnd=WindowFromPoint(CPos.x,CPos.y)sSetFocus=nSetFocus(hWnd)End Sub在窗体上放一个Timer控件,Interval 属性设为100,就是0.1秒,在Timer1控件的Timer事件中填入sSetFocus,在运行一下看看,效果怎么样?可是有的先生小姐要问了,TextBox难道就不能用ScrollBar吗?非也非也,选工程->部件->Microsoft Windows Common Controls-2 6.0 (SP3)就是你的答案,至于卷动TextBox就去研究SendMessage函数吧,否则又有骗稿费之嫌,如果想作绿色软件,不想用控件,可以用俺前面讲到的Label控件,利用字体 Webdings 来模拟ScrollBar,需要注意的是,如果模拟ScrollBar,上下左右箭头分别是5,6,3,4,别忘了把字体设为Webdings再来讲讲窗体的美化,其实将BorderStyle属性设为0就是很好的2D美化;)可是,这样一来,问题又来了,怎么办?凡事都要请API来帮忙,这里需要两个API,一下是该API的声明:Public Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" () As Long 注释:这个API是用来解下鼠标的追踪器,关于他的过多用法以及详细介绍可以写信向俺咨询,还有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 ’表示非工作区左键按下原理很简单,卸下鼠标追踪器后向Form发送一个移动窗体的消息,其实做到这一点的方法很多,但俺个人认为这一种最简单,添加一个过程:Public Sub MoveForm(hWnd As Long)DoEventsReleaseCaptureSendMessage hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&End Sub在Form的MouseMove事件中:Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button=vbLeftButton Then MoveForm hWnd’如果按下鼠标左键就移动窗体End Sub台下的这位小姐又纳闷了,可是光秃秃的窗体没有了标题栏也不好看,俺要向这为小姐推荐俺的东东-ActiveX控件,ToolSign,需要的人可以写信给俺联系,该控件需要在代码编辑区域内添加一下代码:’一下声明是用在ToolSign的 AutoQuit属性的Public Const EXIT_FORCE = 2 ’注意,在VB中运行的时候如果选用此退出方式,VB也会退出Public Const EXIT_MESSAGE = 1 ’由操作系统发送关闭消息Public Const EXIT_CUSTOM = Not (EXIT_FORCE Or EXIT_MESSAGE)’自定义将其注册后在部件栏中把e-Dogkid Studio Tools Sign打钩,添加到工具箱中,双击加入到窗体中,在Form的Load事件中添加一下初始化代码:Private Sub Form_Load()With Sign1.AutoQuit = EXIT_CUSTOM.ParentsHWND =hWnd ’填了此属性可以直接用ToolSign来移动窗体而不需要前面的代码End WithEnd SubSign1的Click事件Private Sub Sign1_Click()End ’关闭程序End Sub在Form的Resize事件中添加一下代码:Private Sub Form_Resize()Sign1.Width = WidthEnd Sub如果想让窗体可以改变大小,可以修改一下属性Caption ""BorderStyle 2或5ControlBox False不知道各位看关见过爆炸试的窗体没有?,没有见过可以从俺要另外一个俺自己的ActiveX DLL,我的那个东东其实是给我的Software作运行库的,各位若不嫌弃,可以用用,注册后在工程->引用->e-Dogkid Runtime Library 然后在窗体Load事件中输入:Private Sub Form_Load()Dim System As e_Dogkid_Runtime_Library.SystemSet System = New e_Dogkid_Runtime_Library.SystemShowSystem.BoomIt hDC, 60, Width, Height, Left, TopSet System = NothingEnd Sub三、能够美化VB6软件界面的软件/s?wd=actskin4下载这个SDK,里面有个控件很不错,三行代码改外观:/u/20090303/02/fb11597e-66af-4f65-adb1-91014add6 89a.html这个SDK带了皮肤编辑器,默认有XP,OFFICE2007,VISTA等几种皮肤,当然也可以自己编辑个性皮可以用皮肤软件,像VBcrazy说的SkinSharp。
用轻松制作特效窗体体是Windows应用程序的基础新一代的开发工具Visual Basic Net为设计制作窗体提供了更多简单而丰富的方法无需再求助于复杂而易错的API函数我们就可以轻松制作多种特效窗体轻松制作透明窗体VB NET可以轻松制作出任一透明度的窗体我们只要在窗体的属性窗口中将 Opacity 属性设置为一个介于(完全透明)与(完全不透明)之间的值就可以了 Dim frm As FrmTrans = New FrmTrans()frm Opacity = frm ShowDialog() 轻松制作始终位于最上层的窗体在VB 中要制作一个始终位于最上层的窗体我们只能求助于令人头痛的API 函数然而在 NET 中我们只要简单设置窗体的 TopMost 属性就可实现同样效果了!例如Dim frm As frmTopMost = New frmTopMost()frm TopMost = Truefrm Show() 轻松制作不可见的窗体如果要编写一个不让别人发现的隐藏程序制作不可见的窗体就是必须实现的第一步窗体的可见性通常由 Visible 属性控制但是如果希望Windows 应用程序的主窗体在应用程序启动时不可见您将会发现将它的 Visible 属性设置为 False 的方法无效窗体总会自己显示出来(这是因为启动窗体的生存期决定了应用程序的生存期)虽然如此我们还是可以通过简单将应用程序的启动设置为一个模块从而从窗体的生存期分出应用程序的生存期轻松实现不可见的窗体在下面这个例子中窗体在特定的时间内自动隐藏()在 Visual Basic 中右击项目并选择添加模块以将模块添加到Windows 应用程序()在已添加的模块(或类)内创建可作为项目启动对象的 Main 函数 Sub main()Dim f As New Form ()f Visible = FalseWhile Hour(Date Now) < 如果当前时间早于点窗体自动隐藏Application DoEvents()End Whilef ShowDialog()End Sub 轻松编写托盘程序托盘程序作为一类特殊的窗体其快捷图标显示在系统托盘中窗体本身则隐藏不可见在 NET之前版本的VB中编写托盘程序是十分困难的但是VB NET提供的新的NotifyIcon组件却使VB初学者也能轻松编写一个这样的程序新建Windows应用程序设置主窗体Opacity属性为 FormBorderStyle属性为None ShowInTaskbar属性为False 这样窗体将在启动后隐藏在窗体上放置一个NotifyIcon组件NotifyIcon 一个ContextMenu(弹出菜单)组件ContextMenu 并根据需要为ContextMenu 添加菜单项设置NotifyIcon 的ICON属性这个图标就是应用程序出现在系统托盘中的快捷图标设置NotifyIcon 的Text属性为 VB NET托盘程序这就是鼠标移动到托盘图标时弹出的文字说明设置NotifyIcon 的ContextMenu属性为ContextMenu 也就是右键单击快捷图标时的弹出菜单为ContextMenu OK 按F 运行!几乎不用编写代码一个托盘程序就这样轻松实现了lishixinzhi/Article/program/net/201311/13831。
---------------------------------------------------------------最新资料推荐------------------------------------------------------vb窗口形状改变(精品)用用 设计各种形状的窗体界面设计各种形状的窗体界面窗体是程序设计最常见,最普通,也是最容易受到程序员忽视的编程对象。
一般来说,在 Visual 针对窗体的编程是不需要人为介入的,因为可视化编程工具 Visual 已经按照窗体的缺省状态实现了。
但是在最近遇到的应用程序中。
我们发现越来越多的应用程序中使用到各种不同规则的窗体,这些不同规则的窗体给应用程序带来异常的情趣和不同平常的效果的同时,也促使使用者思考这样一个问题,如何创建这些窗体?在Visual 中提供了一种简单、直接创建不规则窗体的方法,本文的主要内容就是探讨一下这些方法具体的实现过程。
下面就来详细介绍在 中实现五种不同规格窗体的方法,即:椭圆形、扇形、圆形、环形和三角形。
掌握了这五种不同形状窗体的实现方法后,我想对于其他规则的窗体就不应该有什么问题了。
Visual Basic .Net 中创建、使用 MDI 窗体也是本文的重要内容之一,MDI 是 Multi DocumentInterface 的简称,即:多文档界面,MDI 最早出现于 Windows2.0 中,最先使用到 MDI1 / 17的应用程序是 Excel 电子表格。
为了方便使用者同时能够操作多份电子表格,Excel 就采用了MDI 来解决这个问题。
到了 Windows3.1 中,MDI 在应用程序中得到了更大范围的应用。
其中 Windows3.1 中的程序管理器和文件管理器都采用了 MDI。
目前 MDI 在应用程序中依然被广泛采用。
下面就首先来介绍一下 Visual 创建不规则窗体的相关知识和具体实现方法。
几款VB美化代码窗体半透明效果Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowL ongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowL ongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Lo ng) As LongPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Const WS_EX_LAYERED = &H80000Private Const GWL_EXSTYLE = (-20)Private Const LWA_ALPHA = &H2Private Const LWA_COLORKEY = &H1Private Sub Command1_Click()Dim rtn As Longrtn = GetWindowLong(hwnd, GWL_EXSTYLE)rtn = rtn Or WS_EX_LAYEREDSetWindowLong hwnd, GWL_EXSTYLE, rtnSetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHAEnd Sub二。
VB窗体设计
知识点:
1.在窗体上添加标签,并掌握caption Alignment Backstye 等(文本的对齐方式为右对齐,标签背景透明,且有固定边框)
2.在窗体上添加文本框,并掌握name height Width top left enabled Visible Font ForeColor BackColor text SCrollBars MaXLenth Multiline (前景色\背景色\高度和宽度\允许输入的最大字符数为8)
3、在窗体上添加复选框、单选按钮,并掌握caption style Value 属性。
4、在窗体上画形状控件,并掌握Shape FillStyle BackStyle FillColor (形状的外观为“椭圆形”,形状控件背景非透明,用对角交叉线填充形状的图案,且填充形状的颜色为)
5、在窗体上建立菜单(包括二级菜单),并有快捷键,并注意有“复选、有效、)
6、在窗体上添加一个图片框、图像框,并掌握Height Width borderStyle (在图片框内再添加一个有边框的名称为Img1的图像框,再把图标文件sd1)装入图像框Image1中)
7、在窗体上添加一个通用对话框(方法是什么)
8、在窗体上添加一个水平、垂直滚动条,并掌握它的Max Min Value SmallChang LargeChang 等属性(HS1的最大值为1000,最小值为100,每次点击最大增量值为100,最小增量值为10,文本框中能自动显示该滚动条的值;)
9、在窗体上添加添加一时钟控件,并掌握Interval属性,掌握P141{例7-4}例题。
VBA与图表调整与美化的技巧分享VBA(Visual Basic for Applications)是一种用于编写宏和自定义功能的编程语言,它被广泛应用于Microsoft Office等办公软件中。
在Excel中,VBA可以大大提高数据处理和图表调整的效率。
本文将分享一些关于VBA和图表调整与美化的技巧,帮助您更好地利用VBA提升Excel图表的外观和功能。
一、自动化图表调整使用VBA可以实现自动化图表调整,节省大量的时间和精力。
以下是一些常见的VBA代码示例,可以让您了解如何自动定制和调整图表。
1. 自动调整图表范围通过VBA代码,您可以自动调整图表的范围,使其始终适应数据的变化。
下面是一个简单的示例,可根据数据范围动态调整图表的区域:```VBASub AutoAdjustChartRange()Dim ws As WorksheetDim cht As ChartObjectSet ws = ActiveSheetSet cht = ws.ChartObjects(1)With cht.Chart.SetSourceData ws.Range("A1:B10") '调整为适应数据范围End WithEnd Sub```2. 动态添加数据系列有时候,我们需要根据条件动态添加数据系列到图表中。
通过VBA,您可以根据指定的条件添加或删除数据系列。
```VBASub AddSeriesBasedOnCondition()Dim ws As WorksheetDim cht As ChartObjectDim ser As SeriesSet ws = ActiveSheetSet cht = ws.ChartObjects(1)Set ser = cht.Chart.SeriesCollection.NewSeriesWith ser.Name = "New Series".Values = ws.Range("A1:A10").XValues = ws.Range("B1:B10")End WithEnd Sub```二、美化图表的技巧除了调整图表的数据和范围外,使用VBA还可以实现图表的美化。
VB6.0界面美化不带任何附件的简单实现方法VB6.0界面美化往往生成的exe往往要带有bas、dll、ocx等等东西。
很麻烦。
所以介绍下面的美化方法生成的exe后就一个exe。
没有任何的附件。
首先准备3个美化的东东:vb6.0 she皮肤调用模块.bas、aero.she、SkinH_VB6.dll。
放在“D:\”下面:新建工程,在“外接程序”——“外接程序管理器”——“vb6资源编辑器”然后在“工具”——“资源编辑器”里面添加:vb6.0 she皮肤调用模块.bas、aero.she、SkinH_VB6.dll这3个文件,分别命名为(101, "CUSTOM")、(102, "CUSTOM")、(103, "CUSTOM")好了。
在工程1里面添加模块1(Module1):在Module1添加代码:Sub Main()Dim bas As Stringbas = "D:\vb6.0 she皮肤调用模块.bas"Dim OPEN1() As ByteOPEN1 = LoadResData(101, "CUSTOM")Open bas For Binary As #1Put #1, , OPEN1Close #1Dim she As Stringshe = "D:\aero.she"Dim OPEN2() As ByteOPEN2 = LoadResData(102, "CUSTOM")Open she For Binary As #1Put #1, , OPEN2Close #1Dim dll As Stringdll = "C:\WINDOWS\system32\SkinH_VB6.dll"Dim OPEN3() As ByteOPEN3 = LoadResData(103, "CUSTOM")Open dll For Binary As #1Put #1, , OPEN3Close #1Form1.ShowEnd Sub再添加vb6.0 she皮肤调用模块.bas模块好了。
VB打造超酷个性化菜单众所周知,MS Office 2003推出已经有一段时间了,但我们依然不会忘记Office XP刚刚推出时其令人耳目一新的菜单给我们留下的深刻印象。
突起的悬浮式图标,不同寻常的菜单项填充方式,不仅让办公一族们赞不绝口,更让广大的程序员和编程爱好者对这种风格的菜单的制作产生了浓厚的兴趣。
所以,在这篇文章里,我们就来好好地研究研究用VB怎么制作这种风格的菜单,在文章的最后,我将给出源代码的下载地址。
事实上,在了解其原理以后,不论是用VB、VC还是Delphi,都能够制作出XP风格的菜单。
不仅如此,我们还可以制作出更加充满个性的另类风格的菜单,比如3D立体风格、渐变风格、多彩风格等等。
只有想不到的,没有做不到的。
Follow me!现在,我想有必要说一说我们现在要做的事情。
事实上,我们只要做一个菜单类就行了。
但谁都会明白,只做一个菜单类是不够的,我们需要一个程序,或者更详细的说,是一个窗体,来测试我们的菜单类。
在我个人的开发过程中,我是先写的菜单类,后写的测试窗体,但为了让大家先领略一下写好的菜单类在应用时是多么的方便,所以让我们先来看看测试窗体:(1)打开VB,新建“标准EXE”工程。
(2)下面是窗体的控件:其实就是在窗体上添加了一个Frame,然后在Frame里添加OptionButton控件数组,用来设置菜单风格,还有一个Label,上面只显示一行提示文字,非常简单。
(3)窗体代码:Option ExplicitPrivate Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As LongPrivate Type POINTAPIX As LongY As LongEnd TypeDim menu As cMenuPrivate Sub Form_Load()' 初始化菜单并添加菜单项Set menu = New cMenumenu.CreateMenumenu.AddItem "open", LoadPicture("images\open.ico"), "打开", MIT_STRINGmenu.AddItem "save", LoadPicture("images\save.ico"), "保存", MIT_STRINGmenu.AddItem "print", LoadPicture("images\print.ico"), "打印", MIT_STRINGmenu.AddItem "find", LoadPicture("images\find.ico"), "查找", MIT_STRINGmenu.AddItem "sep1", LoadPicture(), "", MIT_SEPARATORmenu.AddItem "undo", LoadPicture("images\undo.ico"), "撤消", MIT_STRINGmenu.AddItem "redo", LoadPicture("images\redo.ico"), "重复", MIT_STRINGmenu.AddItem "sep2", LoadPicture(), "", MIT_SEPARATORmenu.AddItem "cut", LoadPicture("images\cut.ico"), "剪切", MIT_STRINGmenu.AddItem "copy", LoadPicture("images\copy.ico"), "复制", MIT_STRINGmenu.AddItem "paste", LoadPicture("images\paste.ico"), "粘贴", MIT_STRINGmenu.AddItem "sep3", LoadPicture(), "", MIT_SEPARATORmenu.AddItem "check", LoadPicture("images\check.ico"), "一个 CheckBox", MIT_CHECKBOXmenu.AddItem "exit", LoadPicture("images\exit.ico"), "退出",MIT_STRINGEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)' 单击鼠标右建弹出菜单If Button = vbRightButton ThenDim pos As POINTAPIGetCursorPos posmenu.PopupMenu pos.X, pos.Y, POPUP_LEFTALIGN Or POPUP_TOPALIGNEnd IfEnd SubPrivate Sub Form_Unload(Cancel As Integer)' 释放资源, 卸载窗体Set menu = NothingDim frm As FormFor Each frm In FormsUnload frmNextEnd SubPrivate Sub opnStyle_Click(Index As Integer)' 设置菜单风格Select Case IndexCase 0 ' Windows 标准menu.Style = STYLE_WINDOWSCase 1 ' XP 风格menu.Style = STYLE_XPCase 2 ' 3D 立体风格menu.Style = STYLE_3DCase 3 ' 渐变风格menu.Style = STYLE_SHADECase 4 ' 多彩风格menu.Style = STYLE_COLORFULEnd SelectEnd Sub代码中创建了一个cMenu类的对象,我们的编程重点将会放在cMenu类上,上面的代码只是简单地调用cMenu。
Option Explicit'工程名:VB实现漂亮的用户登录界面,'作者:QQ:659354953 来水美树'本人自学VB将近1年之久,小学学历,就因为学历太低,而且又是一个人自学,所以进步不是很快,'想通这些代码到网上找一些VB爱好者一起学习,讨论,'想和我一起学习的就加我QQ吧! ,小弟我还有好多不懂的要向各位大哥大姐学习呢?''以下代码不是很完善,两个按扭没写完,但是,还是可以操作的'代码提供给VB新手朋友作为参考,'新建工程直接复制代码到窗体模块下即可,无需手动添加任何控件Private Type POINTAPIX As LongY As LongEnd TypePrivate Type RECTTop As LongLeft As LongRight As LongBottom As LongEnd TypePrivate Enum DrawColorStyle[Top to bottom] = 0[left to Right] = 1End EnumDim C As BooleanPrivate Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByV al hwnd As Long, ByV al wMsg As Long, ByV al wParam As Long, lParam As Any)Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByV al nCount As Long, ByV al nPolyFillMode As Long) As LongPrivate Declare Function CreateRectRgn Lib "gdi32" (ByV al x1 As Long, ByV al y1 As Long, ByV al x2 As Long, ByV al y2 As Long) As LongPrivate Declare Function CreateRoundRectRgn Lib "gdi32" (ByV al x1 As Long, ByV al y1 As Long, ByV al x2 As Long, ByV al y2 As Long, ByV al X3 As Long, ByV al y3 As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByV al hObject As Long) As LongPrivate Declare Function CreateSolidBrush Lib "gdi32" (ByV al crColor As Long) As Long Private Declare Function FrameRgn Lib "gdi32" (ByV al hdc As Long, ByV al hRgn As Long, ByV al hBrush As Long, ByV al nWidth As Long, ByV al nHeight As Long) As LongPrivate Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function SetCapture Lib "user32" (ByV al hwnd As Long) As LongPrivate Declare Function SetWindowRgn Lib "user32" (ByV al hwnd As Long, ByV al hRgn As Long, ByV al bRedraw As Boolean) As LongDim WithEvents Picture1 As PictureBox ‘声明窗体Dim WithEvents Picture2 As PictureBox ‘关闭按扭Dim WithEvents Picture3 As PictureBox ‘最小化Dim WithEvents Loading As PictureBox ‘登录按扭Dim WithEvents Cancel As PictureBox ‘取消按扭Dim WithEvents UP As PictureBox ‘文本框边Dim WithEvents PP As PictureBox ‘文本框边Dim UserLaBel As Label ‘标签Dim PasswordLaBel As Label ‘标签Dim WithEvents uText As TextBox ‘帐号文本Dim WithEvents PText As TextBox ‘密码文本Dim Styl As BooleanPrivate Sub LoadWindow()Dim i As LongDim color As LongDim W, h As LongFor i = 1 To 405color = color + 1Picture1.Line (0, i)-(Picture1.ScaleWidth, i), RGB(0, 255, color) ‘画出窗体标题栏Next iPicture1.ForeColor = vbBluePicture1.FontSize = 10Picture1.CurrentX = 200Picture1.CurrentY = 100Picture1.Print Me.CaptionFor i = 1 To 25color = color + 1Picture1.Line (i, 0)-(i, Picture1.ScaleHeight), RGB(0, 255, color)Next iFor i = Picture1.ScaleWidth - 55 To Picture1.ScaleWidthcolor = color + 1Picture1.Line (i, 0)-(i, Picture1.ScaleHeight), RGB(0, 255, color)Next iFor i = Picture1.ScaleHeight - 55 To Picture1.ScaleHeightcolor = color + 1Picture1.Line (0, i)-(ScaleWidth, i), RGB(0, 255, color)Next iDim Rgn As LongDim Brush As LongW = Picture1.ScaleWidthh = Picture1.ScaleHeightRgn = CreateRoundRectRgn(0, 0, Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), Picture1.ScaleY(Picture1.Height + 200, vbTwips, vbPixels), 12, 12)SetWindowRgn Picture1.hwnd, Rgn, True ‘删除窗体上面两个角DeleteObject RgnBrush = CreateSolidBrush(0)Rgn = CreateRoundRectRgn(0, 0, Picture1.ScaleX(Picture1.Width, vbTwips, vbPixels), Picture1.ScaleY(Picture1.Height + 200, vbTwips, vbPixels), 12, 12)FrameRgn Picture1.hdc, Rgn, Brush, 1, 1Picture1.Line (0, Picture1.ScaleHeight - 10)-(Picture1.ScaleWidth, Picture1.ScaleHeight - 10), 0 DeleteObject RgnDeleteObject BrushBrush = CreateSolidBrush(0)Rgn = CreateRectRgn(3, 27, Picture1.ScaleWidth / 15 - 4, Picture1.ScaleHeight / 15 - 3) FrameRgn Picture1.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushEnd SubPrivate Sub Command1_Click()End SubPrivate Sub Form_Load()Me.Width = 6680Me.Height = 5580Me.BackColor = &H808080Me.Caption = "VB画漂亮窗体"Styl = FalseSet Picture1 = Me.Controls.Add("vb.picturebox", "picture1", Me)With Picture1.Width = 4575.Height = 3615.Left = 800.Top = 800.BorderStyle = 0.V isible = TrueEnd WithSet Picture2 = Me.Controls.Add("vb.picturebox", "picture2", Picture1)With Picture2.Width = 300.Left = Picture1.Width - 400.Height = 300.Top = 80.BorderStyle = 0.V isible = TrueEnd WithSet Picture3 = Me.Controls.Add("vb.picturebox", "picture3", Picture1) Picture3.Top = 80Picture3.Left = Picture2.Left - 320Picture3.Width = 300Picture3.Height = 300Picture3.BorderStyle = 0Picture3.V isible = TrueSet UserLaBel = Me.Controls.Add("bel", "uL", Picture1)With UserLaBel.Top = 1000.Left = 800.Caption = "用户名(&U):".ForeColor = vbBlue.Width = 1000.BorderStyle = 0.BackStyle = 0.V isible = TrueEnd WithSet PasswordLaBel = Me.Controls.Add("bel", "PL", Picture1) With PasswordLaBel.Top = 1600.Left = 800.Caption = "密码(&P):".ForeColor = vbBlue.Width = 1000.BorderStyle = 0.BackStyle = 0.V isible = TrueEnd WithSet UP = Me.Controls.Add("vb.picturebox", "UP", Picture1)With UP.V isible = True.Top = 930.Left = 1800.Width = 1900.Height = 330.BorderStyle = 0.BackColor = vbWhiteEnd WithSet uText = Me.Controls.Add("VB.textbox", "ut", UP)With uText.V isible = True.Top = 30.Left = 200.Width = 1500.Height = 250.BorderStyle = 0End WithSet PP = Me.Controls.Add("vb.picturebox", "PP", Picture1)With PP.V isible = True.Top = 1500.Left = 1800.Width = 1900.Height = 330.BorderStyle = 0.BackColor = vbWhiteEnd WithSet PText = Me.Controls.Add("VB.textbox", "Pt", PP)With PText.V isible = True.Top = 30.Left = 200.Width = 1500.Height = 250.BorderStyle = 0.PasswordChar = "*"End WithSet Loading = Me.Controls.Add("vb.picturebox", "Loading1", Picture1) With Loading.V isible = True.Top = 2500.Left = 800.Width = 800.Height = 350.BorderStyle = 0.Appearance = 0.BackColor = vbWhiteEnd WithSet Cancel = Me.Controls.Add("vb.picturebox", "Cancel", Picture1)With Cancel.V isible = True.Top = 2500.Left = 3000.Width = 800.Height = 350.BorderStyle = 0.Appearance = 0.BackColor = vbWhiteEnd WithEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Styl = FalsePP_PaintEnd SubPrivate Sub Picture1_Paint()LoadWindowEnd SubPrivate Sub Drawcolor(ByV al object As Object, ByV al crColor1 As Long, crColor2 As Long, ByV al F As Boolean)Dim W, h As LongDim uH As Single, uW As SingleDim rInfo As Single, gInfo As Single, bInfo As SingleDim rSta As Long, gSta As Long, bSta As LongDim rEnd As Long, gEnd As Long, bEnd As LongDim R As Long, G As Long, B As Long, i As LonguH = object.ScaleHeight: uW = object.ScaleWidthrSta = crColor1 Mod 256gSta = crColor1 \ 256 Mod 256bSta = crColor1 \ 256 \ 256rEnd = crColor2 Mod 256gEnd = crColor2 \ 256 Mod 256bEnd = crColor2 \ 256 \ 256If F = True ThenrSta = rSta * 1.2: gSta = gSta * 1.2: bSta = bSta * 1.2rEnd = rEnd * 1.2: gEnd = gEnd * 1.2: bEnd = bEnd * 1.2rInfo = (rEnd - rSta) / uHgInfo = (gEnd - gSta) / uHbInfo = (bEnd - bSta) / uHFor i = 0 To uH - 1R = rSta + i * rInfoG = gSta + i * gInfoB = bSta + i * bInfoobject.Line (0, i)-(uW - 1, i), RGB(R, G, B)Next iElserInfo = (rEnd - rSta) / uHgInfo = (gEnd - gSta) / uHbInfo = (bEnd - bSta) / uHFor i = 0 To uH - 1R = rSta + i * rInfoG = gSta + i * gInfoB = bSta + i * bInfoobject.Line (0, i)-(uW - 1, i), RGB(R, G, B)Next iEnd IfEnd SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCaptureSendMessage Picture1.hwnd, &HA1, 2, 0& ‘移动里面的窗体End SubPrivate Sub Picture2_Click()Picture1.V isible = FalseEnd SubPrivate Sub Picture2_Paint()Dim W, h As LongDim Rgn As LongDim Brush As LongDrawcolor Picture2, 255, vbWhite, TrueW = Picture2.ScaleWidth / Screen.TwipsPerPixelXh = Picture2.ScaleHeight / Screen.TwipsPerPixelYRgn = CreateRoundRectRgn(0, 0, W, h, 3, 3)SetWindowRgn Picture2.hwnd, Rgn, TrueDeleteObject RgnRgn = CreateRoundRectRgn(0, 0, W, h, 3, 3)Brush = CreateSolidBrush(123)FrameRgn Picture2.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushPicture2.DrawWidth = 2Picture2.Line (70, 70)-(230, 230), &H808080Picture2.Line (230, 70)-(70, 230), &H808080End SubPrivate Sub Picture3_Paint()Dim W, h As LongDim Rgn As LongDim Brush As LongDrawcolor Picture3, &HFF8080, vbWhite, TrueW = Picture3.ScaleWidth / Screen.TwipsPerPixelXh = Picture3.ScaleHeight / Screen.TwipsPerPixelYRgn = CreateRoundRectRgn(0, 0, W, h, 3, 3)SetWindowRgn Picture3.hwnd, Rgn, TrueDeleteObject RgnRgn = CreateRoundRectRgn(0, 0, W, h, 3, 3)Brush = CreateSolidBrush(123)FrameRgn Picture3.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushPicture3.DrawWidth = 2Picture3.Line (70, 170)-(230, 170), &H808080End SubPrivate Sub PText_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim W, h As LongDim Rgn As LongDim Brush As LongW = PP.ScaleWidth / Screen.TwipsPerPixelXh = PP.ScaleHeight / Screen.TwipsPerPixelYIf X >= 0 And X <= PText.Width And Y >= 0 And Y <= PText.Height ThenRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20)Brush = CreateSolidBrush(vbGreen)FrameRgn PP.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushSetCapture PText.hwndElseRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20)Brush = CreateSolidBrush(&H80FF80)FrameRgn PP.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushReleaseCaptureEnd IfEnd SubPrivate Sub UText_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim W, h As LongDim Rgn As LongDim Brush As LongW = UP.ScaleWidth / Screen.TwipsPerPixelXh = UP.ScaleHeight / Screen.TwipsPerPixelYIf X >= 0 And X <= uText.Width And Y >= 0 And Y <= uText.Height ThenRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20)Brush = CreateSolidBrush(vbGreen)FrameRgn UP.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushSetCapture uText.hwndElseRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20)Brush = CreateSolidBrush(&H80FF80)FrameRgn UP.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushReleaseCaptureEnd IfEnd SubPrivate Sub UP_Paint()Dim W, h As LongDim Rgn As LongDim Brush As LongW = UP.ScaleWidth / Screen.TwipsPerPixelXh = UP.ScaleHeight / Screen.TwipsPerPixelYRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20) SetWindowRgn UP.hwnd, Rgn, True DeleteObject RgnRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20) Brush = CreateSolidBrush(&H80FF80) FrameRgn UP.hdc, Rgn, Brush, 1, 1 DeleteObject RgnDeleteObject BrushEnd SubPrivate Sub PP_Paint()Dim W, h As LongDim Rgn As LongDim Brush As LongW = PP.ScaleWidth / Screen.TwipsPerPixelXh = PP.ScaleHeight / Screen.TwipsPerPixelYRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20) SetWindowRgn PP.hwnd, Rgn, True DeleteObject RgnRgn = CreateRoundRectRgn(0, 0, W, h, 20, 20) Brush = CreateSolidBrush(&H80FF80) FrameRgn PP.hdc, Rgn, Brush, 1, 1 DeleteObject RgnDeleteObject BrushEnd SubPrivate Sub Loading_Paint()Drawcolor Loading, vbGreen, vbWhite, True Dim str As Stringstr = "登录"Dim W, h As LongDim Rgn As LongDim Brush As LongW = Loading.ScaleWidth / Screen.TwipsPerPixelX h = Loading.ScaleHeight / Screen.TwipsPerPixelY Rgn = CreateRoundRectRgn(0, 0, W, h, 4, 4) SetWindowRgn Loading.hwnd, Rgn, True DeleteObject RgnRgn = CreateRoundRectRgn(0, 0, W, h, 4, 4) Brush = CreateSolidBrush(&H808080) FrameRgn Loading.hdc, Rgn, Brush, 1, 1 DeleteObject RgnDeleteObject BrushLoading.CurrentX = (Loading.ScaleWidth - Loading.TextWidth(str)) / 2 Loading.CurrentY = (Loading.ScaleHeight - Loading.TextHeight(str)) / 2 Loading.Print strEnd SubPrivate Sub Loading_Click()If uText.Text <> "659354953" ThenMsgBox "用户名错误", , "提示"ElseIf PText.Text <> "659354953" ThenMsgBox "用户密码错误", , "提示!"ElseMsgBox "登录成功"End IfEnd SubPrivate Sub Cancel_Paint()Drawcolor Cancel, vbGreen, vbWhite, TrueDim str As Stringstr = "退出"Dim W, h As LongDim Rgn As LongDim Brush As LongW = Cancel.ScaleWidth / Screen.TwipsPerPixelXh = Cancel.ScaleHeight / Screen.TwipsPerPixelYRgn = CreateRoundRectRgn(0, 0, W, h, 4, 4)SetWindowRgn Cancel.hwnd, Rgn, TrueDeleteObject RgnRgn = CreateRoundRectRgn(0, 0, W, h, 4, 4)Brush = CreateSolidBrush(&H808080)FrameRgn Cancel.hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushCancel.CurrentX = (Cancel.ScaleWidth - Cancel.TextWidth(str)) / 2 Cancel.CurrentY = (Cancel.ScaleHeight - Cancel.TextHeight(str)) / 2 Cancel.Print strEnd Sub方法二,VB简单画漂亮窗体这是一个圆角矩形的窗体模块代码Public Type POINTAPIX As LongY As LongEnd TypePublic Type RECTTop As LongLeft As LongRight As LongBottom As LongEnd TypePublic Enum DrawColorStyle[Top to bottom] = 0[left to Right] = 1End EnumPublic Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByV al wMsg As Long, ByV al wParam As Long, lParam As Any)Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByV al nCount As Long, ByV al nPolyFillMode As Long) As LongPublic Declare Function CreateRectRgn Lib "gdi32" (ByV al X1 As Long, ByV al Y1 As Long, ByV al X2 As Long, ByV al y2 As Long) As LongPublic Declare Function CreateRoundRectRgn Lib "gdi32" (ByV al X1 As Long, ByV al Y1 As Long, ByV al X2 As Long, ByV al y2 As Long, ByV al x3 As Long, ByV al y3 As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByV al hObject As Long) As LongPublic Declare Function CreateSolidBrush Lib "gdi32" (ByV al crColor As Long) As LongPublic Declare Function FrameRgn Lib "gdi32" (ByV al Hdc As Long, ByV al hRgn As Long, ByV al hBrush As Long, ByV al nWidth As Long, ByV al nHeight As Long) As LongPublic Declare Function ReleaseCapture Lib "user32" () As LongPublic Declare Function SetCapture Lib "user32" (ByV al hwnd As Long) As LongPublic Declare Function SetWindowRgn Lib "user32" (ByV al hwnd As Long, ByV al hRgn As Long, ByV al bRedraw As Boolean) As LongPublic Declare Function ShowWindow Lib "user32" (ByV al hwnd As Long, ByV al nCmdShow As Long) As LongPublic Const SW_HIDE = 0Public Const SW_SHOWNORMAL = 1Public Const SW_NORMAL = 1Public Const SW_SHOWMINIMIZED = 2Public Const SW_SHOWMAXIMIZED = 3Public Const SW_MAXIMIZE = 3Public Const SW_SHOWNOACTIV A TE = 4Public Const SW_SHOW = 5Public Const SW_MINIMIZE = 6Public Const SW_SHOWMINNOACTIVE = 7Public Const SW_SHOWNA = 8Public Const SW_RESTORE = 9Public Const SW_SHOWDEFAULT = 10Public Const SW_MAX = 10Public Function DrawRounRec(ByV al Hdc As Long, ByV al X1 As Long, Y1 As Long, _ByV al X2 As Long, y2 As Long, _ByV al x3 As Long, y3 As Long, ByV al crColor As Long)Dim Rgn As LongDim Brush As LongRgn = CreateRoundRectRgn(X1, Y1, X2, y2, x3, y3)Brush = CreateSolidBrush(crColor)FrameRgn Hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject BrushEnd FunctionPublic Function DrawColorGradient(ByV al Object As Object, ByV al X1 As Long, _Y1 As Long, ByV al X2 As Long, y2 As Long, _ByV al crColor1 As Long, crColor2 As Long, _ByRef ColorStyle As Integer, ByV al brighten As Boolean)Dim R, G, B As LongDim R1, G1, B1 As LongDim R2, G2, B2 As LongDim R3, G3, B3 As LongR1 = crColor1 Mod 256G1 = crColor1 \ 256 Mod 256B1 = crColor1 \ 256 \ 256R2 = crColor2 Mod 256G2 = crColor2 \ 256 Mod 256B2 = crColor2 \ 256 \ 256Dim X As LongDim Y As LongSelect Case ColorStyleCase 0If brighten = True ThenR1 = R1 * 1.2: G1 = G1 * 1.2: B1 = B1 * 1.2R2 = R2 * 1.2: G2 = G2 * 1.2: B2 = B2 * 1.2For X = X1 To X2R = R1 + X * R3G = G1 + X * G3B = B1 + X * B3Object.Line (X, Y1)-(X, y2), RGB(R, G, B)Next XElseR3 = (R2 - R1) / X2G3 = (G2 - G1) / X2B3 = (G2 - G2) / X2For X = X1 To X2R = R1 + X * R3G = G1 + X * G3B = B1 + X * B3Object.Line (X, Y1)-(X, y2), RGB(R, G, B)Next XEnd IfCase 1If brighten = True ThenR1 = R1 * 1.2: G1 = G1 * 1.2: B1 = B1 * 1.2R2 = R2 * 1.2: G2 = G2 * 1.2: B2 = B2 * 1.2R3 = (R2 - R1) / y2G3 = (G2 - G1) / y2B3 = (G2 - G2) / y2For Y = Y1 To y2R = R1 + Y * R3G = G1 + Y * G3B = B1 + Y * B3Object.Line (X1, Y)-(X2, Y), RGB(R, G, B)Next YElseR3 = (R2 - R1) / y2G3 = (G2 - G1) / y2B3 = (G2 - G2) / y2For Y = Y1 To y2R = R1 + Y * R3G = G1 + Y * G3B = B1 + Y * B3Object.Line (X1, Y)-(X2, Y), RGB(R, G, B)Next YEnd IfEnd SelectEnd Function窗体代码把FORM的属性.BorderStyle = 0ShowInTaskbar = True直接复制代码Option ExplicitDim WithEvents m_MinButton As PictureBox '声明最小化按扭Dim WithEvents m_CloseButton As PictureBox ''声明关闭按扭Dim opt(4) As POINTAPI '装载两个按扭区域结构Dim F As BooleanPrivate Sub LoadButton()Set m_MinButton = Me.Controls.Add("vb.pictureBox", "Min")With m_MinButton.Top = 9.Width = 500.V isible = True.Height = 300.BackColor = 255.BorderStyle = 0.Left = Me.ScaleWidth - (.Width * 2 + 100)End WithSet m_CloseButton = Me.Controls.Add("vb.pictureBox", "close")With m_CloseButton.Top = 9.Width = 500.V isible = True.Height = 300.BackColor = 0.BorderStyle = 0.Left = Me.ScaleWidth - (.Width + 115)End WithEnd SubPrivate Sub SetRounWindow()Dim W, H As LongDim Rgn As LongW = Me.ScaleWidth / Screen.TwipsPerPixelXH = Me.ScaleHeight / Screen.TwipsPerPixelYCall DrawColorGradient(Form1, 0, 0, Me.ScaleWidth, Me.ScaleHeight, vbBlue, vbGreen, 1, True)'填充窗体背景颜色Rgn = CreateRoundRectRgn(0, 0, W, H, 5, 5)SetWindowRgn Me.hwnd, Rgn, True '设置矩圆窗口DeleteObject RgnCall DrawRounRec(Me.Hdc, 0, 0, W, H, 5, 5, &H808080) '填充窗体边框颜色End SubPrivate Sub Form_Load()Me.Width = 6000Me.Height = 3500LoadButtonEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCaptureSendMessage Me.hwnd, &HA1, 2, 0 '移动窗体End SubPrivate Sub Form_Paint()SetRounWindowMe.ForeColor = 255Me.FontSize = 25PrintStr ("VB最简的漂亮单窗口")End SubPrivate Sub m_MinButton_Paint()Call DrawColorGradient(m_MinButton, 0, 0, m_MinButton.ScaleWidth, m_MinButton.ScaleHeight, vbBlue, vbGreen, 1, F)''参数F = True 时颜色变亮Dim Rgn As LongDim Brush As Longopt(0).X = 0opt(0).Y = 0opt(1).X = 0opt(1).Y = m_MinButton.ScaleHeight / 15 - 3opt(2).X = 3opt(2).Y = m_MinButton.ScaleHeight / 15opt(3).X = m_MinButton.ScaleWidth / 15opt(3).Y = m_MinButton.ScaleHeight / 15opt(4).X = m_MinButton.ScaleWidth / 15opt(4).Y = 0Rgn = CreatePolygonRgn(opt(0), 5, 1)Brush = CreateSolidBrush(&H808080)SetWindowRgn m_MinButton.hwnd, Rgn, TrueDeleteObject RgnRgn = CreatePolygonRgn(opt(0), 5, 1)FrameRgn m_MinButton.Hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject Brushm_MinButton.DrawWidth = 2m_MinButton.ForeColor = vbWhitem_MinButton.Line (170, 200)-(330, 200)End SubPrivate Sub m_CloseButton_Paint()Call DrawColorGradient(m_CloseButton, 0, 0, m_CloseButton.ScaleWidth, m_CloseButton.ScaleHeight, vbBlue, vbGreen, 1, F)'参数F = True 时颜色变亮Dim Rgn As LongDim Brush As Longopt(0).X = 0opt(0).Y = 0opt(1).X = 0opt(1).Y = m_CloseButton.ScaleHeight / 15opt(2).X = (m_CloseButton.ScaleWidth / 15) - 3opt(2).Y = m_CloseButton.ScaleHeight / 15opt(3).X = m_CloseButton.ScaleWidth / 15opt(3).Y = m_CloseButton.ScaleHeight / 15 - 3opt(4).X = m_CloseButton.ScaleWidth / 15opt(4).Y = 0Rgn = CreatePolygonRgn(opt(0), 5, 1)Brush = CreateSolidBrush(&H808080)SetWindowRgn m_CloseButton.hwnd, Rgn, TrueDeleteObject RgnRgn = CreatePolygonRgn(opt(0), 5, 1)FrameRgn m_CloseButton.Hdc, Rgn, Brush, 1, 1DeleteObject RgnDeleteObject Brushm_CloseButton.ForeColor = vbWhitem_CloseButton.DrawWidth = 2m_CloseButton.Line (170, 100)-(330, 200)m_CloseButton.Line (330, 100)-(170, 200)End SubPrivate Sub PrintStr(Str1 As String)Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(Str1)) / 2 Me.CurrentY = (Me.ScaleHeight - Me.TextHeight(Str1)) / 2 Me.Print Str1End SubPrivate Sub m_MinButton_Click()ShowWindow Me.hwnd, SW_MINIMIZE '最小化窗口End Sub。
VBA中窗体和控件的设计和使用技巧在Excel的VBA编程环境中,窗体和控件是非常有用的工具,可以提供一个可交互的界面,使用户能够方便地与程序进行互动。
本文将介绍一些在VBA中设计和使用窗体与控件的技巧,帮助您更好地利用这些功能。
1. 窗体的设计和创建窗体是用来容纳和组织控件的容器,我们可以在窗体上添加各种控件,如按钮、文本框、复选框等。
以下是一些窗体设计和创建的技巧:1.1 设计图形化界面:在Excel的VBA环境中,打开“工具箱”窗口,选择“用户窗体”并插入一个窗体对象。
然后,您可以使用工具箱中的各种控件在窗体上构建图形化的界面。
1.2 窗体属性设置:窗体对象有许多属性可以设置,如大小、位置、背景颜色等。
您可以通过代码来设置这些属性,也可以通过右键单击窗体并选择“属性”来直接修改属性值。
1.3 窗体样式:您可以通过设置窗体的样式属性来美化窗体的外观。
可以选择窗体的边框样式、标题栏样式、背景颜色等。
2. 控件的添加和布局控件是窗体上的各个元素,用于与用户交互和显示信息。
下面是一些控件添加和布局的技巧:2.1 添加控件:在窗体上插入控件前,您需要确保已经打开了“工具箱”窗口。
然后,您可以从工具箱中选择对应的控件,并将其拖放到窗体上。
2.2 控件属性设置:与窗体类似,控件也有一些属性需要设置。
通过代码或者属性窗口,您可以设置控件的大小、位置、字体颜色、字体大小等。
2.3 控件布局:为了使窗体看起来整洁并且易于使用,您可以使用布局控件(如分组框)将相关的控件放在一起。
另外,您还可以使用布局管理器(如表格布局管理器)来自动调整控件的位置和大小。
3. 控件的事件处理控件的事件是指当用户与控件进行交互时,所触发的特定动作。
以下是一些控件事件的处理技巧:3.1 事件的绑定:在VBA中,控件的每个事件都有一个对应的子过程。
您可以通过双击控件,或者在窗体的代码窗口中选择控件和事件,并自动生成事件处理程序的框架。
VB中,如何美化窗体界面首先新建一个EXE工程,再在窗体上拖几个Label控件,看看Label 的强大功能吧,原理就是利用Label来模拟一个按钮,但是首先要将Label控件的属性要调一下,Name:LblBtn,BorderStyle: 1,Appearance: 0,Alignment: 2,这样一个按钮的雏形就已经出来了,如果工程量很大,可以将多个Label控件的Name属性设为一样的,对于按钮的识别就要靠识别Index属性了,为了方便起见,在进入到代码编辑窗口,输入以下代码:Private Const LBL_BACK_COLOR =&HE0E0E0 ’正常时Label控件的背景色Private Const LBL_WHEN_MOUSE_MOVE =&HC0C0C0 ’鼠标移动时Label的背景色Private Const LBL_WHEN_MOUSE_DOWN =&H808080 ’鼠标按下时Label的背景色再在Form的Load事件中输入以下内容Private Sub Form_Load()Dim Count As IntegerFor Count =0 To 3 ’请将此出的3换成你的LblBtn数量的个数-1LblBtn(Count).BackColor=LBL_BACK_COLOR ’初始化LblBtn的背景Next CountEnd Sub然后再在LblBtn的MouseMove和MouseDown事件中来搞定剩余部分:Private Sub LblBtn_MouseDown(Index As Integer,Button As Integer,Shift As Integer,X As Single,Y As Single)’当鼠标按在LblBtn上时LblBtn(Index).BackColor =LBL_WHEN_MOUSE_DOWN ’临时改变LblBtn背景颜色End SubPrivate Sub LblBtn_MouseMove(Index As Integer,Button As Integer,Shift As Integer,X As Single,Y As Single)’鼠标在LblBtn上面移动时触发该事件Dim Count As IntegerDoEvents ’暂时将系统控制权教给系统If Button Then Exit Sub ’如果按钮被按下就退出该过程For Count =0 To 3If Count <> Index Then ’如果按下的不是其它按钮LblBtn(Index).BackColor =LBL_BACK_COLOR ’将背景设为正常ElseLblBtn(Index).BackColor =LBL_WHEN_MOUSE_MOVE ’将背景设为鼠标移动的背景End IfNext CountEnd SubPrivate Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)Dim Count As IntegerDoEventsFor Count=0 To 3LblBtn(Count).BackColor=LBL_BACKCOLOR ’恢复背景Next CountEnd本来利用Windows的消息系统来完成这一“艰巨”的任务最简单,可问题就来了,Label 控件没有窗口句柄怎么办?可是此问题与题无关,写了会有骗稿费之:)OK,Label控件就讲到这里,在来说说TextBox控件,各位看关恐怕看惯了白颜色的背景,那么就换换颜色以养养俺们那和绵羊一样的眼睛(为什么说绵羊?俺也不知道),可是VB提供的RGB函数弄出来的颜色不是怎么好看,这里俺来教大家一个小Tip,RGB函数的Red,Green,Blue这三个参数若一样,则产生的颜色是灰度,当然越接近白颜色越好,但也不能让各位看不出来,俺建议TextBox的背景为RGB(235,235,235),各位还是实战一下,将一个TextBox拖到窗体上,属性设置如下Appearance 0BorderStyle 1MutilLine True千万不要设置ScrollBars属性,否则会影响效果在Form的Load事件中初始化TextBoxDim bkColor As LongPrivate Sub Form_Load()bkColor=RGB(235,235,235)Text1.BackColor=bkColorEnd Sub在Form和Text1的MouseMove事件中:Private Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)Text1.BorderStyle =0End SubPrivate Sub Text1_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)DoEventsText1.BorderStyle =1End Sub在按下F5试试是不是很Cool?可能各位看关玩过石器时代,一定会对里面的TextBox的效果感到很爽,VB还不是可以做到,有焦点的控件可以使用SetFocus方法来为其设置焦点,可是一个窗体上如果控件太多了,一个一个的用SetFocus是不是太傻了?这一节的主角就是--------API函数,首先声明:Private Type POINTAPIx As Longy As LongEnd TypePrivate Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI)As LongPrivate Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long,ByVal yPoint As Long)As LongPrivate Declare Function SetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long)As Long但是这里的SetFocus会和控件的SetFocus会搞混淆,改改吧,Private Declare Function nSetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long)As Long只要Alias指向的接口是对的前面的函数名称简直就是摆设,在建立一个过程:Public Function sSetFocus()As LongDim CPos As POINTAPI,Successfull As Boolean,hWnd As LongDoEventsSuccessfull =GetCursorPos(CPos)If Not Successfull Then Exit Sub ’如果未成功则退出该过程hWnd=WindowFromPoint(CPos.x,CPos.y)sSetFocus=nSetFocus(hWnd)End Sub在窗体上放一个Timer控件,Interval 属性设为100,就是0.1秒,在Timer1控件的Timer 事件中填入sSetFocus,在运行一下看看,效果怎么样?可是有的先生小姐要问了,TextBox难道就不能用ScrollBar吗?非也非也,选工程->部件->Microsoft Windows Common Controls-2 6.0 (SP3)就是你的答案,至于卷动TextBox 就去研究SendMessage函数吧,否则又有骗稿费之嫌,如果想作绿色软件,不想用控件,可以用俺前面讲到的Label控件,利用字体Webdings 来模拟ScrollBar,需要注意的是,如果模拟ScrollBar,上下左右箭头分别是5,6,3,4,别忘了把字体设为Webdings再来讲讲窗体的美化,其实将BorderStyle属性设为0就是很好的2D美化;)可是,这样一来,问题又来了,怎么办?凡事都要请API来帮忙,这里需要两个API,一下是该API的声明:Public Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" ()As Long '这个API是用来解下鼠标的追踪器,关于他的过多用法以及详细介绍可以写信向俺咨询,还有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 ’表示非工作区左键按下原理很简单,卸下鼠标追踪器后向Form发送一个移动窗体的消息,其实做到这一点的方法很多,但俺个人认为这一种最简单,添加一个过程:Public Sub MoveForm(hWnd As Long)DoEventsReleaseCaptureSendMessage hWnd,WM_NCLBUTTONDOWN,HTCAPTION,0&End Sub在Form的MouseMove事件中:Private Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)If Button=vbLeftButton Then MoveForm hWnd’如果按下鼠标左键就移动窗体End Sub台下的这位小姐又纳闷了,可是光秃秃的窗体没有了标题栏也不好看,俺要向这为小姐推荐俺的东东-ActiveX控件,ToolSign,需要的人可以写信给俺联系,该控件需要在代码编辑区域内添加一下代码:’一下声明是用在ToolSign的AutoQuit属性的Public Const EXIT_FORCE =2 ’注意,在VB中运行的时候如果选用此退出方式,VB 也会退出Public Const EXIT_MESSAGE =1 ’由操作系统发送关闭消息Public Const EXIT_CUSTOM =Not (EXIT_FORCE Or EXIT_MESSAGE)’自定义将其注册后在部件栏中把e-Dogkid Studio Tools Sign打钩,添加到工具箱中,双击加入到窗体中,在Form的Load事件中添加一下初始化代码:Private Sub Form_Load()With Sign1.AutoQuit =EXIT_CUSTOM.ParentsHWND =hWnd ’填了此属性可以直接用ToolSign来移动窗体而不需要前面的代码End WithEnd SubSign1的Click事件Private Sub Sign1_Click()End ’关闭程序End Sub在Form的Resize事件中添加一下代码:Private Sub Form_Resize()Sign1.Width =WidthEnd Sub如果想让窗体可以改变大小,可以修改一下属性Caption ""BorderStyle 2或5ControlBox False实际情况如图不知道各位看关见过爆炸试的窗体没有?,没有见过可以从俺要另外一个俺自己的ActiveX DLL,我的那个东东其实是给我的Software作运行库的,各位若不嫌弃,可以用用,注册后在工程->引用->e-Dogkid Runtime Library然后在窗体Load事件中输入:Private Sub Form_Load()Dim System As e_Dogkid_Runtime_Library.SystemSet System =New e_Dogkid_Runtime_Library.SystemShowSystem.BoomIt hDC,60,Width,Height,Left,TopSet System =Nothing End Sub。
学习窗体美化不错的知识====================================================================================相信大家看过许多形状怪异的窗口吧?可是在VB里,系统提供的只是一个矩形的窗体。
如何在VB里实现这种异形窗体呢?其实原理很简单。
首先,在内存中构建一个想要的图形,再通过API函数将窗体设置为此形状,最后将图片放上去就可以了。
关键在于如何构建这个想要的图形。
让我们看看下面这个图:。
这张图片中既有白色,也有其他彩色,而我们想要的颜色正是除白色以外的其它颜色。
我们可以这样想:在内存中创建一幅一样大小的空的图像,然后只把我们需要的颜色(即非白色)输入内存。
这样,就可以创建出我们想要的图形了。
以上是原理,接下来介绍几个API函数。
GetPixel:获取指定对象的某个点的颜色。
定义为:Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long其中hdc为图形对象的句柄,x、y为坐标。
SelectObject:向内存中的指定地点输入图形。
定义为:Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long其中hdc为内存中图形对象的句柄,hObject为欲输入的图像。
CreateCompatibleDC:在内存中创建一个与指定对象一样的场景(可以理解为图像)。
定义为:Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long其中hdc为指定对象的句柄。
DeleteObject:删除GDI对象(在这里用来删除用完的内存中的图形)。
记住,用完后释放资源是非常重要的!定义为:Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long其中hObject为欲删除的对象。
CreateRectRgn:在内存中创建一个矩形,返回值为矩形的句柄。
定义为:Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long其中X1、Y1为矩形左上角的点坐标,X2、Y2为矩形右下角的点坐标。
CombineRgn:将两个图形结合为一个图形。
定义为:Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long其中hDestRgn为合成后的图形句柄,hSrcRgn1、hSrcRgn2为两个欲合成的图形,nCombineMode 为合成模式(包括交集部分、并集部分、并集以外部分、不相交部分,我们需要的是并集部分)SetWindowRgn:使指定窗口形状成为指定形状。
定义为:Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long其中hwnd为指定窗口的句柄,hRgn为指定图形句柄,bRedraw为选择是否立即重画窗口。
SetWindowPos:为窗口指定一个新位置和状态。
定义为:Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (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其中hwnd为目标窗口的句柄,hWndInsertAfter设置窗口的新位置,x、y设置了窗体的坐标,cx、cy设置了窗体的新大小,wFlags设置了窗口的状态。
还有一个需要的常数:RGN_OR,是CombineRgn函数的模式之中的并集模式,定义为:Public Const RGN_OR = 2为了方便,我将这些代码制作成了一个函数。
以下为代码+注释:Public Sub CreateImageForm(Form As Object, Imagebox As Object, strFile As String, BGColor As Long)'Form为目标窗体,Imagebox是放图片用的,strFile是源图片路径,BGColor是不需要的颜色Dim T As Integer '图形横坐标Dim R As Integer '图形纵坐标DoEvents '防止死机Imagebox.AutoSize = True '使图片框自动调整大小,大小为图片大小Imagebox.BorderStyle = 0 '使图片框无边框,防止边框占用图形位置Imagebox.Picture = LoadPicture(strFile) '将图片读入图片框。
图片框是用来更好的控制窗体大小Form.Width = Imagebox.WidthForm.Height = Imagebox.Height '这两行将窗体大小调整为图片框大小Imagebox.Visible = False '图片框不是让用户看的Form.Picture = Imagebox.Picture '图片框没有了,窗体就应该显示图形Form.ScaleMode = 3 '设置度量用的单位FW = Form.ScaleWidthFH = Form.ScaleHeight '将窗体内部大小赋值给变量,方便读取Dim DC As Long '内存中图形句柄Dim BMP As Long '不知道是什么句柄Dim rgn As Long '临时用的矩形的句柄Dim rgnTotal As Long '欲得到的图形句柄Dim SX As Long '搜索用的变量DC = CreateCompatibleDC(Form.hdc) '创建一个与目标窗体一样大的内存图形空间BMP = SelectObject(DC, LoadPicture(strFile)) '将图形放入刚刚创建的空间中rgnTotal = CreateRectRgn(0, 0, 0, 0) '初始化目标图形For T = 0 To FW '逐行搜索R = 0: Do '搜索前横坐标归零While GetPixel(DC, T, R) = BGColor And R <= FH '当找到需要留下的点后退出搜索R = R + 1WendSX = R '记录下此行所需部分开始的点坐标While GetPixel(DC, T, R) <> BGColor And R <= FH '当找到需要要除去的点后退出搜索 R = R + 1WendIf SX <= R - 1 Then '此时R-1为此行所需部分结束的点坐标rgn = CreateRectRgn(T, SX, T + 1, R) '创建这一行中刚才搜索到的矩形CombineRgn rgnTotal, rgnTotal, rgn, RGN_OR '将刚才创建的矩形并入目标图形中 DeleteObject rgn '销毁临时用的小矩形,以释放系统资源(重要)End IfLoop Until R >= FH '此行结束后进入下一个搜索循环Next TSetWindowRgn Form.hwnd, rgnTotal, True '将目标窗体形状设置为已经创建好的图形SetWindowPos Form.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW'将目标窗体设置在所有窗口的最顶层,且不能移动、不能改变大小End Sub最后,还需要注意:有时图片里在需要的部分中也会出现背景颜色(比如说一幅白花的图,背景为白色),此时直接用本函数会造成需要的图片不能完整出现。
怎么办呢?这是你需要准备一张底图。
所谓底图,即只有两种颜色(最好是这样),一种是背景,一种是需要的图的部分。
如上面例子的图的背景图为:。
可以用PS快速地做好背景图。
程序中的操作有所更改,使用函数时用的图应该是背景图,然后在窗体的代码中加一句:Me.Picture = LoadPicture("******") '其中"******"为原图片好,完成了。
PS:囧……写了我半天……再PS:某A等不玩程序的同志们,看了此文莫PIA……。