frmvolumereg.frm

一个把自己的东西刻成光盘后自动查询和启动的原代码

      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   4080
      TabIndex        =   15
      Top             =   1320
      Width           =   2055
   End
   Begin VB.Label LblMain 
      Caption         =   "label"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   10
      Top             =   0
      Visible         =   0   'False
      Width           =   1095
   End
End
Attribute VB_Name = "FrmVolumeReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public gCtlDistance As Long '控件间距
Public gTabWidth As Long '属性页宽度
Public gLabelWidth As Long '标题宽
Public gLabelHeight As Long '标题宽
Public gCmdWidth As Single '按钮宽和高

Public gLabelVDistance As Long '标题与控件垂直间距
Public gBaseHeight As Single '单位高
Public gBaseWidth As Single '单位宽

Public gVolumeRdoRst '存放案卷信息的结果集

'显示日期
Private Sub CalMain_Click(Index As Integer)
On Error GoTo Err
MaskRQ(Index).Text = Format(CalMain(Index).Value, "yyyy年mm月dd日")
CalMain(Index).Visible = False
Err:
End Sub

Private Sub CalMain_LostFocus(Index As Integer)
'CalMain(Index).Visible = False
End Sub

Private Sub CmdCancel_Click()
Unload Me
FrmMain.Show
End Sub

Private Sub CmdNext_Click()
If TabMain.Tabs = 1 Then Exit Sub
If TabMain.Tab < TabMain.Tabs - 1 Then
   TabMain.Tab = TabMain.Tab + 1
Else
   TabMain.Tab = TabMain.Tabs - 1
End If
End Sub

Private Sub CmdPre_Click()
If TabMain.Tabs = 0 Then Exit Sub
If TabMain.Tab > 0 Then
   TabMain.Tab = TabMain.Tab - 1
Else
   TabMain.Tab = 1
End If
End Sub

'####################################################################
'显示日期控件函数
'####################################################################
Private Sub CmdRQ_Click(Index As Integer)
On Error GoTo Err
Dim tHPos As Integer '0左1右
Dim tVPos As Integer '0上1下

If IsControl(CalMain(Index)) = True Then
   If CalMain(Index).Visible = True Then
      CalMain(Index).Visible = False
      Exit Sub
   End If
End If

'添加控件
If AddControl(CalMain(Index)) = True Then CalMain(Index).Visible = False
Set CalMain(Index).Container = CmdRQ(Index).Container

'初始化控件大小
CalMain(Index).Width = CalMain(0).Width
CalMain(Index).Height = CalMain(0).Height

If IsDate(MaskRQ(Index).Text) = False Then
   CalMain(Index).Value = Date
Else
   CalMain(Index).Value = CDate(MaskRQ(Index).Text)
End If

'确定控件位置
'在MaskRQ的左或右
If MaskRQ(Index).Container.Width - MaskRQ(Index).Left > CalMain(Index).Width Then
   tHPos = 1
Else
   tHPos = 0
End If

'在MaskRQ的上或下
If MaskRQ(Index).Container.Height - MaskRQ(Index).Top - MaskRQ(Index).Height > CalMain(Index).Height Then
   tVPos = 1
Else
   tVPos = 0
End If

Set CalMain(Index).Container = CmdRQ(Index).Container
If tVPos = 1 Then '在下
   CalMain(Index).Top = MaskRQ(Index).Top + MaskRQ(Index).Height + 600
Else '在上
   If MaskRQ(Index).Top - CalMain(Index).Height > 0 Then
      CalMain(Index).Top = MaskRQ(Index).Top - CalMain(Index).Height
   Else
      CalMain(Index).Top = 0
   End If
End If
If tHPos = 1 Then '在右
   CalMain(Index).Left = MaskRQ(Index).Left
Else '在左
   If CmdRQ(Index).Left + CmdRQ(Index).Width - CalMain(Index).Width > 0 Then
      CalMain(Index).Left = CmdRQ(Index).Left + CmdRQ(Index).Width - CalMain(Index).Width
   Else
      CalMain(Index).Left = 0
   End If
End If
Set CalMain(Index).Container = CmdRQ(Index).Container
CalMain(Index).Visible = True
CalMain(Index).SetFocus
Exit Sub
Err:
    Call MsgErr("日期显示", "3002", "", False, LXGLY, Err.Description)
'CalMain(Index).ZOrder = 1
End Sub

Private Sub Form_Load()
On Error GoTo Err
TabMain.TabCaption(0) = ""
TabMain.TabCaption(1) = ""
TabMain.TabHeight = 0.1

gCtlDistance = 80
gLabelWidth = 735
gLabelVDistance = 60
gLabelHeight = 255
gCmdWidth = CbxMain(0).Height

TabMain.TabVisible(1) = False
CmdPre.Visible = False
CmdNext.Visible = False
TabMain.TabCaption(0) = ""
TabMain.TabCaption(1) = ""
CalMain(0).Width = 4000
CalMain(0).Height = 2000
Me.Show
'Me.WindowState = 2
gTabWidth = Me.ScaleWidth - gCtlDistance * 2
gBaseWidth = (gTabWidth - gCtlDistance) / 3
gBaseHeight = gCtlDistance + CbxMain(0).Height

Exit Sub
Err:
   Call MsgErr("初始化", "3003", "", False, LXGLY, Err.Description)
End Sub

Private Sub LVFile_DblClick()
Call FrmMain.ViewFileReg(LVFile, FrmVolumeReg, "2")
End Sub

Private Sub PicCmd_Resize()
CmdCancel.Move PicCmd.Width - gCtlDistance - CmdCancel.Width, (PicCmd.Height - CmdCancel.Height) / 2

CmdPre.Move Me.ScaleWidth / 2 - CmdPre.Width, (PicCmd.Height - CmdPre.Height) / 2
CmdNext.Move Me.ScaleWidth / 2, (PicCmd.Height - CmdPre.Height) / 2
End Sub

'###################################################################################
'添加属性页 '未使用
'###################################################################################
Public Sub AddTab()
TabMain.TabVisible(1) = True
TabMain.TabsPerRow = 2
CmdPre.Visible = True
CmdNext.Visible = True
End Sub

'###################################################################################
'初始化窗体
'参数：pTypeCode 案卷类型 p_Operate_Type 操作类型 p_Volume_ID 显示的案卷ID
'返回：Boolean
'###################################################################################
Public Sub FrmInit(pTypeCode As String, p_Operate_Type As String, ByVal p_Volume_ID As String, ByVal p_ObjType As Integer, pType As Integer)
On Error GoTo Err

Dim tTag As String '记录 字段名称，自定义数据类型，数据字典类型,案卷ID
Dim t_End_Height As Single '录入字段终止高度
Dim tErrDes As String
Dim tObjType As Integer   '档案盒、案卷标记
Dim tObjString As String

tObjType = p_ObjType

tErrDes = "控件位置"
LblTitle.Move gCtlDistance, gCtlDistance, Me.ScaleWidth - 2 * gCtlDistance

'调整tab,piccmd位置
TabMain.Move gCtlDistance, LblTitle.Top + LblTitle.Height + gCtlDistance, Me.ScaleWidth - gCtlDistance * 2, (Me.ScaleHeight - LblTitle.Height - LblTitle.Top - gCtlDistance) * 0.92
PicCmd.Move 0, TabMain.Top + TabMain.Height + gCtlDistance, Me.ScaleWidth, Me.ScaleHeight - TabMain.Height - gCtlDistance - LblTitle.Height - LblTitle.Top - gCtlDistance

If p_Volume_ID <> "" And p_Volume_ID <> "0" Then
   Set gVolumeRdoRst = gDbs.OpenRecordset("select * from Volume_" + pTypeCode + " where Volume_id=" + p_Volume_ID)
   If gVolumeRdoRst.EOF Then
      p_Volume_ID = "0"
   Else
      tObjType = gVolumeRdoRst.Fields("type")
   End If
Else
   p_Volume_ID = "0"
End If
   
If tObjType = 1 Then
   tObjString = "盒"
Else
   tObjString = "案卷"
End If

'设置全局案卷关键字
FrmVolumeReg.Tag = "Frm @P " + pTypeCode + " @I " + p_Volume_ID

tErrDes = "固定字段生成"
'案卷标题
tTag = "Ctl @F Title @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos(tObjString + "标题", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, 0, 1, 2, 0, True)

If tObjType = 1 Then
   tTag = "Ctl @F box_no @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
   Call SetCtlPos("盒号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, gBaseWidth * 2, 0, 1, 1, 0, True)
Else
   tTag = "Ctl @F volume_no @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
   Call SetCtlPos("案卷号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, gBaseWidth * 2, 0, 1, 1, 0, True)
End If


'案卷 年度
tTag = "Ctl @F Year @P 2 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("年度", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight, 1, 1, 0, True)
'办理部门
tTag = "Ctl @F Department_ID @P 4 @D 9 @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("办理部门", tTag, LblMain(LblMain.Count), CbxMain(CbxMain.Count), Nothing, gBaseWidth, gBaseHeight, 1, 1, 0, True)
'保管期限
tTag = "Ctl @F Keep_Term @P 2 @D 3 @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("保管期限", tTag, LblMain(LblMain.Count), CbxMain(CbxMain.Count), Nothing, gBaseWidth * 2, gBaseHeight, 1, 1, 0, True)

'全宗号
tTag = "Ctl @F Fonds_No @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("全宗号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight * 2, 1, 1, 0, True)

'全宗名称
tTag = "Ctl @F Fonds_Name @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("全宗名称", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, gBaseWidth, gBaseHeight * 2, 1, 2, 0, True)

'目录号
tTag = "Ctl @F Catalog_No @P 4 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("目录号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight * 3, 1, 1, 0, True)

''案卷号
'tTag = "Ctl @F Volume_No @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
'Call SetCtlPos(tObjString + "ID号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, gBaseWidth, gBaseHeight * 3, 1, 1, 0, True)

'密集架号
tTag = "Ctl @F Shelf_No @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("密集架号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, gBaseWidth, gBaseHeight * 3, 1, 2, 0, True)

'总件数
tTag = "Ctl @F File_Count @P 4 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("总件数", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight * 4, 1, 1, 0, True)

'起始件号
tTag = "Ctl @F First_File_No @P 4 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("起始件号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, gBaseWidth, gBaseHeight * 4, 1, 1, 0, True)

'起始件号
tTag = "Ctl @F Last_File_No @P 4 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("终止件号", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 2 * gBaseWidth, gBaseHeight * 4, 1, 1, 0, True)

'总页数
tTag = "Ctl @F Page_Count @P 4 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("总页数", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight * 5, 1, 1, 0, True)

'起始日期
tTag = "Ctl @F Start_Date @P 1 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("起始日期", tTag, LblMain(LblMain.Count), MaskRQ(MaskRQ.Count), CmdRQ(CmdRQ.Count), gBaseWidth, gBaseHeight * 5, 1, 1, 0, True)

'终止日期
tTag = "Ctl @F Stop_Date @P 1 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("终止日期", tTag, LblMain(LblMain.Count), MaskRQ(MaskRQ.Count), CmdRQ(CmdRQ.Count), 2 * gBaseWidth, gBaseHeight * 5, 1, 1, 0, True)

'创建人
tTag = "Ctl @F Creator @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("创建人", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight * 6, 1, 1, 0, True)

'创建日期
tTag = "Ctl @F Created_Date @P 1 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("创建日期", tTag, LblMain(LblMain.Count), MaskRQ(MaskRQ.Count), CmdRQ(CmdRQ.Count), gBaseWidth, gBaseHeight * 6, 1, 1, 0, True)

'分割线
Call SetCtlPos("", "", Nothing, FrameSep(0), Nothing, 0, gBaseHeight * 6, 0, 0, 0, True)

'备注
tTag = "Ctl @F Remark @P 3 @D @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos(tObjString + "备注", tTag, LblMain(LblMain.Count), TxtMain(TxtMain.Count), Nothing, 0, gBaseHeight * 7, 2, 3, 0, True)

'案卷状态
tTag = "Ctl @F Status @P 4 @D 14 @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos(tObjString + "状态", tTag, LblMain(LblMain.Count), CbxMain(CbxMain.Count), Nothing, 0, gBaseHeight * 9, 1, 1, 0, True)

'移交状态
tTag = "Ctl @F Transfer_Flag @P 4 @D 11 @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("移交状态", tTag, LblMain(LblMain.Count), CbxMain(CbxMain.Count), Nothing, gBaseWidth, gBaseHeight * 9, 1, 1, 0, True)

'销毁状态
tTag = "Ctl @F Destruction_Flag @P 4 @D 12 @I " + p_Volume_ID + " @N 0 @DF 0"
Call SetCtlPos("销毁状态", tTag, LblMain(LblMain.Count), CbxMain(CbxMain.Count), Nothing, gBaseWidth * 2, gBaseHeight * 9, 1, 1, 0, True)

'分割线
Call SetCtlPos("", "", Nothing, FrameSep(2), Nothing, 0, gBaseHeight * 10, 0, 0, 0, True)

'显示自定义字段
Call CreateForm(pTypeCode, 10 * gBaseHeight, t_End_Height)

'分割线
Call SetCtlPos("", "", Nothing, FrameSep(2), Nothing, 0, t_End_Height, 0, 0, 0, True)

'增加文件列表显示