我们知道，通常WINDOWS的窗体大都是矩形的。当然也可以使用API函数制作椭圆型的、三角型的窗体，还可以制作图片窗体。下面我给大家介绍一种制作文字、字符窗体的方法，希望能对大家有所帮助。
要想制作文字窗体就要用到WINDOWS的几个API函数，首先我们来看看这几个函数的功能：
1、 GetPixel (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) 函数
函数功能：取得一个像素的RGB值
参数：hdc ，设备场景的句柄
x,y ，逻辑坐标中的点
2： CreateRectRgn (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
函数功能：创建一个由点X1，Y1和X2，Y2描述的矩形区域
参数：x1,y1，矩形左上角X，Y坐标
x2,y2，矩形右下角X，Y坐标
3：Private 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，源区域1
hSrcRgn2，源区域2
nCombineMode，合并模式
4：Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
函数功能：设置窗口的区域
参数：hWnd ，窗口句柄
hRgn，将设置的区域的句柄
bRedraw ，是否立即重画窗口
在文字窗体的设计中应当先是选定一种屏蔽色作为窗体的背景色（当然这种颜色应当是窗体
图形中所没有的颜色），然后利用了一个字符数组，将设计好的图形存储在里面，之后将图形输
出在窗体上。最后用GetPixel函数扫描窗体上已经输出字符的区域，将窗体上与屏蔽色不同的区
域标记出来，并且用CreateRectRgn函数创建成矩形区域，再将它们用CombineRgn函数合并成一
个区域，之后用SetWindowRgn函数设置窗体区域并生成窗体。
属性设置：新建一个窗体（CAPTION->"制作文字窗体";NAME=FORM1;AUTOREDRAW->TRUE;
SCALEMODE->1;BACKCOLOR->屏蔽色)窗体字体和前景色可根据需要设置,也可以在代码中设置。
以下是程序源代码：
------------- API函数声明---------------------
Option Explicit
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreateRectRgn 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
-------------常量-------------
Const RGN_OR = 2
------------- 变量-------------
Dim oldx As Integer
Dim oldy As Integer
Dim rgn As Long
Dim MaskColor As Long
Private Sub Form_Load()
MaskColor=Form1.BackColor
CreateForm
End Sub
'-------生成文字窗体-------
Public Sub CreateForm()
Const max = 5 '字符行数即窗体图形数组的最大值
Dim graphics(max) As String '存储窗体图形
Dim X As Long
Dim Y As Long
Dim count As Long '相同像素数
Dim curpixels As Long '当前检查像素
Dim temp As Long
Dim textheight As Long '扫描区域的高度
Dim textwidth As Long '扫描区域的宽度
Dim i As Integer
Dim maxwidth As Long '窗体的最大宽度
Me.CurrentX = 0
Me.CurrentY = 0
'-------初始化窗体图形，可根据自己的需要设计出多种样式-------------
graphics(0) = " ★"
graphics(1) = " ★★"
graphics(2) = " ◎▲◎"
graphics(3) = " ★★★★"
graphics(4) = " ★■■■★"
graphics(5) = "哈哈文字窗体 "
'--------输出窗体图形------------
maxwidth = Me.textwidth(graphics(0))
For i = 0 To max
If Me.textwidth(graphics(i)) >= maxwidth Then
maxwidth = Me.textwidth(graphics(i))
End If
textheight = textheight + Me.textheight(graphics(i))
'-----设置图形颜色-----------
If i Mod 2 = 0 Then
Me.ForeColor = vbBlue
Else
Me.ForeColor = vbRed
End If
Me.Print graphics(i)
'-----根据文字大小自动缩放窗体------
If Me.Height < textheight Then
Me.Height = textheight + 500
End If
If Me.Width < maxwidth Then
Me.Width = maxwidth + 500
End If
Next i
textheight = Int(textheight / 15)
textwidth = Int(maxwidth / 15)
RGN = CreateRectRgn(0, 0, 0, 0) '创建空区域
For Y = 0 To textheight - 1
count = 0
For X = 0 To textwidth - 1
curpixels = GetPixel(Form1.hdc, X, Y)
If X >= textwidth - 1 And count > 0 Then
temp = CreateRectRgn(X + Int((Me.Width - Me.ScaleWidth) \ 30) - count, Y + Int((Me.Height - Me.ScaleHeight) \ 15) - Int((Me.Width - Me.ScaleWidth) \ 30), X + Int((Me.Width - Me.ScaleWidth) \ 30), Y + Int((Me.Height - Me.ScaleHeight) \ 15) - Int((Me.Width - Me.ScaleWidth) \ 30) + 1) '创建区域
CombineRgn RGN, RGN, temp, RGN_OR '合并两个区域
DeleteObject temp
End If
If curpixels <> MaskColor Then
count = count + 1
Else
If count > 0 Then
temp = CreateRectRgn(X + Int((Me.Width - Me.ScaleWidth) \ 30) - count, Y + Int((Me.Height - Me.ScaleHeight) \ 15) - Int((Me.Width - Me.ScaleWidth) \ 30), X + Int((Me.Width - Me.ScaleWidth) \ 30), Y + Int((Me.Height - Me.ScaleHeight) \ 15) - Int((Me.Width - Me.ScaleWidth) \ 30) + 1)
CombineRgn RGN, RGN, temp, RGN_OR
DeleteObject temp
End If
count = 0
End If
Next X
Next Y
SetWindowRgn Me.hwnd, RGN, True '设置窗体区域
End Sub
Private Sub Form_DblClick()
End
End Sub
'-----移动窗体代码------
Private Sub form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
oldx = X
oldy = Y
End If
End Sub
Private Sub form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X <> oldx Or Y <> oldy Then
Form1.Left = Form1.Left + (X - oldx)
Form1.Top = Form1.Top + (Y - oldy)
End If
End If
End Sub
|
