A call to an external program, control is returned and waits for the end of the program to persuade subroutine: Sub ShellWait (cCommandLine As String) Dim hShell As LongDim hProc As LongDim lExit As LonghShell = Shell (cCommandLine, vbNormalFocus) hProc = OpenProcess (PROCESS_QUERY_INFORMATION, False, Hshell) Do GetExitcodeProcess Hproc, Lexit Doeventsloop While Lexit = STILL_ACTIVEEND SUB
In the read database field is displayed in the control, if the content of the field is null, it will be wrong, use the following method: ... text1.text = Tab_cust ("cust_name") & "...
Determining whether a file exists: Function FileExists (filename As String) As IntegerDim i As IntegerOn Error Resume Nexti = Len (Dir $ (filename)) If Err Or i = 0 Then FileExists = False Else FileExists = TrueEnd Function
Export data from MSFLEXGRID to Excel, code: Add a CommandButton on the form, a label, a MSFLEXGRID, an OLE (link Excel) private submmand1_click () DIM STR AS STRINGDIM C AS Longdim r as longole1.doverb -2Label2.Linktopic = "Excel.exe | Book1" label2.LinkMode = 2for C = 0 to grid1.cols - 1 for r = 0 to grid1.rows - 1 str = "r" & r 1 & "c" & C 1 label2.LinkItem = str label2.caption = Grid1.textMatrix (r, c) label2.LinkPoke NextXEnd Sub
Use the Image control to display photos and scalable it to a size. Sub ShowPicture (PcitureName As String) Dim ZX As SingleDim ZY As SingleWith Image1 .Stretch = False .Visible = False .Picture = LoadPicture (PictureName) ZX = .Width / 155 'Assuming that the target width of 155 pixels ZY = .Height / 165' Assume the target height is 165 pixels if zx> zy zy = zx else zx = zy end if .stretch = true .width = int (.width / zx) .height = int (.height / zy) .visible = Tureend Withend Sub
A very simple program that utilizes MSFlexGrid controls, you can enter English characters and numbers. Automatically move right on the carriage return, support the arrow keys, which can be added automatically. MsFlexGrid only used a control, no other: Private Sub Form_Load () Grid1.Rows = 10Grid1.Cols = 6End SubPrivate Sub Grid1_KeyDown (KeyCode As Integer, Shift As Integer) Dim X As LongDim Y As LongDim L As LongDim Tmp As StringX = Grid1.coly = grid1.rowselect case keycode case 13 x = x 1 if x> = grid1.cols the x = 1 y = y 1 if> = Grid1.Rows Then Grid1.Rows = Grid1.Rows 1 End if Grid1.col = x Grid1.Row = y Case 8 TMP = Grid1.text L = LEN (TMP) - 1 IF L> -1 Then Grid1.text = Left (TMP, L) Case Else Grid1.text = Grid1 .Text & chr (keycode) End Selectend Sub
A subroutine that gets the name of the file, the parameter can be an arbitrary file name containing the path: Function getLastname (filename as string) AS stringdim name = split (filename, ".", -1) getLastName = names (Ubound (Names) ) End Function The first method is not good, this is better: Const INFINITE = & HFFFFConst STARTF_USESHOWWINDOW = & H1Public Enum enSW SW_HIDE = 0 SW_NORMAL = 1 SW_MAXIMIZE = 3 SW_MINIMIZE = 6End EnumPrivate Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As LongEnd TypePrivate Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As BYTE HSTDINPUT AS Long HSTDOUTPUT AS Long Hstderror AS LONGEND TYPRIVATE TYPE SECURITY_ATTRIBUTES NLENGTH AS Long LPSecurityDescriptor as long binherithandle as longend typepublic Enum enPriority_Class NORMAL_PRIORITY_CLASS = & H20 IDLE_PRIORITY_CLASS = & H40 HIGH_PRIORITY_CLASS = & H80End EnumPrivate Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPrivate Declare Function WaitForSingleObject Lib "kernel32"
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As LongPrivate Declare Function GetCurrentProcess Lib "kernel32" () As LongPublic Function SuperShell (ByVal App As String, ByVal WorkDir As String, ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean Dim pClass As Long Dim sinfo As STARTUPINFO Dim pinfo As PROCESS_INFORMATION 'Not used, but needed Dim sec1 As SECURITY_ATTRIBUTES Dim sec2 As SECURITY_ATTRIBUTES' Set the structure size sec1.nLength = Len (sec1) sec2.nLength = Len (sec2) sinfo.cb = Len (sinfo) 'Set the flags sinfo.dwFlags = STARTF_USESHOWWINDOW' Set the window's startup position sinfo.wShowWindow = start_size 'Set the priority class pClass = Priority_class' Start The Program IF CreateProcess (Vbnullstring, App, Sec1, Sec2, False, Pclass, _ 0 &, Workdir, Sinfo, Pinfo) THEN 'Wait WaitforsingleObject Pinfo.hprocess, Infinite Supershell = true else supershell = false end =nd function
Public Function SetAppPriority (Priority_Class As enPriority_Class) As BooleanDim hProcess As LongDim PClass As LongPClass = Priority_ClasshProcess = GetCurrentProcessSetPriorityClass hProcess, PClassEnd Function
This is the time: SuperShell program location, the program where the program is located, SW_NORMAL, NORMAL_PRIORITY_CLASS This code demonstrates that it can make it no longer CPU usage when the program is running 100%. I personally feel that the database NULL value is Suitable for protective functions. example:
SUB Test () DIM S AS STRING S = DFTOSTRING (RS ("UserName"). Value) End Sub
'Make sure return empty strings or valid conversion values PUBLIC FUNCTION DFTOSTR (Byval StringVar As Variant) AS String On Error Goto Ehif Not Isnull (Stringvar) THEN
Stringvar = CSTR (Stringvar) DFTOSTR = TRIM $ (Stringvar)
Endiff exit functioneh:
End function acquisition program Self path: public function getExepath () AS String getExePath = IIF (right (app.path, 1) <> "/", app.path & "/", app.path) End function
