注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

糊涂小妹

一个矫情到不行的文艺小青年

 
 
 

日志

 
 

窗体设计的几段代码,不得不留  

2014-04-10 20:56:45|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
vb特殊窗体
设计字形窗体

代码如下,可产生文字窗体:

Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load()
Dim hRgn As Long
Me.Height = 5265
Me.Left = 0
Me.Top = 0
Me.Width = 10200

With Me
  .BackColor = QBColor(3)
  .Font.Name = "隶书"
  .Font.Size = 250
End With
'在窗体上产生"窗体"字路径
BeginPath Form1.hdc
TextOut Form1.hdc, 0, 0, "紫色", 6
EndPath Form1.hdc
'将所产生的路径转换为区域
hRgn = PathToRegion(hdc)
'设置窗体形状为转换成的区域
SetWindowRgn hwnd, hRgn, 1
'删除对象,释放系统资源
DeleteObject hRgn
End Sub

2.椭圆形窗体

代码如下:

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load()
Show
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
End Sub

3.使窗体始终保持在最上层

代码如下:

Option Explicit
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) As Long
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40

Private Sub Form_load()
Dim retValue As Long
retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOW)
End Sub

4.创建一个背景具有渐变效果的窗体

很炫的,代码如下:

Private Sub Gradient(TheObject As Object, Redval, Greenval, Blueval)
Dim Step, i, T, L, R, B
Step = (TheObject.Height / 60)
T = 0
L = 0
R = TheObject.Width
B = T + Step
'使用循环在窗体上从上至下依次绘制60个矩形
For i = 1 To 60
TheObject.Line (L, T)-(R, B), RGB(Redval, Greenval, Blueval), BF
Redval = Redval - 4
Greenval = Greenval - 4
Blueval = Blueval - 4
If Redval <= 0 Then Redval = 0
If Greenval <= 0 Then Greenval = 0
If Blueval <= 0 Then Blueval = 0
T = B
B = B + Step
Next
End Sub

Private Sub Form_Resize()
Gradient Form1, 0, 0, 255
End Sub



  评论这张
 
阅读(49)| 评论(12)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017