frmnotepad.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmNotePad 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "记事簿"
   ClientHeight    =   3360
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5745
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3360
   ScaleWidth      =   5745
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOKOrCancel 
      Height          =   350
      Index           =   2
      Left            =   4290
      Style           =   1  'Graphical
      TabIndex        =   8
      Tag             =   "1014"
      Top             =   1220
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKOrCancel 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   4290
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1002"
      Top             =   760
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKOrCancel 
      Height          =   350
      Index           =   0
      Left            =   4290
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1001"
      Top             =   300
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.TextBox txtContent 
      BorderStyle     =   0  'None
      Height          =   1555
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   1560
      Width           =   3865
   End
   Begin VB.Label lblTitle 
      AutoSize        =   -1  'True
      Caption         =   "组名"
      Height          =   180
      Index           =   2
      Left            =   360
      TabIndex        =   7
      Top             =   120
      Width           =   360
   End
   Begin VB.Label lblTitle 
      Caption         =   "编号："
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   6
      Top             =   600
      Width           =   645
   End
   Begin VB.Label lblTitle 
      Caption         =   "名称："
      Height          =   165
      Index           =   1
      Left            =   360
      TabIndex        =   5
      Top             =   960
      Width           =   645
   End
   Begin VB.Label lblTitle 
      Caption         =   "00001"
      Height          =   255
      Index           =   3
      Left            =   1050
      TabIndex        =   4
      Top             =   600
      Width           =   2805
   End
   Begin VB.Label lblTitle 
      Caption         =   "张三"
      Height          =   255
      Index           =   4
      Left            =   1050
      TabIndex        =   3
      Top             =   960
      Width           =   2805
   End
End
Attribute VB_Name = "frmNotePad"
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
            Unload Me
        Case 2
            mintAdd = frmMemo.AddCard(, vbModal)
            
            '备忘录
    End Select
End Sub

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

End Sub

Private Sub Form_Load()
  On Error GoTo ErrHandle
  Me.HelpContextID = 10011
  Utility.LoadFormResPicture Me
  'Set mclsMainControl = gclsSys.MainControls.Add(Me)
  Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 210, 180, 4095, 1365 '画frame边框
    paintrectangles Me.hwnd, 240, 1560, 4155, 3165
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)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
End Sub