frmerrormsg.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmErrorMsg 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "记帐凭证错误信息"
   ClientHeight    =   3105
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5745
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   5745
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdOKOrCancel 
      Caption         =   "清除错误信息"
      Height          =   350
      Index           =   2
      Left            =   4350
      TabIndex        =   3
      Tag             =   "1002"
      Top             =   1350
      UseMaskColor    =   -1  'True
      Width           =   1305
   End
   Begin VB.CommandButton cmdOKOrCancel 
      Height          =   350
      Index           =   1
      Left            =   4350
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1002"
      Top             =   900
      UseMaskColor    =   -1  'True
      Width           =   1305
   End
   Begin VB.CommandButton cmdOKOrCancel 
      Height          =   350
      Index           =   0
      Left            =   4350
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1001"
      Top             =   450
      UseMaskColor    =   -1  'True
      Width           =   1305
   End
   Begin VB.TextBox txtContent 
      BorderStyle     =   0  'None
      Height          =   2220
      Left            =   270
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   420
      Width           =   3840
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "组名"
      Height          =   180
      Index           =   2
      Left            =   300
      TabIndex        =   6
      Top             =   120
      Width           =   360
   End
   Begin VB.Label lblTitle 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "00001"
      Height          =   180
      Index           =   3
      Left            =   3675
      TabIndex        =   5
      Top             =   90
      Width           =   450
   End
   Begin VB.Label lblTitle 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "张三"
      Height          =   180
      Index           =   4
      Left            =   3735
      TabIndex        =   4
      Top             =   2850
      Width           =   360
   End
End
Attribute VB_Name = "frmErrorMsg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  错误信息
'  作者：蔡奇科
'  日期：1998.07.03
'
'  功能：提供界面用来输入记帐凭证的错误信息
'
'  接口： editCard  调用并返回已输入的信息。
'                  参数：strTeamName 调用记事簿的对象的名称，strCode 备注针对的编码，
'                        strName 备注针对的名称，strNote 原来的备注值
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mstrReturn As String
'Private WithEvents mclsMainControl As MainControl               '主控对象

Private Sub cmdOKOrCancel_Click(Index As Integer)
    Dim mintAdd As Integer
    
    Select Case Index
        Case 0
            mstrReturn = txtContent.Text
            Unload Me
        Case 1
            txtContent.Text = mstrReturn
            Unload Me
        Case 2
            txtContent.Text = ""
            '备忘录
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 60117
    Me.Icon = GetFormResPicture(139, vbResIcon)
    Set cmdOKOrCancel(0).Picture = GetFormResPicture(1001, vbResBitmap)
    Set cmdOKOrCancel(1).Picture = GetFormResPicture(1002, vbResBitmap)
'  Set cmdOKOrCancel(2).Picture = GetFormResPicture(1014, vbResBitmap)
''  Set mclsMainControl = gclsSys.MainControls.Add(Me)
End Sub

Private Sub Form_Paint()
 '   FrameBox Me.hwnd, 210, 180, 4095, 1365 '画frame边框
    paintrectangles Me.hwnd, txtContent.Left, txtContent.top, txtContent.width + txtContent.Left + 3 * Screen.TwipsPerPixelX, txtContent.top + txtContent.Height + 3 * Screen.TwipsPerPixelY
End Sub
Private Sub paintrectangles(ByVal hwnd, x1, y1, x2, y2 As Long)
    Dim hdc As Long
    Dim hPen1 As Long, hPen2 As Long, hSavePen As Long
    Dim Point As POINTAPI
    
    hdc = GetDC(hwnd)
    
    x1 = x1 / Screen.TwipsPerPixelX
    x2 = x2 / Screen.TwipsPerPixelX
    y1 = y1 / Screen.TwipsPerPixelY
    y2 = y2 / Screen.TwipsPerPixelY
    
    hPen2 = CreatePen(PS_SOLID, 4, &H707070)
    hSavePen = SelectObject(hdc, hPen2)
    Rectangle hdc, x1 + 4, y1 + 4, x2, y2
    
    hPen1 = CreatePen(PS_SOLID, 1, vbBlack)
    hSavePen = SelectObject(hdc, hPen1)
    Rectangle hdc, x1 - 1, y1 - 1, x2 - 2, y2 - 2
    
    SelectObject hdc, hSavePen
    DeleteObject hPen1
    DeleteObject hPen2
    
    ReleaseDC hwnd, hdc
End Sub

Public Function EditCard(ByVal strTeamName As String, ByVal strCode As String, ByVal strName As String, ByVal strNote As String) As String
    
    lblTitle(2).Caption = strTeamName
    lblTitle(3) = strCode
    lblTitle(4) = strName
    mstrReturn = strNote
    txtContent.Text = mstrReturn
    
    Me.Show vbModal
    EditCard = mstrReturn
End Function

Private Sub Form_Unload(Cancel As Integer)
'   gclsSys.CurrFormName = ""
'   gclsSys.MainControls.Remove Me
  ' Set mclsMainControl = Nothing
   Dim intYesNoCancel As Integer
   If txtContent.Text <> mstrReturn Then
        intYesNoCancel = ShowMsg(Me.hwnd, lblTitle(2).Caption & "的错误信息已经发生改变，是否需要保存?", MB_YESNOCANCEL + MB_DEFBUTTON1 + MB_ICONQUESTION + MB_SYSTEMMODAL, "警告提示")
        If intYesNoCancel = IDYES Then
            mstrReturn = txtContent.Text
        ElseIf intYesNoCancel = IDNO Then
        Else
            Cancel = 1
        End If
   End If
   Utility.RemoveFormResPicture 139
   Utility.RemoveFormResPicture 1001
   Utility.RemoveFormResPicture 1002
End Sub