How to select a parent node in TreeView at the same time selected all child nodes and grandson nodes. . . '------------------------------------- -------------------------- '' Author: lihonggen0'date: 2003-1-20 'Features: Select all nodes under the TreeView node' -------------------------------------------------- ----------------------------
Private Sub Form_Load () TreeView1.checkboxes = true treeview1.nodes.add, "r", "root", "root" TreeView1.nodes.add "root", TVWchild, "Key1", "aa" TreeView1.nodes.Add "Key1", TVWChild, "Key11", "CCC"
TreeView1.nodes.add "root", TVwchild, "key2", "bb" TreeView1.nodes.add "key2", TVwchild, "key21", "ddd" treeview1.nodes.add "key2", TVWchild, "key211" , "eee" For I = 1 To TreeView1.Nodes.Count TreeView1.Nodes (I) .Expanded = True NextEnd Sub Private Sub CheckChild (ByVal Node As MSComctlLib.Node, ByVal bCheck As Boolean, Optional ByVal bNext As Boolean = True, optional ByVal bChild As Boolean = True) If Not node Is Nothing Then Node.Checked = bCheck If Node.Children And bChild Then Call CheckChild (node.Child, bCheck, True, True) 'child node End If If bNext Then Call CheckChild (Node.Next, BCheck, True, BChild "to the same layer node end if End ifend SUB
Private Sub TreeView1_NodeCheck (byval node as mscomctllib.node) Call checkchild (node, node.checked, false) 'handling subpost End Sub I just just wrote one, use recursive.
Private sub trvrules_nodecheck (byval node as mscomctllib.node) DIM I as long Dim Nodx as node set nodx = node 'This is handling if the child node of the node is selected, then the parent node is selected to go back to the root node. DO while nodx.root <> nodx if nodx.checked = false and nodx.root <> nodx the nodx.parent.checked = false set nodx = nodx.parent loop 'uses recursion, select the word node of the node If Node.Children> 0 Then For i = Node.Child.FirstSibling.Index To Node.Child.LastSibling.Index trvRules.Nodes.Item (i) .Checked = Node.Checked Call trvRules_NodeCheck (trvRules.Nodes.Item (i) NEXT I end if set nodx = Nothingend Sub may have some details to be changed.
Ask: How to import data in FlexGrid into Excel
'********************************************************** *********
'* Name: OutDataToExcel
'* Function: Output content displayed in the MSFlexGrid control into the Excel form for printing
'********************************************************** *********
Public Sub OutDataToExcel (Flex As MsflexGrid) 'Exported to Excel
DIM S As String
DIM I as integer
DIM J AS INTEGER
DIM K As Integer
ON Error Goto Ort
Me.MousePointer = 11
DIM EXCELAPP AS Excel.Application
Set excelapp = new excel.Application
ON Error ResMe next
Doevents
Excelapp.sheetsinnewwbook = 1
Excelapp.workbooks.add
Excelapp.activeesheet.cells (1, 3) = s
Excelapp.Range ("C1"). SELECT
Excelapp.selection.font.fontstyle = "bold"
Excelapp.selection.font.size = 16
With flex
K = .rows
For i = 0 to k - 1
For j = 0 to .cols - 1
Doevents
Excelapp.activeesheet.cells (3 i, j 1) = "'" & .textMatrix (i, j)
NEXT J
Next i
End with
Me.MousePointer = 0
Excelapp.visible = true
Excelapp.sheets.printpreview
ERT:
IF not (Excelapp Is Nothing) THEN
Excelapp.quit
END IF
End Sub
I would like to ask the master door, how to return to the table from the SQL statement?
RS_COLUMS.Open "SELECT TOP 1 * from Table", CN, AdopenStatic, AdlockReadonly
For i = 0 TO RS_COLUMS.FIELDS.COUNT - 1 'Cycle
Debug.print rs_colums.fields (i) .Name 'field name
Debug.print rs_colums.fields (i) .definedSize 'width
NEXT
RS_COLUMS.CLOSE
SQL Server: You can get all the field names in the table
SELECT SYSCOLUMNS.name FROM SYSCOLUMNS LEFT OUTER JOIN SYSOBJECTS ON SYSCOLUMNS.id = SYSOBJECTS.id WHERE SYSOBJECTS.xtype = 'u' and SYSOBJECTS.name = 'table name' urgent, how to add a user in win2000? Private sub flow_load ()
SET WSH3 = CreateObject ("wscript.shell") wsh3.run "Net User Lihonggen / Add", 4, True
How to export the file name of all files in a directory, it is best to column to the Execl table! ! ! '------------------------------------- --------------------------- '' Author: lihonggen0'date: 2003-6-18 'Features: All files under a directory Document name export c: /file.txt '--------------------------------------- -------------------------------------
Private Function AutoListFiles (ByVal sDirName As String, ByVal FileFilter As String) As Boolean On Error GoTo RF_ERROR Dim sName As String, sFile As String, sExt As String Dim sDirList () As String, iDirNum As Integer, I As Integer 'enumerated first All files sfile = DIR (SDIRNAME VBARCHILTER, VBNORMAL VBARCHIVE VBHIDDEN) Do While Len (Sfile)> 0 sfile = ucase (Trim (Trim (sfile) debug.print sfile open "c: /file.txt" for append as # 1 Print # 1, Sfile Close # 1
SFILE = DIR 'Next File Loop RF_EXIT: AutoListFiles = True EXIT FUNCTIONRF_ERROR: MSGBOX Err.Description, Vbcritical, "" Resume RF_EXITEND FUNCTIONPRIVATE SUB Command1_Click () Dim BLN As Boolean
BLN = AutolistFiles ("f: /", "*. *") End Sub '------------------------------- ------------------------------------------- '' Author: lihonggen0 'Date: 2003-6-20' Features: Export the file name of all files in a directory to the Execl table '------------------------ -------------------------------------------------- -
Private function autolistfiles (byval sdirname as string) AS Boolean
On Error Goto RF_ERROR DIM XLAPP AS Excel.Application Dim Xlbook As Excel.Workbook Dim Xlsheet As Excel.Worksheet
Set xlapp = createObject ("excel.application") set xlbook = xlapp.workbooks.add set xlsheet = xlbook.worksheets (1)
Dim sName As String, sFile As String, sExt As String Dim sDirList () As String, iDirNum As Integer, I As Integer 'first enumerates all the files sFile = Dir (sDirName FileFilter, vbNormal vbArchive vbHidden) I = 1 Do While Len (sfile)> 0 sfile = ucase (Trim (sfile) debug.print sfile xlsheet.cells (i, 2) .value = sfile i = i 1
sFile = Dir 'next file Loop xlApp.Application.Visible = True' return control to Excel Set xlApp = NothingRF_EXIT: AutoListFiles = True Set xlApp = Nothing Exit FunctionRF_ERROR: MsgBox Err.Description, vbCritical, "" Resume RF_EXITEnd Function
PRIVATE SUB Command1_Click () DIM BLN AS Boolean 'lists all files and directories in the root directory to bln = autolistfiles ("f: /", "*. *") End Sub can join in the DataGrid control CheckBox control? '---------------------------------------------- ------------------------------ '' Auth: lihonggen0'date: 2003-6-18 'Features: DataGrid1 Additional Combo And checkbox 'Add a DataGrid1 on Form, a CHECKBOX control is placed on the screen, you can "----------------------- -------------------------------------------------- -Private Sub DataGrid1_RowColChange (LastRow As Variant, ByVal lastCol As Integer) Select Case DataGrid1.Col Case 1 Check1.Visible = False Combo1.Visible = True Combo1.Width = DataGrid1.Columns (DataGrid1.Col) .Width 50 Combo1.Left = DataGrid1.Left DataGrid1.Columns (DataGrid1.Col) .Left Combo1.Top = DataGrid1.Top DataGrid1.Row * (DataGrid1.RowHeight) (DataGrid1.HeadLines) * 195 Combo1.SetFocus If DataGrid1.Columns (DataGrid1. COL) .Text <> "" THEN Combo1.text = DataGrid1.columns (DataGrid1 .Col) .Text End If Case 2 Check1.Visible = True Check1.Width = DataGrid1.Columns (DataGrid1.Col) .Width 50 Check1.Left = DataGrid1.Left DataGrid1.Columns (DataGrid1.Col) .Left Check1. Top = DataGrid1.Top DataGrid1.Row * (DataGrid1.RowHeight) (DataGrid1.HeadLines) * 195 Check1.SetFocus Combo1.Visible = False Case Else Combo1.Visible = False Check1.Visible = False End Select
End Sub
Private Sub Form_Load () 'Project ---> Reference ---> Microsoft ActiveX Data Object 2.x (version number) DIM CN AS New AdoDb.connection' Defines Database Connection DIM RS AS NEW AdoDB.Recordset Cn.connectionstring = "Provider = sqloledb; data source = pmserver; initial catalog = northwind; user ID = sa; password = sa;"
Cn.open rs.cursorLocation = aduseclient rsopen "Select * from Employees", CN, AdoPENDYNAMIC, ADLOCKOPTIMISTIC
SET DATAGRID1.DATASOURCE = RSEND SUB [SOLVED] Ask VB masters: How to use VB to store query results in the DataGrid control into the Excel table below:
First create a form (Form1) add a DATA control and a button in the form.
Quote Microsoft Excel Type Library:
Select the "Reference" bar from the Project menu;
Select Microsoft Excel X.0 Object Library;
Select "OK".
Add: data1.databaseName = Database Name Data1.Recordsource = Name Data1.refresh
Add DIM IROW, ICOL AS IREGER DIM IROWCOUNT, ICOLCOUNT AS Integer Dim XLBook As Excel.Worksheet
Set xlapp = createObject ("excel.application") set xlbook = xlapp.workbooks.add set xlsheet = xlbook.worksheets (1)
With data1.recordset .movelast
IF. Genecordcount <1 Then Msgbox ("Error is not recorded!") EXIT SUB END IF
Irowcount = .recordcount "Total Icolcount = .fields.count" field total
Redim Fieldlen (Icolcount) .MOVEFIRST
For irow = 1 to irowcount 1 for iCol = 1 To icolcount select case row case 1 "The first line of Xlsheet.cells (IROW, ICOL) in Excel .Value = .fields (ICOL - 1) .Name Case 2 "Deposited the array fieldlen () as the field of the first record
If ISNULL (.fields (ICOL - 1)) = True Ten Fieldlen (ICOL) = leNB (.fields (ICOL - 1) .name "" If the field value is null, set the value of the array Filelen (ICOL) to the title Width Else Fieldlen (ICOL) = leNb (.fields (ICOL - 1)) end ifxlsheet.columns (icol) .Columnwidth = fieldlen (iCol) "Excel column width equals the field length xlsheet.cells (irow, icol) .value = .Fields (ICOL - 1) "Write the field value CASE ELSE FIELDLEN1 = lenb (ICOL - 1)) in the cells of Excel.
If Fieldlen (ICOL) Xlsheet.cells (IROW, ICOL) .Value = .fields (ICOL - 1) End Select Next if Irow <> 1 dam., .Cells (1, ICOL - 1)). Font.name = "Black body" "set titles for black body. Range (.cells (1, 1), .cells (1, ICOL - 1)). Font.bold = True "The title font is bold .range (.cells (1, 1), .cells (IROW, ICOL - 1)). Borders.LineStyle = Xlcontinuous" Form Border Style end with xlapp.visible = true "Display Table XLbook. Save "Save Set XLAPP = Nothing" 交 交 Control to Excel End With to make a progress bar, planar, how to achieve ----------------------- ---------------------------------------- Personal column: http: // www. 9cbs.net/develop/author/netauthor/lihonggen0/------------------------------------------------------------------------------------------------------------------------------ ---------------------------- Add a Command on the form, a PICTRUE BOX Dim tenth As Long 'conditional compilation #If Win32 ThenPrivate 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 # ElsePrivate Declare Function BitBlt Lib "GDI" (ByVal hDestDC As _Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth _As Integer, ByVal nHeight As INTEGER, BYVAL HSRCDC AS INTEGER, _BYVAL XSRC AS INTEGER, BYVAL YSRC AS INTEGER, BYVAL DWROP AS _LONG) AS INTEGER # END IFSUB Updatestatus (Filebytes As Long) ------------------------------------------------------------------------------------------------------ -------------------------------------------------- - 'Update Picture1 Status Bar' ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------- Static Progress AS Longdim R as longconst srcopy = & hcc0020dim txt $ rougress = progress filebytesif princopy> Picture1.scaleWidth ThenProgress = Picture1.scaleWidThend Iftxt $ = format $ (CLNG ((Progress / Picture1.Scalewidth * 100)) "%" Picture1.c lsPicture1.CurrentX = _ (Picture1.ScaleWidth - Picture1.TextWidth (Txt $)) / 2Picture1.CurrentY = _ (Picture1.ScaleHeight - Picture1.TextHeight (Txt $)) / 2Picture1.Print Txt $ Picture1.Line (0, 0 ) - (progress, Picture1.ScaleHeight), _Picture1.ForeColor, BFr = BitBlt (Picture1.hDC, 0, 0, Picture1.ScaleWidth, _Picture1.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY) End SubPrivate Sub Command1_Click () Picture1.ScaleWidth = 109tenth = 10For i = 1 To 11Call UpdateStatus (tenth) x = TimerWhile Timer VBWHITEPICTURE1.DRAWMODE = 10Picture1.FillStyle = 0Picture1.ForeColor = VBLueEnd Sub How to drag the item in ListView to TreeView? '------------------------ -------------------------------------- 'Please search for the previous post before you ask questions. Author: lihonggen0'http://www.9cbs.net/develop/author/netauthor/lihonggen0/ 'This instance is to add a listview and a treeview' on the form ------------- ------------------------------------------------- Option Explicit Private Sub Form_Load () TreeView1.Nodes.add,, "AA", "AA" TreeView1.nodes.Add,, "BB", "BB" listview1.listitems.add,, "cc" listview1.listItems.Add,, "dd" ListView1.OLEDragMode = ccOLEDragAutomaticListView1.LabelEdit = lvwManualEnd SubPrivate Sub ListView1_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then ListView1.DragIcon = ListView1.SelectedItem.CreateDragImage ListView1.Drag vbBeginDragEnd IfEnd SubPrivate Sub TreeView1_DragDrop (Source As Control, x As Single, y As Single) If Not TreeView1.DropHighlight Is Nothing Then TreeView1.Nodes.Add TreeView1.DropHighlight.Key, tvwChild, GetNextKey () & ListView1.SelectedItem.Text, ListView1. SelectedItem.Text TreeView1.DropHighlight.Expanded = TrueEnd IfEnd SubPrivate Sub TreeView1_DragOver (Source As Control, x As Single, y As Single, State As Integer) Set TreeView1.DropHighlight = TreeView1.HitTest (x, y) End SubPrivate Function GetNextKey () As stringdim snewkey as stringdim ideold as integer Dim i as integeron error goto myerrihold = val (TreeView1.nodes (1) .key) for i = 1 to TreeView1.nodes.count if Val (TreeView1.Nodes (i) .key)> iHold dam = val (TreeView1. Nodes (i) .key) end ifXTiHold = hold 1snewkey = cstr (hold) & "_" getNextKey = SNEWKEYEXIT FUNCTIONMYERR: GetNextKey = "1_" End Function how to determine all sheets in a database? '------------------------------------- --------------------------- '' Author: lihonggen0'date: 2003-6-19 'Features: Get a table in the Access library How to implement the name and how to use ADO 'Project ---> Quote ---> Microsoft ActiveX Data Object 2.x (version number)' -------------------------------------------------- -------------------------- Private sub-us new adod.com connection DIM STRCNN AS New Adod.RecordSetdim I As Integer str1 = "Provider = Microsoft.Jet.OLEDB.4.0; Data Source = c: /Northwind.MDB; Persist Security Info = False" adoCN.Open str1 Set rstSchema = adoCN.OpenSchema (adSchemaTables) Do Until rstSchema.EOF ! If rstSchema TABLE_TYPE = "TABLE" Then out = out & "Table name:"! & _ rstSchema TABLE_NAME & vbCr & _ "Table type:"! & rstSchema TABLE_TYPE & vbCr I = I 1 End If rstSchema.MoveNext Loop MsgBox I RSTSChema.close Adoccn.closedebug.print Outend Sub '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ -------------------------------------- '' Author: lihonggen0'date: 2003-6- 19 'Features: Get the number of the number of tables in the Access library, how do you implement the name with ADO' project ---> Quote ---> Microsoft ActiveX Data Object 2.x (version number) "-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ---------------------------------------------- ------------------------ Private Sub Form_Load () Dim Adocn As New AdoAdb.connection 'Defines Database Connection DIM STRCNN AS New Adod.RecordSetdim i as Integer str1 = "Provider = Microsoft.Jet.OLEDB.4.0; Data Source = c: /Northwind.MDB; Persist Security Info = False" adoCN.Open str1 Set rstSchema = adoCN.OpenSchema (adSchemaTables) Do Until rstSchema.EOF If rstSchema Table_type = "Table" Ten Out = OUT & "Table Name:" & _ Rstschema! Table_name & VBCR & _ " Table type:! "& RstSchema TABLE_TYPE & vbCr I = I 1 End If rstSchema.MoveNext Loop MsgBox I rstSchema.Close adoCN.CloseDebug.Print outEnd Sub how to make the dialog box (CommonDialog) in the center of the screen to display the VB CommonDialog be? Implement Open, Print and other functions, but its location cannot be adjusted to the center of the parent window or the center of the screen. Is there any position to modify these dialogs? Answer: If it is in C or Delphi, the hook function can be used and then set the position of the dialog box in the hook function. However, the use of the hook (hook) function in VB is trouble, this is the weakness of VB. However, VB also has its own way. To solve this problem, you should first find how Commondialog sets its dialog position. First put a Commondialog control in an Form, then constantly moving the Form on the screen and activates Commondialog. You will find that Commondialog always appears in the upper left corner of the Form, which is very obvious when Form appears on the left or upper part of the screen. However, when Form appears below or on the right side, Commondialog will make a slight adjustment to ensure that the entire dialog box can be displayed within the screen. If your Form is close to the center of the screen, then Commondialog will naturally appear on the center of the screen. With this feature, we can build an empty form called MycDform, and then place a Commondialog control thereon. This MycDform is only used to place the Commondialog control, without other purposes. Then enter the following function. Private Function ChooseFile (argLeft As Single, argTop As Single) As Boolean 'no files are selected to ChooseFile = False' position of the mobile MyCDForm MyCDForm.Left = argLeft MyCDForm.Top = argTop 'provided CommonDialog control MyCDForm! CommonDialog1.CancelError = True On Error GoTo OpenError 'display CommonDialog MyCDForm CommonDialog1.ShowOpen!' uninstall MyCDForm unload MyCDForm ChooseFile = True Exit Function OpenError: 'user presses the Cancel button unload MyCDForm Exit Function End Function when your program needs to call the Open dialog box, you can use ChooseFile . Argleft and Argtop are coordinates of the top left corner of the Open dialog box appearing on the screen. As can be seen from this function, in fact, we are the location of the MycDform's location as argleft and argtop, and the location of the Open dialog always appears to change the screen position of the Open dialog box in the top left corner of its parent window. Similarly, you can also display other dialogs. If you want the dialog box appear in the center of the screen, argleft = (Screen.Width - dialog width) / 2, argtop = (Screen.Height - Dialog Height) / 2. For the screen size of 800 * 600 pixels, the OPEN dialog is displayed, and these two values are substantially 1500. If you also want to set through the Hook technology in VB, you can refer to the example http://www.china-askpro.com/download/f_51.zip. How to respond to the closing event in the upper right corner? Private Sub Form_Unload (Cancel As Integer) IF MSGBOX ("Do you want to exit the system?", 4 32 256, cprogramname) = Vbyes the Cancel = false end else caledl = true end ifend sub-screen Darration effect ( The effect when Windows is turned off) uses VB to generate the screen darkened. 1. Add two CommandButton and a PictureBox.2 in Form1, add the following code in the Form1 code window: Private Type Rectleft As Longtop As LongRight As Longbottom As Longend Type Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPrivate Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As LongPrivate Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As long, byval hobject as longidaterect lib "user32" (Byval HWnd As Long, Byval Brase As long) As long Private Bybits (1 to 16) AS BYTEPRIVATE HBITMAP As Long, Hbrush As Longprivate HDESKTOPWND As Long PRIVATE SUB COMMAND1_CLICK () DIM ROP AS Long, RES AS Longdim HDC5 As Long, Width5 As Long, Height5 As Long HDC5 = getdc (0) width5 = screen.width / screen.twipsperpixelxheight5 = Screen.height / Screen.twipsPixely ROP = & HA000C9Call SelectObject (HDC5, Hbrush) Res = Patblt (HDC5, 0, 0, Width5, Height5, ROP) Call deleteObject (Hbrush) Res = releasedc (0, HDC5) End Sub PRIVATE SUB Command2_Click () DIM AA As Long AA = INVALIDATERECT (0, 0, 1) End Sub Private Sub Form_Load () Dim Arydim i as longary = array (& H55, & H0, & HAA, & H0, _ & H55, & H0, & HAA, & H0, _ & H55, & H0, & HAA, & H0, _ & H55, & H0, & HAA, & H0) for i = 1 to 16bybits (i) = ary (i - 1) Next hbitmap = createbitmap (8, 8, 1, 1, bybits (1)) HBrush = createpatternbrush (hbitmap) Picture1.ForeColor = RGB (0, 0, 0) Picture1.backcolor = RGB (255, 255, 255) Picture1.scalemode = 3END SUB running program, press Command1 to make the screen down, press Command2 to recover. ------------------------------------ Twenty-eight, turn off keyboard and mouse event When programming, if you want to temporarily block the keyboard and the mouse, you can use the following statements: Private Declare Function EnableWindow Lib "User32" (Byval Hwnd As Long) AS Long SUB FORM-LOAD () Call enableWindow (Form.hwnd, 0) 'Rejecting the keyboard and mouse event ...... Call enableWindow (Form.hWnd, 1) 'Allows to accept keyboards and mouse events End Sub ------------------------------------ Twenty-nine, close the program Maybe everyone will say that the shutdown is not very simple, use the END statement. In fact, shutting down programs with an end statement is not a good way, and the End statement can end the program, but cannot remove the form from the memory, resulting in the result of the form also occupies some Windows resources; complete Release the resource method or use the unload statement, then use the set form = NOTHING statement. If there are many forms in the program, you can use the following method to remove all the forms at a time: Sub unloadAllForms () DIM FORM AS FORM For Each Form in Forms Unload form SET form = Nothing Next form End Sub The above function uses the method of the form object, no need to use the unload statement one by one, call it in the program end button. -----------------------------------30, avoid the conflict that can be opened We often open files using statements such as Open ... AS # 1, for example, Open "myfile.txt" for append as # 1 Print # 1, "a line of text" Close # 1 If there is a need to open in the program, it may cause conflicts due to the file number, and if the file number used in other forms is not closed, it will have an error in other forms. To avoid such possible errors, it is best to make sure it is not used before using the file number. VB provides a function freefile () to resolve this problem, which returns the next file number of the currently used file number, which guarantees that there is no conflict. We will rewrite the above code as follows: INTFILE = FreeFile () Open "myfile.txt" for append as #intfile Print #intfile, "a line of text" CLOSE #intfile ----------------------------------- 31, use the name command to move files Name Commands You may only think it is used to change the name of the file, in fact it can also be used to move files, such as: Name "c: /myfile.txt" AS "c: /dos/file.txt", this statement Not only changed the name of the file, but also files from C: / moved to the C: / DOS path. It should be noted that it is only suitable for file new, old path on the same drive, can only be used to move files, can not move the directory or folder, and the file name cannot be included in the file name. ------------------------------------ 32, make a countdown clock The method of making a countdown clock is very simple, first set an initial time, then subtract the current time with the initial time. Example, countdown one hour clock can write code like this: DIM TXT AS STRING 'Plus the current time as an hour as the end time EndTime = DateAdd ("H", 1, now) 'Countdown, use a label to display the remaining time TXT = Format $ (AlarmTime - Now, "HH: mm: ss") Label1.caption = txt ---------------------------------- thirty-three, realize the label text vertical Normally, the tag text is of a row, but we can make it vertical, vertical method is to add the carriage return button after each character, can be input directly in the title of the label, but it is more troublesome. Using a small program to complete, in which the MID $ function is used, the English is used in alphabetical, and the Chinese character is arranged in a single Chinese character: DIM S As String DIM SS AS STRING For i = 1 to len (label1) S = MID $ (Label1, I, 1) & VBCRLF SS = SS S NEXT Label1 = SS ------------------------------------ Thirty-four, realize no title window No title window is generally used to make a program start-opening cover, etc., to make the window no title must set the four properties of the form as the lower value: CAPTION = Controlbox = false Minbox = false Maxbox = false ------------------------------------ Thirty-five, play the MIDI file with the API function MIDI music files are generally smaller, often available for background music, playing MIDI music files can use MCI controls, but for a software, add a MCI control to play a background music file seems to be a little big, actually utilizing the API function This feature can be done very simply. Examples are as follows: Declaring the API function McIndstring as follows: Private Declare Function McIndstring Lib "Winmm.dll" Alias _ "McIndstringa" (Byval LPSTRCOMMAND AS STRING, BYVAL _ LPSTRRRRRRRINSTRING AS ANY, BYVAL URETURNLENGTH AS Long, Byval_ HWNDCALLBACK AS Long AS Long Add a command button in the form, double click on the following code: Private submmand1_click () DIM RET AS INTEGER 'Open MIDI files and sequence devices Ret = mciSendstring ("Open C: /WIN95/Media/canyon.mid type sequenceer _ Alias Canyon, 0 &, 0, 0) 'Play MIDI file Ret = McISendstring ("Play Canyon Wait", 0 &, 0, 0) 'Close MIDI file and sequence device RET = McISendstring ("Close Canyon", 0 &, 0, 0) End Sub reads and writes four functions of the INI file Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As LongPublic 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 LongPublic 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 'read ini string Public Function GetIniS (ByVal SectionName As string, ByVal KeyWord As string, ByVal DefString As string, ByVal FileName As string) As string Dim ResultString As string * 144 , Temp As Integer Dim S AS String, I as Integer Temp% = getPrivateProfileString (SectionName, Keyword, "", R Esultstring, 144, filename) 'Retrieve keyword IF TEMP%> 0 THEN' keyword is not empty S = "" "" "for i = 1 to 144 IF ASC (MID $ (RESULTSTRING, I, 1)) = 0 THEN EXIT for Else S = S & MID $ (Resultstring, I, 1) End if Next Else Temp% = WritePrivateProfileString (SectionName, Keyword, Defstring, FileName) 'Write the default value to the INI file s = defstring endware = Send Function ' Read ini value Public Function GetIniN (ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Integer, ByVal FileName As String) As Integer Dim d As Long, s As String d = DefValue GetIniN = GetPrivateProfileInt (SectionName, KeyWord, DefValue, FileName) If d <> DefValue Then s = "" & d d = WritePrivateProfileString (SectionName, KeyWord, s, FileName) End IfEnd Function 'write ini string Public Sub SetIniS (ByVal SectionName As string, ByVal KeyWord As string, ByVal ValStr As String, ByVal FileName As String) Dim res% res% = WritePrivateProfileString (SectionName, KeyWord, ValStr, FileName) End Sub 'write ini value Public Sub SetIniN (ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Integer, ByVal FileName As String) DIM RES%, S $ S $ = STR $ (VALINT) RES% = WritePrivateProfileString (SectionName, Keyword, S, filename) End Sub How to develop like VB menu (ie before: menu item Menu with icons)? Creating a Bitchart menu In the usual program, the menu always exists in text, sometimes it is very monotonous. If you can add bitmap graphics in the menu, you will greatly increase the user's use interest. This article describes how to make menu options using a bitmap. Create a bitmap menu ---- Creating a bitmap menu is actually very simple, it needs to use some menu functions and bitmap functions of the Windows Application Programming Interface (API), you need to include these functions in the standard module of your application. For details, please refer to the sample program. Proceed as follows: Use the function getSubmenu to extract the handle of the submenu and create a compatible device environment description table by using the function createCompatibleDC; In a loop process, by using the CreateCompaPaTMAP function, the SelectObject function, and the Bitblt function, the bitmaps loaded by each menu item will be selected into the compatible device environment. Draw a true bitmap menu option by the ModifyMenu function; Use the deletedc function to release the device environment so that other programs can be used. ---- Extracting a bitmap can have a variety of ways, set up four graphics box controls on the form in this program, using them to load 4 preset icons to use the source file of the menu option bitmap Of course, you can also use other methods, such as using the LoadPicture function to load a bitmap from the disk. Sample program Start a new project in Visual Basic, build FORM1 with the default method. Create a new module, build Module1.bas with the default approach. The following constants and added to the declaration statement Module1.Bas module: Option ExplicitDeclare Function GetMenu Lib "user32" (ByVal hwnd As Long) As LongDeclare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As LongDeclare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongDeclare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongDeclare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongDeclare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongDeclare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, Byval nheight as long, byval hsrcdcas long, byval hsrcdcas long L xsrc as long, byval ysrc as long, byval dwrop ask as longpublic const srcopy = & hcc0020 Public const mf_beposition = & h400 & public const mf_bitmap = & h4 & Note that the above declaration statement needs to be written in one line. Add 4 graphics box controls on Form1, set their Name properties to Picture1, set their index properties to 0, 1, 2, 3, set their AutoRedRew properties to True, set their AutoSize property settings To TURE, and set their Visable property to false. Set the Picture property of the above four graphics box controls to Face1.ico, Face2.ico, Face3.ico, Face4.ico. Add the first menu item on Form1, set it to "[& F] file", and the name is set to Mnufile. Add a submenu item under which it is set to "[& E] exit", the name is set to Mnuexit. Add a second menu item on Form1, set its title to "[& A] Facebook, the name is set to Mnuface. Add 4 submenu items to add 4 submenu names, the name of the four submenu will be changed to "[N] Normal", "[& S] smile", "[& l] laugh", and "[& o] sad". Set their name to "MnuFaceSel" and set the index of the four submenu items to 0, 1, 2, and 3 accordingly. Add the following code to the Form_Load event of Form1: Private Sub Form_Load () Dim nLoopCtr As Integer Dim lResult As Long Dim hTempDC As Long Dim nWidth As Integer Dim nHeight As Integer Dim lTempID As Long Dim hMenuID As Long Dim lItemCount As Long Dim hBitmap As Long nWidth = Picture1 (nLoopCtr) .Width / Screen.TwipsPerPixelX nHeight = Picture1 (nLoopCtr) .Height / Screen.TwipsPerPixelY hMenuID = GetSubMenu (GetMenu ((Me.hwnd)), 1) hTempDC = CreateCompatibleDC (Picture1 (nLoopCtr) .hdc) For nLoopCtr = 0 To 3 hBitmap = CreateCompatibleBitmap (Picture1 (nLoopCtr) .hdc, nWidth, nHeight) lTempID = SelectObject (hTempDC, hBitmap) lResult = BitBlt (hTempDC, 0, 0, nWidth, nHeight, (Picture1 (nLoopCtr). hdc), 0, 0, SRCCOPY) lTempID = SelectObject (HTEMPDC, LTEMPID) MNUFaceSel (nloopctr) .caption = "" LRESULT = ModifyMenu (HMENUID, NLOOPCTR, MF_BYPOSITION OR MF_BITMAP, GETMENUITEM ID (HMENUID, NLOOPCTR), HBitmap Next Nloopctr LRESULT = Deletedc (HTEMPDC) End Sub Add the following code to the "Exit" submenu Click event: Private sub mnuexit_click (index as integer) SELECT CASE INDEX CASE 0 Unload Me End SelectensEnd Sub Run the sample program, click the "Facebook" menu, you will see the bitmark menu item formed by 4 facet icons, as shown in Figure 1. Click the File / Exit menu to exit the application. 'API function declaration Option ExplicitPrivate Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) _As Long' get a menu window handle, hwnd is the handle of the window Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As _Long, ByVal nPos As Long) As Long 'made submenu handle, nPos is the location of the menu Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal _hMenu As Long, ByVal nPos As Long, ByVal wFlags As Long, ByVal _hBitUnchecked As Long, ByVal hBitChecked As Long) As Long 'Set the corresponding graphic const mf_bitmap = & h400 &' with image or picture or imagelist control (must be BMP format), 16 * 16-enable menu private sub form_load () Dim Hmenu, HSubmenu1, HSubMenu2 AS LonghMenu = hSubMenu1 GetMenu (Me.hwnd) = GetSubMenu (hMenu, 0) 'to obtain a handle to the first submenu item menu SetMenuItemBitmaps hSubMenu1, 0, MF_BITMAP, imagelist1.listimages (1) _.Picture, imagelist1.listimages (1). Picture 'The first set of graphics for HsubMenu1, assumes that the imagelist control is loaded into graphical setmenuitembitmaps HSubMenu1, 1, mf_bitmap, imagelist1.listimages (2) _.picture, imagelist1.listimages (2) .PICTURE' Settings second, the same You can also set the XX item. HSUBMENU2 = GetSubmenu (HMENU, 1) 'The submenu handle of the second menu can also use setMenuItemBitmaps to set its graphics, only HSUBMENU1 can be HSubMenu2', how can I: End Sub: Time on the Control Ms Chart on the Control Ms Chart , saved as a graphic file On Error GoTo saverr Dim strsavefile as String With dlgChart 'CommonDialog object .Filter = "Pictures (* .bmp) | * .bmp" .DefaultExt = "bmp" .CancelError = True .ShowSave strsavefile = .FileName If strsavefile = "" "The eXIT SUB End with Mschart1.editcopy SavePicture Clipboard.getdata, StrsaveFile Exit Subsaverr: Yes, how do I determine if a node exists in TreeView? Private Function IsExistNode (Key As String) As Boolean On Error GoTo Err Dim nodeX As Node Set nodeX = TreeView.Nodes (Key) IsExistNode = TrueErr: IsExistNode = FalseEnd FunctionPrivate Sub Command1_Click () MsgBox IsExistNode ( "keystr") End Sub Private Sub Form_Load () TreeView1.nodes.add, "Key", "AAA" End Sub
