soft1.htm

根据图像生成数据

'记录结束位置<br>
Ma.Ex = x<br>
'记录区域的块数<br>
n = n + 1<br>
'记录区域的Y轴的开始位置<br>
Ma.Sy = y<br>
'因为矩形区域是线形的，所以Y轴的结束位置是在开始<br>
'的Y轴加上1<br>
Ma.Ey = y + 1<br>
'把所测到的窗体数据存放入数据文件<br>
Put #1, n, Ma<br>
'变量化0<br>
Ma.Sx = 0<br>
Ma.Ex = 0<br>
Ma.Ey = 0<br>
Ma.Sy = 0<br>
End If<br>
Next x<br>
Next y<br>
'提示完成图像扫描<br>
MsgBox &quot;完成图像扫描&quot; &amp; Chr(13) &amp; &quot;数据文件大小为：&quot; 
&amp; LOF(1) &amp; &quot;字节&quot;<br>
<br>
'关闭文件<br>
Close #1<br>
End Sub<br>
<br>
Private Sub 背景色_Click(Index As Integer)<br>
'设置背景色<br>
'将打上选择的符号取消<br>
For i = 0 To 15<br>
背景色(i).Checked = False<br>
Next<br>
'将被子点击到的选项加上符号<br>
背景色(Index).Checked = True<br>
'背景色的号码为<br>
颜色 = Index<br>
End Sub<br>
<br>
Private Sub 关闭_Click()<br>
'关闭生成器程序<br>
Unload Me<br>
End Sub<br>
<br>
'加载图像的设置<br>
'通用型对话框控件属性Flags为&amp;H1001<br>
'Filter为图像文件 *.bmp,*.jpg,*.gif,*.ico，*.wmf等<br>
'将通用型对话框控件属性ComcelError 设为True<br>
<br>
Private Sub 加载图像_Click()<br>
'当在对话框上按下取消时，不加载图像<br>
On Error GoTo Er<br>
' 设置打开文件的类型<br>
CommonDialog1.Filter = &quot;位图(*.bmp),Jpg文件|*.bmp;*.jpg&quot;<br>
CommonDialog1.ShowOpen<br>
'把图像加载到窗体和图片框上<br>
Picture1.Picture = LoadPicture(CommonDialog1.FileName)<br>
Form1.Picture = Picture1.Picture<br>
Er:<br>
End Sub<br>
<br>
运行这个程序，单击“开始”菜单，该程序就会扫描图像，并且生成了一个区域描数据文件---D:\ma.dat。下面就可以用这个文件来生成不规则窗体了。</p>

<p><strong><font size="4">建立一个</font><font color="#FF0000" size="4">新</font><font
size="4">工程</font></strong>，只要窗体加载扫描的图像把窗体的大小调到和图像一这大小就可以，并把BorderStyle 
设置为0 'None。只要程序一运行，窗体立既变成不规则的。不过数据文件要在这个新工程同个目录中。</p>

<p>'在程序中加入模块Module1.bas，在模块中输入代码为：</p>

<p>'声明API函数<br>
'Createrectrgn为创建一个由点X1，Y1和X2，Y2描述的矩形区域<br>
'因为窗体是由一个个矩形组成的<br>
Public Declare Function CreateRectRgn Lib &quot;gdi32&quot; (ByVal X1 As Long, ByVal Y1 As 
Long, ByVal X2 As Long, ByVal Y2 As Long) As Long<br>
'Combinergn将两个区域组合为一个新区域<br>
'把一个个矩形合为一个新的区域<br>
Public Declare Function CombineRgn Lib &quot;gdi32&quot; (ByVal hDestRgn As Long, ByVal 
hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long<br>
'做一个古怪的窗口必须要用的也是那个程序中最重要的一个函数就是SetWindowRgn<br>
'它的功能就是对指定的窗口进行重画，把这个窗口你选择的部分留下<br>
'其余的部分抹掉。<br>
'参数：hWnd：你所要重画的窗口的句柄，比如你想重画form1<br>
'则应该让此参数为form1.hWnd<br>
' hRgn：你要保留的区域的句柄，这个句柄是关键，你需要通过别的渠道来获得<br>
'在这里的区域是由Combinergn合成的新区域<br>
' bRedram：是否要马上重画，一般设为true<br>
Public Declare Function SetWindowRgn Lib &quot;user32&quot; (ByVal hWnd As Long, ByVal 
hRgn As Long, ByVal bRedraw As Boolean) As Long<br>
'用这个函数删除GDI对象，比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放<br>
Public Declare Function DeleteObject Lib &quot;gdi32&quot; (ByVal hObject As Long) As Long<br>
<br>
Type Dat '自定义类型<br>
'为了和坐标配合，把变量设置为整数型<br>
sx As Integer '存扫描头次遇到非背景色的X坐标<br>
ex As Integer '存扫描非背景色结束的X坐标<br>
sy As Integer 'Y坐标的开始<br>
ey As Integer 'Y坐标的结束<br>
End Type<br>
<br>
<br>
’在窗体中输入的代码为:</p>

<p>'鼠标位置的变量<br>
Dim mX As Integer<br>
Dim mY As Integer<br>
'rgn1 和 rgn2 是存放区域的变量<br>
<br>
Private Sub Form_Load()<br>
<br>
Dim Ma As Dat<br>
Show<br>
'打开不规则窗体的数据文件，随机文件方式<br>
'****注意&quot;MA.dat&quot;要在本程序的目录内***<br>
'不然App.Path要改为&quot;Ma.dat&quot;所在的目录<br>
'如果找不到窗体数据有可能窗体会看不到<br>
Open App.Path &amp; &quot;\Ma.dat&quot; For Random As #1 Len = Len(Ma)<br>
'循环读取 Ma.dat 的数据<br>
'只要遇到文件尾结束读取数据<br>
Do While Not EOF(1)<br>
'N 为读取数据的数据指针<br>
n = n + 1<br>
'读取第n个<br>
Get #1, n, Ma<br>
'rgn1区域变量没有存放区域数据时，存放头个矩形区域<br>
If rgn1 = 0 Then rgn1 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)<br>
'rgn1变量以有存放数据时，把其它矩形区域数据存放在rgn2中<br>
If rgn1 &lt;&gt; 0 Then<br>
rgn2 = CreateRectRgn(Ma.sx, Ma.sy, Ma.ex, Ma.ey)<br>
'把两个矩形区域合成一个并存放在rgn1中<br>
CombineRgn rgn1, rgn1, rgn2, 2<br>
'释放系统资源<br>
DeleteObject rgn2<br>
End If<br>
Loop<br>
'关闭文件<br>
Close #1<br>
'生成窗体数据文件所设置成的窗体<br>
'创建不规则窗体------“完工”。<br>
'一个绝世的窗体降临 ^_^ ,在你的手中创生<br>
SetWindowRgn hWnd, rgn1, True<br>
DeleteObject rgn1<br>
End Sub<br>
<br>
'***********************************************<br>
'以下程序是为了窗体少的标题栏没法移动窗体,<br>
'所设计的与不规则窗体 没有大关系的程序----窗体移动<br>
'*********************************<br>
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)<br>
'当鼠标单击按下时,把当前鼠标的位置存放在变量<br>
'左钮单击<br>
If Button = 1 Then<br>
mX = X '存放X轴<br>
mY = Y<br>
End If<br>
End Sub<br>
<br>
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)<br>
'当鼠标单击后移动时,窗体跟着移动<br>
If Button = 1 Then<br>
Form1.Move Form1.Left - mX + X, Form1.Top - mY + Y<br>
End If<br>
End Sub<br>
'********************************<br>
<br>
'注：由于窗体移后会留下影子，这可能是正常现象<br>
'由有什么意见请来信 [e-mail]<br>
'记住---我永远是你的朋友 XXLno2</p>

<p>现在，程序完工了，点一下“运行”，只要你的图像做得好，那你的窗体就会变得很好看。如果你是游戏玩家的话，把电玩里面的东西变成窗体时，那会怎么样呢？星际的“小狗”怎样？</p>

<p>我等侍你的好消息，把你的窗体都变成世上的绝品吧！！！！ 
》》》》》<a href="soft2.htm">下载源程序</a></p>

<p>　</p>

<p>作者：<a href="mailto:[e-mail]">XXLno2</a></p>

<p>　</p>

<p><a href="http://xxlno2vb.yeah.net">小亮VB天地</a>版权所有 有什么问题请<a
href="mailto:[e-mail]">与我联系</a></p>
</body>
</html>