yfskin.ctl

OCX DLL注册工具 OCX DLL注册工具

End Function

'===========================================================================================
'界面处理
'===========================================================================================

'*************************************************************************
'**函 数 名：SkinInit
'**输    入：frmMain(Form) -
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2005-03-27 15:24:47
'**修 改 人：
'**日    期：
'**版    本：V1.0.3
'*************************************************************************
Public Function SkinInit(frm As Object)
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim i As Long, j As Long
    
    Set frmWindow = frm
    frmWindow.Tag = ""
   
    With frmWindow

        .ScaleMode = 3

        If .BorderStyle <> 0 Then
            SetWindowLong .hwnd, GWL_STYLE, 100663296
        End If
        
        Call ShowIcon(frmWindow.hwnd)

        strControlName() = Array("imgIcon", "imgCorner0", "imgCorner1", "imgCorner2", "imgCorner3", "imgBorder0", "imgBorder1", _
                       "imgBorder2", "imgTitle", "imgTitleBegin", "imgTitleEnd", "imgTitleControl", "imgTitleButton0", _
                       "imgTitleButton1", "imgTitleButton2", "lblTitle", "imgTitleCaption")

        lngWindowW = .ScaleWidth * 15
        lngWindowH = .ScaleHeight * 15

        For i = 0 To frmWindow.Controls.Count - 1
            For j = 0 To UBound(strControlName)
                If frmWindow.Controls(i).Name = strControlName(j) Then
                    GoTo Continue
                End If
            Next
            .Controls(i).Tag = Format(.Controls(i).Left, "00000000") & Format(.Controls(i).Top, "00000000")
Continue:
        Next

        Set imgIcon = .Controls.Add("VB.Image", "imgIcon")
        imgIcon.Visible = True

        Set imgCorner0 = .Controls.Add("VB.Image", "imgCorner0")
        imgCorner0.Visible = True

        Set imgCorner1 = .Controls.Add("VB.Image", "imgCorner1")
        imgCorner1.Visible = True

        Set imgCorner2 = .Controls.Add("VB.Image", "imgCorner2")
        imgCorner2.Visible = True

        Set imgCorner3 = .Controls.Add("VB.Image", "imgCorner3")
        imgCorner3.Visible = True

        Set imgBorder0 = .Controls.Add("VB.Image", "imgBorder0")
        imgBorder0.Visible = True
        imgBorder0.Stretch = True

        Set imgBorder1 = .Controls.Add("VB.Image", "imgBorder1")
        imgBorder1.Visible = True
        imgBorder1.Stretch = True

        Set imgBorder2 = .Controls.Add("VB.Image", "imgBorder2")
        imgBorder2.Visible = True
        imgBorder2.Stretch = True

        Set imgTitle = .Controls.Add("VB.Image", "imgTitle")
        imgTitle.Visible = True

        Set imgTitleBegin = .Controls.Add("VB.Image", "imgTitleBegin")
        imgTitleBegin.Visible = True

        Set imgTitleEnd = .Controls.Add("VB.Image", "imgTitleEnd")
        imgTitleEnd.Visible = True

        Set imgTitleControl = .Controls.Add("VB.Image", "imgTitleControl")
        imgTitleControl.Visible = True

        Set imgTitleButton0 = .Controls.Add("VB.Image", "imgTitleButton0")
        imgTitleButton0.Visible = True

        Set imgTitleButton1 = .Controls.Add("VB.Image", "imgTitleButton1")
        imgTitleButton1.Visible = True

        Set imgTitleButton2 = .Controls.Add("VB.Image", "imgTitleButton2")
        imgTitleButton2.Visible = True

        Set lblTitle = .Controls.Add("VB.Label", "lblTitle")
        lblTitle.BackStyle = 0
        lblTitle.Visible = True

        Set imgTitleCaption = .Controls.Add("VB.Image", "imgTitleCaption")
        imgTitleCaption.Visible = True

    End With
    '------------------------------------------------
    SkinLoadImage
   
    
Exit Function

    '----------------
ToExit:
    Resume Next
End Function

'*************************************************************************
'**函 数 名：FindLanguage
'**输    入：strSkinFile()(String)          - 皮肤文件
'**        ：strSkin()(String)              - 皮肤信息
'**        ：Optional strPath(String = "Null")  - 皮肤路径
'**输    出：(Long) - 皮肤个数
'**功能描述：查找皮肤信息
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-09-26 20:25:19
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function FindSkin(strSkinFile() As String, strSkin() As String, Optional strPath As String = "Null") As Long
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim lngNum As Long
    Dim strFile As String

    If strPath = "Null" Or Len(strPath) = 0 Then
        strPath = App.Path & "\" & "skins"
        strPath = Replace(strPath, "\\", "\")
    End If

    strFile = Dir(strPath & "\", vbDirectory)

    While strFile <> ""
          
        '是否目录
        If strFile <> "." And strFile <> ".." And GetAttr(strPath & "\" & strFile) = vbDirectory Then
            lngNum = lngNum + 1
            ReDim Preserve strSkinFile(lngNum - 1) As String
            ReDim Preserve strSkin(lngNum - 1) As String

            strSkinFile(lngNum - 1) = strPath & "\" & strFile
            strSkin(lngNum - 1) = ReadIniOne(strSkinFile(lngNum - 1) & "\Skin.ini", "Info", "Skin", "Error")
        End If

        strFile = Dir()
    Wend

    FindSkin = lngNum
    '------------------------------------------------

Exit Function

    '----------------
ToExit:
    FindSkin = 0
End Function

'*************************************************************************
'**函 数 名：SkinGetFilePath
'**输    入：strFile(String)               - 文件名
'**        ：Optional strPath(String = "") - 默认路径
'**输    出：无
'**功能描述：获取文件路径
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-10-07 20:36:34
'**修 改 人：
'**日    期：
'**版    本：V1.0.2
'*************************************************************************
Public Function SkinGetFilePath(strFile As String, Optional strPath As String = "")
    Dim strFilePath As String
    If Len(strPath) = 0 Then
        strFilePath = strSkinPath
    Else
        strFilePath = strPath
    End If

    strFilePath = strFilePath & "\" & strFile
    SkinGetFilePath = Replace(strFilePath, "\\", "\")
End Function

'*************************************************************************
'**函 数 名：SkinGetData
'**输    入：strKey(String)                - 主键
'**        ：strSubKey(String)             - 子键
'**        ：Optional lngValue(Long)       - 如果有第二参数则返回
'**        ：Optional strPath(String = "") - 文件路径
'**输    出：(Long) - 参数值
'**功能描述：返回Skin配置文件参数
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-10-07 16:14:24
'**修 改 人：
'**日    期：
'**版    本：V1.0.2
'*************************************************************************
Public Function SkinGetData(strKey As String, strSubKey As String, Optional lngValue As Long, Optional strPath As String = "") As Long
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim strTemp As String
    Dim strFile As String
    Dim lngBegin As Long

    If Len(strPath) = 0 Then
        strPath = strSkinPath
    End If

    If Len(strPath) = 0 Then
        strPath = App.Path & "\skins\Default"
        strSkinPath = strPath
    End If

    strFile = SkinGetFilePath("Skin.ini", strPath)
    strTemp = ReadIniOne(strFile, strKey, strSubKey, "0")

    lngBegin = InStr(strTemp, ",")
    If lngBegin > 0 Then
        lngValue = Val(Right(strTemp, Len(strTemp) - lngBegin))
        SkinGetData = Val(Left(strTemp, lngBegin - 1))
    Else
        SkinGetData = Val(strTemp)
    End If

    '------------------------------------------------

Exit Function

    '----------------
ToExit:
    Resume Next
End Function

'*************************************************************************
'**函 数 名：LoadSkinImage
'**输    入：frmBar(Form)    - 需要加载的窗体
'**        ：strPath(String) - Skin所在的路径
'**输    出：(Long) -
'**功能描述：图片加载
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004-10-07 15:08:22
'**修 改 人：
'**日    期：
'**版    本：V1.0.2
'*************************************************************************
Public Function SkinLoadImage(Optional strPath As String = "", Optional lngFlag As Long = 0) As Long
    On Error GoTo ToExit '打开错误陷阱
    '------------------------------------------------
    Dim i As Long
    Dim strFile As String
    Dim lngCaptionNo As Long

    If Len(strPath) = 0 Then
        strPath = strSkinPath
    End If

    '------------------------------------------------------------------
    '基本界面
    '------------------------------------------------------------------
    '语言调整

    mCaption = GetIniTable("100")
    'frmWindow.Caption = mCaption
    lblTitle.Caption = mCaption

    lblTitle.ForeColor = SkinGetData("Title", "TitleCaptionsColor")  '&HC00000

    imgTitleButton0.ToolTipText = GetIniTable("10")
    imgTitleButton1.ToolTipText = GetIniTable("11")
    imgTitleButton2.ToolTipText = GetIniTable("12")

    '------------------------------------------------
    '加载四角图片
    strFile = SkinGetFilePath("Corner0.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgCorner0.Picture = LoadPicture(strFile)
    Else
        imgCorner0.Picture = LoadPicture()
    End If

    strFile = SkinGetFilePath("Corner1.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgCorner1.Picture = LoadPicture(strFile)
    Else
        imgCorner1.Picture = LoadPicture()
    End If

    strFile = SkinGetFilePath("Corner2.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgCorner2.Picture = LoadPicture(strFile)
    Else
        imgCorner2.Picture = LoadPicture()
    End If

    strFile = SkinGetFilePath("Corner3.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgCorner3.Picture = LoadPicture(strFile)
    Else
        imgCorner3.Picture = LoadPicture()
    End If

    '加载三边图片
    strFile = SkinGetFilePath("Border0.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgBorder0.Picture = LoadPicture(strFile)
    Else
        imgBorder0.Picture = LoadPicture()
    End If

    strFile = SkinGetFilePath("Border1.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgBorder1.Picture = LoadPicture(strFile)
    Else
        imgBorder1.Picture = LoadPicture()
    End If

    strFile = SkinGetFilePath("Border2.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgBorder2.Picture = LoadPicture(strFile)
    Else
        imgBorder2.Picture = LoadPicture()
    End If

    '叶帆标志
    strFile = SkinGetFilePath("YFFlag.ico", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgIcon.Picture = LoadPicture(strFile)
    Else
        imgIcon.Picture = LoadPicture()
    End If

    If SkinGetData("Title", "TitleIconFlag") = 1 Then
        imgIcon.Visible = True
    Else
        imgIcon.Visible = False
    End If

    '标题底
    strFile = SkinGetFilePath("TitleBar.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgTitle.Picture = LoadPicture(strFile)
    Else
        imgTitle.Picture = LoadPicture()
    End If

    If SkinGetData("Title", "TitleBarFlag") = 1 Then
        imgTitle.Visible = True
    Else
        imgTitle.Visible = False
    End If

    '标题头
    strFile = SkinGetFilePath("TitleBegin.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgTitleBegin.Picture = LoadPicture(strFile)
    Else
        imgTitleBegin.Picture = LoadPicture()
    End If

    If SkinGetData("Title", "TitleBeginFlag") = 1 Then
        imgTitleBegin.Visible = True
    Else
        imgTitleBegin.Visible = False
    End If

    '标题尾
    strFile = SkinGetFilePath("TitleEnd.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgTitleEnd.Picture = LoadPicture(strFile)
    Else
        imgTitleEnd.Picture = LoadPicture()
    End If

    If SkinGetData("Title", "TitleEndFlag") = 1 Then
        imgTitleEnd.Visible = True
    Else
        imgTitleEnd.Visible = False
    End If

    '标题控制区
    strFile = SkinGetFilePath("TitleControl.bmp", strPath)
    If Len(Dir(strFile)) > 0 Then
        imgTitleControl.Picture = LoadPicture(strFile)
    Else
        imgTitleControl.Picture = LoadPicture()
    End If

    If SkinGetData("Title", "TitleControlFlag") = 1 Then
        imgTitleControl.Visible = True