picselect.frm

1、以DLL形式提供医生工作站 2、 根据【检查项目】

        Loop
        ImageInt = DcmN
    End If
    DcmBmpRS.Close
Else
  MsgBox "对不起,您没有查询的权限", vbExclamation + vbOKOnly, "权限出错"
End If
End Sub


Private Sub UnloadImg() '卸载Image控件
On Error Resume Next
For ImgN = 1 To ImageInt
  Unload Image1(ImgN)
Next ImgN
Image1(0).Visible = False
End Sub

Private Sub PrintDcmHead(DcmTouInt As Integer)   '打印字头到图片上
Dim PrintTouRs As New ADODB.Recordset
  PrintTouRs.Open "select * from DicomBmpHead where InsPectID='" & Text1.Text & "' and InsPectPicNo= " & DcmTouInt, conn, adOpenDynamic, adLockOptimistic
    DcmTxtBox.ScaleMode = vbPixels '设置文字打印起始位置
    DcmTxtBox.FontSize = 10
    DcmTxtBox.CurrentY = 10
    
    If Not PrintTouRs.EOF Then
       DcmTxtBox.ForeColor = RGB(0, 0, 0)
        If IsNull(PrintTouRs.Fields(2)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(2)
        If IsNull(PrintTouRs.Fields(3)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(3)
        If IsNull(PrintTouRs.Fields(4)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(4)
        If IsNull(PrintTouRs.Fields(5)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(5)
        If IsNull(PrintTouRs.Fields(6)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(6)
        If IsNull(PrintTouRs.Fields(7)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(7)
        If IsNull(PrintTouRs.Fields(8)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(8)
        If IsNull(PrintTouRs.Fields(9)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(9)
        If IsNull(PrintTouRs.Fields(10)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(10)
        If IsNull(PrintTouRs.Fields(11)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(11)
        If IsNull(PrintTouRs.Fields(12)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(12)
        If IsNull(PrintTouRs.Fields(13)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(13)
        If IsNull(PrintTouRs.Fields(14)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(14)
        If IsNull(PrintTouRs.Fields(15)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(15)
        If IsNull(PrintTouRs.Fields(16)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(16)
        If IsNull(PrintTouRs.Fields(17)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(17)
        If IsNull(PrintTouRs.Fields(18)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(18)
        If IsNull(PrintTouRs.Fields(19)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(19)
        If IsNull(PrintTouRs.Fields(20)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(20)
        If IsNull(PrintTouRs.Fields(21)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(21)
        If IsNull(PrintTouRs.Fields(22)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(22)
        If IsNull(PrintTouRs.Fields(23)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(23)
        If IsNull(PrintTouRs.Fields(24)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(24)
        If IsNull(PrintTouRs.Fields(25)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(25)
        If IsNull(PrintTouRs.Fields(26)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(26)
        If IsNull(PrintTouRs.Fields(27)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(27)
        If IsNull(PrintTouRs.Fields(28)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(28)
        If IsNull(PrintTouRs.Fields(29)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(29)
        If IsNull(PrintTouRs.Fields(30)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(30)
        If IsNull(PrintTouRs.Fields(31)) = False Then DcmTxtBox.Print Tab(2); PrintTouRs.Fields(31)
  End If
PrintTouRs.Close
DcmTxtBox.ScaleMode = vbTwips
End Sub

Private Sub Exit_Click()
     Unload Me
End Sub

Private Sub Form_Load()  '初始化位置
  
End Sub

Private Sub Form_Resize()
  DcmTxtBox.left = Me.ScaleLeft
  DcmTxtBox.top = Me.ScaleTop
  DcmTxtBox.Width = Me.ScaleWidth
  DcmTxtBox.Height = Me.ScaleHeight
  Image1(0).left = 200
  Image1(0).top = 200
  Image1(0).Height = 2000
  Image1(0).Width = 2000
End Sub

Private Sub Form_Unload(Cancel As Integer)
 If MsgBox("真的要退出dicom图片查询吗", vbOKCancel + vbQuestion, "提示") = vbOK Then
  If picquerybool = True Then
     dicomserver.show
  Else
    MDIForm1.show
    formtest.show
  End If
Else
  Cancel = -1
End If
End Sub

Private Sub MenuSel_Click()
Dim InPutStr As String
InPutStr = InputBox("请填写需要查询报告单的14位检查编号", "查询输入窗口", "在这里输入")
If InPutStr <> "" Then
  Text1.Text = InPutStr
  Call CMDSel_Click
Else
  MsgBox "检查编号不能为空！", vbExclamation + vbOKOnly, "错误"
End If
End Sub

Private Sub NextPic_Click()  '显示放大的后一张图片
   Image1(f).Width = Twidth
   Image1(f).Height = Theight
   Image1(f).Visible = False
   Image1(f).left = ImgIndexLeft
   Image1(f).top = ImgIndexTop
   Image1(f).Visible = False
   f = f + 1
   ImgIndexLeft = Image1(f).left
   ImgIndexTop = Image1(f).top
   Twidth = Image1(f).Width
   Theight = Image1(f).Height
   If Image1(f).Picture.Height > Image1(f).Picture.Width Then
      Image1(f).Height = DcmTxtBox.Height * 0.9
      Image1(f).Width = Image1(f).Height * Twidth / Theight
   Else
      Image1(f).Width = DcmTxtBox.Height * 0.9
      Image1(f).Height = Image1(f).Width / Twidth * Theight
   End If
   Image1(f).left = DcmTxtBox.Width - DcmTxtBox.Height * 0.95
   Image1(f).top = (DcmTxtBox.Height - Image1(f).Height - 300) / 2
   Image1(f).Visible = True '显示放大的图片
   NextPic.Enabled = True
   BeforPic.Enabled = True
   If f = ImageInt - 1 Then NextPic.Enabled = False
   DcmTxtBox.Cls
   Call PrintDcmHead(f)
End Sub

Private Sub picmagnify_Click()
   Dim showRS As New ADODB.Recordset
If picmagnify.Caption = "放大" Then
    Call ImageShow(False) '隐藏全部图片
   ImgIndexLeft = Image1(f).left
   ImgIndexTop = Image1(f).top
   Twidth = Image1(f).Width
   Theight = Image1(f).Height
   If Image1(f).Picture.Height > Image1(f).Picture.Width Then
      Image1(f).Height = DcmTxtBox.Height * 0.9
      Image1(f).Width = Image1(f).Height * Twidth / Theight
   Else
      Image1(f).Width = DcmTxtBox.Height * 0.9
      Image1(f).Height = Image1(f).Width / Twidth * Theight
   End If
   Image1(f).left = DcmTxtBox.Width - DcmTxtBox.Height * 0.95
   Image1(f).top = (DcmTxtBox.Height - Image1(f).Height - 300) / 2
   picmagnify.Caption = "缩小"
   Image1(f).Visible = True '显示放大的图片
   BeforPic.Visible = True
   NextPic.Visible = True
   BeforPic.Enabled = True
   NextPic.Enabled = True
   If f = 0 Then BeforPic.Enabled = False
   If f = ImageInt - 1 Then NextPic.Enabled = False
   Call PrintDcmHead(f)
ElseIf picmagnify.Caption = "缩小" Then
  Image1(f).Width = Twidth
  Image1(f).Height = Theight
  picmagnify.Caption = "放大"
  Image1(f).Visible = False
  Image1(f).left = ImgIndexLeft
  Image1(f).top = ImgIndexTop
  DcmTxtBox.Cls
  BeforPic.Visible = False
  NextPic.Visible = False
  Call ImageShow(True) '显示全部图片
End If
End Sub

Private Sub SaveAs_Click()
  SaveDialog.InitDir = CurDir
  SaveDialog.Filter = "位图文件(*.bmp)|*.bmp"
  SaveDialog.ShowSave
  If SaveDialog.Filename <> "" Then
    SavePicture Image1(f).Picture, SaveDialog.Filename
  End If
End Sub

Private Sub unloadmeform_click()
Call Exit_Click
End Sub

Private Sub ImageShow(ShowBool As Boolean) '图片隐藏和显示
On Error Resume Next '错误处理
Dim ImageShowIndex As Integer
ImageShowIndex = 0
    If ShowBool = True Then
        For ImageForIndex = 0 To ImageInt - 1 '显示
            Image1(ImageShowIndex).Visible = True
            ImageShowIndex = ImageShowIndex + 1
        Next ImageForIndex
    ElseIf ShowBool = False Then
        For ImageForIndex = 0 To ImageInt - 1 '隐藏
            Image1(ImageShowIndex).Visible = False
            ImageShowIndex = ImageShowIndex + 1
        Next ImageForIndex
    End If
End Sub

Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
f = Index
'MsgBox f
'弹出试菜单
If Button = 2 Then
    Me.PopupMenu Me.rightmouse
End If
End Sub