modxp.bas

本医疗点数据管理系统适用于乡镇卫生所

Attribute VB_Name = "modXP"


Option Explicit
Dim FrmMenuCaption
'Hello, The above code will make sure you declare everything.

'This module will allow you to run an ordinary VB6 application (on WinXP) using the cool Windows XP Style Controls.

'I used bits from a few various projects downloaded from PSC. I just put them all together to
'create a 100% working XP style Control Module.

'You can however give me credit for resolving the timing issue with running only one
'instance of the application. (I made sure the program will always run - whether it's run for the
'first time and not...)

'NOTES:

'1. This only works when running the compiled .EXE file.

'2. This only works with WINDOWS XP - Don't try with an older version: IT WON'T WORK!

'3. A "App.EXEname.exe.MANIFEST" file must be created in the same directory as the EXE.
'        EG. 'WinXP.exe.MANIFEST' in the same directory as 'WinXP.exe'
'        (This module will do it automatically)

'4. A MANIFEST file is a .NET FrameWork file - In other words: We are 'instructing' WinXP into
'        changing the old VB6 generated controls into the new look XP style

'5. If there wan't a manifest file to begin with - and you only just created one when a user runs
'        your program for the first time - YOU NEED TO RESTART your application. (This module
'        will do this automatically)

'6. If you only want one instance of your program to run - There WAS a timing issue which i sorted
'        out using the registry.

'7. You will notice i have code which detects the OS - This isn't necessary as creating a MANIFEST
'        file in older versions and then trying to apply it - WON'T effect/apply anything.

'8. All this is done automatically if you use VB.NET.

'9. It's a Sunday evening - hence please tolerate any spelling mistakes. :)


'Enjoy!
'David Sykes
'dsykes@ mighty.co.za








'#####################################################################################
'#
'#      This code will apply WinXP style controls into your program
'#
'#      NB: Only works in the compiled .EXE file
'#
'#      By: David Sykes
'#
'#####################################################################################




'Function to get OS
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

'Function to Start a external program/file
Public Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)

'Function to apply WinXP style controls
Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (lpInitCtrls As _
    INITCOMMONCONTROLSEX_TYPE) As Long

'For XP style controls
Public Const ICC_INTERNET_CLASSES = &H800

'For OS detection
Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2

'For 'Start a external program/file'
Public Enum StartWindowState
    START_HIDDEN = 0
    START_NORMAL = 4
    START_MINIMIZED = 2
    START_MAXIMIZED = 3
End Enum

'For OS detection
Private Type OSVERSIONINFO
    OSVSize As Long
    dwVerMajor As Long
    dwVerMinor As Long
    dwBuildNumber As Long           '#### NT: Build Number, 9x: High-Order has Major/Minor ver, Low-Order has build
    PlatformID As Long
    szCSDVersion As String * 128    '#### NT: ie- "Service Pack 3", 9x: 'arbitrary additional information'
End Type

'For OS detection
Public Enum cnWin32Ver
    UnknownOS = 0
    Win95 = 1
    Win98 = 2
    WinME = 3
    WinNT4 = 4
    Win2k = 5
    WinXP = 6
End Enum

'For XP Style controls
Public Type INITCOMMONCONTROLSEX_TYPE
    dwSize As Long
    dwICC As Long
End Type





'#################################################################################
'#################################################################################
'#################################################################################
'#################################################################################
'#################################################################################

'THE PROGRAM STARTS HERE: (If you don't want to start your program in the Sub Main
'module then copy the below code in Sub Main into your Form_Load of the first form
'that loads.

'/OR/

'Call Main from the Form_Load of the first form that loads ("Call Main")

'NB: It's good coding practice to start a program in Sub Main

'HINT: To start a program in Sub Main then goto:
' Click "Project"             in "File, Edit, View menu"
' Click "Project" Properties
' Change "StartUp object" to "Sub Main"

Public Sub Main()
    
    Dim comctls As INITCOMMONCONTROLSEX_TYPE
    Dim retval As Long
    Dim CanProceed As Boolean
    
    CanProceed = IsManifestFile 'CanProceed = True if MANIFEST FILE EXISTS
    'Hence - No need to auto restart the application
    
    
    
    
    
    If Val(Win32Ver) > 5 Then 'IF WINDOWS XP
        If MakeMANIFESTfile Then 'IF MANIFEST FILE WAS SUCCESSFULLY CREATED
            
            'Apply XP Style Controls
            With comctls
                .dwSize = Len(comctls)
                .dwICC = ICC_INTERNET_CLASSES
            End With
            retval = InitCommonControlsEx(comctls)
            '#######################
            
        Else
            'Manifest file -->wasn't<--- successfully created
            'Hence - can't apply xp style controls
            'Hence - No need to auto restart the application
            CanProceed = True
        End If
    Else
        'Not WinXP
        'Hence - can't apply xp style controls
        'Hence - No need to auto restart the application
        CanProceed = True
    End If
    
    
    
    
    
    
    
    If CanProceed Then   'Can continue with this exe session.
    
    
        'Load FIRST FORM
        Load FrmMenuCaption
        'Show FIRST FORM
        FrmMenuCaption.Show
        
    Else
    
    
        'The application needs to be auto restarted
    
        'USE THIS CODE IF YOU WANT ONE INSTANCE OF YOUR PROGRAM TO RUN:
        SaveSetting App.EXEName, "Settings", "CanRun", "YES"
        '###################################################
        
        'START THE EXE FILE AGAIN: (Shelldocument = True if program was successfully
        'restarted // False if it wasn't
        
        If ShellDocument(App.Path & "\" & App.EXEName & ".exe", , , , START_NORMAL) Then
            End ' End this program --> New one auto started
            
        Else 'Wasn't able to start exe file (Proceed in current exe session)
        
            'USE THIS CODE IF YOU WANT ONE INSTANCE OF YOUR PROGRAM TO RUN:
            SaveSetting App.EXEName, "Settings", "CanRun", "NO"
            '##################################################
            
            'Load FIRST FORM
            Load FrmMenuCaption
            'SHOW FIRST FORM
            FrmMenuCaption.Show
            
        End If
        
        
        
    End If
        
End Sub
'#################################################################################
'#################################################################################
'#################################################################################
'#################################################################################
'#################################################################################





'#################################################################################
'THE BELOW CODE CREATES A MANIFEST FILE:
'MakeMANIFESTfile returns True if it was able to create the file

Public Property Get MakeMANIFESTfile() As Boolean
    
    MakeMANIFESTfile = False
    
    On Local Error GoTo MakeMANIFESTfile_Err
    
    Dim ManifestFileName As String
    Dim NewFreeFile As Integer
    
    ManifestFileName = App.Path & "\" & App.EXEName & ".exe.MANIFEST"
    NewFreeFile = FreeFile
    
    'Note:  CHR(34)   =   "