by Gehan Fernando. (13 Submissions)
Category: Windows System Services
Compatability: VB.NET
Difficulty: Unknown Difficulty
Originally Published: Fri 25th May 2007
Date Added: Mon 8th February 2021
Rating: (1 Votes)
VB.Net - "AFTER BUG FIX v 1.0.0" Run Time Glass Effect Message Box ... All Controls Create In Run Time, This Is Wonderful Dll Project. Use It
API Declarations
Imports System
Imports System.Text
Imports System.Drawing
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Drawing.Drawing2D
Imports System.Collections.Generic
#Region "About Author ...."
REM Name : Gehan Fernando
REM Product : Custom MessageBox [ v 1.0.1 ]
REM Date : 18-May-2007
REM Company : Aklo Information Technologies (Pvt) Ltd.
#End Region
Inherits Form
''' <summary>
''' Declare All Message Buttons
''' </summary>
''' <remarks></remarks>
Private WithEvents CmdOk As Button
Private WithEvents CmdYes As Button
Private WithEvents CmdNo As Button
Private WithEvents CmdCancel As Button
Private WithEvents CmdAbort As Button
Private WithEvents CmdRetry As Button
Private WithEvents CmdIgnore As Button
''' <summary>
''' Declare All Message Variables
''' </summary>
''' <remarks></remarks>
Private WithEvents Frm As Form
Private WithEvents LblHeader As Label
Private WithEvents PicBox As PictureBox
Private WithEvents LblBody As Label
Private RetValue As DialogResult
Private MLocation As Point
Private BSize As Size = Nothing
Private BFont As New Font("Tahoma", 9, FontStyle.Bold)
Private _HeaderTitle As String = ""
Private _BodyMessage As String = ""
Private _MessageIcon As MessageBoxIcon
Private _MessageButton As MessageBoxButtons
''' <summary>
''' Set Constructor For MessageBox
''' </summary>
''' <remarks></remarks>
Public Sub New()
Frm = New Form()
BSize = New Size(430, 150)
With Frm
.FormBorderStyle = Windows.Forms.FormBorderStyle.None
.Size = BSize
.StartPosition = FormStartPosition.CenterScreen
.ShowIcon = False
.TopMost = True
.Text = ""
.Font = BFont
.Opacity = 0.85
.ShowInTaskbar = False
Call AddHeaderLabel()
.Controls.Add(LblHeader)
Call AddPicture()
.Controls.Add(PicBox)
Call AddBodyLabel()
.Controls.Add(LblBody)
End With
End Sub
Public Sub New(ByRef StartPosition As System.Windows.Forms.FormStartPosition)
Frm = New Form()
BSize = New Size(430, 150)
With Frm
.FormBorderStyle = Windows.Forms.FormBorderStyle.None
.Size = BSize
.StartPosition = StartPosition
.ShowIcon = False
.TopMost = True
.Text = ""
.Font = BFont
.Opacity = 0.85
.ShowInTaskbar = False
Call AddHeaderLabel()
.Controls.Add(LblHeader)
Call AddPicture()
.Controls.Add(PicBox)
Call AddBodyLabel()
.Controls.Add(LblBody)
End With
End Sub
''' <summary>
''' Declare All Properties And Methods
''' </summary>
''' <remarks></remarks>
Private Sub AddHeaderLabel()
LblHeader = New Label()
With LblHeader
.Text = ""
.Width = 430
.Height = 23
.Dock = DockStyle.Top
.Font = BFont
.Visible = True
End With
End Sub
Private Sub AddBodyLabel()
LblBody = New Label()
MLocation = New Point(49, 31)
With LblBody
.Text = ""
.Width = 310
.Height = 87
.AutoSize = False
.Location = MLocation
.BorderStyle = BorderStyle.None
.BackColor = Color.Transparent
.Font = BFont
.Visible = True
End With
End Sub
Private Sub AddPicture()
PicBox = New PictureBox()
MLocation = New Point(7, 31)
With PicBox
.Location = MLocation
.BorderStyle = BorderStyle.None
.BackColor = Color.Transparent
.Width = 35
.Height = 35
.Visible = True
End With
End Sub
Public Function ShowSAMAK_MESSAGE(ByVal MsgMessage As String, ByVal MsgButton As MessageBoxButtons, _
Optional ByVal MsgICon As MessageBoxIcon = MessageBoxIcon.None, _
Optional ByVal MsgHeader As String = "") As DialogResult
_HeaderTitle = MsgHeader.ToString()
_BodyMessage = MsgMessage.ToString()
_MessageIcon = MsgICon
_MessageButton = MsgButton
LblBody.Text = MsgMessage.ToString()
If MessageBoxIcon.Asterisk = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Asterisk.ToBitmap()
End If
If MessageBoxIcon.Error = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Error.ToBitmap()
End If
If MessageBoxIcon.Exclamation = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Exclamation.ToBitmap()
End If
If MessageBoxIcon.Hand = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Hand.ToBitmap()
End If
If MessageBoxIcon.Information = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Information.ToBitmap()
End If
If MessageBoxIcon.Question = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Question.ToBitmap()
End If
If MessageBoxIcon.Warning = _MessageIcon Then
PicBox.Image = System.Drawing.SystemIcons.Warning.ToBitmap()
End If
Call ShowButton(_MessageButton)
Frm.ShowDialog()
Return RetValue
End Function
Private Sub ShowButton(ByVal BtnType As MessageBoxButtons)
BSize = New Size(58, 24)
If BtnType = MessageBoxButtons.AbortRetryIgnore Then
BSize = New Size(58, 24)
CmdAbort = New Button
Dim BLocation As New Point(248, 120)
Call CommanSet(CmdAbort, "&Abort", BSize, BLocation)
BLocation = Nothing
CmdRetry = New Button
BLocation = New Point(308, 120)
Call CommanSet(CmdRetry, "&Retry", BSize, BLocation)
BLocation = Nothing
CmdIgnore = New Button
BLocation = New Point(368, 120)
Call CommanSet(CmdIgnore, "&Ignore", BSize, BLocation)
BLocation = Nothing
End If
If BtnType = MessageBoxButtons.OK Then
BSize = New Size(58, 24)
CmdOk = New Button
Dim BLocation As New Point(368, 120)
Call CommanSet(CmdOk, "&Ok", BSize, BLocation)
BLocation = Nothing
Exit Sub
End If
If BtnType = MessageBoxButtons.OKCancel Then
BSize = New Size(58, 24)
CmdYes = New Button
Dim BLocation As New Point(308, 120)
Call CommanSet(CmdYes, "&Ok", BSize, BLocation)
BLocation = Nothing
CmdNo = New Button
BLocation = New Point(368, 120)
Call CommanSet(CmdNo, "&Cancel", BSize, BLocation)
BLocation = Nothing
Exit Sub
End If
If BtnType = MessageBoxButtons.RetryCancel Then
BSize = New Size(58, 24)
CmdYes = New Button
Dim BLocation As New Point(308, 120)
Call CommanSet(CmdYes, "&Retry", BSize, BLocation)
BLocation = Nothing
CmdNo = New Button
BLocation = New Point(368, 120)
Call CommanSet(CmdNo, "&Cancel", BSize, BLocation)
BLocation = Nothing
Exit Sub
End If
If BtnType = MessageBoxButtons.YesNo Then
BSize = New Size(58, 24)
CmdYes = New Button
Dim BLocation As New Point(308, 120)
Call CommanSet(CmdYes, "&Yes", BSize, BLocation)
BLocation = Nothing
CmdNo = New Button
BLocation = New Point(368, 120)
Call CommanSet(CmdNo, "&No", BSize, BLocation)
BLocation = Nothing
Exit Sub
End If
If BtnType = MessageBoxButtons.YesNoCancel Then
BSize = New Size(58, 24)
CmdYes = New Button
Dim BLocation As New Point(248, 120)
Call CommanSet(CmdYes, "&Yes", BSize, BLocation)
BLocation = Nothing
CmdNo = New Button
BLocation = New Point(308, 120)
Call CommanSet(CmdNo, "&No", BSize, BLocation)
BLocation = Nothing
CmdCancel = New Button
BLocation = New Point(368, 120)
Call CommanSet(CmdCancel, "&Cancel", BSize, BLocation)
BLocation = Nothing
End If
End Sub
Private Sub CommanSet(ByVal Btn As Button, ByVal Txt As String, ByVal Sz As Size, ByVal Lc As Point)
With Btn
.Size = Sz
.Text = Txt
.BackColor = Color.Transparent
.FlatAppearance.BorderSize = 0
.FlatStyle = FlatStyle.Standard
.Location = Lc
.Anchor = AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right
.TextAlign = ContentAlignment.MiddleCenter
.Font = BFont
.Visible = True
End With
Frm.Controls.Add(Btn)
End Sub
Private Sub LblHeader_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles LblHeader.MouseDown
MLocation = e.Location
End Sub
Private Sub LblHeader_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles LblHeader.MouseMove
If String.Compare(Control.MouseButtons.ToString(), "Left") = 0 Then
Dim MSize As New Size(MLocation)
MSize.Width = e.X - MLocation.X
MSize.Height = e.Y - MLocation.Y
Frm.Location = Point.Add(Frm.Location, MSize)
End If
End Sub
Private Sub LblHeader_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles LblHeader.Paint
Dim MGraphics As Graphics = e.Graphics
Dim MPen As New Pen(Color.FromArgb(96, 155, 173), 1)
Dim Area As New Rectangle(0, 0, LblHeader.Width - 1, LblHeader.Height - 1)
Dim LGradient As New LinearGradientBrush(Area, Color.FromArgb(166, 197, 227), Color.FromArgb(245, 251, 251), LinearGradientMode.BackwardDiagonal)
MGraphics.FillRectangle(LGradient, Area)
MGraphics.DrawRectangle(MPen, Area)
Dim DrawFont As New Font("Tahoma", 10, FontStyle.Bold)
Dim DrawBrush As New SolidBrush(Color.Black)
Dim DrawPoint As New PointF(2.0F, 3.0F)
Dim DrawGradientBrush As New LinearGradientBrush(e.Graphics.ClipBounds, Color.White, _
Color.FromArgb(122, 158, 226), LinearGradientMode.ForwardDiagonal)
e.Graphics.DrawString(_HeaderTitle.ToString(), DrawFont, DrawBrush, DrawPoint)
End Sub
Private Sub FrmMessageBox_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Frm.Paint
Dim MGraphics As Graphics = e.Graphics
Dim MPen As New Pen(Color.FromArgb(96, 155, 173), 1)
Dim Area As New Rectangle(0, 0, Frm.Width - 1, Frm.Height - 1)
Dim LGradient As New LinearGradientBrush(Area, Color.FromArgb(166, 197, 227), Color.FromArgb(245, 251, 251), LinearGradientMode.BackwardDiagonal)
MGraphics.FillRectangle(LGradient, Area)
MGraphics.DrawRectangle(MPen, Area)
End Sub
Private Sub CmdOk_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdOk.Click
RetValue = Windows.Forms.DialogResult.OK
Frm.Dispose()
End Sub
Private Sub CmdYes_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdYes.Click
Frm.Dispose()
RetValue = Windows.Forms.DialogResult.Yes
End Sub
Private Sub CmdNo_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdNo.Click
Frm.Dispose()
RetValue = Windows.Forms.DialogResult.No
End Sub
Private Sub CmdRetry_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdRetry.Click
Frm.Dispose()
RetValue = Windows.Forms.DialogResult.Retry
End Sub
Private Sub CmdCancel_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdCancel.Click
Frm.Dispose()
RetValue = Windows.Forms.DialogResult.Cancel
End Sub
Private Sub CmdAbort_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdAbort.Click
Frm.Dispose()
RetValue = Windows.Forms.DialogResult.Abort
End Sub
Private Sub CmdIgnore_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CmdIgnore.Click
Frm.Dispose()
RetValue = Windows.Forms.DialogResult.Ignore
End Sub
End Class
No comments have been posted about VB.Net - AFTER BUG FIX v 1.0.0 Run Time Glass Effect Message Box ... All Controls Create In Run T. Why not be the first to post a comment about VB.Net - AFTER BUG FIX v 1.0.0 Run Time Glass Effect Message Box ... All Controls Create In Run T.