home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Homam_Anti21381012252008.psc / Appender / modMain.bas < prev    next >
BASIC Source File  |  2008-12-17  |  3KB  |  91 lines
  1. Attribute VB_Name = "modMain"
  2. '
  3. ' By Homam Babi - 2008
  4. ' humam_babi@hotmail.com
  5. '
  6. Option Explicit
  7.  
  8. Private Const ICC_USEREX_CLASSES = &H200
  9. Private Const MAX_PATH = 260
  10. Private Const IMAGE_ICON = 1
  11. Private Const SM_CXICON = 11
  12. Private Const SM_CYICON = 12
  13. Private Const SM_CXSMICON = 49
  14. Private Const SM_CYSMICON = 50
  15. Private Const GW_OWNER = 4
  16. Private Const LR_SHARED = &H8000&
  17. Private Const WM_SETICON = &H80
  18. Private Const ICON_BIG = 1
  19. Private Const ICON_SMALL = 0
  20.  
  21. Public Type tagInitCommonControlsEx
  22.    lngSize As Long
  23.    lngICC As Long
  24. End Type
  25.  
  26. Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
  27. Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  28. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  29. Private Declare Function LoadImageAsString Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long
  30. Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  31. Public Sub Main()
  32.     
  33.     'Don't allow a second instance of the app
  34.     If App.PrevInstance = True Then
  35.         MsgBox "Sorry, but this program is already running !", vbApplicationModal Or vbInformation Or vbOKOnly
  36.         End
  37.     End If
  38.  
  39.    ' we need to call InitCommonControls before we can use XP visual styles.
  40.    ' Here I'm using InitCommonControlsEx, which is the extended version
  41.    ' provided in v4.72 upwards (you need v6.00 or higher to get XP styles)
  42.    On Error Resume Next
  43.    ' this will fail if Comctl not available - unlikely now though!
  44.    Dim iccex As tagInitCommonControlsEx
  45.    With iccex
  46.        .lngSize = LenB(iccex)
  47.        .lngICC = ICC_USEREX_CLASSES
  48.    End With
  49.    InitCommonControlsEx iccex
  50.    
  51.    ' now start the application
  52.    On Error GoTo 0
  53.    frmMain.Show
  54. End Sub
  55. Public Sub SetIcon(ByVal hwnd As Long, ByVal sIconResName As String, Optional ByVal bSetAsAppIcon As Boolean = True)
  56.     Dim lhWndTop As Long
  57.     Dim lhWnd As Long
  58.     Dim cx As Long
  59.     Dim cy As Long
  60.     Dim hIconLarge As Long
  61.     Dim hIconSmall As Long
  62.       
  63.     If (bSetAsAppIcon) Then
  64.         ' Find VB's hidden parent window:
  65.         lhWnd = hwnd
  66.         lhWndTop = lhWnd
  67.         Do While Not (lhWnd = 0)
  68.             lhWnd = GetWindow(lhWnd, GW_OWNER)
  69.             If Not (lhWnd = 0) Then
  70.                 lhWndTop = lhWnd
  71.             End If
  72.         Loop
  73.     End If
  74.    
  75.     cx = GetSystemMetrics(SM_CXICON)
  76.     cy = GetSystemMetrics(SM_CYICON)
  77.     hIconLarge = LoadImageAsString(App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)
  78.     If (bSetAsAppIcon) Then
  79.         SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
  80.     End If
  81.     SendMessageLong hwnd, WM_SETICON, ICON_BIG, hIconLarge
  82.    
  83.     cx = GetSystemMetrics(SM_CXSMICON)
  84.     cy = GetSystemMetrics(SM_CYSMICON)
  85.     hIconSmall = LoadImageAsString(App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)
  86.     If (bSetAsAppIcon) Then
  87.         SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
  88.     End If
  89.     SendMessageLong hwnd, WM_SETICON, ICON_SMALL, hIconSmall
  90. End Sub
  91.