PageRenderTime 42ms CodeModel.GetById 1ms app.highlight 35ms RepoModel.GetById 2ms app.codeStats 0ms

/Source Code/ExperimentalProjection/GDI/GdiProjector.vb

#
Visual Basic | 209 lines | 125 code | 64 blank | 20 comment | 1 complexity | f5c5fbb506d7381976e14fdb50df2dca MD5 | raw file
  1Imports System.Drawing
  2Imports System.Drawing.Imaging
  3
  4Public NotInheritable Class GdiProjector
  5    Inherits BaseProjector
  6
  7    Private FControl As Control = Nothing
  8
  9    Private Shared FMatrices As ImageAttributes() = PrecomputeMatrices()
 10
 11    Private Shared Function PrecomputeMatrices() As ImageAttributes()
 12
 13        Dim Result As New List(Of ImageAttributes)
 14
 15        For Index As Integer = 0 To 255
 16
 17            ' Create the next matrix
 18            Dim Values As Single()() = {New Single() {1, 0, 0, 0, 0}, _
 19                                        New Single() {0, 1, 0, 0, 0}, _
 20                                        New Single() {0, 0, 1, 0, 0}, _
 21                                        New Single() {0, 0, 0, Index / 255, 0}, _
 22                                        New Single() {0, 0, 0, 0, 1}}
 23            Dim Matrix As New ColorMatrix(Values)
 24
 25            ' Add to the list of available alpha-blending matrices
 26            Dim Attributes As New ImageAttributes
 27            Attributes.SetColorMatrix(Matrix)
 28            Result.Add(Attributes)
 29
 30        Next
 31
 32        Return Result.ToArray
 33
 34    End Function
 35
 36    Friend Sub New(ByVal control As Control)
 37        FControl = control
 38    End Sub
 39
 40    Private FCanvas As Bitmap = Nothing
 41    Private FCanvasGraphics As Graphics = Nothing
 42
 43    Public Overrides Sub RenderFrame()
 44
 45        ' Detect when the control has been resized
 46        If FCanvasGraphics IsNot Nothing AndAlso (FCanvas.Width <> FControl.Width OrElse FCanvas.Height <> FControl.Height) Then
 47            HandleControlResized()
 48        End If
 49
 50        ' If we haven't already, create a context in which to draw on
 51        If FCanvas Is Nothing Then FCanvas = New Bitmap(FControl.Width, FControl.Height, PixelFormat.Format32bppPArgb)
 52        If FCanvasGraphics Is Nothing Then FCanvasGraphics = Graphics.FromImage(FCanvas)
 53
 54        ' Render each of the projectlets onto a buffered canvas
 55        ' TODO: Resolve
 56        FCanvasGraphics.Clear(Color.DarkBlue)
 57        For Each Projectlet As GdiProjectlet In _Projectlets
 58
 59            Dim ActualOpacity As Double = Projectlet.Opacity
 60            Dim Visible As Boolean = Projectlet.VisibleWhenNotFading
 61
 62            ' Animate if an animation is defined
 63            Dim Animation As GdiProjectletAnimation = Projectlet.PeekNextAnimation
 64            If Animation IsNot Nothing Then
 65                If Animation.StartTick = 0 Then Animation.StartTick = Now.Ticks
 66                Visible = True
 67
 68                Select Case Animation.AnimationType
 69
 70                    Case FadeEffect.FadeIn
 71                        ActualOpacity = Animation.PercentageThrough * Projectlet.Opacity
 72
 73                    Case FadeEffect.FadeOut
 74                        ActualOpacity = Projectlet.Opacity - (Animation.PercentageThrough * Projectlet.Opacity)
 75
 76                End Select
 77
 78                If Animation.IsFinished Then Projectlet.RemoveNextAnimation()
 79
 80            End If
 81
 82            ' Draw the projectlet image
 83            If Visible Then
 84                Dim X As Integer = FControl.Width * Projectlet.Area.Left
 85                Dim Y As Integer = FControl.Height * Projectlet.Area.Top
 86                Dim Width As Integer = FControl.Width * Projectlet.Area.Width
 87                Dim Height As Integer = FControl.Height * Projectlet.Area.Height
 88                FCanvasGraphics.DrawImage(Projectlet.Bitmap, _
 89                                          New Rectangle(X, Y, Width, Height), _
 90                                          0, 0, Projectlet.Bitmap.Width, Projectlet.Bitmap.Height, _
 91                                          GraphicsUnit.Pixel, _
 92                                          FMatrices(CInt(ActualOpacity)))
 93            End If
 94
 95        Next
 96
 97        ' Draw the buffer image onto the assigned control
 98        FControl.CreateGraphics.DrawImageUnscaled(FCanvas, 0, 0)
 99
100    End Sub
101
102    Public Overloads Overrides Sub ShowProjectlet(ByVal name As String)
103
104        Dim Projectlet As GdiProjectlet = GetProjectlet(name)
105        Projectlet.ClearAnimations()
106        Projectlet.VisibleWhenNotFading = True
107
108    End Sub
109
110    Public Overloads Overrides Sub ShowProjectlet(ByVal name As String, _
111                                                  ByVal animationMethod As FadeEffect, _
112                                                  ByVal duration As System.TimeSpan)
113
114        Dim Projectlet As GdiProjectlet = GetProjectlet(name)
115        Projectlet.AddAnimation(New GdiProjectletAnimation(animationMethod, duration.Ticks))
116        Projectlet.VisibleWhenNotFading = True
117
118    End Sub
119
120    Public Overloads Overrides Sub HideProjectlet(ByVal name As String)
121
122        Dim Projectlet As GdiProjectlet = GetProjectlet(name)
123        Projectlet.ClearAnimations()
124        Projectlet.VisibleWhenNotFading = False
125
126    End Sub
127
128    Public Overloads Overrides Sub HideProjectlet(ByVal name As String, _
129                                                  ByVal animationMethod As FadeEffect, _
130                                                  ByVal duration As System.TimeSpan)
131
132        Dim Projectlet As GdiProjectlet = GetProjectlet(name)
133        Projectlet.AddAnimation(New GdiProjectletAnimation(animationMethod, duration.Ticks))
134        Projectlet.VisibleWhenNotFading = False
135
136    End Sub
137
138#Region " Methods for Creating and Updating Projectlets "
139
140    Friend Overrides Function CreateProjectlet(ByVal details As ProjectletDetails) As BaseProjectlet
141
142        ' Create the projectlet
143        Dim Result As New GdiProjectlet(details.Name, details)
144        UpdateProjectlet(Result)
145        Return Result
146
147    End Function
148
149    Friend Overloads Overrides Function CreateProjectlet(ByVal name As String, _
150                                                         ByVal area As AgnosticRectangle, _
151                                                         ByVal bitmapImage As Object) As BaseProjectlet
152
153        Dim Result As New GdiProjectlet(name)
154        Result.Bitmap = bitmapImage
155        ' TODO: Need to fix this - are you going to use integers or doubles? Also, need to include width and height
156        Result.Area = New RectangleF(area.Left, area.Top, area.Width, area.Height)
157        Return Result
158
159    End Function
160
161    Private Sub UpdateProjectlet(ByVal projectlet As GdiProjectlet)
162
163        ' Are there details for us to be able to update the projectlet?
164        If projectlet.Details IsNot Nothing Then
165
166            ' Extract the details
167            Dim Details As ProjectletDetails = projectlet.Details
168
169            ' Define the area
170            projectlet.Area = New RectangleF(Details.Area.Left, Details.Area.Top, Details.Area.Width, Details.Area.Height)
171
172            ' Determine the actual font size to use
173            Dim ActualFontSize As Double = Details.FontSizeRatio * FControl.Width
174
175            ' Determine the actual font style to use
176            Dim ActualFontStyle As FontStyle = FontStyle.Regular
177            If (Details.FontStyle And AgnosticFontStyle.Bold) = AgnosticFontStyle.Bold Then ActualFontStyle += FontStyle.Bold
178            If (Details.FontStyle And AgnosticFontStyle.Italic) = AgnosticFontStyle.Italic Then ActualFontStyle += FontStyle.Italic
179            If (Details.FontStyle And AgnosticFontStyle.Underline) = AgnosticFontStyle.Underline Then ActualFontStyle += FontStyle.Underline
180
181            ' Create the bitmap
182            Dim ControlSize As New Size(FControl.Width, FControl.Height)
183            Dim Font As New Font(Details.FontName, CInt(ActualFontSize), ActualFontStyle)
184            projectlet.Bitmap = CreateTextBitmap(ControlSize, Font, Details.Effect, Color.Blue, Color.White, Details.Alignment, Details.Text)
185
186        End If
187
188    End Sub
189
190#End Region
191
192    Private Sub HandleControlResized()
193
194        ' Dispose the canvas
195        FCanvas.Dispose()
196        FCanvas = Nothing
197
198        ' Dispose the canvas graphics
199        FCanvasGraphics.Dispose()
200        FCanvasGraphics = Nothing
201
202        ' Recreate all the projectlet bitmaps
203        For Each Projectlet As GdiProjectlet In _Projectlets
204            UpdateProjectlet(Projectlet)
205        Next
206
207    End Sub
208
209End Class