navigation.frm

即时通讯

                m_funBtn(m_oldFunBtnIndex).Y + m_funBtn(m_oldFunBtnIndex).textY, m_funBtn(m_oldFunBtnIndex).caption, _
                Len(m_funBtn(m_oldFunBtnIndex).caption)
    End If
    
    
    If m_funBtnIndex <> -1 And m_oldFunBtnIndex <> m_funBtnIndex Then
        m_apiFont.setcolor Picture1, 300
        TextOut Picture1.hDC, m_funBtn(m_funBtnIndex).X + m_funBtn(m_funBtnIndex).textX, _
                m_funBtn(m_funBtnIndex).Y + m_funBtn(m_funBtnIndex).textY, m_funBtn(m_funBtnIndex).caption, _
                Len(m_funBtn(m_funBtnIndex).caption)
        m_apiFont.setcolor Picture1, 200
        
        ' 设置鼠标形状
        
    End If
    
End Sub

Private Sub Picture1_Paint()
    If m_drawType = 1 Then
        DrawImages
        m_tempDib.PaintTo Picture1.hDC, 0, 0
        DrawTexts
    Else
        DrawEmptyForm
        m_tempDib.PaintTo Picture1.hDC, 0, 0
    End If
    
End Sub
Public Function DrawImages()
    BitBlt m_tempDib.hDC, 0, 0, m_tempDib.Width, m_tempDib.Height, m_backGrounDib.hDC, 0, 0, vbSrcCopy

    Dim i As Integer
    
    ' 画导航按钮
    For i = 0 To NAVBTNUM
        If i <> m_btnIndex Then
            BitBlt m_tempDib.hDC, m_navBtn(i).X, m_navBtn(i).Y, _
                   m_tempDib.Width - m_navBtn(i).X, m_tempDib.Height - m_navBtn(i).Y, _
                   m_navigationBtn.hDC, 0, 0, vbSrcCopy
        End If
    Next i
    
    ' 画功能按钮
    Dim funPic As Integer
    For i = 2 To FUNBTNUM
        funPic = m_funBtn(i).btnPic
        If m_btnIndex = m_funBtn(i).included Then
            BitBlt m_tempDib.hDC, m_funBtn(i).X, m_funBtn(i).Y, _
                   m_tempDib.Width - m_funBtn(i).X, m_tempDib.Height - m_funBtn(i).Y, _
                   m_funBtnPic(funPic).hDC, 0, 0, vbSrcCopy
'            doTransparentRotateAndResize m_funBtnPic(funPic), m_tempDib, _
                                         0, m_funBtn(i).X, m_funBtn(i).Y, 0
        End If
    Next i
End Function
Public Function DrawTexts()
    Dim X, Y As Integer
    Dim i As Integer
        
    m_apiFont.Escapement = 2
    m_apiFont.setcolor Picture1, 200

    ' 画导航按钮的文字
    For i = 0 To NAVBTNUM
        If m_btnIndex = i Then
            m_apiFont.setcolor Picture1, 300
        End If
    
        m_apiFont.FontOut m_navBtn(i).caption, Picture1, _
        m_navBtn(i).X + m_navBtn(i).textX, m_navBtn(i).Y + m_navBtn(i).textY
        
        If m_btnIndex = i Then
            m_apiFont.setcolor Picture1, 200
        End If
    Next i
    ' 画功能按钮的文字
    For i = 0 To FUNBTNUM
        If m_btnIndex = m_funBtn(i).included Then
            m_apiFont.FontOut m_funBtn(i).caption, Picture1, _
            m_funBtn(i).X + m_funBtn(i).textX, m_funBtn(i).Y + m_funBtn(i).textY
        End If
    Next i

        
    m_apiFont.SelectOrg Picture1
End Function
Public Function DrawEmptyForm()
    BitBlt m_tempDib.hDC, 0, 0, m_tempDib.Width, m_tempDib.Height, m_blankGrounDib.hDC, 0, 0, vbSrcCopy
End Function
Private Sub ProcessFunBtn(funBtnIndex As Integer)
    ' 功能按钮的处理函数
    Select Case funBtnIndex
        Case 0                  ' 采购定单
            MainForm.CallModule STOCKORDER_LIST
        Case 1                  ' 采购入库
            MainForm.CallModule STOCK_STOREC
        Case 2                  ' 公司信息
            CompanyInfo.show
        Case 3                  ' BOM 设计
            MainForm.CallModule BOMTABLE_DESIGN
        Case 4                  ' 生产计划单
            MainForm.CallModule PRODUCT_SCHEME_LIST
        Case 5                  ' 生产列表单
            MainForm.CallModule PRODUCE_LIST
        Case 6                  ' 生产领料单
            MainForm.CallModule PRODUCEDRAWMATERIAL
        Case 7                  ' 生产完工单
            MainForm.CallModule PRODUCE_FINISH_LIST
        Case 8                  ' 外协列表
            MainForm.CallModule COOPERATE_LIST
        Case 9                  ' 外协发料
            MainForm.CallModule COOPERATEDROWMATERIALQD
        Case 10                  ' 外协收工
            MainForm.CallModule COOPERATE_FINISH_LIST
        Case 11                  ' 外协返工
            MainForm.CallModule COOPERATE_REDO_LIST
        Case 12                  ' 外协索赔
            MainForm.CallModule COOPERATE_COUNTERCLAIM
        Case 13                  ' 外协统计
            MainForm.CallModule COOPERATE_STAT
        Case 14                  ' 质量检验
            MainForm.CallModule CHECKPRODUCTION
        Case 15                  ' 检验类型管理
            MainForm.CallModule CHECKSTANDARD
        Case 16                  ' 检验项管理
            MainForm.CallModule CHECK_OPTION
        Case 17                  ' 检验值管理
            MainForm.CallModule checkvalue
'        Case 18                  ' 检验组管理
'            MainForm.CallModule STOCKORDER_LIST
        Case 19                  ' 仓库资料
            MainForm.CallModule WAREHOUSE_SINGLE
        Case 20                  ' 仓库列表
            MainForm.CallModule WAREHOUSE_LIST
        Case 21                  ' 仓 库 单
            MainForm.CallModule POSITIONQD
        Case 22                  ' 重新连接
            MainForm.CallModule RE_CONNECT_TO_SERVER
        Case 23                  ' 修改密码
            MainForm.CallModule EMPLOYEE_PASSWORD
        Case Else                                            '退 出
            GoTo Over
    End Select
Over:
End Sub
' ok, here's general rotation formula
'     x' = x * Cos(a) - y * Sin(a)
'     y' = x * Sin(a) + y * Cos(a)
' where (x,y) is original point, (x',y') is rotated one and "a" is angle
'
' so, to rotate a bitmap, we will "map" (x,y) coordinates in dest bitmap
' to corresponding (x',y') in source. in other words, we will move color
' bytes (RGB values) from source(x',y') to dest(x,y).
'
' we can't do much to optimize formula, but we can optimize
' our rotation procedure. so we will calculate points mappings
' for only one quadrant of source-bitmap QUAD and use OX/OY axes mirror
' reflections of calculated point to move RGB bytes
'
' second step in optimisation is to work with linear (one-dimensioned)
' array of bytes representing bitmaps. knowing how many bytes are in
' one line of bitmap, we can get linear addres of (X,Y) point in bitmap
' as Y*(num_of_bytes_per_line)+X*3 (hope it's clear why *3 - R,G and B bytes)
Sub doTransparentRotateAndResize(s As CDIB, d As CDIB, _
                                 Angle As Double, _
                                 ByVal dcX As Long, ByVal dcY As Long, _
                                 ByVal rz As Long)
' s - source,
' d - destination DIBs
' Angle - guess what?
' dcX,dCY - point at dest DIB where result picture's center should be
' rz - resize factor. take it as percent value of 100/rz,
'      ie 50 is for double-size and 200 for half-size

    ' source DIB's center AS WELL as quadrant (1/4th of whole pic)
    ' side length
    Dim scX As Long, scY As Long
    scX = (s.Width - 1) \ 2: scY = (s.Height - 1) \ 2
    
    ' ok, we work only on QUAD bitmaps so let's get rid of bigger dimension
    If scX < scY Then scY = scX Else scX = scY
    
    ' stretch quadrant to calculate since rotated quad surrounding
    ' area will grow in size. max growth is at 45 degree (PI/4)
    ' - remember hypotenuse stuff? hehe, do your math better ;)
    scY = Sqr(scX * scX * 2)
    
    ' pre-calc these sin/cos to save computing time in loop
    Dim aSin As Double, aCos As Double
    aSin = Sin(Angle): aCos = Cos(Angle)

    ' ok, let's get our linear memory spaces for both DIB's
    ' we will map it to byte-arrays for...
    Dim sB() As Byte, sP As Long, sRB As Long ' ...source DIB
    Dim dB() As Byte, dP As Long, dRB As Long ' ...dest DIB, using...
    ' ...very useful function of my DIB-Helper class. MapArray fools VB
    ' making him think that his array (which is not bounded, in fact)
    ' is mapped to particular space in memory (DIB bits in our case).
    ' it returns byte-width of one line of pixels in DIB
    sRB = s.MapArray(sB): dRB = d.MapArray(dB)
    ' so, after this call count that sB(0),sB(1) and sB(2) are
    ' B,G and R components of first pixel in source DIB.
    ' don't forget that it's in fact LAST pixel because DIBs are upside-down
    
    ' get linear address of CENTERs in our DIBs
    sP = scX * sRB + scX * 3 ' sP stands for "source Pointer"
    dP = dcY * dRB + dcX * 3 ' -"- "dest" one. not really matching names
                             ' but I like shorties ;)

    ' transparency part - suppose first upper-left pixel color is transparent one
    ' for speed, use only one color component (blue)
    Dim TransB As Byte
    TransB = sB(UBound(sB) - 1)
    
    Dim X As Long, Y As Long
    Dim XX As Long, YY As Long
    ' ok, lets do real business
    ' loop all pixels in ONE quadrant of ENLARGED (see scY comment above)
    ' area of source dib. it's upper-right quadrant, counting that DIB bits are upside-down
    For Y = 0 To scY - 1
        For X = 0 To scY - 1
            ' here we get that "mapped" coordinates
            ' and apply tricky resize-part. yes, one extra MUL
            ' and we have resize functionality - so easy...
            XX = (X * aCos - Y * aSin) * rz / 100
            YY = (X * aSin + Y * aCos) * rz / 100

            ' it could fall off original DIB because we scan
            ' enlarged area, so be aware
            If Abs(XX) <= scX And Abs(YY) <= scX Then
                Dim i As Long, j As Long
                ' same way to get linear address in DIB bytes memspace
                ' this time it will be OFFSETS from CENTER pointers...
                j = Y * dRB + X * 3   ' ... in dest bitmap
                i = YY * sRB + XX * 3 ' ... in source
                
                ' is pixel is not transparent one,
                ' copy three bytes (R,G and B values) from source(xx,yx) to dest(X,Y)
                ' in calculated quadrant (upper-right)...
                If sB(sP + i) <> TransB Then dB(dP + j) = sB(sP + i): dB(dP + j + 1) = sB(sP + i + 1): dB(dP + j + 2) = sB(sP + i + 2)
                ' ... and it's opposite one (down-left), "mirrored" by OX and OY axes
                If sB(sP - i) <> TransB Then dB(dP - j) = sB(sP - i): dB(dP - j + 1) = sB(sP - i + 1): dB(dP - j + 2) = sB(sP - i + 2):
                
                ' now, we have to recalc linear offsets for
                ' mirrored (x,y) in upper-left quadrant...
                j = X * dRB - Y * 3
                i = XX * sRB - YY * 3
                ' copy 3 bytes in it...
                If sB(sP + i) <> TransB Then dB(dP + j) = sB(sP + i): dB(dP + j + 1) = sB(sP + i + 1): dB(dP + j + 2) = sB(sP + i + 2)
                ' ... and mirror it once more (down-right quadrant)
                If sB(sP - i) <> TransB Then dB(dP - j) = sB(sP - i): dB(dP - j + 1) = sB(sP - i + 1): dB(dP - j + 2) = sB(sP - i + 2):
            End If
        Next
    Next
    ' uff, seems like we're done
    ' have to "un-fool" VB back so it won't lost its mind and GPF :-)
    d.UnMapArray dB: s.UnMapArray sB
End Sub