ErrorForm.frm #1

VERSION 5.00
Begin VB.Form ErrorForm 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "P4OFC - Error"
   ClientHeight    =   3315
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5760
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3315
   ScaleWidth      =   5760
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox ErrMsg 
      BackColor       =   &H8000000F&
      Height          =   1575
      Left            =   1080
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Text            =   "ErrorForm.frx":0000
      Top             =   240
      Width           =   4335
   End
   Begin VB.PictureBox picIcon 
      Height          =   855
      Left            =   120
      ScaleHeight     =   795
      ScaleWidth      =   795
      TabIndex        =   3
      Top             =   240
      Width           =   855
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3120
      TabIndex        =   1
      Top             =   2760
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1560
      TabIndex        =   0
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Click OK to create an email which you can add to before sending to Support (it will not be sent automatically)."
      Height          =   495
      Left            =   1080
      TabIndex        =   2
      Top             =   2040
      Width           =   4215
   End
End
Attribute VB_Name = "ErrorForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const SM_CXICON = 11
Private Const SM_CYICON = 12

Private Const SM_CXSMICON = 49
Private Const SM_CYSMICON = 50

Const IDI_APPLICATION = 32512&
Const IDI_HAND = 32513&
Const IDI_QUESTION = 32514&
Const IDI_EXCLAMATION = 32515&
Const IDI_ASTERISK = 32516&

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function LoadIconByID Lib "user32" Alias "LoadIconA" (ByVal _
    hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, _
    ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long

Private m_Action As VbMsgBoxResult

Private Sub DoClick(Action As VbMsgBoxResult)
    Me.Hide
    m_Action = Action
End Sub

Private Sub cmdCancel_Click()
    On Error GoTo Error_Block
    Dim T As Tracker: Set T = GStackTrace.Enter(TypeName(Me), "cmdCancel_Click")

    DoClick vbCancel
    Exit Sub

Error_Block:
    T.Report
End Sub

Private Sub cmdOK_Click()
    On Error GoTo Error_Block
    Dim T As Tracker: Set T = GStackTrace.Enter(TypeName(Me), "cmdOK_Click")

    DoClick vbOK
    Exit Sub

Error_Block:
    T.Report
End Sub

Public Function Answer(Msg As String) As VbMsgBoxResult

    Answer = vbCancel
    m_Action = vbCancel
    ErrMsg.Text = Msg
    Screen.MousePointer = vbDefault
    ShowForm Me, True
    Answer = m_Action
    Unload Me

End Function

Private Sub Form_Load()
    Dim h_icon  As Long
    Dim icon_wid As Long
    Dim icon_hgt As Long
    Dim i As Integer

    ' See how big the icons are.
    icon_wid = GetSystemMetrics(SM_CXICON)
    icon_hgt = GetSystemMetrics(SM_CYICON)

    ScaleMode = vbPixels

    Dim hIcon As Integer
    Dim X As Integer

    With picIcon
        .BorderStyle = vbBSNone
        .Width = icon_wid
        .Height = icon_hgt
        .AutoRedraw = True
        h_icon = LoadIconByID(0, IDI_EXCLAMATION)
        DrawIcon .hDC, 0, 0, h_icon
        .Visible = True
    End With


End Sub