mfrm_main.frm

套打程序

    g_ActFrm.SetAlign (AlignRight)
End Sub

Private Sub mun_AlignTop_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    g_ActFrm.SetAlign (AlignTop)
End Sub

Private Sub mun_AlignVCenter_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    g_ActFrm.SetAlign (AlignVCenter)
End Sub

Private Sub mun_Clone_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    Call g_ActFrm.CloneObj
End Sub

Private Sub mun_Delete_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    Call g_ActFrm.Delete
End Sub

Private Sub mun_DrawObj_Click(Index As Integer)
    Call mun_ObjDraw_Click(Index)
End Sub

Private Sub mun_EditClone_Click()
    Call mun_Clone_Click
End Sub

Private Sub mun_EditDel_Click()
    Call mun_Delete_Click
End Sub

Private Sub mun_EditLock_Click()
    Call mun_Lock_Click
End Sub

Private Sub mun_EditProp_Click()
    Call mun_ObjProp_Click
End Sub

Private Sub mun_EditSelAll_Click()
    Call mun_SelAll_Click
End Sub

Private Sub mun_FileClose_Click()
    Unload g_ActFrm
End Sub

Private Sub mun_FileNew_Click()
    Call Opened
End Sub

Private Sub mun_FileOpen_Click()
    Call Opened(False)
End Sub

Private Sub mun_FilePageSetup_Click()
    Call PageSetup
End Sub

Private Sub mun_FilePreView_Click()
    Call PreViewed
End Sub

Private Sub mun_FileSave_Click()
    Call Saved
End Sub

Private Sub mun_FileSaveAs_Click()
    Call Saved(True)
End Sub

Private Sub mun_FormatBottom_Click()
    Call mun_AlignBottom_Click
End Sub

Private Sub mun_FormatHCenter_Click()
    Call mun_AlignHCenter_Click
End Sub

Private Sub mun_FormatHeight_Click()
    Call mun_SameHeight_Click
End Sub

Private Sub mun_FormatLeft_Click()
    Call mun_AlignLeft_Click
End Sub

Private Sub mun_FormatRight_Click()
    Call mun_AlignRight_Click
End Sub

Private Sub mun_FormatSize_Click()
    Call mun_SameAll_Click
End Sub

Private Sub mun_FormatTop_Click()
    Call mun_AlignTop_Click
End Sub

Private Sub mun_FormatVCenter_Click()
    Call mun_AlignVCenter_Click
End Sub

Private Sub mun_FormatWidth_Click()
    Call mun_SameWidth_Click
End Sub

Private Sub mun_Lock_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    Call g_ActFrm.Locked
End Sub

Public Sub mun_ObjDraw_Click(Index As Integer)
Dim i As Integer
Dim strkey As String
    g_DrawMode = Index
    For i = 0 To mun_ObjDraw.UBound: mun_ObjDraw(i).Checked = False: Next
    For i = 0 To mun_DrawObj.UBound: mun_DrawObj(i).Checked = False: Next
    mun_ObjDraw(Index).Checked = True
    mun_DrawObj(Index).Checked = True
End Sub

Private Sub mun_ObjProp_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    g_ActFrm.SetObjProp
End Sub

Private Sub mun_SameAll_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    g_ActFrm.SetSameSize (SameSizeAll)
End Sub

Private Sub mun_SameHeight_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    g_ActFrm.SetSameSize (SameSizeHeight)
End Sub

Private Sub mun_SameWidth_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    g_ActFrm.SetSameSize (SameSizeWidth)
End Sub

Private Sub Opened(Optional bNew As Boolean = True)
Dim tmpfrm As New mFrm_Bill, tmpID As Integer
    With mFrm_Select
        If Not mbSelLoad Then Load mFrm_Select: mbSelLoad = True
        .SetFlag (bNew)
        .Show 1
        tmpID = .mID
        If tmpID = -1 Then Exit Sub
        tmpfrm.Caption = mFrm_Select.mName
        tmpfrm.mScreenID = mFrm_Select.mScreenID
        tmpfrm.Show
        Set g_ActFrm = tmpfrm
        If tmpID > 0 Then tmpfrm.LoadBill (tmpID)
    End With
End Sub

Private Sub Saved(Optional SaveAs As Boolean = False)
    If g_ActFrm Is Nothing Then Exit Sub
    SaveBill (IIf(SaveAs, -1, g_ActFrm.mID))
End Sub

Public Sub SaveBill(tmpID As Integer)
Dim tmpobj As ObjDraw, ID As Long, strsql As String, bInTrans As Boolean
Dim bSaveAs As Boolean, ScreenID As Integer, Name As String

    bSaveAs = (tmpID = -1)
    ScreenID = g_ActFrm.mScreenID
    Name = g_ActFrm.Caption
    If bSaveAs Then
        With mFrm_Select
            .SetFlag True, ScreenID, Name
            .Show 1
            If .mID = -1 Then Exit Sub
            ScreenID = .mScreenID
            Name = .mName
        End With
    End If
    
    'Set The Flag
    If g_ActFrm.mID = 0 Then g_ActFrm.mID = ID
    g_ActFrm.mScreenID = ScreenID
    g_ActFrm.Caption = Name
    For Each tmpobj In g_ActFrm.mObjs
        tmpobj.EditFlag = -1
    Next
    
    MsgBox "保存成功！", vbExclamation, Me.Caption
    Exit Sub
Err:
'    If bInTrans Then g_CnMain.RollbackTrans
    Call ErrInfo("保存错误！")
End Sub

Private Function GetObjSql(tmpobj As ObjDraw, ID As Long, Optional bSaveAs As Boolean = False) As String
Dim tmpstr As String, EntryID As Integer, tmpFlag As Integer, tmpVisible As Boolean, mType As ObjType
    With tmpobj
        tmpFlag = .EditFlag
        tmpVisible = .ObjCtl.Visible
        If bSaveAs Then tmpFlag = 0
        If tmpFlag = -1 And tmpVisible Then Exit Function
        mType = .eType
        EntryID = .nID
    End With
    GetObjSql = tmpstr
    Exit Function
    
End Function


Private Sub Exited()
    Unload Me
End Sub

Private Sub PreViewed()
    If g_ActFrm Is Nothing Then Exit Sub
    Call g_ActFrm.PreView
End Sub

Private Sub mun_SelAll_Click()
    If g_ActFrm Is Nothing Then Exit Sub
    Call g_ActFrm.SelAll
End Sub

Private Sub PageSetup()
    If g_ActFrm Is Nothing Then Exit Sub
    mFrm_PageSetup.Show 1
End Sub

Private Sub mun_ToolSystem_Click()
    mfrm_Option.Show vbModal
    Call InitSystem
End Sub

Private Sub mun_ViewStatusbar_Click()
    mun_ViewStatusbar.Checked = Not mun_ViewStatusbar.Checked
    sbrMain.Visible = mun_ViewStatusbar.Checked
End Sub

Private Sub mun_ViewToolbar_Click()
    mun_ViewToolbar.Checked = Not mun_ViewToolbar.Checked
    TlbMain.Visible = mun_ViewToolbar.Checked
End Sub

Private Sub Timer_Timer()
    sbrMain.Panels("dat").Text = Format(Date, "yyyy-mm-dd hh:mm")
End Sub

Public Sub TlbMain_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "New": Call Opened
        Case "Open": Call Opened(False)
        Case "Save": Call Saved
        Case "SaveAs": Call Saved(True)
        Case "DrawSel": Call mun_DrawObj_Click(0)
        Case "DrawLine": Call mun_DrawObj_Click(1)
        Case "DrawText": Call mun_DrawObj_Click(2)
        Case "DrawImg": Call mun_DrawObj_Click(3)
        Case "SelAll": Call mun_SelAll_Click
        Case "Delete": Call mun_Delete_Click
        Case "Clone": Call mun_Clone_Click
        Case "Locked": Call mun_Lock_Click
        Case "Left": Call mun_FormatLeft_Click
        Case "HCenter": Call mun_FormatHCenter_Click
        Case "Right": Call mun_FormatRight_Click
        Case "Top": Call mun_FormatTop_Click
        Case "VCenter": Call mun_FormatVCenter_Click
        Case "Bottom": Call mun_FormatBottom_Click
        Case "Width": Call mun_FormatWidth_Click
        Case "Height": Call mun_FormatHeight_Click
        Case "SizeAll": Call mun_FormatSize_Click
        Case "Prop": Call mun_ObjProp_Click
        Case "PageSetup": Call PageSetup
        Case "View": Call PreViewed
        Case "Exit": Call Exited
    End Select
End Sub

Private Sub UpdateImage(ID As Long)
'Dim tmprs As New ADODB.Recordset, CurEntryID As Long, CurID As Long
'Dim tmpFile As String, FileNum As Integer, tmpByte() As Byte
'Dim fileLen As Long, BlockNum As Long, BlockRem As Long, j As Long
'Dim ImageWidth As Long, ImageHeight As Long, SizeByte(7) As Byte, strSize(2) As String
'
'    tmpFile = g_strAppPath & "tmp.bmp"
'    tmprs.Open " Select * From " & g_TableImg & " Where FID=" & ID, g_CnMain, adOpenDynamic, adLockOptimistic, adCmdText
'
'    Do While Not tmprs.EOF
'
'        CurID = tmprs!FID
'        CurEntryID = tmprs!FEntryID
'
'        tmprs.Fields("FImage") = Null
'        tmprs.Fields("FImageLen") = 0
'        tmprs.Fields("FImageHeight") = 0
'        tmprs.Fields("FImageWidth") = 0
'
'        If g_ActFrm.ObjImg(CurEntryID).Picture <> 0 Then
'
'            SavePicture g_ActFrm.ObjImg(CurEntryID).Picture, tmpFile
'            FileNum = FreeFile()
'            Open tmpFile For Binary Access Read As FileNum
'
'                fileLen = LOF(FileNum)
'                BlockNum = fileLen / BLOCKSIZE
'                BlockRem = fileLen Mod BLOCKSIZE
'
'                If BlockNum > 0 Then ReDim tmpByte(BLOCKSIZE)
'                For j = 1 To BlockNum
'                    Get FileNum, , tmpByte()
'                    tmprs.Fields("FImage").AppendChunk tmpByte()
'                Next
'
'                If BlockRem > 0 Then
'                    ReDim tmpByte(BlockRem)
'                    Get FileNum, , tmpByte()
'                    tmprs.Fields("FImage").AppendChunk tmpByte()
'                End If
'
''                '取图形大小
'                With g_ActFrm.ObjImg(2000)
'                    .Stretch = False
'                    .Picture = LoadPicture(tmpFile)
'                    ImageWidth = .Width
'                    ImageHeight = .Height
'                End With
'
''                Get FileNum, 19, SizeByte
''                strSize(0) = "&H": strSize(1) = "&H"
''                For j = 3 To 0 Step -1
''                    strSize(0) = strSize(0) & IIf(Len(Hex(SizeByte(j))) > 1, "", "0") & Hex(SizeByte(j))
''                    strSize(1) = strSize(1) & IIf(Len(Hex(SizeByte(j))) > 1, "", "0") & Hex(SizeByte(j + 4))
''                Next
''                ImageWidth = g_ActFrm.ScaleX(Val(strSize(0)), vbPixels, vbTwips)
''                ImageHeight = g_ActFrm.ScaleY(Val(strSize(1)), vbPixels, vbTwips)
'
'            Close FileNum
'            Kill (tmpFile)
'
'            tmprs.Fields("FImageLen") = fileLen
'            tmprs.Fields("FImageWidth") = ImageWidth
'            tmprs.Fields("FImageHeight") = ImageHeight
'
'        End If
'        tmprs.Update
'        tmprs.MoveNext
'    Loop

End Sub