form2.frm

该程序是思路是经过专门的顾问专家集十年的经验设计

VERSION 5.00
Begin VB.Form Form2 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   8520
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11910
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form2.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8520
   ScaleWidth      =   11910
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox Combo1 
      Height          =   330
      Left            =   2520
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   30
      Width           =   4440
   End
   Begin VB.ListBox List1 
      Height          =   2580
      Left            =   11040
      TabIndex        =   6
      Top             =   2670
      Visible         =   0   'False
      Width           =   2775
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H8000000C&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   8100
      Left            =   30
      ScaleHeight     =   8040
      ScaleWidth      =   11895
      TabIndex        =   2
      Top             =   375
      Width           =   11955
      Begin VB.VScrollBar VS 
         Height          =   8010
         LargeChange     =   100
         Left            =   11535
         Max             =   2
         Min             =   1
         SmallChange     =   10
         TabIndex        =   3
         Top             =   -15
         Value           =   1
         Width           =   285
      End
      Begin VB.PictureBox Picture2 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   7365
         Left            =   -15
         MousePointer    =   99  'Custom
         ScaleHeight     =   489
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   351
         TabIndex        =   4
         Top             =   0
         Width           =   5300
      End
   End
   Begin VB.CommandButton Command1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   7560
      TabIndex        =   1
      Top             =   30
      Width           =   1110
   End
   Begin VB.CommandButton Command5 
      Cancel          =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   9135
      TabIndex        =   0
      Top             =   30
      Width           =   1110
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Height          =   210
      Left            =   2415
      TabIndex        =   5
      Top             =   135
      Width           =   105
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub PPP(ByVal TF As Object)      '预览代码
Dim Re As Single
Dim t As Long
Dim Sum As Long
Dim Sts(12) As String
Sts(0) = "(1)思考性"
Sts(1) = "(2)共鸣性"
Sts(2) = "(3)自律性"
Sts(3) = "(4)活动性"
Sts(4) = "(5)指导性"
Sts(5) = "(6)社交性"
Sts(6) = "(7)创造性"
Sts(7) = "(8)成就性"
Sts(8) = "(9)变易性"
Sts(9) = "(10)抑郁性"
Sts(10) = "(11)神经质"
Sts(11) = "(12)自卑感"
Sts(12) = "(13)虚构性"
Dim i, j As Long
Dim t1 As Long
Dim Strr As String
Dim Str1 As String
Dim Str2 As String
Dim Str3 As String
Dim Str4 As String
Dim TmpStr As String
Dim Str_T(12) As String
Dim RsD As New ADODB.Recordset
Strr = StrJG
If Strr = "" Then MsgBox "请选定人员": Exit Sub
VS.Max = (Picture2.Height - Picture1.Height) \ 100 + 4
TF.ScaleMode = 6
DoEvents
TF.Height = 29 * 567
TF.Width = 21 * 567
TF.DrawStyle = 0
TF.ScaleLeft = 0
TF.ScaleTop = -15
TF.CurrentX = 65
TF.CurrentY = 0
TF.Font = "宋体"
TF.Font.Size = 14
TF.Font.Bold = True
TF.Print "工 作 性 向 测 试 报 告 书"
TF.Font.Bold = False
TF.CurrentX = 145
TF.CurrentY = 10
TF.Font.Size = 10
TF.Print "实施日:" & UserT
Re = TF.CurrentY
TF.Line (20, TF.CurrentY)-(180, TF.CurrentY + 8), , B
TF.CurrentX = 30
TF.CurrentY = Re + 2
TF.Font.Size = 10.5
TF.Font.Bold = True
TF.Print "姓名：" + UserN + "   性别：" + UserS + "  年龄：" + UserA + "  工作类别：" + UserL + "   单位：" + UserD
TF.CurrentX = 20
TF.CurrentY = TF.CurrentY + 6
TF.Print "（1）答案列表"
TF.Font.Bold = False
TF.Font.Size = 10
TF.CurrentX = 125
TF.CurrentY = TF.CurrentY - 3
TF.Print "  [+] 是 [-] 否 [\] 不知道"
Re = TF.CurrentY
TF.Line (20, TF.CurrentY)-(180, TF.CurrentY + 62), , B
TF.CurrentY = Re + 1
For j = 1 To 13
For i = j To Len(StrJG) Step 13
Str2 = Mid(StrJG, i, 1)
Select Case Str2
Case "0"
    If i < 92 Then
        Str3 = "-"
    Else
        Str3 = "+"
    End If
Case "1": Str3 = "\"
Case "2"
    If i < 92 Then
        Str3 = "+"
    Else
        Str3 = "-"
    End If
End Select
Str4 = Str4 + Format(i, "000") + "[" + Str3 + "]  "
Next
TF.CurrentX = 30
TF.CurrentY = TF.CurrentY + 1
TF.Print Str4
Str4 = ""
Next
TF.CurrentX = 20
TF.CurrentY = TF.CurrentY + 5
TF.Font.Size = 10.5
TF.Font.Bold = True
TF.Print "（2）特殊性向"
TF.Font.Bold = False
TF.DrawWidth = 1
Str1 = JiSuan(Strr)
Str3 = JS2(Strr)
Str2 = JSS(Str1)
Re = TF.CurrentY + 1
TF.Line (20, TF.CurrentY + 1)-(180, TF.CurrentY + 28), , B
TF.CurrentX = 30
TF.CurrentY = Re + 1
RsD.Open "select * from xx1", Conn, 1, 1
For i = 1 To 13
Str_T(i - 1) = RsD.Fields(0).Value & "：" & RsD.Fields(Val(Mid(Str2, i, 1))).Value
RsD.MoveNext
Next
RsD.Close
Set RsD = Nothing
For i = 0 To 3
TF.CurrentX = 30
TF.CurrentY = TF.CurrentY + 1
TF.Print Str_T(i * 3) & "     " & Str_T(i * 3 + 1) & "     " & Str_T(i * 3 + 2)
DoEvents
Next
TmpStr = " ＊＊＊＊＊ "
If Val(Mid(Str1, 1, 2)) > Val(Mid(Str1, 7, 2)) + 5 Then TmpStr = "<深思缓慢的>"
If Val(Mid(Str1, 7, 2)) > Val(Mid(Str1, 1, 2)) + 5 Then TmpStr = "<冲动快速的>"
Sum = 0
For i = 1 To Len(Str3)
Sum = Sum + Val(Mid(Str3, i, 1))
Next
t = Sum
If Sum < 26 Then TmpStr = TmpStr + Space(15) + " ＊＊＊＊＊ "
If Sum >= 25 Then TmpStr = TmpStr + Space(15) + "<优柔寡断的>"
If Sum >= 45 Then TmpStr = TmpStr + Space(15) + "<缺决断力的>"
TF.CurrentX = 30
TF.CurrentY = TF.CurrentY + 1
TF.Print Str_T(12) + "               " + TmpStr
Sum = ZH(Str2)
If Sum > 17 And Sum < 19 Then TmpStr = "C-           劣": GoTo ExitAA
If Sum > 18 And Sum < 25 Then TmpStr = "C            差": GoTo ExitAA
If Sum > 24 And Sum < 31 Then TmpStr = "B-           普通下位": GoTo ExitAA
If Sum > 30 And Sum < 37 Then TmpStr = "B            普通": GoTo ExitAA
If Sum > 36 And Sum < 43 Then TmpStr = "B+           普通上位": GoTo ExitAA
If Sum > 42 And Sum < 49 Then TmpStr = "A            良": GoTo ExitAA
If Sum > 48 Then TmpStr = "优 [A+]": GoTo ExitAA
TmpStr = Str_T(12) + "     " + "可能太差"
ExitAA:
TF.CurrentX = 20
TF.CurrentY = TF.CurrentY + 5
TF.Font.Bold = True
TF.Print "（3）综合评定"
TF.Font.Bold = False
Re = TF.CurrentY + 1
TF.Line (20, TF.CurrentY + 1)-(180, TF.CurrentY + 24), , B
TF.CurrentX = 40
TF.CurrentY = Re + 1.5
TF.Print TmpStr & Space(12) & Sum & Space(12) & t
TF.Line (20, TF.CurrentY + 2)-(180, TF.CurrentY + 2)
TF.CurrentX = 24
TF.CurrentY = TF.CurrentY + 1.5
TF.Print "改善指导方法："
TF.CurrentX = 20
TF.CurrentY = TF.CurrentY + 14
TF.Font.Bold = True
TF.Print "（4）性向特性图"
TF.Font.Bold = False
TF.Font.Size = 9
TF.CurrentY = TF.CurrentY + 4
Re = TF.CurrentY
TF.Line (50, Re)-(150, Re + 60), , B    '画框
TF.CurrentY = Re
For i = 1 To 11
TF.CurrentY = TF.CurrentY + 5
TF.Line (50, TF.CurrentY)-(150, TF.CurrentY) '画横线
Next
TF.CurrentY = Re - 3
For t = 1 To 13
TF.CurrentX = 30
TF.CurrentY = TF.CurrentY + 1.72
TF.Print Sts(t - 1)
Next
TF.CurrentY = Re - 3
For t = 1 To 13
TF.CurrentX = 152
TF.CurrentY = TF.CurrentY + 1.72
TF.CurrentY = TF.CurrentY
TF.Print Mid(Str2, t, 1) + "  " + Mid(Str1, t * 2 - 1, 2) + "  " + Mid(Str3, t, 1)
Next
TF.DrawStyle = 2
TF.CurrentX = 50
TF.CurrentY = Re
For i = 1 To 19
TF.CurrentX = TF.CurrentX + 5
TF.Line (TF.CurrentX, Re)-(TF.CurrentX, Re + 60)  '画竖线
Next
TF.DrawStyle = 0
TF.Line (99.9, Re)-(99.9, Re + 60) '画中间的直线
TF.CurrentX = 50
TF.CurrentY = TF.CurrentY + 1
TF.Print "0                              10                            20"
For i = 0 To Len(Str1) / 2 - 2
j = Val(Mid(Str1, i * 2 + 1, 2))    '性向曲线起
t = Val(Mid(Str1, i * 2 + 3, 2))    '性向曲线止
TF.Line (j * 5 + 50, Re + i * 5)-(t * 5 + 50, Re + i * 5 + 5)
DoEvents
Next
TF.CurrentX = 20
TF.CurrentY = TF.CurrentY + 6
TF.Font.Size = 11
TF.Font.Bold = True
TF.Print "（5）本人填写"
TF.Font.Size = 9
TF.Font.Bold = False
Re = TF.CurrentY + 1
TF.Line (20, TF.CurrentY + 1)-(180, TF.CurrentY + 12), , B
TF.CurrentX = 30
TF.CurrentY = Re + 2
TF.Print "长　处：" + UserCC
TF.CurrentX = 30
TF.CurrentY = TF.CurrentY + 1
TF.Print "短　处：" + UserDC
Re = TF.CurrentX
TF.CurrentY = TF.CurrentY + 10
TF.Line (15, TF.CurrentY)-(185, TF.CurrentY)
TF.Line (15, TF.CurrentY + 1)-(185, TF.CurrentY + 1)
TF.CurrentX = 116
TF.CurrentY = TF.CurrentY + 1
TF.Print "版权所有：（台湾）智囊团顾问管理有限公司"
End Sub

Private Sub Combo1_Click()
List1.Text = Combo1.Text
Set Printer = Printers(List1.ListIndex)
End Sub

Private Sub Command1_Click()
If Combo1.Text = "" Then MsgBox "请选择打印机！  ", vbInformation: Exit Sub
Printer.PaperSize = vbPRPSA4
PPP Printer
DoEvents
Printer.EndDoc
End Sub

Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim PP As Printer
Me.Left = 0
Me.Top = 0
Me.Caption = "打印预览"
Command1.Caption = "打印(&P)..."
Command5.Caption = "关闭(&C)"
Label1.Caption = "请选择打印机："
For Each PP In Printers
    List1.AddItem PP.DeviceName
    Combo1.AddItem PP.DeviceName
Next
Combo1.Text = Printer.DeviceName
List1.Text = Combo1.Text
Set Printer = Printers(List1.ListIndex)
End Sub

Private Sub Picture2_Paint()
PPP Picture2
End Sub

Private Sub VS_Change()
Picture2.Top = -VS.Value * 100 + 200
Picture1.SetFocus
End Sub