<back> 1.1. My typical VB.NET desktop application. Starter.
(Catch up non GUI exceptions and load embedded font to managed memory)
This is my starter code, it show black screen before program started, createe instance of windows desktop form and after that black windows (for console application id disappear) and application started.
What common goal of this module?
- Main goal is catch up unexpected non GUI exception, show message, and after that store message to DB. Without catch up non GUI exception (if error is raised) program silently disappear from screen. And getting reason to error is impossible.
- Second big goal of this module is upload embedded font of whole application and create link for it to managed memory.
1: Imports System
2: Imports System.IO
3: Imports System.Runtime.InteropServices
4: Imports System.Windows.Forms
5: Imports System.Drawing.Text
6:
7: Public Module Starter
8:
9: <DllImport("user32.dll")>
10: Private Function ShowWindow(ByVal hWnd As IntPtr, ByVal nCmdShow As Integer) As Boolean
11: End Function
12:
13: <DllImport("Kernel32")>
14: Private Function GetConsoleWindow() As IntPtr
15: End Function
16:
17: <DllImport("gdi32.dll")>
18: Private Function AddFontMemResourceEx(ByVal pbFont As IntPtr, ByVal cbFont As UInteger, ByVal pdv As IntPtr, <[In]> ByRef pcFonts As UInteger) As IntPtr
19: End Function
20:
21: Const SW_HIDE As Integer = 0
22: Const SW_SHOW As Integer = 5
23:
24: Public MainMDI_Instance As New MainMDI
25:
26:
27: <STAThread>
28: Public Sub Main()
29:
30:
31: Dim hwnd As IntPtr
32: hwnd = GetConsoleWindow()
33: ShowWindow(hwnd, SW_HIDE)
34:
35: AddHandler Application.ThreadException, New Threading.ThreadExceptionEventHandler(AddressOf Form1_UIThreadException)
36: 'Application.SetUnhandledExceptionMode(UnhandledExceptionMode.CatchException)
37: AddHandler AppDomain.CurrentDomain.UnhandledException, New UnhandledExceptionEventHandler(AddressOf CurrentDomain_UnhandledException)
38:
39: LoadFontToUnmanagedMemory(My.Resources.Cuprum_Regular, FontsAllSize)
40: LoadFontToUnmanagedMemory(My.Resources.Cuprum_Bold, FontsAllSize)
41: LoadFontToUnmanagedMemory(My.Resources.Cuprum_Italic, FontsAllSize)
42: LoadFontToUnmanagedMemory(My.Resources.Cuprum_BoldItalic, FontsAllSize)
43: Cuprum_Regular_8 = New Font(FontsAllSize.Families(0), 8.0F)
44: Cuprum_Regular_9 = New Font(FontsAllSize.Families(0), 9.0F)
45: Cuprum_Regular_10 = New Font(FontsAllSize.Families(0), 10.0F)
46: Cuprum_Regular_11 = New Font(FontsAllSize.Families(0), 11.0F)
47: Cuprum_Regular_12 = New Font(FontsAllSize.Families(0), 12.0F)
48: Cuprum_Regular_8_5 = New Font(FontsAllSize.Families(0), 8.5F)
49: Cuprum_Regular_9_5 = New Font(FontsAllSize.Families(0), 9.5F)
50: Cuprum_Regular_10_5 = New Font(FontsAllSize.Families(0), 10.5F)
51: Cuprum_Regular_11_5 = New Font(FontsAllSize.Families(0), 11.5F)
52:
53: MainMDI_Instance = New MainMDI
54: Application.Run(MainMDI_Instance)
55: End Sub
56:
57:
58: Public Cuprum_Regular_8 As Font
59: Public Cuprum_Regular_9 As Font
60: Public Cuprum_Regular_10 As Font
61: Public Cuprum_Regular_11 As Font
62: Public Cuprum_Regular_12 As Font
63: Public Cuprum_Regular_8_5 As Font
64: Public Cuprum_Regular_9_5 As Font
65: Public Cuprum_Regular_10_5 As Font
66: Public Cuprum_Regular_11_5 As Font
67:
68: Public FontsAllSize As PrivateFontCollection = New PrivateFontCollection()
69: Sub LoadFontToUnmanagedMemory(FontResourceName As Byte(), fonts As PrivateFontCollection)
70: Dim FontResourceNamerPtr As IntPtr = Marshal.AllocCoTaskMem(FontResourceName.Length)
71: Marshal.Copy(FontResourceName, 0, FontResourceNamerPtr, FontResourceName.Length)
72: fonts.AddMemoryFont(FontResourceNamerPtr, FontResourceName.Length)
73: Dim dummy As UInteger = 0
74: AddFontMemResourceEx(FontResourceNamerPtr, CUInt(FontResourceName.Length), IntPtr.Zero, dummy)
75: Marshal.FreeCoTaskMem(FontResourceNamerPtr)
76: End Sub
77:
78:
79:
80: Private Sub Form1_UIThreadException(ByVal sender As Object, ByVal t As Threading.ThreadExceptionEventArgs)
81: Dim result As DialogResult = DialogResult.Cancel
82:
83: Try
84: result = ShowThreadExceptionDialog("Fatal Error", t.Exception)
85: If result = DialogResult.Abort Then Application.[Exit]()
86: Catch
87: Try
88: MessageBox.Show("Fatal Windows Forms Error", "UIThreadException", MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.[Stop])
89: Finally
90: Application.[Exit]()
91: End Try
92: End Try
93:
94: End Sub
95:
96:
97: Private Sub CurrentDomain_UnhandledException(ByVal sender As Object, ByVal e As UnhandledExceptionEventArgs)
98: Dim errorMsg As String = "Fatal Non-UI Error:" & vbLf & vbLf
99: Dim ex As Exception = CType(e.ExceptionObject, Exception)
100: Try
101: Dim result As DialogResult = DialogResult.Cancel
102: result = ShowThreadExceptionDialog("Fatal Non-UI Error:", ex)
103: If result = DialogResult.Abort Then Application.[Exit]()
104: Catch
105: Try
106: MessageBox.Show("Fatal Windows Forms Error", "UnhandledException", MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.[Stop])
107: Finally
108: Application.[Exit]()
109: End Try
110: End Try
111: Try
112:
113: Dim db1 As New SamanthaEntities
114: db1.ApplicationErrors.Add(New ApplicationError With {.Key = "UnhandledException", .[Date] = Now, .Msg = errorMsg & ex.Message & vbLf & vbLf & "Stack Trace:" & vbLf + ex.StackTrace})
115: db1.SaveChanges()
116: Catch
117: Try
118: MessageBox.Show("Error to write exception to database Samantha", errorMsg & ex.Message & vbLf & vbLf & "Stack Trace:" & vbLf + ex.StackTrace, MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.[Stop])
119: Finally
120: Application.[Exit]()
121: End Try
122: End Try
123: 'Dim myLog As EventLog = New EventLog() With {.Source = "Samantha"}
124: 'myLog.Source = "ThreadException"
125: 'myLog.WriteEntry(errorMsg & ex.Message & vbLf & vbLf & "Stack Trace:" & vbLf + ex.StackTrace)
126: 'Catch exc As Exception
127:
128: ' Try
129: ' MessageBox.Show("Could not write the error to the event log. Reason: " & exc.Message, "UnhandledException", MessageBoxButtons.OK, MessageBoxIcon.[Stop])
130: ' Finally
131: ' Application.[Exit]()
132: ' End Try
133: 'End Try
134: End Sub
135:
136: Public Function ShowThreadExceptionDialog(ByVal title As String, ByVal e As Exception) As DialogResult
137: Dim errorMsg As String = "An application error occurred. Please contact the adminstrator " & "with the following information:" & vbLf & vbLf
138: errorMsg = errorMsg & e.Message & vbLf & vbLf & "Stack Trace:" & vbLf + e.StackTrace
139: Return MessageBox.Show(errorMsg, title, MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.[Stop])
140: End Function
141:
142: End Module
For select font on each form I use this two extension
1: Imports System.Runtime.CompilerServices
2:
3: Module Extensions
4:
5: <Extension>
6: Public Function FindRecusriveByType(ByVal control As Control, ByVal type As Type) As IEnumerable(Of Control)
7: Dim controls = control.Controls.Cast(Of Control)()
8: Return controls.SelectMany(Function(ctrl) FindRecusriveByType(ctrl, type)).Concat(controls).Where(Function(c) c.[GetType]() = type)
9: End Function
10:
11: <Extension>
12: Public Sub SetFontSize(CurForm As Form, FontSize As String)
13: Dim FormControlList = (From Z In CurForm.Controls Select Z).ToList
14: Select Case FontSize
15: Case "8" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_8)
16: Case "8,5" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_8_5)
17: Case "9" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_9)
18: Case "9,5" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_9_5)
19: Case "10" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_10)
20: Case "10,5" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_10_5)
21: Case "11" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_11)
22: Case "11,5" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_11_5)
23: Case "12" : FormControlList.ForEach(Sub(X) X.Font = Cuprum_Regular_12)
24: End Select
25: End Sub
On the beginning of each form
13: Private Sub EmailCenter_Load(sender As Object, e As EventArgs) Handles Me.Load
14: Me.SetFontSize(MainMDI_Instance.FontSize)
Comments (
)
)
Link to this page:
//www.vb-net.com/Samantha/Starter.htm
|
|