home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD8582832000.psc / Active01.bas < prev    next >
Encoding:
BASIC Source File  |  2000-07-15  |  7.5 KB  |  176 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  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
  4.      Global Const SWP_NOMOVE = 2
  5.      Global Const SWP_NOSIZE = 1
  6.      Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  7.      Global Const HWND_TOPMOST = -1
  8.      Global Const HWND_NOTOPMOST = -2
  9.  
  10.   Public Const INVALID_HANDLE_VALUE = -1
  11.   Public Const MAX_PATH = 260
  12.  
  13.   Type FILETIME
  14.      dwLowDateTime As Long
  15.      dwHighDateTime As Long
  16.   End Type
  17.  
  18.   Type WIN32_FIND_DATA
  19.      dwFileAttributes As Long
  20.      ftCreationTime As FILETIME
  21.      ftLastAccessTime As FILETIME
  22.      ftLastWriteTime As FILETIME
  23.      nFileSizeHigh As Long
  24.      nFileSizeLow As Long
  25.      dwReserved0 As Long
  26.      dwReserved1 As Long
  27.      cFileName As String * MAX_PATH
  28.      cAlternate As String * 14
  29.   End Type
  30. Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  31. Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  32. Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  33. Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  34. Declare Function ExtractIcon Lib "shell32" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
  35.  
  36. Global NumeroDeProgramasAtivos As Integer, ArquivoDePrograma As String, NextPGM As Integer
  37. Global DiretorioInicial As String, UltimoProgramaAtivo As Integer, ProximoBotaoDaBarra As Integer
  38. Global Active_INI As String, Chave As String, Seτπo As String, Valor As String
  39. Global i As Integer, J As Integer, K As Integer, L As Integer, X As String, CrLf As String
  40. Global TabelaDeProgramasAtivos(1 To 44, 1 To 6) As String, NumeroDoPrimeiroProgramaDaBarra As Integer
  41. Global TitleAnterior As String, NumeroDoItem As Integer, AlterouLista As Boolean, InicializarBarra As Boolean
  42. Global NumeroMaximoDeProgramasNaBarra As Integer ', NumeroMaximoDeProgramasAtivos As Integer
  43. Global Const MaximoComIconesMenores = 20, MaximoComIconesMaiores = 14
  44. Global Const NumeroMaximoDeProgramasAtivos = 44
  45. Global Const Posicionar = "P", Alterar = "A", Excluir = "E", Desistir = "D", Alterar═cone = "I"
  46. Global Funcao As String, LinhaAnterior As Integer, PGMVersao As String
  47. Global Const MB_OK = 0, MB_OKCANCEL = 1      ' Define buttons.
  48. Global Const MB_YESNOCANCEL = 3, MB_YESNO = 4
  49. Global Const MB_ICONSTOP = 16, MB_ICONquestion = 32            ' Define Icons.
  50. Global Const MB_ICONEXCLAMATION = 48, MB_ICONINFORMATION = 64
  51. Global Const MB_DEFBUTTON2 = 256, IDYES = 6, IDNO = 7          ' Define other.
  52. Global Const PGMName = "PGM_Name_", PGMTitle = "PGM_Title_", PGMbmp = "PGM_bmp_", PGMParm = "PGM-Parm_"
  53. Global Const CTLNumPGM = "Numero_De_Programas_Ativos", PGMStatus = "PGMStatus_Topo", PGMIcon = "PGM_Icone_"
  54. Global Const CTLPrimeiroPrograma = "PrimeiroProgramaDaBarra", CTLProximoPrograma = "Proximo_Programa_"
  55. Global Const CTLMaximoPGMNaBarra = "MaximoDeProgramasNaBarra", TopoYES = "Sim", TopoNO = "Nπo"
  56. Global DgDef, Msg, Response, Title      ' Declare variables.
  57. ' ------------ Declaraτ⌡es necesßrias para a funτπo de extrair icon de um m≤dulo ---------
  58.  
  59. Private Type PicBmp
  60.   Size As Long
  61.   tType As Long   '* 245 - 2 100 + 75 5 90+4*45
  62.   hBmp As Long
  63.   hPal As Long
  64.   Reserved As Long
  65. End Type
  66.  
  67. Private Type GUID
  68.   Data1 As Long
  69.   Data2 As Integer
  70.   Data3 As Integer
  71.   Data4(7) As Byte
  72. End Type
  73.  
  74. 'Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
  75. 'Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
  76. 'Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
  77. '---
  78. Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
  79. Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
  80. Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
  81.  
  82.  
  83. ' ------------ Final das declaraτ⌡es necesßrias para a funτπo de extrair icon de um m≤dulo ---------
  84. Public Sub RegerarActiveINI()
  85. Kill Active_INI
  86. Chave = CTLNumPGM
  87. Valor = Format(NumeroDeProgramasAtivos, "00")
  88. X = EscreveIni(Seτπo, Chave, Valor)
  89. Call SalvarStatusTOP
  90. For i = 1 To NumeroDeProgramasAtivos
  91.     Chave = PGMName + Format(i, "00")
  92.     Valor = TabelaDeProgramasAtivos(i, 1)
  93.     X = EscreveIni(Seτπo, Chave, Valor)
  94.     Chave = PGMTitle + Format(i, "00")
  95.     Valor = TabelaDeProgramasAtivos(i, 2)
  96.     X = EscreveIni(Seτπo, Chave, Valor)
  97.     Chave = Left(TabelaDeProgramasAtivos(i, 3), Len(TabelaDeProgramasAtivos(i, 3)) - 4)
  98.     Valor = Format(i, "00") + Valor
  99.     X = EscreveIni(Seτπo, Chave, Valor)
  100.     Chave = PGMbmp + Format(i, "00")
  101.     Valor = TabelaDeProgramasAtivos(i, 3)
  102.     X = EscreveIni(Seτπo, Chave, Valor)
  103.     Chave = PGMParm + Format(i, "00")
  104.     Valor = TabelaDeProgramasAtivos(i, 4)
  105.     X = EscreveIni(Seτπo, Chave, Valor)
  106. Next i
  107.  
  108. End Sub
  109. Public Sub SalvarStatusTOP()
  110. Chave = PGMStatus
  111. Valor = IIf(frmActive.mnutopo.Checked, TopoYES, TopoNO)
  112. X = EscreveIni(Seτπo, Chave, Valor)
  113. End Sub
  114.  
  115. Public Sub TextSelected()
  116. Dim i As Integer
  117. Dim oMyTextBox As Object
  118.  
  119. Set oMyTextBox = Screen.ActiveControl
  120. If TypeName(oMyTextBox) = "TextBox" Then
  121. i = Len(oMyTextBox.Text)
  122.  
  123. oMyTextBox.SelStart = 0
  124. oMyTextBox.SelLength = i
  125. End If
  126. End Sub
  127. '----------------------------------------------------------
  128. ' Check for the existence of a file by attempting an OPEN.
  129. '----------------------------------------------------------
  130. Public Function FileExists(sSource As String) As Boolean
  131.  
  132.    Dim WFD As WIN32_FIND_DATA
  133.    Dim hFile As Long
  134.    
  135.    hFile = FindFirstFile(sSource, WFD)
  136.    FileExists = hFile <> INVALID_HANDLE_VALUE
  137.    
  138.    Call FindClose(hFile)
  139.    
  140. End Function
  141.  
  142.  
  143.  
  144. Public Function EscreveIni(Seτπo As String, Chave As String, Valor As String)
  145.   
  146.   ' Escreve Valor na seτπo e chave indicadas
  147.   Dim lpFileName As String, X  As Integer
  148.   lpFileName = Active_INI
  149.  
  150.   X = WritePrivateProfileString(Seτπo, Chave, Valor, lpFileName)
  151.   
  152. End Function
  153. Public Function LeIni(Seτπo As String, Chave As String)
  154.   ' LΩ o valor na seτπo e chave indicadas
  155.  
  156.   Dim lpAppName As String, lpKeyName As String
  157.   Dim lpDefault As String, lpReturnedString As String
  158.   Dim nSize As Integer, lpFileName As String, X As Integer
  159.  
  160.   lpFileName = Active_INI
  161.   lpAppName = Seτπo
  162.   lpKeyName = Chave
  163.   lpDefault = ""
  164.   lpReturnedString = Space$(512)
  165.   nSize = 512
  166.  
  167.   X = GetPrivateProfileString(lpAppName, lpKeyName, lpDefault, lpReturnedString, nSize, lpFileName)
  168.   LeIni = Left$(lpReturnedString, X)
  169. End Function
  170. Public Sub TornaBrancaACelula(N)
  171. 'Torna a coluna 01 da linha N da Lista de programas branco novamente ...
  172.       frmManutencao.flxLista.ColSel = 1
  173.       frmManutencao.flxLista.Row = N
  174.       frmManutencao.flxLista.CellBackColor = RGB(255, 255, 255)
  175. End Sub
  176.