showbitmap.vb

Programming the .NET Compact Framework with vb 源代码

' ShowBitmap.vb - Main form for ShowBitmap program, which
' demonstrates several ways to create and display bitmaps.
'
' Code from _Programming the .NET Compact Framework with C#_
' and _Programming the .NET Compact Framework with VB_
' (c) Copyright 2002-2003 Paul Yao and David Durant. 
' All rights reserved.

Imports System
Imports System.Drawing
Imports System.Collections
Imports System.Windows.Forms
Imports System.Data
Imports System.Reflection ' Needed to Assembly
Imports System.IO         ' Needed for Stream
Imports System.Drawing.Imaging  ' Needed for ImageAttributes

Public Class FormMain
    Inherits System.Windows.Forms.Form
      Friend WithEvents menuMain As System.Windows.Forms.MainMenu
      Friend WithEvents mitemFilePopup As System.Windows.Forms.MenuItem
      Friend WithEvents mitemFileOpen As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourcePopup As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourceClub As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourceDiamond As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourceHeart As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourceSpade As System.Windows.Forms.MenuItem
      Friend WithEvents menuItem6 As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourceBell As System.Windows.Forms.MenuItem
      Friend WithEvents mitemResourceCup As System.Windows.Forms.MenuItem
      Friend WithEvents mitemScalePopup As System.Windows.Forms.MenuItem
      Friend WithEvents mitemScale50 As System.Windows.Forms.MenuItem
      Friend WithEvents mitemScale100 As System.Windows.Forms.MenuItem
      Friend WithEvents mitemScale200 As System.Windows.Forms.MenuItem
      Friend WithEvents mitemScale400 As System.Windows.Forms.MenuItem
      Friend WithEvents dlgFileOpen As System.Windows.Forms.OpenFileDialog

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        MyBase.Dispose(disposing)
    End Sub

    '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()
Me.menuMain = New System.Windows.Forms.MainMenu
Me.mitemFilePopup = New System.Windows.Forms.MenuItem
Me.mitemFileOpen = New System.Windows.Forms.MenuItem
Me.mitemResourcePopup = New System.Windows.Forms.MenuItem
Me.mitemResourceClub = New System.Windows.Forms.MenuItem
Me.mitemResourceDiamond = New System.Windows.Forms.MenuItem
Me.mitemResourceHeart = New System.Windows.Forms.MenuItem
Me.mitemResourceSpade = New System.Windows.Forms.MenuItem
Me.menuItem6 = New System.Windows.Forms.MenuItem
Me.mitemResourceBell = New System.Windows.Forms.MenuItem
Me.mitemResourceCup = New System.Windows.Forms.MenuItem
Me.mitemScalePopup = New System.Windows.Forms.MenuItem
Me.mitemScale50 = New System.Windows.Forms.MenuItem
Me.mitemScale100 = New System.Windows.Forms.MenuItem
Me.mitemScale200 = New System.Windows.Forms.MenuItem
Me.mitemScale400 = New System.Windows.Forms.MenuItem
Me.dlgFileOpen = New System.Windows.Forms.OpenFileDialog
'
'menuMain
'
Me.menuMain.MenuItems.Add(Me.mitemFilePopup)
Me.menuMain.MenuItems.Add(Me.mitemResourcePopup)
Me.menuMain.MenuItems.Add(Me.mitemScalePopup)
'
'mitemFilePopup
'
Me.mitemFilePopup.MenuItems.Add(Me.mitemFileOpen)
Me.mitemFilePopup.Text = "File"
'
'mitemFileOpen
'
Me.mitemFileOpen.Text = "Open..."
'
'mitemResourcePopup
'
Me.mitemResourcePopup.MenuItems.Add(Me.mitemResourceClub)
Me.mitemResourcePopup.MenuItems.Add(Me.mitemResourceDiamond)
Me.mitemResourcePopup.MenuItems.Add(Me.mitemResourceHeart)
Me.mitemResourcePopup.MenuItems.Add(Me.mitemResourceSpade)
Me.mitemResourcePopup.MenuItems.Add(Me.menuItem6)
Me.mitemResourcePopup.MenuItems.Add(Me.mitemResourceBell)
Me.mitemResourcePopup.MenuItems.Add(Me.mitemResourceCup)
Me.mitemResourcePopup.Text = "Resource"
'
'mitemResourceClub
'
Me.mitemResourceClub.Text = "Club"
'
'mitemResourceDiamond
'
Me.mitemResourceDiamond.Text = "Diamond"
'
'mitemResourceHeart
'
Me.mitemResourceHeart.Text = "Heart"
'
'mitemResourceSpade
'
Me.mitemResourceSpade.Text = "Spade"
'
'menuItem6
'
Me.menuItem6.Text = "-"
'
'mitemResourceBell
'
Me.mitemResourceBell.Text = "Bell"
'
'mitemResourceCup
'
Me.mitemResourceCup.Text = "Cup"
'
'mitemScalePopup
'
Me.mitemScalePopup.MenuItems.Add(Me.mitemScale50)
Me.mitemScalePopup.MenuItems.Add(Me.mitemScale100)
Me.mitemScalePopup.MenuItems.Add(Me.mitemScale200)
Me.mitemScalePopup.MenuItems.Add(Me.mitemScale400)
Me.mitemScalePopup.Text = "Scale"
'
'mitemScale50
'
Me.mitemScale50.Text = "50%"
'
'mitemScale100
'
Me.mitemScale100.Text = "100%"
'
'mitemScale200
'
Me.mitemScale200.Checked = True
Me.mitemScale200.Text = "200%"
'
'mitemScale400
'
Me.mitemScale400.Text = "400%"
'
'FormMain
'
Me.Menu = Me.menuMain
Me.MinimizeBox = False
Me.Text = "Show Bitmap"

    End Sub

#End Region

      Private bmpDraw As Bitmap
      Dim bFirstTime As Boolean = True
      Dim bResource As Boolean = False
      Dim strResName As String

      Private Sub FormMain_MouseDown( _
      ByVal sender As Object, _
      ByVal e As MouseEventArgs) Handles MyBase.MouseDown
#If False Then
         CreateAndDraw(e.X, e.Y)
#End If
         ' Get graphics object for form.
         Dim g As Graphics = CreateGraphics()

         ' Create bitmap and graphics object for bitmap.
         Dim bmpNew As Bitmap = New Bitmap(100, 100)
         Dim gbmp As Graphics = Graphics.FromImage(bmpNew)

         ' Clear bitmap background.
         gbmp.Clear(Color.LightGray)

         ' Some drawing objects.
         Dim penBlack As Pen = New Pen(Color.Black)
         Dim brBlack As Brush = New SolidBrush(Color.Black)
         Dim brYellow As Brush = New SolidBrush(Color.Yellow)

         ' Draw onto bitmap.         
         gbmp.FillEllipse(brYellow, 0, 0, 98, 98)
         gbmp.DrawEllipse(penBlack, 0, 0, 98, 98)
         gbmp.DrawString("At " + e.X.ToString() + "," + _
            e.Y.ToString(), Font, brBlack, 40, 40)

         ' Copy bitmap to window at mouse down location.
         If (bFirstTime) Then
            ' Copy without transparency.
            g.DrawImage(bmpNew, e.X, e.Y)
            bFirstTime = False
         Else

            ' Copy bitmap using transparency.
            Dim rectDest As Rectangle = New Rectangle(e.X, e.Y, _
               100, 100)
            Dim imgatt As ImageAttributes = New ImageAttributes
            imgatt.SetColorKey(Color.LightGray, Color.LightGray)
            g.DrawImage(bmpNew, rectDest, 0, 0, 99, 99, _
               GraphicsUnit.Pixel, imgatt)
         End If

         ' Clean up when we are done.
         g.Dispose()
         gbmp.Dispose()
         bmpNew.Dispose()
      End Sub

      Private Sub FormMain_Paint( _
      ByVal sender As Object, _
      ByVal e As PaintEventArgs) Handles MyBase.Paint
         Dim g As Graphics = e.Graphics
         Dim sinX As Single = 10.0F
         Dim sinY As Single = 10.0F
         Dim szfText As SizeF = g.MeasureString("X", Font)
         Dim cyLine As Single = szfText.Height

         Dim brText As Brush = New SolidBrush(SystemColors.WindowText)
         If Not bmpDraw Is Nothing Then
            If (bResource) Then
            g.DrawString("Resource: " + strResName, _
               Font, brText, sinX, sinY)
            Else
            g.DrawString("File: " + dlgFileOpen.FileName, _
               Font, brText, sinX, sinY)
            End If
            sinY += cyLine

            g.DrawString("Bitmap Height = " + bmpDraw.Height.ToString(), _
               Font, brText, sinX, sinY)
            sinY += cyLine

            g.DrawString("Bitmap Width = " + bmpDraw.Width.ToString(), _
               Font, brText, sinX, sinY)
            sinY += cyLine
            sinY += cyLine

            If mitemScale100.Checked Then
               g.DrawImage(bmpDraw, CInt(sinX), CInt(sinY))
            Else
               Dim rectSrc As Rectangle = New Rectangle(0, 0, _
                  bmpDraw.Width, bmpDraw.Height)
               Dim xScaled As Integer = 0
               Dim yScaled As Integer = 0
               If mitemScale50.Checked Then
                  xScaled = bmpDraw.Width / 2
                  yScaled = bmpDraw.Height / 2
               ElseIf mitemScale200.Checked Then
                  xScaled = bmpDraw.Width * 2
                  yScaled = bmpDraw.Height * 2
               ElseIf mitemScale400.Checked Then
                  xScaled = bmpDraw.Width * 4
                  yScaled = bmpDraw.Height * 4
               End If

               Dim rectDest As Rectangle = New Rectangle(CInt(sinX), _
                  CInt(sinY), xScaled, yScaled)
               g.DrawImage(bmpDraw, rectDest, rectSrc, _
                  GraphicsUnit.Pixel)
            End If
         Else
            g.DrawString("File: None", Font, brText, sinX, sinY)
         End If
      End Sub

      Private Sub mitemFileOpen_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles mitemFileOpen.Click
         dlgFileOpen.Filter = "Bitmap (*.bmp)|*.bmp|" + _
                              "Picture (*.jpg)|*.jpg|" + _
                              "PNG Files (*.png)|*.png|" + _
                              "TIF Files (*.tif)|*.tif|" + _
                              "GIF Files (*.gif)|*.gif |" + _
                              "All Files (*.*)|*.*"

         If dlgFileOpen.ShowDialog() = DialogResult.OK Then
            Dim bmpNew As Bitmap = Nothing
            Try
               bmpNew = New Bitmap(dlgFileOpen.FileName)
               bResource = False
            Catch
               MessageBox.Show("Cannot create bitmap from " + _
                  "File: " + dlgFileOpen.FileName)
               Return
            End Try

            DisposeBitmap(bmpDraw)
            bmpDraw = bmpNew
            Invalidate()
         End If
      End Sub

      Private Sub mitemScale_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemScale50.Click, mitemScale100.Click, _
      mitemScale200.Click, mitemScale400.Click
         ' Clear checkmark on related items.
         mitemScale50.Checked = False
         mitemScale100.Checked = False
         mitemScale200.Checked = False
         mitemScale400.Checked = False

         ' Set checkmark on selected menu item.
         CType(sender, MenuItem).Checked = True

         ' Request paint to redraw bitmap.
         Invalidate()
      End Sub

      Private Sub mitemResourceCup_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemResourceCup.Click
         DisposeBitmap(bmpDraw)
         bmpDraw = LoadBitmapResource("CUP.BMP")
         Invalidate()
      End Sub

      Private Sub mitemResourceBell_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemResourceBell.Click
         DisposeBitmap(bmpDraw)
         bmpDraw = LoadBitmapResource("BELL.BMP")
         Invalidate()
      End Sub
      Private Sub mitemResourceSpade_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemResourceSpade.Click
         DisposeBitmap(bmpDraw)
         bmpDraw = LoadBitmapResource("SPADE.BMP")
         Invalidate()
      End Sub

      Private Sub mitemResourceHeart_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemResourceHeart.Click
         DisposeBitmap(bmpDraw)
         bmpDraw = LoadBitmapResource("HEART.BMP")
         Invalidate()
      End Sub

      Private Sub mitemResourceDiamond_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemResourceDiamond.Click
         DisposeBitmap(bmpDraw)
         bmpDraw = LoadBitmapResource("DIAMOND.BMP")
         Invalidate()
      End Sub

      Private Sub mitemResourceClub_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles mitemResourceClub.Click
         DisposeBitmap(bmpDraw)
         bmpDraw = LoadBitmapResource("CLUB.BMP")
         Invalidate()
      End Sub

      Private Function LoadBitmapResource( _
      ByVal strName As String) As Bitmap
         Dim [assembly] As System.Reflection.Assembly = _
            System.Reflection.Assembly.GetExecutingAssembly()
         Dim strRes As String = "ShowBitmap." + strName
         Dim [stream] As Stream = _
            [assembly].GetManifestResourceStream(strRes)
         Dim bmp As Bitmap = Nothing
         Try
             bmp = New Bitmap([stream])
             strResName = strRes
             bResource = True
         Catch
         End Try
         [stream].Close()

         Return bmp
      End Function

      Private Sub DisposeBitmap(ByRef bmp As Bitmap)
         If Not bmp Is Nothing Then
            bmp.Dispose()
         End If
         bmp = Nothing
      End Sub

      ' Simplest possible bitmap: create a bitmap, clear
      ' bitmap background, draw bitmap to display screen.
      Private Sub CreateAndDraw( _
      ByVal x As Integer, ByVal y As Integer)
         ' Create bitmap and graphics object for bitmap.
         Dim bmpNew As Bitmap = New Bitmap(100, 100)
         Dim gbmp As Graphics = Graphics.FromImage(bmpNew)

         ' Clear bitmap background.
         gbmp.Clear(Color.LightGray)

         ' Get graphics object for form.
         Dim g As Graphics = CreateGraphics()

         ' Copy bitmap to window at (x,y) location
         g.DrawImage(bmpNew, x, y)

         ' Clean up when we are done.
         g.Dispose()
         gbmp.Dispose()
         bmpNew.Dispose()
      End Sub

End Class