openwordtoprint.frm

内窥镜图案工作站有说明 有文档 有应用程序

VERSION 5.00
Begin VB.Form OpenWordToPrint 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   9900
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2145
   LinkTopic       =   "Form1"
   ScaleHeight     =   9900
   ScaleWidth      =   2145
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer TimerInWord 
      Left            =   1560
      Top             =   120
   End
   Begin VB.PictureBox PicBWordPrint 
      Height          =   9954
      Left            =   0
      ScaleHeight     =   9900
      ScaleWidth      =   2115
      TabIndex        =   1
      Top             =   600
      Width           =   2175
      Begin VB.FileListBox FileListBInWord 
         Height          =   270
         Left            =   120
         Pattern         =   "*.BMP"
         TabIndex        =   4
         Top             =   1920
         Visible         =   0   'False
         Width           =   1575
      End
      Begin VB.Frame FrameInWord 
         BorderStyle     =   0  'None
         Height          =   1395
         Left            =   0
         TabIndex        =   3
         Top             =   0
         Width           =   1695
         Begin VB.Image ImageBoxInWord 
            Height          =   1155
            Index           =   0
            Left            =   120
            Stretch         =   -1  'True
            Top             =   120
            Visible         =   0   'False
            Width           =   1530
         End
      End
      Begin VB.VScrollBar VScrBInWord 
         Height          =   9195
         LargeChange     =   5400
         Left            =   1800
         SmallChange     =   2700
         TabIndex        =   2
         Top             =   0
         Visible         =   0   'False
         Width           =   255
      End
   End
   Begin VB.CommandButton CmdBInWordPrint 
      Caption         =   "打印"
      Height          =   375
      Left            =   600
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "OpenWordToPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'用来使窗体始终在最前面
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'查找程序是否仍在运行
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Any) As Long

Private WordAppX As New Word.Application    '打开Word用到的变量
Private WordDocX As Word.Document
Private WordTableX As Word.Table

Private NumberInWord(5) As Integer    '存储点击了几次图片,方便添加图像
Private ImageNumInWord As Integer

Const HWND_TOPMOST = -1

Private Sub Form_Load()    '窗体初始化

    Dim SaveImageStr As String    '存储图像路径
    Dim SaveImageNum As Integer    '存储图像数
    Dim I As Integer, N As Integer
    
    ImageNumInWord = 0
    Me.top = 1440    '设置窗体在桌面上的位置
    Me.left = 13200
    
    SaveImageStr = App.Path + "\" + "Results\" + left(CurPatientInAll.CheckNumInAll, 8)    '得到当前文件夹的路径
    If (dir(SaveImageStr, vbNormal + vbDirectory) <> "") Then
        SaveImageStr = SaveImageStr + "\" + CurPatientInAll.CheckNumInAll    '获得当前病人存储图像的文件夹路径
        If (dir(SaveImageStr, vbNormal + vbDirectory) <> "") Then
            If CurPatientInAll.SaveImageNum > 0 Then    '如果有图像
                FrameInWord.Height = 120 + CurPatientInAll.SaveImageNum * 1275 '设置浏览图像框的Height值,1275 = 1155 + 120
                If CurPatientInAll.SaveImageNum > 7 Then     '如果采集图像数大于7,那么需要显示垂直滚动条
                    VScrBInWord.Visible = True
                    VScrBInWord.Value = 0
                    VScrBInWord.Max = FrameInWord.Height - VScrBInWord.Height
                    VScrBInWord.SmallChange = ImageBoxInWord(0).Height + 120    '最小改变,移动一副图像
                    VScrBInWord.LargeChange = VScrBInWord.SmallChange * 4    '最大改变,移动四副图像
                End If
                For I = 1 To CurPatientInAll.SaveImageNum
                    Load ImageBoxInWord(I)
                    ImageBoxInWord(I).top = 120 + 1275 * (I - 1)    '设置图像控件数组的各个属性值
                    ImageBoxInWord(I).left = 120
                    ImageBoxInWord(I).Visible = True
                    ImageBoxInWord(I).Picture = LoadPicture(ImageFileNameIn4(I))    '读取并显示图像
                Next I
                FrameInWord.Visible = True    '图像浏览框可见
            End If
        End If
    End If
    
    SetWindowPos Me.hWnd, HWND_TOPMOST, Me.left / Screen.TwipsPerPixelX, Me.top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, Me.Height \ Screen.TwipsPerPixelY, 0
    Set WordAppX = New Word.Application    '打开Word,加载一图文档
    WordAppX.ChangeFileOpenDirectory App.Path & "\打印模版\"
    Set WordDocX = WordAppX.Documents.Open(filename:="云南省第一人民医院超声科1.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", format:=wdOpenFormatAuto)
    
    Call InsertInforInWord    '调用过程加载病人信息
    
    MainForm.Visible = False    '主窗体不可见
    TimerInWord.Interval = 500    '设置时间控件的间隔
    
End Sub

Private Sub ImageBoxInWord_DblClick(Index As Integer)    '双击图像框数组中的一副图像,加载Word文档

    ImageNumInWord = ImageNumInWord + 1
    If ImageNumInWord = 1 Then
        NumberInWord(0) = Index
        Set WordTableX = WordDocX.Tables(2)
        WordTableX.Cell(1, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(0)), linktofile:=False, savewithdocument:=True
        WordAppX.Application.Visible = True
    End If
    If ImageNumInWord = 2 Then
        WordAppX.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        NumberInWord(1) = Index
        WordAppX.ChangeFileOpenDirectory App.Path & "\打印模版\"
        Set WordDocX = WordAppX.Documents.Open(filename:="云南省第一人民医院超声科2.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", format:=wdOpenFormatAuto)
        Call InsertInforInWord
        Set WordTableX = WordDocX.Tables(2)
        WordTableX.Cell(2, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(0)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(1)), linktofile:=False, savewithdocument:=True
        WordAppX.Application.Visible = True
    End If
    If ImageNumInWord = 3 Then
        WordAppX.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        NumberInWord(2) = Index