走近VB.Net(十一) 随心所欲窗体外观(skin精彩源码)

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

             走近VB.Net(十一随心所欲窗体外观skin精彩源码
             前几天因为应付约稿,答应的这个源码推迟了几天,今天熬夜把他写出来,请见谅。另外我想说一些题外话,前时我曾在文章中说过,说VB.Net的面向对象抄袭java,delphi没有实际根据(你总不能把面象对象理解成linux核心一样的源码技术,他主要还是一种指导思想),这句话本身就有了逻辑性的错误,请问java与delphi是谁抄谁呢?答案只能是SmallTalk的面向对象更早(见王国荣的文章)。 VC的面向对象大家闭口不提,然而我个人认为在windows编程上(不包括网络应用)VC仍是最强大的语言,而VC的程序员几乎没有人出来说这些无聊的话。那么是谁在说呢......

           这个说法最早源于国外的文章(指在网络应用上有涉嫌模仿Java,如果是编写windows程序则毫无根据),而作者在后来的撰文中很清楚的告诉大家纠正此说法。我也一再提到过。可有 人视若无睹。大家现在就说VB.Net如何如何太早了一点,我们都是在实践摸索,用都不会用,就毫无根据的揣测有些不智。很多学java的告诉你先学java再学VB.Net.这有些不可思议,起码到目前,没有看到java程序员写出我们可以拿来学的VB.Net程序。因为有了面象对象的思想不等于有了一切。

           现在面向对象真有些神化了,这不可思议,程序员不是哲人,是要通宵达旦的工作学习创造,好象一点也不浪漫!而现在竟被一部分人浪漫了。

           不论微软如何的称颂他的网络功能,我相信在不久的将来,VB.Net必将成为最快速,最重要,也最适用windows平台的应用程序编程语言(我没有涉及网络应用)。当然决不可能是最强大的,这世界好象没有谁最强大!而且我对他的网络应用不感兴趣。每个人都有自已的路。正如大家都说VB如何的适宜于开发数据库。但是你相不相信一个人从不接触数据库可以写出让人很看好的程 序,每个人有权利选择自已的路! 如果你对网络应用毫无兴趣,java还会是一个好的选择吗?

           我个人认为无论是java,delphi,还是VB.Net甚至C++,各有各的长处。各有各的用途。无优劣之分,编程最重要的是灵感,是广博的视野,是宽大的襟怀。任何想贬低别人的人,正暴露自已的浅见与无知。我虽然是学VB的,但我在进入delphi的论坛以后,我亦为之感动,这里也有很多兢兢业业,无私奉献的值得尊敬与学习的人。工具永远不能征服人性!外国人没有因这纸是中国人造的而不用,亦没有因火药是中国人发明的而羞愧,也没有因这二进制的起源于中国而牢骚,科学是跨越国界的,不应被蒙上政治色彩。

     我曾在一个专门介绍比尔盖茨的网站看了一下他的生平,想来看过的人不少。看了他一生的奋斗历程,我们还能说什么呢?

            以上是个人的浅见(鉴于本人对delphi,java的无知,对VB.Net的初识以及对面象对象技术的部分误解),只是谈谈感受,请勿借题发挥,大作文章。我写这些是防止一些错得离谱的歪论误导初学者。另外我一再鼓励大家研究一下,弄出一些实际的心得来。我因为自身的限制与没有相互的研讨,所以每一篇文章写出来所付出的努力不亚于写一个工程。所以请转载文章的在跟我联系以后 在文中明确按本文结尾处样式注明我的网站名,网址 。这里先向您致谢了!

     另外鉴于一些初学者的要求,以及前辈的指点,我在源码中对入门级的知识进行了注解,如果您认为这些对您是多余的,请谅解还有很多人看不懂。   

'  本源码出自VB.Net中文站 VBNetcn.126.com">http://VBNetcn.126.com  hejianzhong 请尊重作者劳动不要修改此信息(ai.....................)

'  ___________________________________________________________________________________________________________________

'  -------------------------------------------------------------------------------------------------------------------

'  请首先清添加lable(lbExit,lbPre,lbShow)控件

'  请在属性栏设置这三个lable控件的BackColr(背景色)为system.desktop 即在出现的取色对话框中选择system标签下的desktop颜色

'  下一步,添加AxAgent控件这个请参考拙作《走近VB.Net(九) AxAgent动画窗体的实现》

'  设置窗体背景图片为SK1.GIF 请在  BackgroundImage 属性栏设置  

'  所有需要的图片用photoshop做出来,如果你不会做可到《VB.Net中文论坛》去找我帮你做。

'  设置lbExit的Text属性(指在标签上显示的文本)为“退出”

'  设置lbPre的Text属性(指在标签上显示的文本)为“窗体”

'  设置lbShow的Text属性(指在标签上显示的文本)为“动画”

'  设置所有label的 TextAlign(文本的排列方式)为center(居中)

 

Option Strict Off '关闭Option Strict

Imports System.ComponentModel '引用族名

Imports System.Drawing '引用族名

Imports System.WinForms '引用族名

 

Public Class Form1

    Inherits System.WinForms.Form '继承一个窗体的类

    Dim Genie As AgentObjects.IAgentCtlCharacterEx '声明一个agent的对象

    Const DATAPATH As String = "MERLIN.ACS" '加载动画数据

    Public frmpre As Form1 '声明一个新的窗体,请不要在这里使用初始化的方法或使用New方法

    Public Imindex As Short '声明一个整数

    Public Overloads Sub New() '每一个类一般都有一个new过程,在新建一个对象(使用new方法)时调用

        MyBase.New() '直接调用父类的new过程

        Form1 = Me '设定me关键字

        InitializeComponent() '下面是初始化组件,你也可以在下面使用call方法呼叫一个子过程(见前面的文章)

        axAgent1.Characters.Load("MERLIN", DATAPATH) '装载动画数据

        Genie = axAgent1.Characters("MERLIN") '把Agent对象赋于声明的对象,简化书写的过程

        Genie.LanguageID = &H409S '设定语音ID

        Call skinRegion(form1) '为窗体改变skin(外观)

    End Sub

    Overloads Sub new(ByVal strImage As String)

        MyBase.New() '直接调用父类的new过程

        Form1 = Me '设定me关键字

        InitializeComponent() '下面是初始化组件,你也可以在下面使用call方法呼叫一个子过程(见前面的文章)

        lbExit.Visible = False : lbShow.Visible = False : lbpre.Visible = False : label3.Visible = False '新窗体不显示控制

        Me.top = Me.top + 150 '新窗体的位置,top是距离屏幕顶部的高度

        Call skinRegion(form1, strImage) '为窗体改变skin(外观)

    End Sub

    '上面使用overloads定义了两个不同的new过程,在new过程中使用重载可以间接地使一个类产生很好的可重用性,如果你不明白为什么不写一个新的过程,而一定要使用重载

    '那么你看看这里的用法,一定会有所启发的。

    Public Overrides Sub Dispose() '释放资源,终止程序

        MyBase.Dispose() '调用父类的方法

        Region1.Dispose() '释放GDI资源

        genie = Nothing '释放动画占用的资源

        components.Dispose() '释放组件占用的资源

    End Sub

     '下面的是非编辑模块,就不用看了

#Region " Windows Form Designer generated code "

   

    'Required by the Windows Form Designer

    Private components As System.ComponentModel.Container

    Private WithEvents lbShow As System.WinForms.Label

    Private WithEvents Label3 As System.WinForms.Label

    Private WithEvents LinkLabel3 As System.WinForms.LinkLabel

    Private WithEvents lbExit As System.WinForms.Label

    Private WithEvents lbpre As System.WinForms.Label

    Private WithEvents AxAgent1 As AxAgentObjects.AxAgent

    Dim WithEvents Form1 As System.WinForms.Form

    'NOTE: The following procedure is required by the Windows Form Designer

    'It can be modified using the Windows Form Designer. 

    'Do not modify it using the code editor.

     Private Sub InitializeComponent()

       Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))

       

        Me.components = New System.ComponentModel.Container()

        Me.lbpre = New System.WinForms.Label()

        Me.lbShow = New System.WinForms.Label()

        Me.Label3 = New System.WinForms.Label()

        Me.AxAgent1 = New AxAgentObjects.AxAgent()

        Me.LinkLabel3 = New System.WinForms.LinkLabel()

        Me.lbExit = New System.WinForms.Label()

       

        AxAgent1.BeginInit()

       

        '@design Me.TrayHeight = 90

        '@design Me.TrayLargeIcon = False

        '@design Me.TrayAutoArrange = True

        lbpre.Location = New System.Drawing.Point(32, 72)

        lbpre.Text = "窗体"

        lbpre.Size = New System.Drawing.Size(64, 24)

        lbpre.TabIndex = 10

        lbpre.BackColor = System.Drawing.SystemColors.Desktop

        lbpre.TextAlign = System.WinForms.HorizontalAlignment.Center

       

        lbShow.Location = New System.Drawing.Point(32, 24)

        lbShow.Text = "动画"

        lbShow.Size = New System.Drawing.Size(64, 24)

        lbShow.TabIndex = 17

        lbShow.BackColor = System.Drawing.SystemColors.Desktop

        lbShow.TextAlign = System.WinForms.HorizontalAlignment.Center

       

        Label3.Location = New System.Drawing.Point(176, 16)

        Label3.Text = " "

        Label3.Size = New System.Drawing.Size(176, 88)

        Label3.BorderStyle = System.WinForms.BorderStyle.Fixed3D

        Label3.TabIndex = 16

       

        AxAgent1.Size = New System.Drawing.Size(56, 40)

        AxAgent1.OcxState = CType(resources.GetObject("AxAgent1.OcxState"), System.WinForms.AxHost.State)

        AxAgent1.TabIndex = 1

        AxAgent1.Location = New System.Drawing.Point(232, 216)

       

        LinkLabel3.Text = "LinkLabel3"

        LinkLabel3.Size = New System.Drawing.Size(0, 16)

        LinkLabel3.TabIndex = 15

        LinkLabel3.TabStop = True

        LinkLabel3.Location = New System.Drawing.Point(352, 88)

       

        lbExit.Location = New System.Drawing.Point(32, 48)

        lbExit.Text = "退出"

        lbExit.Size = New System.Drawing.Size(64, 24)

        lbExit.TabIndex = 11

        lbExit.BackColor = System.Drawing.SystemColors.Desktop

        lbExit.TextAlign = System.WinForms.HorizontalAlignment.Center

       

        Me.Text = "Form1"

        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)

        Me.BorderStyle = System.WinForms.FormBorderStyle.None

        Me.BackgroundImage = CType(resources.GetObject("$this.BackgroundImage"), System.Drawing.Image)

        Me.ClientSize = New System.Drawing.Size(392, 288)

       

        Me.Controls.Add(lbShow)

        Me.Controls.Add(Label3)

        Me.Controls.Add(LinkLabel3)

        Me.Controls.Add(lbExit)

        Me.Controls.Add(lbpre)

        Me.Controls.Add(AxAgent1)

       

        AxAgent1.EndInit()

    End Sub

   

#End Region

    '上面的是非编辑模块,就不用看了

    Protected Sub lbExit_Click(ByVal sender As Object, ByVal e As System.EventArgs)

        If frmpre <> Nothing Then '如果加载了新窗体

            frmpre.Dispose() '终止新窗体

            frmpre = Nothing '释放占用的资源

        End If

        Me.Dispose() '终止程序

        End  '彻底终止程序(如果程序无法退出,请使用此关键字)

    End Sub

   

   

    '下面是动画过程,在前面的文章中很详细,可以不用看了!

    Protected Sub lbshow_Click(ByVal sender As Object, ByVal e As System.EventArgs)

        genie.Left = 500 '设定agent的位置

        Genie.Show() '使用show方法显示agent

        genie.MoveTo(12, 180) 'moveto方法是移动agent到一个位置,如果加上定时器,你可以很容易地让他在屏幕上 乱跑()

        messagebox.Show("如果你是MM,请按Ctrl+Alt+Del关闭 " & chr(10) & chr(13) & "您真的要继续吗, 等到我不 动再说!")

        Genie.Speak("ni hao") '发出声音

        messagebox.Show("你好") '对话框,更多的参数请看以前的相关文章

        Genie.Speak("WO SHI HAO KAN DI") '发出声音

        messagebox.Show("我是好看的") '对话框,更多的参数请看以前的相关文章

        Genie.Speak("NI SHI NAN KAN DI") '发出声音

        messagebox.Show("你是难看的") '对话框,更多的参数请看以前的相关文章

        Genie.Speak("ZIA JIE MIMI  ") '发出声音

        messagebox.Show("再见 MM") '对话框,更多的参数请看以前的相关文章

        genie.Play("Wave") '挥手致意

        '众MM请勿生气

        '上面是开一个小玩笑,如果要真正的读中文,就用下面的

        'Genie.Speak("CNstring ",CNstring.wav) '这里的CNstring就是中文的语音文件

        genie.Hide() '使用hide方法隐藏agent

    End Sub

   

    Protected Sub lbpre_Click(ByVal sender As Object, ByVal e As System.EventArgs)

        If frmpre <> Nothing Then frmpre.Dispose() '如果新窗体已经存在,清除之

        Dim strIm As String '定义一个字符类型变量

        If Imindex <> 6 Then '反过来想,就是说如果到了6就从头开始,因这我只有这么几张图片了

            imindex = Imindex + 1

        Else

            IMINDEX = 1 '从头开始

        End If

        strIm = "SK" & imindex.ToString 'tostring的意思是从字符类型转为数字类型

        '在VB.Net中label控件有image控件一样的作用,不但可以显示文本而且可以显示图片,而在VB6中是只能显示图片的

        Label3.image = label3.Image.FromFile(System.WinForms.Application.StartUpPath & "" & strim & ".GIF") 'formfile是从一个路径装载图片

        'System.WinForms.Application.StartUpPath的意思是当前目录,同VB6中的App.Path

        '请注意调试过程中使用的当前目录是在bin目录下,在下一个版本有可能更改

        frmpre = New form1(strim) '初始化一个实例(对象)

        frmpre.Visible = True '显示新窗体,如果没有这个只怕你什么也看不到!

    End Sub

   

   

   

    '下面是移动窗体的代码,请参考前面的文章

    Private Sub Form1_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.WinForms.MouseEventArgs)

        Me.Capture = False '释放鼠标捕获

        Me.SendMessage(&HA1S, 2, 0) '这是VB6中最有名的API消息函数

    End Sub

    '下面是鼠标移动_MouseMove时发生的事件了

    Public Sub lbpre_MouseMove(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbpre.MouseMove

        lbpre.BackColor = system.drawing.Color.Black '设置颜色

        lbpre.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    Public Sub lbExit_MouseMove(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbExit.MouseMove

        lbExit.BackColor = system.drawing.Color.Black '设置颜色

        lbExit.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    Public Sub lbshow_MouseMove(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbshow.MouseMove

        lbshow.BackColor = system.drawing.Color.BLack '设置颜色

        lbshow.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    '下面是鼠标按下_MouseMove时发生的事件了

    Public Sub lbpre_MouseDown(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbpre.MouseDown

        lbpre.BackColor = system.drawing.Color.Blue '设置颜色

        lbpre.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    Public Sub lbExit_MouseDown(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbExit.MouseDown

        lbExit.BackColor = system.drawing.Color.Blue '设置颜色

        lbExit.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    Public Sub lbShow_MouseDown(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbShow.MouseDown

        lbshow.BackColor = system.drawing.Color.Blue '设置颜色

        lbshow.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

   

    Public Sub lbpre_MouseUp(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbpre.MouseUp

        lbpre.BackColor = system.drawing.Color.Black '设置颜色

        lbpre.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    Public Sub lbExit_MouseUp(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbExit.MouseUp

        lbExit.BackColor = system.drawing.Color.Black '设置颜色

        lbExit.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    Public Sub lbShow_MouseUp(ByVal sender As Object, ByVal e As System.WinForms.MouseEventArgs) Handles lbShow.MouseUp

        lbshow.BackColor = system.drawing.Color.BLack '设置颜色

        lbshow.ForeColor = system.Drawing.Color.AliceBlue '设置颜色

    End Sub

    '下面是鼠标离开_MouseLeave时发生的事件了

    Public Sub lbShow_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles lbShow.MouseLeave

        lbshow.BackColor = system.drawing.Color.BlanchedAlmond '设置颜色

        lbshow.ForeColor = system.Drawing.Color.Black '设置颜色

    End Sub

    Public Sub lbExit_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles lbExit.MouseLeave

        lbExit.BackColor = system.drawing.Color.BlanchedAlmond '设置颜色

        lbExit.ForeColor = system.Drawing.Color.Black '设置颜色

    End Sub

    Public Sub lbpre_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles lbpre.MouseLeave

        lbpre.BackColor = system.drawing.Color.BlanchedAlmond '设置颜色

        lbpre.ForeColor = system.Drawing.Color.Black '设置颜色

    End Sub

End Class

 

'###################################################################################################################

'!!!0001!!!04!!!26!!!!!!

'建议不要修改此模块 以免产生不必要的错误(此代码已相当完美) 如欲修改请先备份  _______VB.Net中文站 hejianzhong

'此模块可真接粘贴到您的程序中使用。

'不要删除此信息,我免费为您提供此代码,想得到的回报就是最起码的尊重,虽然最终用户并不能看到,我仍感到欣慰

'!!!0001!!!04!!!26!!!!!!

Public Module skin

    Public Rect1 As New Rectangle(0, 0, 0, 0)

    Public Region1 As New System.Drawing.Region(Rect1)

    Public Sub skinRegion(ByVal SKform As Form, Optional ByVal skinNaSKform As String = Nothing)

        Dim X, Y, transPix, opaciPix, BgWidth, BgHeight As Integer

        Dim rect2 As New Rectangle()

        Dim FirARGB As Integer = getpixel(SKform, 1, 1)

        Dim Region1 As New System.Drawing.Region(Rect1)

        Rect1 = Nothing

        'SKform.Visible = False 

        If skinnaSKform <> Nothing Then SKform.BackgroundImage = SKform.BackgroundImage.FromFile(System.WinForms.Application.StartUpPath & "" & skinNaSKform & ".gif")

        BgWidth = SKform.BackgroundImage.Width

        BgHeight = SKform.BackgroundImage.Height

        SKform.Height = BgHeight

        SKform.Width = BgWidth

        For Y = 1 To BgHeight - 1 '这里参考了VB6中的扫描方法,请参考相关资料

            X = 0

            Do

                X = X + 1

                While (getpixel(SKform, X, Y) = FirARGB) And (X < BgWidth)

                    X = X + 1

                End While

                transPix = X

                While (getpixel(SKform, X, Y) <> FirARGB) And (X < BgWidth)

                    X = X + 1

                End While

                opaciPix = X - 1

                If transPix <= opaciPix Then

                    rect2 = rect2.FromLTRB(transPix - 1, Y - 1, opaciPix, Y)

                    Region1.Union(rect2)

                    rect2 = Nothing

                End If

            Loop Until X >= BgWidth

        Next Y

        SKform.Region = Region1

        SKform.Refresh()

        'SKform.Visible = True 

    End Sub

    Public Function Getpixel(ByVal SKform As Form, ByVal x As Integer, ByVal y As Integer) As Integer

        Dim pm As Bitmap = SKform.BackgroundImage

        Try

            Return pm.GetPixel(x, y).ToARGB

        Catch

            Exit Function

        End Try

    End Function

End Module

'###################################################################################################################

                                             

 VB.Net中文站下载skinform源码示例 190K (请到VB.Net论坛索取免费解压密码)

                                                                  VBNetcn.126.com">http://VBNetcn.126.com


 

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页