mfrm_bill.frm

print打印功能.实现套打,请下载查看具体的功能介绍.

        PicFixHd(2).Move .Left + (.Width / 2) - nWidth, .Top + .Height - nHeight - yFudge
        'Bottom right
        PicFixHd(3).Move (.Left + .Width) - nWidth - xFudge, .Top + .Height - nHeight - yFudge
    End With
    
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim neww As Single, newh As Single
Dim rc As RECTAPI
    If mbPageDraw And Button = vbLeftButton Then
        With PicPage
            neww = .Width + (X - OldPoint.X)
            newh = .Height + (Y - OldPoint.Y)
            If neww < 1000 Then neww = 1000
            If newh < 1000 Then newh = 1000
            Select Case mFixHdIdx
                'Center Right
                Case 1: .Width = neww
                'Bottom Center
                Case 2: .Height = newh
                'Bottom Right
                Case 3: .Width = neww: .Height = newh
            End Select
            OldPoint.Y = Y
            OldPoint.X = X
        End With
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mbPageDraw And Button = vbLeftButton Then
        Call MoveFixHd
        PicFixHd(1).Visible = True
        PicFixHd(2).Visible = True
        PicFixHd(3).Visible = True
        ClipCursor ByVal 0&
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ClipCursor ByVal 0&
    Set mObjs = Nothing
    Set mObj_Draw = Nothing
    Set g_ActFrm = Nothing
End Sub

Private Sub ObjImg_DblClick(Index As Integer)
On Error GoTo Er
    With Cdlg
        .CancelError = True
        .DialogTitle = "选择图形文件"
        .Filter = "位图文件(*.Bmp)|*.Bmp|所有图形文件|*.Bmp;*.Jpg;*.Gif;*.Ico|所有文件(*.*)|*.*"
        .ShowOpen
        Cdlg.Flags = cdlOFNHelpButton + cdlOFNHideReadOnly + cdlOFNPathMustExist + cdlOFNFileMustExist
        If .FileName <> "" Then
            ObjImg(Index).Picture = LoadPicture(.FileName)
            ObjImg(Index).Tag = .FileName
        End If
    End With
    Exit Sub
Er:
    If Err.Number = 32755 Then: ObjImg(Index).Picture = LoadPicture(): ObjImg(Index).Tag = "": Exit Sub: Else: Call ErrInfo
End Sub

Private Sub ObjImg_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PicPage_MouseDown(Button, Shift, ObjImg(Index).Left + X, ObjImg(Index).Top + Y)
End Sub

Private Sub ObjImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PicPage_MouseMove(Button, Shift, ObjImg(Index).Left + X, ObjImg(Index).Top + Y)
End Sub

Private Sub ObjImg_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PicPage_MouseUp(Button, Shift, ObjImg(Index).Left + X, ObjImg(Index).Top + Y)
End Sub

Private Sub ObjText_DblClick(Index As Integer)
    If mObjs("Obj" & Index).IsFix Then
        With ObjText(Index)
            mActLab = Index
            TxtLab.Move .Left, .Top, .Width, .Height
            TxtLab.Text = .Caption
            Set TxtLab.Font = .Font
            TxtLab.ForeColor = .ForeColor
            TxtLab.Visible = True
            TxtLab.SetFocus
        End With
    End If
End Sub

Private Sub ObjText_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PicPage_MouseDown(Button, Shift, ObjText(Index).Left + X, ObjText(Index).Top + Y)
End Sub

Private Sub ObjText_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PicPage_MouseMove(Button, Shift, ObjText(Index).Left + X, ObjText(Index).Top + Y)
End Sub

Private Sub ObjText_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call PicPage_MouseUp(Button, Shift, ObjText(Index).Left + X, ObjText(Index).Top + Y)
End Sub

Private Sub PicFixHd_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mbPageDraw Then
        Call Form_MouseMove(Button, Shift, PicFixHd(Index).Left + X, PicFixHd(Index).Height + Y)
    End If
End Sub

Private Sub PicFixHd_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim tmpindex As Long
    If mbPageDraw Then
        Call Form_MouseUp(Button, Shift, PicFixHd(Index).Left + X, PicFixHd(Index).Height + Y)
        mbPageDraw = False
    End If
End Sub

Private Sub PicFixHd_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer
    Dim rc As RECTAPI

    mFixHdIdx = Index
    OldPoint.X = PicFixHd(Index).Left + X
    OldPoint.Y = PicFixHd(Index).Height + Y
    mbPageDraw = True
    
    PicFixHd(1).Visible = False
    PicFixHd(2).Visible = False
    PicFixHd(3).Visible = False
    
    GetWindowRect g_ActFrm.hwnd, rc
    ClipCursor rc
    
End Sub

Private Sub PicHd_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rc As RECTAPI
    If Button = vbLeftButton And mObjs.nActCount > 0 Then
        If mObjs.nActCount > 1 Then
            mObjs.nActCount = 0
            mObjs.nCurID = IIf((Index Mod 8) = 0, Index / 8, Int(Index / 8) + 1)
        End If
        If mObjs.nCurID <= 0 Then Exit Sub
        Set mObjAct = mObjs.Item("Obj" & mObjs.nCurID)
        GetWindowRect PicPage.hwnd, rc
        ClipCursor rc
        mObjAct.Handls(Val(PicHD(Index).Tag)).OnMouseDown mObjAct, Button, Shift, X, Y
        mActHd = Val(PicHD(Index).Tag)
    End If
End Sub

Private Sub PicHd_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton And mObjAct.IsSizing And Not mObjAct.Locked Then
        If mObjAct Is Nothing Then Exit Sub
        mObjAct.Handls(Val(PicHD(Index).Tag)).OnMouseMove mObjAct, Button, Shift, PicHD(Index).Left + X, PicHD(Index).Top + Y
    End If
End Sub

Private Sub PicHd_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then ClipCursor ByVal 0&
    If Button = vbLeftButton And mObjAct.IsSizing And Not mObjAct.Locked Then
        If mObjAct Is Nothing Then Exit Sub
        mObjAct.Handls(Val(PicHD(Index).Tag)).OnMouseUp mObjAct, Button, Shift, X, Y
    End If
End Sub

Private Sub PicPage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rc As RECTAPI
    If Button = vbRightButton Then Call RightMenu: Exit Sub
    If Button = vbLeftButton Then GetWindowRect PicPage.hwnd, rc: ClipCursor rc
    '画对象
    If Button = vbLeftButton And g_DrawMode <> mObjNone Then
        Set mObj_Draw = New ObjDraw
        mObj_Draw.eType = g_DrawMode
        '拖动选中的多个对象
        If g_DrawMode = mObjSelect And mObjs.nActCount > 1 Then
            If mObjs.StartMoveMore(X, Y, mObjAct) Then
                If mObjAct Is Nothing Then Exit Sub
                mbMoreMove = True
                Exit Sub
            End If
        End If
        '拖动当前单个对象
        If g_DrawMode = mObjSelect Then
            If mObjs.ChkPoint(X, Y, mObjAct) Then
                If mObjAct Is Nothing Then Exit Sub
                If Not mObjAct.Locked Then mObjAct.OnStartDrag X, Y
                Exit Sub
            End If
        End If
        '画对象
        mObjs.nActCount = 0
        OldPoint.X = X
        OldPoint.Y = Y
        mObj_Draw.nID = mObjs.Count + 1
        mObj_Draw.IsActive = False
        mObj_Draw.OnStartDraw Button, Shift, X, Y
    End If
End Sub

Private Sub PicPage_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    PicPage.MousePointer = IIf(g_DrawMode > mObjSelect, vbCrosshair, vbDefault)
    If Button = vbLeftButton And mObj_Draw.IsDrawing Then mObj_Draw.OnDrawing Button, Shift, X, Y
    '单个拖动
    If Button = vbLeftButton And mObjs.nActCount = 1 And g_DrawMode = mObjSelect Then
        If mObjAct.IsDraging And Not mObjAct.Locked Then
            mObjAct.OnDraging X, Y, True, PicPage.Width, PicPage.Height
        End If
    End If
    '多个拖动
    If Button = vbLeftButton And g_DrawMode = mObjSelect And mbMoreMove Then
        Call mObjs.MovingMore(X, Y, True, PicPage.Width, PicPage.Height)
        Exit Sub
    End If
    '调整大小
    If Button = vbLeftButton And mObjs.nActCount = 1 And g_DrawMode = mObjSelect Then
        If mObjAct.IsSizing And Not mObjAct.Locked Then
            mObjAct.Handls(mActHd).OnMouseMove mObjAct, Button, Shift, X, Y
        End If
   End If
End Sub

Private Sub PicPage_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then ClipCursor ByVal 0&
    '画对象
    If Button = vbLeftButton And mObj_Draw.IsDrawing Then
        mObj_Draw.OnEndDraw Button, Shift, X, Y
        If g_DrawMode > mObjSelect Then
            mObjs.Add mObj_Draw, "Obj" & mObj_Draw.nID     '真实对象
            Set mObjAct = mObj_Draw
            Set mObjAct.Handls = mObj_Draw.Handls
            Set mObjAct.ObjCtl = mObj_Draw.ObjCtl
            mObjs.nCurID = mObjAct.nID
        ElseIf g_DrawMode = mObjSelect Then         '选择对象
                PicPage.Cls
                mObjs.ChkRange CSng(OldPoint.X), CSng(OldPoint.Y), X, Y, mObjAct
                Exit Sub
        End If
        Call mFrm_Main.mun_ObjDraw_Click(mObjSelect)
        mFrm_Main.TlbMain.Buttons("DrawSel").Value = tbrPressed
    End If
    '单个拖动
    If Button = vbLeftButton And mObjs.nActCount = 1 And g_DrawMode = mObjSelect Then
        If mObjAct.IsDraging And Not mObjAct.Locked Then
            mObjAct.OnEndDrag X, Y
        End If
    End If
    '多个拖动
    If Button = vbLeftButton And g_DrawMode = mObjSelect And mbMoreMove Then
        Call mObjs.EndMoveMore(X, Y)
        mbMoreMove = False
        Exit Sub
    End If
    '调整大小
    If Button = vbLeftButton And mObjs.nActCount = 1 And g_DrawMode = mObjSelect Then
        If mObjAct.IsSizing And Not mObjAct.Locked Then
            mObjAct.Handls(mActHd).OnMouseUp mObjAct, Button, Shift, X, Y
        End If
    End If
    If mObjs.nCurID > 0 Then
        mFrm_Main.mun_EditLock.Checked = mObjs.Item("Obj" & mObjs.nCurID).Locked
        mFrm_Main.TlbMain.Buttons("Locked").Value = IIf(mFrm_Main.mun_EditLock.Checked, 1, 0)
    End If
End Sub

Private Sub PicPage_Resize()
    If PicFixHd(1).Visible Then MoveFixHd
    Call Form_Resize
End Sub

Private Sub TxtLab_Change()
    ObjText(mActLab).Caption = TxtLab.Text
    ObjText(mActLab).Tag = TxtLab.Text
End Sub

Private Sub TxtLab_GotFocus()
    With TxtLab
        .SelStart = 0
        .SelLength = Len(.Text)
    End With
End Sub

Private Sub TxtLab_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then TxtLab.Visible = False
End Sub

Private Sub TxtLab_LostFocus()
    TxtLab.Visible = False
End Sub

'-------------------------
Private Sub HS_Change()
    PicPage.Move PictSet - HS.Value
    If PicFixHd(1).Visible Then MoveFixHd
End Sub

Private Sub VS_Change()
    PicPage.Move PicPage.Left, PictSet - VS.Value
    If PicFixHd(1).Visible Then MoveFixHd
End Sub

Private Sub Form_Resize()
    Dim mX, mY As Single
    
    On Error Resume Next
    
    HS.Move 0, Me.Height - HS.Height - 400, Me.Width - VS.Width - 100
    VS.Move Me.Width - VS.Width - 100, 0, VS.Width, Me.Height - HS.Height - 400
    
    mX = HS.Value: mY = VS.Value
    
    If PicPage.Width > VS.Left Then

        HS.Min = 0: HS.Max = PicPage.Width - VS.Left + 2 * VS.Width

        If mX < HS.Min Then mX = HS.Min
        If mX > HS.Max Then mX = HS.Max

        HS.Visible = True
        HS.Value = mX

    Else
        HS.Visible = False
        HS.Value = 0
    End If

    If PicPage.Height > HS.Top Then

        VS.Min = 0: VS.Max = PicPage.Height - HS.Top + 2 * HS.Height

        If mY < VS.Min Then mY = VS.Min
        If mY > VS.Max Then mY = VS.Max

        VS.Visible = True
        VS.Value = mY

    Else
        VS.Visible = False
        VS.Value = 0
    End If

End Sub