| Zablokuje počítač, tzn. CTRL+ALT+DEL apod. tak, že nejde udělat vůbec nic (RESET samozřejmě ano), dokud nevložíte heslo. | |
| 3234 bytů | Kopírovat |
| Vypíše hardwarovou adresu síťové karty. Zda je správná, můžete ověřit spuštěním programu winipcfg.exe v adresáři Windows. | |
| 2245 bytů | Kopírovat |
Jak měnit menu za běhu programu
| Zdrojový kód ukazuje vlastně příklady dva. První přidává menu za běhu programu (pomocí API, ne pomocí pole menu a funkce load) a druhý přidává do systémového menu novou položku About. | |
| 4142 bytů | Kopírovat |
| Porovnává rychlost přidávání znaků do řetězce pomocí standardního způsobu Visual Basicu (str = str & "novy") a pomocí API funkce CopyMemory. | |
| 6158 bytů | Kopírovat |
| Program ukazuje některé grafické funkce, např. TransBlt, hDCToPicture, atd. | |
| 11325 bytů | Kopírovat |
| Jak vytvořit message box, který zmizí sám po určitém čase, jak nastavit jeho souřadnice a také změnit font, ukazuje tento příklad. | |
| 6218 bytů | Kopírovat |
| Program počítá číslo Pi na zadaný počet míst. Jen pro zajímavost, 1000 desetinných míst trvá přibližně 4 minuty. | |
| 7378 bytů | Kopírovat |
Zobrazujete-li data pomocí FlexGridu, často potřebujete mít také možnost tato data vytisknout. Při použití normálního Gridu není problém. FlexGrid však umí spojovat buňky do jedné, vlastnost MergeCells, a to už se nedá jednoduše tisknout. Proto můžete vyzkoušet metodu PaintPicture objektu Printer.
'Grid bude "rozprostřen" na celou šířku papíru Printer.PaintPicture FlexGrid.Picture, 0, 0, Printer.ScaleWidth
Pokud však tisknete na jehličkovou tiskárnu, výstup bude špatně čitelný. Proto je dobré nastavit vlastnost PictureType na hodnotu 1 neboli flexPictureMonochrome.
Následující kód vypíše do prvku ListView (lvwPripojeni) seznam ODBC připojení. ListView nastavte pro zobrazení detailů (view = lvwReport).
Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1
Const SQL_FETCH_FIRST As Long = 2
Declare Function SQLAllocEnv Lib "odbc32.dll" (Env As Long) As Integer
Declare Function SQLDataSources Lib "odbc32.dll" (ByVal hEnv As Long, _
ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, _
pcbDSN As Integer, ByVal szDescriptions As String, ByVal cbDescriptionMax As Integer, _
pcbDescription As Integer) As Integer
Dim errReturn As Integer, lngHenv As Long
Dim strDSN As String * 32, strDesc As String * 255
Dim lst As ListItem
errReturn = SQLAllocEnv(lngHenv)
If errReturn <> SQL_SUCCESS Then
MsgBox "Nelze nalézt okolí"
Else
'Vytvoreni sloupcu v ListView
lvwPripojeni.ListItems.Clear
With lvwPripojeni.ColumnHeaders
.Clear
.Add , , "Název zdroje"
.Add , , "Popis zdroje"
End With
'Prochazeni jednotlivych pripojeni
errReturn = SQLDataSources(lngHenv, SQL_FETCH_FIRST, strDSN, 32, 0, strDesc, 255, 0)
Do While errReturn = SQL_SUCCESS
Set lst = lvwPripojeni.ListItems.Add()
lst.Text = strDSN
lst.SubItems(1) = strDesc
errReturn = SQLDataSources(lngHenv, SQL_FETCH_NEXT, strDSN, 32, _
Len(strDSN), strDesc, 255, Len(strDesc))
Loop
End If
K napsání tohoto kódu mě inspiroval jeden můj kolega v práci. Měl totiž soubor s třiceti listy a ty všechny pozamykal. Když to měl hotové, vzpomněl si, že tam má chybu. Tak je zase všechny odemknul, upravil v každém jednu buňku a zase zamknul. Celá tato operace mu zabrala necelých 20 minut, ale když to dělal potřetí, vypadal na zhroucení. Proto jsem vytvořil proceduru, která potřebné listy odemkne (v tomto případě všechny, až na poslední) za několik sekund.
'Funkce predpoklada stejne heslo pro kazdy list
Public Sub OdemkniXls(ByVal soubor As String, ByVal heslo As String)
Dim mExcel As Object, i As Long
Set mExcel = CreateObject("Excel.Application")
mExcel.Workbooks.Open soubor
For i=1 To mExcel.Worksheets.Count - 1
mExcel.Worksheets(i).Unprotect heslo
Next i
mExcel.Quit
Set mExcel = Nothing
End Sub
List můžete zamknout funkcí Protect. Stejné metody má i objekt WorkBook, kde však slouží pro zamknutí či odemknutí celého sešitu.
Výpis databází a uživatelů SQL serveru
Protože Microsoft uvolnil MSDE, může mít každý na pracovní stanici svůj "SQL server". Proto se tu občas objeví i nějaký tip z této oblasti. Tento vypíše všechny databáze na SQL serveru. K tomu používá objekt SQLDMO.
Dim sqlSrv As sqldmo.SQLServer, i As Long Set sqlSrv=New sqldmo.SQLServer sqlSrv.Connect "PC9", "Sa", "" 'server, uzivatel, heslo For i = 1 To sqlSrv.Databases.Count Debug.Print sqlSrv.Databases(i).Name Next i
Podobným způsobem, za použití SQLDMO, můžete vypsat také uživatele v databázi.
Dim sqlSrv As sqldmo.SQLServer, i As Long
Set sqlSrv=New sqldmo.SQLServer
sqlSrv.Connect "PC9", "Sa", "" 'server, uzivatel, heslo
For i = 1 To sqlSrv.Databases("master").Users.Count
Debug.Print sqlSrv.Databases("master").Users(i).Name
Next i
Je možno deklarovat proměnnou typu User a procházet uživatele cyklem For .. Each (stejně tak i u databází).
I když nadpis vypadá složitě, nejedná se o nic jiného než o použití API funkce Sleep. Tato funkce má pouze jediný parametr, dwMilliseconds, který určuje dobu v milisekundách, po kterou bude pozastaveno provádění programu.
Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long) Debug.Print Time Sleep 5000 'cekej 5 sekund Debug.Print Time
Chcete-li mít v TextBoxu jinou velikost a tloušťku kurzoru než je nabízena standardně, musíte použít dvě API funkce. CreateCaret kurzor vytvoří a ShowCaret jej zobrazí. Kód je nejlepší umístit do události GotFocus patřičného TextBoxu.
Public Declare Function CreateCaret Lib "user32" (ByVal hwnd As Long, _ ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Public Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long Private Sub Text1_GotFocus() CreateCaret Text1.hwnd, 0, 3, 24 'sirka 3 pixely, vyska 24 pixelu ShowCaret Text1.hwnd End Sub
Chcete-li vymazat obsah DBGridu, stačí nastavit zdroji, na který je připojen, neexistující zdroj dat. Nemůžete však vybrat neexistující tabulku, musíte zadat dotaz, který nevrací žádné záznamy. Pro to se dobře hodí podmínka, ve které je primární klíč roven NULL. Takový záznam v databázi být nemůže.
Public Sub VymazGrid(db As Data, ByVal tabulka As String, ByVal klic As String) db.RecordSource="SELECT * FROM " & tabulka & " WHERE " & klic & " IS NULL" db.Refresh End Sub
Jak vymazat obrázek v PictureBoxu
Také velice jednoduchý tip. Chcete-li mít PictureBox bez obrázku, použijte metodu LoadPicture bez parametrů.
Picture1.Picture=LoadPicture
Jak zjistit první volné písmeno pro disk
Funkce VolnyDisk vrátí první volné písmeno pro disk. Výhodné např. pro síťové připojení disku, kdy musíte zadat volné písmeno.
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Public Function VolnyDisk() As String
Dim disk As Long, retVal As Long
disk = 1
Do
disk = disk + 1 'zaciname od 2, tedy C:
retVal = GetDriveType(Chr(disk + 65) & ":\")
Loop Until retVal = 1
VolnyDisk = Chr(disk + 65) & ":"
End Function
Pro vytváření instalačního programu je ve Visual Basicu 6.0 nástroj zvaný Package & Deployment Wizard. Často se však stává, že nám nestačí jeho možnosti. Potom nastupuje buď program od jiného autora nebo úprava zdrojového kódu. Instalaci totiž řídí dva programy. SETUP.EXE rozbalí archív a "předá řízení" programu SETUP1.EXE. A právě jeho zdrojový kód je dodáván s Visual Basicem. U verze 6.0 jej najdete v adresáři Visual Basicu, a dále Wizards\PDWizard\Setup1. Stačí pouze upravit tento projekt, vytvořit EXE a nahradit standardní SETUP1.EXE v adresáři PDWizardu.
Častou změnou je "počeštění" instalace. To lze velice jednoduše. Setup1 totiž používá veškeré texty z resource souboru, jehož zdroj je rovněž přiložen. "Počeštěný" soubor SETUP1.RES můžete rovněž najít na Chip CD 9/99.
Další častou změnou je vložení formuláře pro registraci. V tomto kroku je potřeba zápis do registru. Nepoužívejte vlastní funkce, ale zkuste ty, které jsou již v projektu vytvořeny (modul SETUP1.BAS). Ty totiž zapisují informace o změnách do logu, který je použit při odinstalování programu.
Jak zabránit výběru adresáře při instalaci
Někdy můžete chtít uživateli při instalaci zabránit možnost výběru cílového adresáře. Není to nic složitého. Stačí do souboru SETUP.LST zapsat řádek ForceUseDefDir=1 a to hned za řádek DefaultDir=....