Lista VB Ro
Carti
Surse
Articole
Programe
Legaturi
Pareri

1. Cum pot obtine adresa curenta de la IE sau Netscape Navigator ?
   Pun un textbox (DDEText) apoi scriu:
   

   
   strApplication = "IEXPLORE" ' Pentru Internet Explorer 
   strApplication = "NETSCAPE" ' Pentru Netscape
   strDDETopic = strApplication & "|WWW_GetWindowInfo"
   With DDEText
   .LinkTopic = strDDETopic
   .LinkItem = "0xFFFFFFFF"
   .LinkMode = 2
   .LinkRequest
   End With
   sCurrentURL = Mid(DDEText.Text, 2, InStr(DDEText.Text, ",") - 3)
   

2. Cum lansez browserul Internet implicit cu o anumita adresa ?
   

   
   Private 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) As Long 
   
   Const SW_MAXIMIZE = 3 
   
   Private Sub Command1_Click() 
   Dim lRet As Long 
   
   lRet = ShellExecute(Me.hwnd, "open","http://www.geocities.com/siliconvalley/hills/4377", _
             vbNullString, vbNullString, SW_MAXIMIZE) 
   End Sub
   

3. Rezolutia ecranului
   

   
   Public Function GetScreenResolution() As String
   Dim TWidth As Long
   Dim THeight As Long
   
   TWidth = Screen.Width \ Screen.TwipsPerPixelX
   THeight = Screen.Height \ Screen.TwipsPerPixelY
   GetScreenResolution = TWidth & "x" & THeight
   End Function
   

4. Cum lansez dialogul 'Find File' ?
   Pun un label chiar invizibil pe ecran (lbl_DDE), apoi:

   
   With lbl_DDE
   .LinkTopic = "Folders|AppProperties"
   .LinkMode = vbLinkManual
   .LinkExecute "[OpenFindFile(,)]"
   End With
   

5. Apelare 'Help' din meniu propriu
   

   
   Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long,
   ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As
   Long
   
   Public Const HELP_CONTEXT = &H1 ' Display topic in ulTopic 
   Public Const HELP_HELPONHELP = &H4 ' Display help on using help 
   Public Const HELP_INDEX = &H3 ' Display index
   Public Const HELP_QUIT = &H2 ' Terminate help
   Public Const HELP_SETINDEX = &H5 ' Set current Index for multi
   index help
   Public Const HELP_MULTIKEY = &H201&
   Public Const HELP_PARTIALKEY = &H105&
   
   Private Sub MnuHelpContents_Click()
   Dim Help_path As String
   Dim RV As Long
   Help_path = App.HelpFile
   RV = WinHelp(Me.hwnd, Help_path, &H3, CLng(0))
   End Sub
   

6. Dezactivarea butonului de inchidere a ferestrei ('X')
   

   
   Public Sub DisableCloseButton(frm as Form)
   Dim hMenu As Long
   Dim menuItemCount As Long
   hMenu = GetSystemMenu(frm.hWnd, 0)
   If hMenu Then 
   menuItemCount = GetMenuItemCount(hMenu)
   'este pe ultima pozitie (menuItemCount-1) 
   RemoveMenu hMenu, menuItemCount - 1, MF_REMOVE Or MF_BYPOSITION 
   'Sterg separatorul de linie
   RemoveMenu hMenu, menuItemCount - 2, MF_REMOVE Or MF_BYPOSITION
   DrawMenuBar frm.hWnd
   End If
   End Sub
   

   Declaratiile functiilor GetSystemMenu, GetMenuItemCount, RemoveMenu, DrawMenuBar si a constantelor MF_REMOVE si MF_BYPOSITION se gasesc cu API Viewer.

7. Toolbar (flat) stil IE sau MS Office
   

   
   Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As 
   Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
   Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As 
   Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
   
   Private Const WM_USER = &H400
   Private Const TB_SETSTYLE = WM_USER + 56
   Private Const TB_GETSTYLE = WM_USER + 57
   Private Const TBSTYLE_FLAT = &H800
   Private Const TBSTYLE_LIST = &H1000
   
   Public Sub CoolBar(tlb As Toolbar, tlbToolbarStyle As Long)
       Dim lngStyle As Long, lngResult As Long, lngHWND As Long 
   
       ' Find child window and get style bits
       lngHWND = FindWindowEx(tlb.hwnd, 0&, "ToolbarWindow32", vbNullString)
       lngStyle = SendMessage(lngHWND, TB_GETSTYLE, 0&, 0&)
       Select Case tlbToolbarStyle
           Case 1
               'Creates an Office97 Toolbar
               lngStyle = lngStyle Or TBSTYLE_FLAT
           Case 2
               'Creates an IE4 stsyle toolbar with text to the right of the picture. 
               'You must supply text in order to get the effect 
               lngStyle = lngStyle Or TBSTYLE_FLAT Or TBSTYLE_LIST
           Case Else
               lngStyle = lngStyle Or TBSTYLE_FLAT
       End Select
       'Use the API call to change the Toolbar effect
       lngResult = SendMessage(lngHWND, TB_SETSTYLE, 0, lngStyle)
       tlb.Refresh
   End Sub
   

8. MSFlexGrid cu ComboBox in celula (text selectabil dintr-o lista)
   

   
   Private Sub Combo1_Click()
       MSFlexGrid1.Text = Combo1.Text
   End Sub
   
   Private Sub Form_Load()
       'hide combo until we need it
       Combo1.Visible = False
   
   
       'aici creez lista de selectie
       Combo1.AddItem "Linie 1"
       Combo1.AddItem "Linie 2"
       Combo1.AddItem "Linie 3"
       Combo1.AddItem "Linie 4"
       Combo1.AddItem "Linie 5"
   
       'make lots and lots of rows and columns
       MSFlexGrid1.Rows = 500
       MSFlexGrid1.Cols = 500
       MSFlexGrid1.FixedRows = 2
       MSFlexGrid1.FixedCols = 1
   End Sub
   
   Private Sub Form_Resize()
       'make grid the size of the form
       MSFlexGrid1.Move Me.ScaleLeft, Me.ScaleTop, Me.ScaleWidth, Me.ScaleHeight
   End Sub
   
   Private Sub MSFlexGrid1_Click()
       'make sure user didn't click on a fixed row or column
       If MSFlexGrid1.Col >= MSFlexGrid1.FixedCols And MSFlexGrid1.Row >=
   MSFlexGrid1.FixedRows Then
           Call PositionCombo
       End If
   End Sub
   
   Private Sub MSFlexGrid1_EnterCell()
       Call PositionCombo
   End Sub
   
   
   Sub PositionCombo()
   'Positions the combobox on the current cell and make it visible
       Combo1.Move MSFlexGrid1.CellLeft + MSFlexGrid1.Left, MSFlexGrid1.CellTop +
   MSFlexGrid1.Top, MSFlexGrid1.CellWidth
       Combo1.Visible = True
   End Sub
   
   Sub HideCombo()
   'set combo1 visible property to false
       Combo1.Visible = False
   End Sub
   
   Private Sub MSFlexGrid1_LeaveCell()
       Call HideCombo
   End Sub
   
   Private Sub MSFlexGrid1_RowColChange()
       Call HideCombo
   End Sub
   
   Private Sub MSFlexGrid1_Scroll()
       Call HideCombo
   End Sub
   
   

9. Fereastra always-on-top
   

   
   Public Sub TopMost(ByVal sformname As Form)
   'this function keeps the form at the top
   'not good when the argument ( sfomrname) is an mdichild already.
   
   
   'I usually call this procedure on the form_load
   'event of any form that I want to be on top
   'by simply typing;
   'Topmost(me)
   
   'in order this to work, you need to declare the SetWinDowPos 
   'in a module gen declaration area as follows;
   'Declare Sub 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)
   
   
   'here is the procedure ;
   
   If sformname.MDIChild = True Then
   MsgBox ("Form cannot be MDI child")
   Exit Sub
   End If
   
   SetWindowPos sformname.hwnd, -1, sformname.LEFT / Screen.TwipsPerPixelX, _
   sformname.TOP / Screen.TwipsPerPixelY, sformname.Width / Screen.TwipsPerPixelX, _
   sformname.Height / Screen.TwipsPerPixelY, &H10 Or &H40
   
   End Sub
   

10. Verific prezenta dischetei in unitatea a:
    

    
    Function IsMediaValid(ByVal strPathName As String) As Boolean
    Dim bMedia As Boolean
    Dim nDrive As Long, nDriveType As Long
    Dim nSerialNumber As Long, nCompLen As Long
    Dim nFlags As Long
    Dim strDrive As String, strVolName As String
    Dim strFileSystem As String
    
    ' // Return TRUE if the drive doesn't support removable media.
    nDriveType = GetDriveType(strPathName)
    If ((nDriveType <> DRIVE_REMOVABLE) And _
    (nDriveType <> DRIVE_CDROM)) Then
    IsMediaValid = True
    Exit Function
    End If
    
    ' // Return FALSE if the drive is empty (::GetVolumeInformation fails).
    strDrive = Left(strPathName, 3)
    nDrive = Asc(Left(strDrive, 1)) - &H41
    
    strVolName = String(255, Chr(0))
    strFileSystem = String(255, Chr(0))
    bMedia = GetVolumeInformation _
    (strDrive, strVolName, 255, nSerialNumber, _
    nCompLen, nFlags, strFileSystem, 255)
    If (Not bMedia) Then
    m_dwMediaID(nDrive) = &HFFFFFFFF
    IsMediaValid = False
    Exit Function
    End If
    
    ' // Also return FALSE if the disk's serial number has changed.
    If ((m_dwMediaID(nDrive) <> nSerialNumber) And _
    (m_dwMediaID(nDrive) <> &HFFFFFFFF)) Then
    m_dwMediaID(nDrive) = nSerialNumber
    IsMediaValid = False
    Exit Function
    End If
    
    ' // Update our record of the serial number and return TRUE.
    m_dwMediaID(nDrive) = nSerialNumber
    IsMediaValid = True
    
    End Function