modfx.bas

收银机库存销售管理程序

Attribute VB_Name = "modFx"
'##############################################
'#          Coded by Walter A. Narvasa        #
'#       POS2000 - Point of Sales System      #
'#                                            #
'#           area :  modFX                    #
'#    description :  Screen & GUI Effects     #
'#         e-mail :  [e-mail]     #
'#            url :  http://wancom.8k.com     #
'#                                            #
'##############################################

'EXIT WINDOWS SETTINGS
Public Declare Function ExitWindows Lib "User32" (ByVal dwReturnCode As Long, ByVal uReserved As Integer) As Integer
Global Const EW_REBOOTSYSTEM = &H43
Global Const EW_RESTARTWINDOWS = &H42
Global Const EW_EXITWINDOWS = 0

' TO DISABLE/ENABLE CTRL-ALT-DELETE
Public Declare Function SystemParametersInfo Lib "User32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

' FOR INI SETTINGS
#If Win16 Then
   Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal Keyname As String, ByVal NewString As String, ByVal filename As String) As Integer
   Declare Function GetPrivateProfileString Lib "Kernel" Alias "GetPrivateProfilestring" (ByVal AppName As String, ByVal Keyname As Any, ByVal default As String, ByVal ReturnedString As String, ByVal MAXSIZE As Integer, ByVal filename As String) As Integer
#Else
   Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
   Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long
#End If

' SET FORM ON TOP Declare our API functions
Declare Function SetWindowPos Lib "User32" ( _
                                ByVal hwnd As Long, _
                                ByVal hWndInsertAfter As Long, _
                                ByVal X As Long, ByVal Y As Long, _
                                ByVal cx As Long, ByVal cy As Long, _
                                ByVal wFlags As Long) As Long

' FOR RESOLUTION CHANGER
Private Declare Function EnumDisplaySettings Lib "User32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Public Declare Function ChangeDisplaySettings Lib "User32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
    Private Const CCDEVICENAME = 32
    Private Const CCFORMNAME = 32
    Private Const DM_BITSPERPEL = &H60000
    Private Const DM_PELSWIDTH = &H80000
    Private Const DM_PELSHEIGHT = &H100000
Public Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    End Type

' FOR SYSTEM TRAY ICON
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public Declare Function SetForegroundWindow Lib "User32" (ByVal hwnd As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const flags = SWP_NOMOVE Or SWP_NOSIZE
Public nid As NOTIFYICONDATA
Dim hKey As Long, MainKeyHandle As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Public Type POINTAPI
        X As Long
        Y As Long
End Type
Public Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uId As Long
        uFlags As Long
        uCallBackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type
Const DisplayErrorMsg = False

' DISABLE RIGHT MOUSE CLICK
Public Declare Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "User32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Public Const WM_RBUTTONUP = &H205
'Public Const WH_MOUSE = 7
'Type POINTAPI
'    x As Long
'    y As Long
'End Type
Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
    End Type
Public l_hMouseHook As Long

' Drag Form Declaration
Public Declare Function ReleaseCapture Lib "User32" () As Long
Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Any) As Long
Public Const WM_NCLBUTTONDOWN = &HA1

'BITBIT FUNCTION & declare SRCCOPY
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Const SRCCOPY = &HCC0020

' MACOS Titlebar
Public Function CreateMacOSTitleBar(pict As PictureBox, title As String)
    pict.FontTransparent = False
    pict.AutoRedraw = True
    pict.ScaleMode = 3
    pict.BackColor = &HCCCCCC
    pict.BorderStyle = 0
    pict.ForeColor = QBColor(0)
    pict.Font = "Chicago"
    pict.FontBold = False
    pict.FontSize = 10
    If (pict.ScaleWidth / 2) - (pict.TextWidth(title) / 2) <= 8 Then title = ""
    If title = "" Then
        lhs_left = 8
        lhs_right = pict.ScaleWidth - 8
        l_top = pict.ScaleHeight / 2 - 6
        dorhs = False
            dolhs = True
                GoTo drawit
            End If
            l_top = pict.ScaleHeight / 2 - 6
            lhs_left = 8
            sc = pict.ScaleWidth
            lhs_right = ((sc / 2) - (pict.TextWidth(title) / 2)) - 4
            lhs_right = Int(lhs_right)
            rhs_left = ((sc / 2) + (pict.TextWidth(title) / 2)) + 4
            rhs_left = Int(rhs_left)
            rhs_right = pict.ScaleWidth - 8
            dolhs = True
                dorhs = True
drawit:
                    If dolhs = True Then
                        For X = l_top To l_top + 10 Step 2
                            pict.Line (lhs_left - 1, X)-(lhs_right, X), &HFFFFFF
                            pict.Line (lhs_left, X + 1.5)-(lhs_right + 1, X + 1.5), &H666666
                        Next X
                    End If
                    If dorhs = True Then
                        For X = l_top To l_top + 10 Step 2
                            pict.Line (rhs_left - 1, X)-(rhs_right, X), &HFFFFFF
                            pict.Line (rhs_left, X + 1.5)-(rhs_right + 1, X + 1.5), &H666666
                        Next X
                    End If
                    pict.Line (0, pict.ScaleHeight - 1)-(pict.ScaleWidth, pict.ScaleHeight - 1), &H666666
                    maclefttext = (pict.ScaleWidth / 2) - (pict.TextWidth(title) / 2)
                    pict.CurrentX = maclefttext
                    mactoptext = (pict.ScaleHeight / 2) - (pict.TextHeight(title) / 2)
                    pict.CurrentY = mactoptext
                    pict.Print title
End Function