VB6 common method compilation

xiaoxiao2021-03-06 72

Use static variables

Place Control: Form1: Label1, Command1

Property setting: Clabel1.autosize = true

Code:

Private submmand1_click ()

Static Stflag as Boolean 'uses static variables to save variable values

If stflag = false kil

Label1.font.size = 14

Stflag = true

Else

Label1.font.size = 9

Stflag = false

END IF

End Sub

Create an object

Place the control: Form1: command1, text1

Code:

Private submmand1_click ()

DIM T1 As Textbox

SET T1 = form1.text1

IF t1.text = 0 THEN

T1.backcolor = 0

T1.ForeColor = 255

END IF

End Sub

When running, just write 0 in Text1, click Command1, the text1 box is discolored.

If you don't have to use a T1 object, you should write to Form1.Text1.backcolor in the program.

Custom methods and properties

Place the control: Form1: command1, text1

Code:

Public Tsize As Integer 'Defines Properties

Public Sub TextLarge () 'Defining Method

Text1.width = text1.width * 1.1

Text1.height = text1.height * 1.1

Text1.fontsize = text1.fontsize Tsize

End Sub

Private submmand1_click ()

Form1.tsize = 4

Form1.textlarge

End Sub

Traverse control collection

Place Control: Form1: Label1, Command1, Text1, List1

Code:

Private sub flow_load ()

DIM MyC1 AS Control

For Each Myc1 in Controls

List1.additem myc1.name

Next myc1

End Sub

Collection addressing

Place Control: Form1: Label1, Command1, Text1, List1

Code:

Private submmand1_click ()

TEXT1 = Controls (3) .left

'Text1 = Controls ("Label1"). LEFT

'Text1 = Controls! Label1.Left

End Sub

Code wrap and parallelism

variable:

A1 = 2: A2 = 3: A3 = 4 'parallel

B1 = a1 a2 _ '

For strings:

S1 = "SADD" & C1 & "Qwer" 'join

S1 = "SADD" & C1 & "Qwer" & _ '

"Fjkgjgj06"

Print and display the wrap

S1 = "fjdkkjd" & vbcrlf & "iioknno"

Forced variable declaration

Option expedition

You can also select [Require Variable Declaration] in the menu [Tool] ‖ [Option] (Editor), automatically add Option Explicit on each module.

Find a string display length

Public Function LEN1 (STR AS STRING) AS INTEGER 'Common Function DIM SI, I AS INTEGER

DIM STR1 AS STRING

Si = 0

For i = 1 to Len (STR)

STR1 = MID (STR, I, 1)

IF ASC (str1) <0 THEN

Si = Si 2 'Chinese character is 2

Else

Si = Si 1

END IF

Len1 = Si

END FUNCTION

Intercept string

Public Function Len2 (S2 AS String, Si As INTEGER) AS STRING

Do While Len1 (S2)> Si

S2 = MID (S2, 1, LEN (S2) - 1)

Loop

Len2 = S2

END FUNCTION

Intercept and replenish the settlement string

Public Function Len3 (S2 AS String, Si As Integer) AS String

IF len1 (S2)> Si Then

Do While Len1 (S2)> Si

S2 = MID (S2, 1, LEN (S2) - 1) 'Long truncation

Loop

Else

Do WHILE LEN1 (S2)

S2 = S2 & "" is shorter with space

Loop

END IF

Len3 = S2

END FUNCTION

Vague look

Sub Shumlook (Byval Shu2 As String)

DIM SHU3 AS STRING

SHU3 = MID (SHU3, 1, LEN (SHU2))

IF shu3 = shu2 Then

END IF

End Sub

Clear all spaces of strings

Function TRIMK (CC0)

DIM I, J, S1

J = LEN (CC0)

i = 1

While i

S1 = MID (CC0, I, 1)

'Msgbox "S1 =" & S1 & ";"

IF S1 = "" OR S1 = "" "

CC0 = MID (CC0, 1, I - 1) MID (CC0, I 1, J)

i = i - 1

'Msgbox "cc0 =" & cc0

END IF

i = i 1

Wend

Trimk = CC0

END FUNCTION

Read the current date and time

Place Control: Form1: Text1, Text2, Command1

Code:

Private submmand1_click ()

DIM D1 AS DATE

D1 = DATE

TEXT1 = D1 'Shows such as 00-6-24

D1 = TIME

Text2 = d1 'Show such as 10:30:23

End Sub

Enter the date and calculate

Place Control: Form1: Text1, Text2, Command1

Code:

Private submmand1_click ()

DIM D1 AS DATE

D1 = Text1

D1 = D1 - 100

Text2 = D1

Text1 = weekday (d1)

End Sub

When running, you can enter the date in Text1 (such as 00-5-30), then click Command1, then display the date of the input date of 100 days in Text2, and show the date in Text1. Return the year, month, day, time, minute, second function is Year, Month, Day, Hour, Minute, Second.

Note Weekday returns 1 represents Sunday, 2 represents Monday, 7 represents Saturday.

Initialization events and termination events

When a form is called, the initialize event will generally first initiate the LOAD event. But just reference the data or procedure on the form, it may not trigger the LOAD event. The LOAD is only triggered when the control is called.

When the form is terminated, first trigger the unload event and then trigger the Terminate event. However, when using unload form1, it is not possible to raise the Terminate event, and the process and variables in the form can still be referenced. Only use SET FORM1 = Nothing to trigger the ternimum event.

Unexpected group

First define array DIM array1 ()

Use Redim (3, 9) when using

Or REDIM (1 to 3, 1 to 9)

Using Format to determine the data format

1. Date and time

Returns the current system date in long-term format set in system settings.

Print Format (Date, "Long Date") 'Returns October 29, 2001

MyStr = Format (MyTime, "H: M: S") 'Returns "17: 4: 23".

MyStr = Format (MyTime, "HH: mm: SS ampm") 'Returns "05:04:23 PM".

MyStr = Format (MyDate, "DDDD, MMM D YYYY") 'Returns "Wednesday, Jan 27 1993".

2. digital

MyStr = Format (5459.4, "## 0.00") 'returns "5,459.40".

MyStr = Format (334.9, "### 0.00") 'returns "334.90".

MyStr = Format (0.5, "0.00%") 'returns "50.00%".

Simplification: such as AA = 1235432/3

Print Format (AA, "0.000") 'Return 411810.667

Integer: Print Format (123, "00000") 'Return 00123

3. Character

Lowercase: mystr = format ("Hello", "<") 'Returns "Hello".

Upress: mystr = format ("this is it", ">") 'Returns "this is it".

If there is no specified format, return to the original string.

MyStr = format (23) 'Returns "23".

Variable

First define in modules (such as Module1):

Type Qipurec

QX as integer

qy as integer

Qcolor as string

End Type

Add it in Form1:

DIM Qishu (1 to 400) AS Qipurec can reference Qishu.QX, Qishu.qy.

Two common controls

Call different form

Place Control: Form1: Command1, Command2; Form2: Command1

Property setting: 〖Form1.command1.caption〗 = Enter Form2

〖Form1.command2.caption〗 = Exit

〖Form2.command1.caption〗 = Return to Form1

FORM1 code:

Private submmand1_click ()

FORM2.SHOW

End Sub

Private sub fascist2_click ()

End

End Sub

FORM2 code

Private submmand1_click ()

FORM2.HIDE

FORM1.SHOW

End Sub

Unsend with optionbutton

Place Control: Form1: Option1, Option2, Option3, Label1

Property setting: 〖Option1.caption〗 = Basic

〖Option2.caption〗 = Pascal

〖Option3.caption〗 = C

Code:

Private subbotion1_click ()

Label1.caption = "Basic"

End Sub

Private subboption2_click ()

Label1.caption = "pascal"

End Sub

Private subbotion3_click ()

Label1.caption = "c"

End Sub

CHECK check

Place Control: Form1: Text1, Check1, Check2

Property setting: 〖text1.text〗 = Font Demo

Code:

Private sub check1_click ()

If Check1.Value = 1 THEN '

Text1.FontSize = 14 'font is 14th, big words

Else 'cancellation

Text1.fontsize = 9 'font is 9th, ordinary words

END IF

End Sub

Private sub check2_click ()

If Check2.Value = 1 THEN

TEXT1.FONTITALIC = True '

Else

Text1.Fontital = false 'resumes normal

END IF

End Sub

Select ComboBOX table value

Place Control: Form1: Combo1 (ComboBox)

Code:

Private sub combo1_click ()

S1 = combo1.text

Print "You selected:"; S1

End Sub

Private sub flow_load ()

Combo1.additem "junior high school"

Combo1.additem "High School"

Combo1.additem "University"

End Sub

Listbox assigns from the program

Place Control: Form1: List1 (Listbox), Label1

Code:

Private sub flow_load ()

List1.additem "A1" 'assigns the value with the AddItem method

List1.additem "a2"

List1.additem "a3"

End Sub

Private sub list1_click ()

SELECT CASTIND1.LISTINDEX 'LISTINDEX value is 0, 1, 2case 0: label1.caption = "ok1"

Case 1: label1.caption = "ok2"

Case 2: label1.caption = "ok3"

End SELECT

End Sub

Use MSGBOX two-way selection

Place Control: Form1: Command1

Property setting: 〖Command1.caption〗 = exit

Code:

Private submmand1_click ()

MyExit = msgbox ("Do you really want to exit?", vbokcancel, "exit")

IF myexit = vbok kil

Unload me

Else

Debug.print "Abandon Exit"

END IF

End Sub

Enter value with inputbox

Place Control: Form1: Command1

Property setting: 〖command1.caption〗 = start

Code:

Private submmand1_click ()

DIM STRING1 AS STRING

DIM INT1 AS INTEGER

String1 = InputBox ("Input")

INT1 = VAL (String1)

'Can use int1 = Val (InputBox ("Input"))

Print "INT1 ="; INT1

End Sub

Complex Inputbox input

Private submmand1_click ()

QS = 1.2

Qs1 = 1.2

Ts1 = "2001-2002" & QS & "% in the township and townships," & QS & "%, after the revision, press 'OK'"

S1 = VAL (InputBox (TS1, Calculation Modification ", QS1))

IF S1 <> "" and S1 <> "0" THEN

"2002 市场市场市场市场市场市场市场市场市场市场市场市场市场市场市场

Else

MsgBox "give up the modification."

END IF

End Sub

Timer timer

Place Control: Form1: Text1, Timer1

Property settings: 〖Timer1.Interval〗 = 1000 '1000ms

Code:

Private sub timer1_timer ()

IF text1.text <> "10:02:00" THEN

Text1.text = TIME

Else 'time

Text1.text = "ok"

Timer1.enabled = false 'no longer display time

END IF

End Sub

Preparation of delay programs with Timer

Place Control: Form1: Command1, Timer1

Property setting: 〖Timer1.Interval〗 = 10 '10ms

Code:

SUB DELAY (SS AS Integer) 'Delay Process

Dim Start, Check

Start = Timer

Check = Timer

Loop While Check

End Sub

Private sub fascist1_click () Command1.caption = "test1"

DELAY (1000)

Command1.caption = "TEST2"

DELAY (2000)

Unload me 'exits

End Sub

Use the File control

Private sub flow_load ()

File1.pattern = "* .txt"

File1.path = "c: / fxfx / kfb"

End Sub

If you use the directory list control DIR1, you can use it.

File1.path = DIR1

Connect can be used.

Use the Commondialog control

Open Microsoft Common Dialog Control 6.0 (SP) in the control of the part, add the Commondialog1, Command1, and Text1 controls. Open the file dialog as run and display the selected file in the text box.

Private submmand1_click ()

ON Error Goto Errhandler

Commondialog1.filter = "all files (*. *) | *. * | Text files (*. Txt) | * .txt"

CommonDialog1.filterIndex = 1 'default is all Files

CommonDialog1.showopen

TEXT1 = CommonDialog1.FileName

EXIT SUB

Errhandler:

EXIT SUB

End Sub

Commondialog controls can also display color dialogs (CommonDialog1.ShowColor), Font dialog (Commondialog1.ShowFont), printing dialog (Commondialog1.printer), Display Help dialog (with commondialog1.helpfile = "C: / Windows / Cadio. HLP settings, call with commondialog1.showhelp).

Cancel the button of the form

Form1.controlbox = false

Bind databases using Microsoft Flex Grid 6.0 control

Directly added to the settings;

Running dynamic change control array

First add a COMBO control to the Form, then copy a set of controls, remove Combo1 (1), move Combo1 (0) to the upper left corner, add a command to the right, encoding as follows:

Private submmand1_click ()

Unload combo1 (5) 'Remove a control

End Sub

Private sub flow_load ()

C1Y = 600

For i = 1 to 5 'Add a set of controls

Load combo1 (i)

Combo1 (i) .top = C1Y

Combo1 (i) .left = 100

C1Y = C1Y 500

Combo1 (i) .visible = true

End Sub

STATUSBAR

Open Microsoft Common Dialog Control 6.0 (SP) in the control of the part, add the StatusBar control. Right-click to add a pane and adjust the width.

When you add a text, the program is:

STATUSBAR1.PANELS (1) .text = "ratio 1:" & format $ (sbscalebar1.rfscale, "###, ###, ###, ###, ###") VBModal call mode

Calling Form using VBModal, you can perform the next statement after it is complete, such as:

FRMTIP.SHOW VBMODAL

Msgbox TipType

If TIPTYPE = 100 is set in FRMTIP, this value can be displayed.

Use of ProgressBar

Open Microsoft Windows Common Control 6.0 in the controls of the part, add the ProgressBar control.

When programming, you must first set up ProgressBar1.max (generally maximum loop number 1) and progressbar1.min (general 0), plus a variable of one and cyclic number synchronization, reuse again

ProgressBar1.Value = Si

The result of the process strip can be implemented.

Examples in the For loop are:

Private submmand1_click ()

DIM I as long

DIM J AS Long

DIM SI As Long

Si = 0

Progressbar1.max = 10001

Progressbar1.min = 0

For i = 0 to 10000

For j = 0 to 1000

a = "sdf"

NEXT J

Si = Si 1

ProgressBar1.Value = Si

Next i

MSGBOX "END"

End Sub

Examples in database operations are:

Progressbar1.max = ri 1 'ri is all records;

Progressbar1.min = 0

Rst2.movefirst

While Not Rst2.eof

......

RJ = RJ 1

ProgressBar1.Value = rj

Wend

Three control programming basic methods

Control input location and focus

Place Control: Form1: Text1, Command1

Code:

Private submmand1_click ()

TEXT1.SELSTART = 3 'cursor in the third position

TEXT1.SETFOCUS 'Make Focus Back to Text1

End Sub

Use container controls

Container controls include: Frame, Picturebox and Toolbar.

Ways to accommodate other controls using a container control:

1. A container control first, draw other controls there;

2. Scrapped existing controls onto the container control;

3. Using program command1.container = frame1

Set up with one button

Place control: Form1: command1, list1

Code:

Private submmand1_click ()

IF BZL THEN

List1.visible = true

Command1.cption = "exit"

Bzl = false

Else

List1.visible = false

Command1.caption = "display"

Bzl = true

END IF

End Sub

Private sub flow_load ()

Bzl = turelist1.visiblae = false

Command1.caption = "display"

End Sub

List control selection properties

Take the properties of List1 as an example, list classes such as List, Combo, File, DIR, etc.

1. Select the I Item List1.Selected (i) (true)

2. Return the Item List1.List (i)

3. Return to the list of total numbers list1.listcount

4. Returns the last click position list1.listindex

Note: I starts from scratch.

List control

For i = 0 to file1.listcount - 1

File1.selected (i) = true

Some of the selection of list controls

Dim fscount, i, j

DIM FS1 (100) AS STRING

J = 0

For i = 0 to file1.listcount - 1

If file1.selected (i) THEN

FS1 (j) = file1.list (i)

J = J 1

END IF

fscount = j

Generate a directory using the TreeView control

Select "Microsoft Windows Common Control 6.0 (SP3) in [Parts], you can open a set of controls, with Tabstrip, Toolbar, Statusbar, ProgressBar, TreeView, ListView, ImageList, Slider, ImageCombo.

Add TreeView1 and Imagelist1 to the form;

Right click on ImageList1, open the property page, add graphics;

Right-click TreeView1, open the property page, select ImageList1 in [Image List], and change the indentation from the directory;

Change the TreeView1 attribute LINESTYLE 1;

Add code:

Private sub treeview1_nodeclick (byval node as mscomctllib.node)

Select Case Node.Key

Case "FX1"

HyperLink.navigateto ("http://b4x5d1/faexcise/fa1/default1.asp")

Case "FX2"

Hyperlink.navigateto ("http://b4x5d1/faexcise/fa1/create1.asp")

End SELECT

End Sub

Private sub Userdocument_initialize ()

DIM MYNODE AS NODE

Set mynode = TreeView1.nodes.add (, "FX", "Release System", 2)

Set mynode = TreeView1.nodes.add (, "CB", "Publishing System", 2)

Set mynode = TreeView1.nodes.add (, "CW", Finance System, 2)

Set mynode = treaiview1.nodes.add (,, "bw", "Multiple System", 2)

Set mynode = TreeView1.nodes.add (, "XT", System Management ", 2) 'Second Directory

Set mynode = TreeView1.nodes.add ("fx", TVwchild, "fx1", "Batch", 3)

Set mynode = TreeView1.nodes.add ("FX", TVWChild, "FX2", "sample book", 3)

Set mynode = TreeView1.nodes.add ("FX", TVWChild, "FX3", "Distribution Management", 3)

Set mynode = TreeView1.nodes.add ("FX", TVWChild, "FX4", "Query", 3)

MyNode.ensurevisible

End Sub

Four error handling

Examples using monitoring window debugging

Place Control: Form1: Command1

Property setting: 〖Command1.caption〗 = Start calculation

Code:

Private submmand1_click ()

N = 4

'm = 1

For i = 1 to n

m = m * i

Next i

Print "M ="; M

End Sub

Select [Debug] ‖ [Add Monitor] After entering, write M in [Expression], then click [OK]. At this time, the monitor window containing M is appeared below the screen. The above process is repeated, and N is also added to the monitor window.

Press the F8 key for single-step debugging (ie, press the F8 to run a line), step by step to check the variable change of the monitoring window. After clicking [Command1], press F8 to continue running. If the [Immediate] window is appeared in the lower part of the screen, turn it off, then select the [Window] ‖ [Monitor window] on the menu.

Error handling when using inputBox inputs

Continue to call InputBox until it is correct.

Private submmand1_click ()

DIM S11 AS INTEGER

DIM S2 AS STRING

ON Error Goto Head

HEAD1:

S2 = INPUTBOX ("Please enter a single price:")

IF S2 <> "" THEN

S11 = S2

END IF

EXIT SUB

HEAD:

Msgbox "Enter wrong! Please re-enter"

RESUME HEAD1

End Sub

Use Resume Next to handle errors

Exit Command1 when an error occurs.

Private submmand1_click ()

DIM S11 AS INTEGER

DIM S2 AS STRING

ON Error Goto Head

S2 = INPUTBOX ("Please enter a single price:")

IF S2 <> "" THEN

S11 = S2

END IF

EXIT SUB

HEAD:

Msgbox "Enter wrong! Please re-enter"

Resume next

End Sub

Error handling when using a Text Control

Private submmand1_click ()

DIM I1 AS INTEGER

ON Error Goto Handle

I1 = text1

Msgbox "Enter correct, i1 =" & i1

EXIT SUB

Handle:

MsgBox "Enter an error!" Text1 = ""

EXIT SUB

End Sub

Private sub flow_load ()

TEXT1 = ""

End Sub

Error handling when using an input form

Place Control: Form1: Command1, Form2: Command1, Text1, Module1

Module1 code:

Public I1 AS Integer

FORM1 code:

Private submmand1_click ()

Form2.show vbmodal

Msgbox "Input Complete, I1 =" & I1

End Sub

FORM2 code:

Private submmand1_click ()

ON Error Goto Handle

I1 = text1

Msgbox "Enter correct, i1 =" & i1

Unload me

EXIT SUB

Handle:

Msgbox "Enter an error!"

TEXT1 = ""

EXIT SUB

End Sub

Private sub flow_load ()

TEXT1 = ""

End Sub

Display error message

ON Error ResMe next 'changes the error handling.

Err.clear

Err.raise 6 'generates an overflow error.

'Check the error code, display the relevant error message.

IF Err.Number <> 0 THEN

Msg = "Error #" & Str (Err.Number) & "Was Generated By" _

& Err.Source & Chr (13) & Err.Description

MsgBox Msg,, "Error", Err.helpfile, Err.HelpContext

END IF

Five printing

Use currentx, y specifies the Print location

Place Control: Form1: Command1, Command2, Text1

Code:

DIM G1, G2 AS INTEGER

Private submmand1_click ()

G1 = G1 200

CWRITE

End Sub

Private sub fascist2_click ()

G2 = G2 200

CWRITE

End Sub

Sub cwrite ()

CLS 'Clear the last string

Currentx = G1

Currenty = G2

Print "Position Test."

End Sub

Print printing with Printer method

1. Set page coordinates

PW = 400: pH = 650

Printer.scale (0, 0) - (PW, pH)

Note: The above settings can only be set up page coordinates, and the page size cannot be set. To set the page size to Windows / Printer / Properties / in. For standard continuous printing paper, set a Letter.

2. Font

Printer.FontName = "black body"

Printer.fontsize = 10 '5 characters

Printer.fontbold = true 'bold

3. Print location

Printer.currentx = 110

PRINTER.CURRENTY = 30

4. Print data Printer.print "China Water Conservancy Hydropower Publishing House"

Printer.print "single number:" & TNUM

5. Painted table

Printer.DrawWidth = 3 'line width

Printer.Line (20, 20) - (300, 300)

6. Print account

PRINTER.COPIES = 2

7. Change

Printer.newpage

8. Print start

Printer.Enddoc

Note: As long as the Printer method is used, no matter whether it is using Printer.Enddoc, the program is running to run.

Change the page location

For use with printer.scale (0, 0) - (PW, pH)

Increase the left border printer.scale (-50, 0) - (PW, pH)

Overall left shift printer.scale (-50, 0) - (PW-50, pH)

Increase the upper boundary.scale (0, -50) - (PW, pH)

Increase the lower boundary printer.scale (0, 0) - (PW, PH 50)

Move the whole minus printer.scale (0, -50) - (PW, PH-50)

Direct print form with Printer

Private subdprint_click ()

Dim n as integer

DIM RS As New Adodb.Recordset

Rs.Open "Select * from JGGZ", "provider = microsoft.jet.Oledb.4.0; data source = d: /jggz/jggz.mdb; persist security info = false, AdopenStatic, AdlockPESSIMISTIC

N = 0

rs.movefirst

Form1.print "┌ - ─ ┬─── ┐"

While Not Rs.eof

Printer.print "│" & │Fields ("Name") .value; Tab (11); "│"; RS.Fields ("Class Tour"); Tab (21); "│"

rs.movenext

n = n 1

IF n / 5 = int (n / 5) or or.eof kil

Printer.print "└ - ─ ┴─── ┘"

Printer.print "┌ - ─ ┬─── ┐"

Else

Printer.print "├──────── ┤"

END IF

Wend

Printer.print "└ - ─ ┴─── ┘"

Rs.close

End Sub

Attachment 1: Table symbol location control

Location

0904

0906

0916

0920

0924

0940

0948

symbol

│

Bamboo

Location

0956

0964

0905

0907

0919

0931

0939

symbol

Bamboo

━

┃

Bamboo

Location

0947

0955

0963

0979

0936

0959

symbol

Bamboo

Six-drawing

Pointing point using a PSET

Place Control: Form1: Command1

Property setting: 〖command1.caption〗 = start

Code:

Private submmand1_click ()

Const Pi = 3.14159dim X0, Y0 as Single

DIM X1, Y1 AS INTEGER

X0 = 0

Do While X0 <= 4 * Pi 'draws two phases

Y0 = sin (x0)

X1 = x0 * 400 'zoom in 400 times

Y1 = Y0 * 400 1000

Pset (x1, y1) '

X0 = X0 0.01 'step size is 0.01

Loop

End Sub

Use LINE Picture

Place Control: Form1: Command1

Property setting: 〖Command1.caption〗 = Start Drawing

Code:

Private submmand1_click ()

LINE (100, 100) - (1000, 1000)

Line - (0, 500) 'Pointing the current point by default, ie (1000, 1000)

LINE - (100, 100) 'Complete a triangle

End Sub

Use the LINE erase line segment

Place Control: Form1: Command1, Command2

Property setting: 〖command1.caption〗 = Plumbing, 〖Command2.caption〗 = Erase

Code:

Private submmand1_click ()

DrawMode = 1

Line (0, 0) - (1000, 1000)

End Sub

Private sub fascist2_click ()

DrawMode = 7

LINE (0, 0) - (1000, 1000), Backcolor

End Sub

Use a Circle scripture arc

Place Control: Form1: Command1

Property setting: 〖Command1.caption〗 = Start Drawing

Code:

Private submmand1_click ()

Const pi = 3.1416

Circle (1000, 1000), 500,, 0, PI 'draws a arc from 0 degrees to π (180) degrees

End Sub

Use mouse picture garden pie and erase

Place control: Form1

Code:

Private Sub Form_MouseDown (Button As Integer, Shift As Integer, x as single, y as single)

Static X0, Y0 AS Integer 'Save the parameters of the last mouse position

FillStyle = 0 'Setting the padding mode

Circle (X0, Y0), 200, BackColor 'erases the onset

Refresh 'Heavy painting

DrawMode = 1 'drawing method restore

Circle (X, Y), 200

X0 = x 'Save the current mouse position

Y0 = Y

DrawMode = 7 'is ready to use xor drawing

End Sub

If you want to erase on the already background, use the following procedure:

Private submmand1_click ()

DrawMode = 1

Line (0, 0) - (1000, 1000)

End Sub

Private Sub Form_MouseDown (Button As Integer, Shift As Integer, X as Single, Y as Single) Static X0, Y0 AS Integer 'Save Parameters of the Location Location

FillStyle = 0 'Setting the padding mode

DrawMode = 7 'is ready to use xor drawing

Circle (X0, Y0), 200, BackColor 'erases the onset

Refresh 'Heavy painting

Command1_click

DrawMode = 1 'drawing method restore

Circle (X, Y), 200

X0 = x 'Save the current mouse position

Y0 = Y

End Sub

Make simple animation with Picturebox

Place Control: Form1: Picture1, Picture2, Picture3, Command1, Timer1

Property setting: 〖Picture1.autosize〗 = True, 〖Picture1.Picture〗 = bfly1.bmp

〖Picture2.autosize〗 = True, 〖Picture2.picture〗 = bfly2.bmp

〖Picture3.autosize〗 = TRUE

〖Command1.caption〗 = Start

〖Timer1.ItersRVAL〗 = 10

Note: BMP files from C: / Program Files / Microsoft Visual / MSDN98 / 98VS / VCR / Selection

Code:

Option expedition

SUB DELAY (SS AS Integer) delay program, SS unit is millisecond (MS)

Dim Start, Check

Start = Timer

Check = Timer

Loop While Check

End Sub

Private submmand1_click ()

DIM I as integer

For i = 1 to 10 'butterfly fan 10 wings

Picture3.Picture = Picture1.Picture 'Show Figure 1

DELAY (100) 'delayed 100 milliseconds

Picture3.Picture = Picture2.Picture 'Show Figure 2

DELAY (100)

Next i

End Sub

Making animations with Picturebox (interrupt with doevents)

Place Control: Form1: P1, P2, P3 (Picturebox), Command1, Command2, Timer1

Property setting: 〖p1.autosize〗 = true, 〖p1.picture〗 = bfly1.bmp

〖P2.autosize〗 = True, 〖p2.picture〗 = bfly2.bmp

〖P3.autosize〗 = TRUE

〖Command1.caption〗 = Start

〖Command2.caption〗 = Exit, 〖Command2.visible〗 = false

〖Timer1.ItersRVAL〗 = 10

〖Form1.backcolor〗 = White 'picks up from the palette

Note: BMP files from C: / Program Files / Microsoft Visual / MSDN98 / 98VS / VCR / Selection Code:

Option expedition

SUB DELAY (SS AS Integer)

Dim Start, Check

Start = Timer

Check = Timer

Loop While Check

End Sub

Sub flying () 'flying process

Const D1 = 30

P3.Picture = p1.picture

DELAY (D1)

P3.Picture = p2.picture

DELAY (D1)

End Sub

Private submmand1_click ()

DIM MX0, MY0 AS INTEGER 'randomly generated X, Y direction

DIM MX, MY AS INTEGER 'After the direction of conversion direction

DIM K AS INTEGER '

DIM BL AS INTEGER 'Interrupt Test Count

K = 400

MX0 = k * rnd: my0 = k * rnd 'assigned initial value

MX = mx0: my = my0

Command1.visible = false

If P3.LEFT <0 Then 'If you encounter the left boundary

MX0 = k * rnd: my0 = k * rND 'to the right

MX = mx0: my = 2 * (MY0 - K / 2)

END IF

If P3.LEFT> FORM1.WIDTH - P3.WIDTH TEN 'If you encounter the right

MX0 = k * rnd: my0 = k * rND 'to Zuo

MX = -mx0: my = 2 * (My0 - K / 2)

END IF

If p3.top <0 Then 'encounters the upper boundary

MX0 = k * rnd: my0 = k * rND '

MX = 2 * (mx0 - k / 2): my = my0

END IF

If p3.top> form1.height - p3.height then 'If you encounter the next boundary

MX0 = k * rnd: my0 = k * rND '

MX = 2 * (MX0 - K / 2): my = -my0

END IF

P3.Picture = loadingPicture 'Clear the previous picture

P3.Move P3.LEFT MX, P3.TOP MY 'Move by setting step

Flying 'calls flying process

Form1.Refresh 'Heavy Pictures

BL = BL 1 'Interrupt Procedure

IF BL> 100 TEN 'set up 100 interruptions 1 time

Command2.visible = true 'Display "Exit" button

Refresh

Delay (3000) 'Stop Waiting for Users to click "Exit" button Doevents' Interrupt Processing

Command2.visible = false 'If the user is not selected, hide the button

BL = 0 're-count

END IF

LOOP Until 1 = 2 'Unlimited Cycle

End Sub

Private sub fascist2_click ()

End

End Sub

Make complex animations with Image

Place Control: Form1: P1, P2, P3 (Image), Command1, Timer1

Property setting: 〖p1.stretch〗 = True, 〖p1.picture〗 = bfly1.bmp

〖P2.stretch〗 = True, 〖p2.picture〗 = bfly2.bmp

〖P3.stretch〗 = TRUE

〖Timer1.ItersRVAL〗 = 10

〖Form1.backcolor〗 = White 'picks up from the palette

Note: BMP files from C: / Program Files / Microsoft Visual / MSDN98 / 98VS / VCR / Selection

Code:

Option Explicit 'forced variable description

DIM MX0, MY0 AS INTEGER 'randomly generated X, Y direction

DIM MX, MY AS INTEGER 'After the direction of conversion direction

DIM K AS INTEGER '

DIM DOFLAG AS Boolean 'Detects Command1 Click Mark

SUB DELAY (SS AS Integer) 'Delay Process

Dim Start, Check

Start = Timer

Check = Timer

Loop While Check

End Sub

Sub flying () 'flying process

Const d1 = 40

P3.Picture = loadingPicture 'Clear the previous picture

P3.Move P3.LEFT MX, P3.TOP MY 'Move by setting step

P3.Picture = p1.picture 'Shows the first picture

Refresh

DELAY (D1 * 3)

P3.Picture = p2.picture 'Display the second picture

Refresh

DELAY (D1)

End Sub

SUB fly_direction ()

If P3.LEFT <0 Then 'If you encounter the left boundary

MX0 = k * rnd: my0 = k * rnd 'Fly to the right random direction

MX = mx0: my = 2 * (MY0 - K / 2)

END IF

If P3.LEFT> FORM1.WIDTH - P3.WIDTH TEN 'If you encounter the right

MX0 = k * rnd: my0 = k * rnd 'flies to the left

MX = -mx0: my = 2 * (My0 - K / 2)

END IF

If P3.TOP <0 Then 'If you encounter the upper boundary MX0 = K * RND: my0 = k * rnd' to fly in the random direction

MX = 2 * (mx0 - k / 2): my = my0

END IF

If p3.top> form1.height - p3.height then 'If you encounter the next boundary

MX0 = k * rnd: my0 = k * rnd 'fly in random direction

MX = 2 * (MX0 - K / 2): my = -my0

END IF

Flying 'calls flying process

End Sub

Private submmand1_click ()

SELECT CASE DOFLAG

Case True

Command1.caption = "Start"

DOFLAG = FALSE

CLS

Case False

Command1.caption = "Stop"

Doflag = TRUE

MX0 = k * rnd: my0 = k * rnd 'assigned initial value

MX = mx0: my = my0

End SELECT

End Sub

Private sub flow_load ()

K = 600

DOFLAG = FALSE

End Sub

Private sub timer1_timer () 'clock controls are detected at any time, if not clicked

If DOFLAG THEN 'Command1 (stop), continue calling the animation program

fly_direction

END IF

End Sub

Seven report

Simple data report with database controls

Place Control: Form1: Data1, Command1

Property setting: 〖Data1.DatabaseName〗 = "nwind.mdb", 〖Data1.Recordsource〗 = Categories

Description: 1. Any common database can be set in Data1

2. Output reports to a .txt file, you can edit in Word or other editing software.

3. Set the mortar distance to zero (set fixed value in Word = 10 pounds).

Code:

Option expedition

DIM F1 AS Field 'field variable

DIM FI AS Integer '

DIM PageRow as integer 'number of rows per page

DIM RPTCAPTION AS STRING 'Report Title Strings

DIM repage as integer 'Report page

Dim repfield () AS integer 'field width array

Dim MaxWidth As INTEGER 'Maximum Field Width

Dim Repwidth As INTEGER 'Report Wide

Dim Leftspace AS Integer 'Report left start position

DIM chi as integer 'Chinese character number

Function Len1 (str1 as string) AS Integer

'Return the absolute length of the string (such as Len1 ("Hello!") = 5)

DIM L1 AS STRING

DIM I, LN1 AS INTEGER

Len1 = 0

For i = 1 to len (str1)

L1 = MID $ (STR1, I, 1) IF ASC (L1) <0 Then 'Chinese characters

LN1 = 2

Else

LN1 = 1

END IF

Len1 = len1 ln1

Next i

END FUNCTION

SUB Createrptfield ()

'Compare field name and field length, determine the field width and calculate the total report of the report

Redim Repfield (FI) AS Integer 'uses the grower group

DIM FNAME, FSIZE AS INTEGER

DIM FI1 AS INTEGER

Repwidth = Leftspace 2

FOR FI1 = 0 to FI - 1

Set f1 = data1.recordset.fields (Fi1)

FNAME = INT ((LEN1 (F1.NAME) 1) / 2 0.5) * 2

fsize = int ((f1.size 1) / 2 0.5) * 2

If fsize> maxwidth the fsize = maxwidth 'Limited field width

IF fname> fsize kil

Repfield (FI1) = FNAME

Else

Repfield (FI1) = fsize

END IF

Repwidth = Repwidth Repfield (FI1) 2

Next Fi1

End Sub

Sub Repline (STR1, STR2, STR3, STR4 AS STRING) 'printing table

DIM FI1, FI2 AS INTEGER

DIM RL AS INTEGER

For Fi1 = 1 to Leftspace

Print # 1, "";

Next Fi1

Print # 1, STR1;

For fi2 = 1 to int (Repfield (0) / 2)

Print # 1, STR2;

Next Fi2

FOR FI1 = 1 to FI - 1

Print # 1, STR3;

For fi2 = 1 to int (Repfield (FI1) / 2)

Print # 1, STR2;

Next Fi2

Next Fi1

Print # 1, STR4

End Sub

SUB RPTHEADLINE (str1 as string) 'print heading and page number

Dim Start, Fi1 AS Integer

Print # 1,

IF Int (Repwidth / 2) - INT (Len1 (STR1) / 2)> 10 Leftspace Then

Start = int (repwidth / 2) - int (Len1 (str1) / 2) Leftspace

For Fi1 = 1 to start

Print # 1, "";

Next Fi1

Print # 1, STR1, "-"; repy; "-"

Else

For Fi1 = 1 to Leftspace

Print # 1, "";

Next Fi1

Print # 1, STR1, "-"; repy; "-"

END IF

Print # 1,

End Sub

Function Leftstr (str1 as string, fsize as integer) AS STRING

'Return to string str1 left fsize (absolute length) long skeed

IF len1 (str1) <= fsize kil = str1

Else

Do While Len1 (str1)> fsize

Str1 = Left $ (str1, len (str1) - 1)

Loop

Leftstr = STR1

END IF

END FUNCTION

Function Checkfield (str1 as variant, int1 as integer) AS STRING

'Check the type of record variable STR1 and make it absolute length do not exceed INT1

DIM STR2 AS STRING

IF isnull (Data1.Recordset (f1.sourcefield) THEN 'handling empty record

Checkfield = ""

Elseif f1.type = 11 THEN 'Handling Binary Type Record

Checkfield = ""

Else

STR2 = str1 'forced conversion to String

Checkfield = leftstr (str2, int1)

END IF

END FUNCTION

Sub rpthead () 'printhead

Dim Fi1, Ti, Chi AS Integer

Call Repline ("┏", "━", "┳", "┓")

For Fi1 = 1 to Leftspace

Print # 1, "";

Next Fi1

Ti = Leftspace 1

FOR FI1 = 0 to FI - 1

Print # 1, "";

Set f1 = data1.recordset.fields (fi1) 'Remove the current field

Ti = Ti Repfield (FI1) 2

Chi = len1 (f1.sourcefield) - len (f1.sourcefield) set print transformation

Ti = Ti - CHI - 1 'Setting print transformation

Print # 1, f1.sourcefield; tab (ti); 'printing the current field name

Next Fi1

Print # 1, ""

Call Repline ("┣", "━", "╇", "┫")

End Sub

Sub rptrecord () 'Print Record Row

DIM FI1, TI AS INTEGER

DIM TEMP AS STRING 'record content

FOR FI1 = 1 to Leftspace 'First print the first field first

Print # 1, "";

Next Fi1

Print # 1, "";

Ti = Leftspace 3

Set f1 = data1.recordset.fields (0) 'Remove the first field

Ti = Ti Repfield (0)

Temp = Checkfield (Data1.Recordset (F1. Sourcefield), Repfield (0)) CHI = LEN1 (TEMP) - LEN (TEMP) Settings Print Transform

Ti = Ti - CHI - 1 'Setting print transformation

Print # 1, Temp; Tab (Ti); 'Print Record Content

FOR FI1 = 1 TO FI - 1 'The following fields are printed

Print # 1, "│";

Set f1 = data1.recordset.fields (Fi1)

Ti = Ti Repfield (FI1) 2

Temp = Checkfield (Data1.Recordset (f1.sourcefield), Repfield (FI1))

CHI = LEN1 (TEMP) - LEN (TEMP) Settings Print Transform

Ti = Ti - CHI - 1 'Setting print transformation

Print # 1, TEMP; Tab (Ti);

Next Fi1

Print # 1, ""

End Sub

Sub repform () 'printing report

DIM Li AS INTEGER 'Report Row Variables

DIM PBL AS Boolean 'Table Type Tag

Repage = 1

Li = 1

PBL = TRUE

Do While Not Data1.Recordset.eof

If PBL THEN 'table behavior starts line, you want to print the head

Call Rptheadline (RPTCAPTION)

Call Rpthead

PBL = FALSE

Else 'table behavior ordinary record

Call Repline ("┠", "─", "┼", "┨")

END IF

Call RPTRecord

Li = li 1

If Li = PageRow Then 'arrives at the tail

Call Repline ("┗", "━", "┷", "┛")

Print # 1,

Repage = repAge 1

Li = 1

PBL = True 'Sets the starting line tag

END IF

Data1.RecordSet.movenext 'Move to the next record

Loop

IF not pbl then 'full report prints the bottom line

Call Repline ("┗", "━", "┷", "┛")

Print # 1,

END IF

End Sub

Private sub fascist1_click () 'Main Program Open "Test.txt" for output as # 1' Open Report File

LEFTSPACE = 0 'Set the left side of the report

Fi = data1.recordset.fields.count 'finds the number of fields of the current record set

Call createrptfield 'determines the width of each field

RPTCAPTION = "Report Table Example" gives the title

MaxWidth = 10 'gives the maximum field width

PageRow = 20 'gives the number of rows per page

Call repform 'printing report

Close # 1 'Close report file

End Sub

Print report with database

Place Control: Form1: Command1, Command2

Description: Read the MDB Database RST1 Print Form, the table parameter is in the DAIMA array.

Code:

Option expedition

DIM PW, PH 'Paper width and paper high coordinates

DIM PX, PY

DIM TI 'Report Field Number

DIM WH, WW 'Width and word high

DIM TABLE1 'First Page Table Start Height

Dim Daima (100, 3) AS STRING

Sub Finput ()

Ti = 7

DAIMA (1, 1) = "Sequence"

DAIMA (1, 2) = 6 'table width

DAIMA (1, 3) = "Sequence"

DAIMA (2, 1) = "code"

DAIMA (2, 2) = 8

DAIMA (2, 3) = "scode" field name

DAIMA (3, 1) = "Library Station"

DAIMA (3, 2) = 8

DAIMA (3, 3) = "SKWH"

DAIMA (4, 1) = "Title"

DAIMA (4, 2) = 36

DAIMA (4, 3) = "sname"

DAIMA (5, 1) = "unit price"

DAIMA (5, 2) = 8

DAIMA (5, 3) = "SDANJIA"

DAIMA (6, 1) = "Publish Date"

DAIMA (6, 2) = 10

DAIMA (6, 3) = "SYEAR"

DAIMA (7, 1) = "Remarks"

DAIMA (7, 2) = 10

DAIMA (7, 3) = "blank"

End Sub

Sub printhead ()

Printer.currentx = 150: printer.currenty = 30

Printer.fontsize = 19: printer.fontbold = true

Printer.print "China Water Conservancy Hydropower Press Business List"

Table1 = 50END SUB

Sub PrintFrame (Byval PP1 AS INTEGER, PP2 AS Integer, PP3 AS INTEGER)

DIM PY1 AS INTEGER

DIM PXM, PXI, PX1, BI

Dim Daim1, DAIM2 AS STRING

PXM = 0 'calculates the width of the report

For PXI = 1 to Ti

PXM = PXM DAIMA (PXI, 2) * WW

Printer.drawidth = 3

Printer.fontsize = 11

Printer.fontbold = true

PY = PP1 (PP3 2 - PP2) * WH 'calculates the height

Printer.Line (0, PP1) - (PXM, PP1) 'Print Border

Printer.Line (PXM, PP1) - (PXM, PY)

Printer.Line (PXM, PY) - (0, PY)

Printer.Line (0, py) - (0, pp1)

Printer.drawidth = 1 'printhead

PX = 0

For PXI = 1 to Ti

DAIM2 = DAIMA (PXI, 1)

PX1 = INT ((DAIMA (PXI, 2) - LEN1 (DAIM2)) / 2)

Printer.currentx = PX PX1 * WW

Printer.currenty = PP1 INT (0.2 * WH)

Printer.print Daima (PXI, 1) 'Print field name

PX = PX DAIMA (PXI, 2) * WW

Printer.Line (PX, PP1) - (PX, PY) 'print vertical line

Printer.FontBold = FALSE

Py = pp1 wh

For bi = pp2 to PP3

PX = 0

For PXI = 1 to Ti

Printer.currentx = PX 2

Printer.currenty = PY INT (0.2 * WH)

DAIM1 = DAIMA (PXI, 3)

SELECT CASE DAIM1

Case "serial number": Daim2 = BI 'print serial number

Case "blank": daim2 = "" 'printing blank field

Case Else: DAIM2 = RST1 (DAIM1)

End SELECT

Printer.Print Len2 (DAIM2, INT (DAIMA (PXI, 2))) 'Printing Field Content

PX = PX DAIMA (PXI, 2) * WW

Next PXI

Printer.Line (0, PY) - (PXM, PY) 'Print Horizontal

PY = PY WH

Rst1.movenext

Next bi

End Sub

Sub Printfoot (PP1 AS Integer, PP2 AS Integer) 'Print Page Code

PX = PW - 300: py = pH - 5 * WH

Printer.currentx = px: printer.currenty = pyprinter.print "Total number of pages:" & pp2 & "Current page number:" & pp1

End Sub

Sub Printail (Byval P1 AS Integer, P2 AS Integer, P3 AS Integer, P4 AS Integer, P5 AS Integer

Call PrintFrame (P1, P2, P3)

Call Printfoot (P4, P5)

End Sub

Sub printbody ()

DIM Page As INTEGER 'page number

DIM PI As INTEGER

DIM P1Y As INTEGER 'The number of records

DIM P2Y AS INTEGER 'second page record number

DIM TABLE2 'second page start position

P2y = 37

TABLE2 = 20

Table1 = Table1 WH

P1Y = (pH - Table1 - 100) / WH

Rst1.movefirst

IF BNUM

Call Printail (Table1, 1, Bnum, 1, 1) 'is only one page

Else

Page = INT (((BNUM - P1Y) / P2Y) 1.9999) 'calculation page

Call Printail (Table1, 1, P1Y, 1, Page) Prints the first page

IF Page> 2 THEN

For pi = 1 to Page - 2

Printer.newpage

Call Printail (Table2, P1Y (PI - 1) * P2Y 1, P1Y PI * P2Y, PI 1, PAGE

Next Pi

Printer.newpage

Call Printail (Table2, P1Y (Page - 2) * P2Y 1, BNUM, Page, Page "Print last page

Else

Printer.newpage

Call Printail (Table2, P1Y 1, BNUM, Page, Page) Print last page

END IF

End Sub

SUB PRINTP ()

DIM SP 'left margin

PW = 850: pH = 600

Wh = 13

WW = 9

sp = 40 printer.scale (-SP, 0) - (PW, pH)

Printhead

PrintBody

Printer.Enddoc

End Sub

Private submmand1_click ()

BNUM = Rst1.Recordcount

Finput

Printp

End Sub

Private submmand3_click ()

Unload me

End Sub

Private sub flow_load ()

DIM STR1, STRCNN

Strcnn = "provider = microsoft.jet.OleDb.3.51; persist security info = false;" & _

"Data Source =" & fpath1 & "shukux.mdb"

SET CNN2 = New Adodb.connectionCn2.Open STRCNN

Set rst1 = new adoDb.recordset

Rst1.cursortype = adopenkeyset

Rst1.lockType = AdlockOptimistic

Rst1.open "SHU00", CNN2,, Adcmdtable

End Sub

Print the report report

Place Control: Form1: Command1, Command3

Description: Read MDB Database Runor Group Print Form, DAIMA Arch Plate Parameters, DAI1 Architecture Playing Record Parameters.

Code:

Option expedition

DIM PW, PH, PX, PY AS INTEGER

DIM TI 'Report Field Number

DIM WH, WW 'Word Height and Width

DIM TABLE1 'first page Table start position

DIM DAI1 (400, 8) AS STRING

Sub Finput ()

Ti = 7

DAIMA (1, 1) = "Sequence"

DAIMA (1, 2) = 6

DAIMA (1, 3) = 0

DAIMA (2, 1) = "code"

DAIMA (2, 2) = 8

DAIMA (2, 3) = 1

DAIMA (3, 1) = "Library Station"

DAIMA (3, 2) = 8

DAIMA (3, 3) = 2

DAIMA (4, 1) = "Title"

DAIMA (4, 2) = 36

DAIMA (4, 3) = 3

DAIMA (5, 1) = "unit price"

DAIMA (5, 2) = 8

DAIMA (5, 3) = 4

DAIMA (6, 1) = "Publish Date"

DAIMA (6, 2) = 10

DAIMA (6, 3) = 5

DAIMA (7, 1) = "Remarks"

DAIMA (7, 2) = 10

DAIMA (7, 3) = 6

End Sub

Sub finput2 ()

DIM DI

Di = 0

Rst1.movefirst

Do While Not Rst1.eof

Di = di 1

DAI1 (di, 0) = di

DAI1 (Di, 1) = RST1! Scode

DAI1 (di, 2) = RST1! SKWH

DAI1 (di, 3) = RST1! SNAME

DAI1 (Di, 4) = RST1! SDANJIA

DAI1 (Di, 5) = RST1! SYEAR

DAI1 (Di, 6) = ""

Rst1.movenext

Loop

End Sub

Sub printhead ()

DIM X1, X2, X3

Printer.currentx = 150: printer.currenty = 30

Printer.fontsize = 19: printer.fontbold = true

Printer.print "China Water Conservancy Hydropower Press Business List"

Table1 = 50

CLH = "k0405"

X1 = 20: x2 = 270: x3 = 520

Printer.currentx = x1: printer.currenty = Table1

Printer.fontsize = 9: printer.fontbold = falseprinter.print "Processing single number:" & clh

Printer.currentx = x2: printer.currenty = Table1

Printer.print "Bank Date: 20" & NOW

Printer.currentx = x3: printer.currenty = Table1

Printer.print "Method:"

Table1 = Table1 WH

End Sub

Sub PrintFrame (Byval PP1 AS INTEGER, PP2 AS Integer, PP3 AS INTEGER)

DIM PY1 AS INTEGER

DIM PXM, PXI, PX1, BI

Dim Daim1, DAIM2 AS STRING

PXM = 0

For PXI = 1 to Ti

PXM = PXM DAIMA (PXI, 2) * WW

Printer.drawidth = 3

Printer.fontsize = 11

Printer.fontbold = true

PY = PP1 (PP3 2 - PP2) * WH

Printer.Line (0, pp1) - (PXM, PP1)

Printer.Line (PXM, PP1) - (PXM, PY)

Printer.Line (PXM, PY) - (0, PY)

Printer.Line (0, py) - (0, pp1)

Printer.drawidth = 1

PX = 0

For PXI = 1 to Ti

DAIM2 = DAIMA (PXI, 1)

PX1 = INT ((DAIMA (PXI, 2) - LEN1 (DAIM2)) / 2)

Printer.currentx = PX PX1 * WW

Printer.currenty = PP1 INT (0.2 * WH)

Printer.Print Daima (PXI, 1)

PX = PX DAIMA (PXI, 2) * WW

Printer.Line (PX, PP1) - (PX, PY)

Printer.FontBold = FALSE

Py = pp1 wh

For bi = pp2 to PP3

PX = 0

For PXI = 1 to Ti

Printer.currentx = PX 2

Printer.currenty = PY INT (0.2 * WH)

DAIM1 = DAIMA (PXI, 3)

DAIM2 = DAI1 (Bi, Daim1)

Printer.Print Len2 (DAIM2, INT (DAIMA (PXI, 2))))

PX = PX DAIMA (PXI, 2) * WW

Next PXI

Printer.Line (0, PY) - (PXM, PY)

PY = PY WH

Rst1.movenext

Next bi

End Sub

Sub Printfoot (PP1 AS Integer, PP2 AS Integer)

PX = PW - 300: py = pH - 5 * WH

Printer.currentx = px: printer.currenty = py

Printer.print "Total Page:" & PP2 & "Current Page:" & PP1END SUB

Sub Printail (Byval P1 AS Integer, P2 AS Integer, P3 AS Integer, P4 AS Integer, P5 AS Integer

Call PrintFrame (P1, P2, P3)

Call Printfoot (P4, P5)

End Sub

Sub printbody ()

DIM Page As INTEGER

DIM PI As INTEGER

DIM P1Y AS INTEGER

DIM P2Y AS INTEGER 'FIRST Page Lines and other Page Lines

DIM TABLE2

P2y = 37 '44

TABLE2 = 20

Table1 = Table1 WH

P1Y = (pH - Table1 - 100) / WH

Rst1.movefirst

IF BNUM

Call Printail (Table1, 1, BNUM, 1, 1)

Else

Page = INT (((BNUM - P1Y) / P2Y) 1.9999)

Call Printail (Table1, 1, P1Y, 1, PAGE)

IF Page> 2 THEN

For pi = 1 to Page - 2

Printer.newpage

Call Printail (Table2, P1Y (PI - 1) * P2Y 1, P1Y PI * P2Y, PI 1, PAGE

Next Pi

Printer.newpage

Call Printail (Table2, P1Y (Page - 2) * P2Y 1, BNUM, Page, Page

Else

Printer.newpage

Call Printail (Table2, P1Y 1, BNUM, Page, Page)

END IF

End Sub

SUB PRINTP ()

DIM SP

PW = 850: pH = 600

Wh = 13

WW = 9

SP = 40

Printer.scale (-SP, 0) - (PW, pH)

Printhead

PrintBody

Printer.Enddoc

End Sub

Private submmand1_click ()

BNUM = Rst1.Recordcount

Finput

FINPUT2

Printp

End Sub

Private submmand3_click ()

Unload me

End Sub

Private sub flow_load ()

DIM STR1, STRCNN

Strcnn = "provider = microsoft.jet.OleDb.3.51; persist security info = false;" & _

"Data Source =" & fpath1 & "shukux.mdb"

SET CNN2 = New Adodb.connection

CNN2.Open STRCNN

Set rst1 = new adoDb.recordset

Rst1.cursortype = adopenkeyset

Rst1.lockType = AdlockOptimistic

Rst1.open "SHU00", CNN2,, Adcmdtablend Sub

Print reports with array

Establish a module module1:

DIM WH, WW 'Word Height and Width

DIM PW, PH, PX, PY AS INTEGER

DIM TABLE1 'first page Table start position

DIM PXM '

Sub printhead ()

DIM I

'Calculate the width

PXM = 0

For i = 0 to TXI - 1

PXM = PXM TX (I, 2) * WW

'Print heading

TABLE1 = 0

For i = 0 to TYI - 1

Printer.FontName = TY (i, 0)

Printer.fontsize = TY (i, 1)

Printer.fontbold = TY (i, 2)

Printer.currentx = TY (i, 3)

Printer.currenty = TY (i, 4)

Printer.print Ty (i, 5)

Table1 = TY (i, 4)

'Painting underline

IF TY (I, 6) = 1 THEN

Printer.drawidth = 2

Printer.Line (0, Table1 10) - (PXM, Table1 10)

END IF

End Sub

Sub Printa (Byval P1 AS Integer, P2 AS Integer, P3 AS Integer, P4 AS Integer, P5 AS Integer

DIM PY1 AS INTEGER

DIM PXI, PX1, BI

Dim Daim1, DAIM2 AS STRING

'Printing form line

Printer.drawidth = 3

PY = P1 (P3 2 - P2) * WH

Printer.Line (0, P1) - (PXM, P1)

Printer.Line (PXM, P1) - (PXM, PY)

Printer.Line (PXM, PY) - (0, PY)

Printer.Line (0, PY) - (0, P1)

'Printhead

Printer.drawidth = 1

Printer.fontsize = 11

Printer.fontbold = true

PX = 0

For PXI = 0 to TXI - 1

DAIM2 = TX (PXI, 1)

PX1 = INT ((TX (PXI, 2) - LEN1 (DAIM2)) / 2)

Printer.currentx = PX PX1 * WW

Printer.currenty = p1 int (0.2 * WH)

Printer.Print TX (PXI, 1)

PX = PX TX (PXI, 2) * WW

Printer.Line (PX, P1) - (PX, PY)

'Printing form content

Printer.FontBold = FALSE

PY = P1 WH

For bi = p2 to P3

PX = 0

For PXI = 0 to TXI - 1

Printer.currentx = PX 2

Printer.currenty = PY INT (0.2 * WH)

DAIM1 = TX (PXI, 3)

DAIM2 = TZ (Bi - 1, Daim1) Printer.Print Daim2 'LEN2 (DAIM2, INT (TX (PXI, 2))))

PX = PX TX (PXI, 2) * WW

Next PXI

Printer.Line (0, PY) - (PXM, PY)

PY = PY WH

Next bi

'Print page number

PX = int (0.6 * pw): py = pH - 7 * WH

Printer.currentx = px: printer.currenty = py

Printer.print "Total Page:" & P5 & "Current page number:" & P4

End Sub

Sub printbody ()

DIM Page As INTEGER

DIM PI As INTEGER

DIM P1Y AS INTEGER

DIM P2Y AS INTEGER 'FIRST Page Lines and other Page Lines

DIM TABLE2

'p2y = 38

TABLE2 = 0

Table1 = Table1 WH

P1Y = (pH - TABLE1 - 115) / WH

P2y = (pH - 115) / WH

MSGBOX P2Y

IF TZI

Call Printa (Table1, 1, Tzi, 1, 1)

Else

Page = INT ((TZI - P1Y) / P2Y) 1.9999)

Call Printa (Table1, 1, P1Y, 1, PAGE)

IF Page> 2 THEN

For pi = 1 to Page - 2

Printer.newpage

Call Printa (Table2, P1Y (PI - 1) * P2Y 1, P1Y PI * P2Y, PI 1, PAGE

Next Pi

Printer.newpage

Call Printa (Table2, P1Y (Page - 2) * P2Y 1, Tzi, Page, Page

Else

Printer.newpage

Call Printa (Table2, P1Y 1, Tzi, Page, Page

END IF

End Sub

SUB PRINTP ()

DIM SP

IF TZI <1 the EXIT SUB

PW = 850: pH = 600

Wh = 13

WW = 9

SP = 40

Printer.scale (0, 0) - (PW, pH)

Printhead

PrintBody

Printer.Enddoc

End Sub

When calling in other modules, as long as the TX, TY, TZ array value, and TXI, TYI, TZI, and then call Module1.printp. E.g:

Sub TableDataX ()

TXI = 10 '10 column

TX (0, 1) = "Sequence" 'table title

TX (0, 2) = 4 'Sum width (4 words)

TX (0, 3) = 0 'serial number

TX (1, 1) = "code"

TX (1, 2) = 8

TX (1, 3) = 1

TX (2, 1) = "Library Station" TX (2, 2) = 8

TX (2, 3) = 2

TX (3, 1) = "unit price"

TX (3, 2) = 7

TX (3, 3) = 3

TX (4, 1) = "book name"

TX (4, 2) = 33

TX (4, 3) = 4

TX (5, 1) = "Number of books"

TX (5, 2) = 6

TX (5, 3) = 5

TX (6, 1) = "Code Ocean"

TX (6, 2) = 7

TX (6, 3) = 6

TX (7, 1) = "Discount"

TX (7, 2) = 5

TX (7, 3) = 7

TX (8, 1) = "Search"

TX (8, 2) = 7

TX (8, 3) = 8

TX (9, 1) = "Pack Volume"

TX (9, 2) = 8

TX (9, 3) = 9

End Sub

Sub TableData ()

DIM PX1, PX2, PX3, PY

DIM WH0

WH0 = 10

TYI = 10

PX1 = 20

PX2 = 370

PX3 = 620

TY (0, 0) = "Song" Font

TY (0, 1) = 17 'font

TY (0, 2) = 1 'bold

TY (0, 3) = 180 'Current X

TY (0, 4) = 10 'current y

TY (0, 5) = "China Water Conservancy Power Publishing House Batch Service List"

TY (0, 6) = 0 'Whether to add wire

PY = 30

TY (1, 0) = "Song"

TY (1, 1) = 10

TY (1, 2) = 0

TY (1, 3) = PX1

TY (1, 4) = py

TY (1, 5) = "processing single number:" & clh

TY (1, 6) = 0

TY (2, 0) = "Song"

TY (2, 1) = 10

TY (2, 2) = 0

TY (2, 3) = PX2

TY (2, 4) = py

TY (2, 5) = "Bank Date: 20" & DDATE

TY (2, 6) = 0

TY (3, 0) = "Song"

TY (3, 1) = 10

TY (3, 2) = 0

TY (3, 3) = PX3

TY (3, 4) = py

TY (3, 5) = "Book Order Number:" & Numb

TY (3, 6) = 1 'plus line

PY = PY 20

TY (4, 0) = "Song"

TY (4, 1) = 10

TY (4, 2) = 0

TY (4, 3) = PX1

TY (4, 4) = py

TY (4, 5) = "purchase unit:" & len2 (uname, 36)

TY (4, 6) = 0

TY (5, 0) = "Song"

TY (5, 1) = 10

TY (5, 2) = 0

TY (5, 3) = PX2

TY (5, 4) = Pyty (5, 5) = "Volume Number:" & ZCE

TY (5, 6) = 0

TY (6, 0) = "Song"

TY (6, 1) = 10

TY (6, 2) = 0

TY (6, 3) = PX3

TY (6, 4) = py

TY (6, 5) = "Bracelet:"

TY (6, 6) = 0

PY = Py WH

TY (7, 0) = "Song"

TY (7, 1) = 10

TY (7, 2) = 0

TY (7, 3) = PX1

TY (7, 4) = py

TY (7, 5) = "Address:" & Add

TY (7, 6) = 0

TY (8, 0) = "Song"

TY (8, 1) = 10

TY (8, 2) = 0

TY (8, 3) = PX2

TY (8, 4) = py

TY (8, 5) = "Total Codon:" & ZMA

TY (8, 6) = 0

TY (9, 0) = "Song"

TY (9, 1) = 10

TY (9, 2) = 0

TY (9, 3) = PX3

TY (9, 4) = py

TY (9, 5) = "Card Number:" & ZL

TY (9, 6) = 0

End Sub

SUB TableDataz ()

DIM I, BB AS INTEGER, DD1 AS SINGLE

TZI = BNUM

For i = 0 to Tzi - 1

Tz (i, 0) = i 1

Tz (i, 1) = Code (i)

Tz (i, 2) = kWh (i)

Tz (I, 3) = xiao2 (Danjia (i))

Tz (I, 4) = len2 (BName (I), 35)

Tz (i, 5) = "" & shice (i)

DD1 = Danjia (i) * Shice (i)

Tz (I, 6) = xiao2 (DD1)

Tz (i, 7) = "0" & bzhe (i)

DD1 = Danjia (i) * Shice (i) * bzhe (i)

Tz (I, 8) = xiao2 (DD1)

BB = Int (Shice (I) / Bag (i))

Tz (I, 9) = BB & " " & Shice (I) - BB * BAG (I) & "(" & Bag (I) & ")"

End Sub

SUB Print_pxd ()

TableDatax

TableData

TableDataz

Module1.printp 'Call the print table module

End Sub

Generate reports with Report

1. New standard project 1;

2. Add data environment: Select menu [Project] / [More ActiveX Designer] / [DataEnvironment], add DataEnvironment1;

3. Establish an ODBC connection:

(1) Set database connections in [Control Panel] / [ODBC Data Source] / [System DNS], such as TEST0;

(2) Right-click [Connection1], select [Properties], appear "Data Link" dialog: (3) Select [... for odbc drivers] in the Provider Properties.

(4) Select [Use connection string] in the "Connection" property page, click [Compile] / [Machine Data Source], select the data connection required, such as Test0, click [OK];

(5) Click [Test Connection], if pass, you can perform the next step;

4. Add connection command: Right-click [Connection1], select [Add Command], "Command1" appears;

5. Set the connection command: Right-click [Command1], select [Properties], appear "Properties" dialog, set [Database Object] to [Table], [Object Name] to the desired table name, such as "Water Basic Information Form ", Click number, you can expand the table, as shown in the figure:

6. Add a report: Select menu [Project] / [Add Datareport], add DataReport1;

7. Set report connection: Set [DataNVironment1] in the attribute panel on the right, [DataMember] is [Command1];

8. Set the report data: Drag each field from DataEnvironment1 to DataReport1, arrange it; Note: Drag the field has 2 pieces, the left is the field name (can be placed in the "page head" column), right is a field value ( Put in the Detail "column);

9. Setting report Title: Right-click on the report, select [Insert Control] / [Tag], place it in the report header bar; you can also insert the page number in the "Page" field;

10. Set the report border: Right-click on the report, select [Insert Control] / [Shape], adjust the rectangular size, place a replication control (Shape) on each field and field name;

11. Show reports: Add a button to the form of Form1 (or UserControl1), add code to it:

DataReport1.show

Then you can run. You can also print a report when running.

If you create an ActiveX control, you must first create a standard EXE project (for debugging), then build an ActiveX control, on it.

Eight database control

Database browsing with database controls

Place Control: Form1: Data1, Combo1, Text1, Text2, Lbel1, Label2, Label3

Property setting: 〖Combo1.datasource〗 = DATA1

TEXT1.DATASOURCE〗 = DATA1

〖Text2.datasource〗 = DATA1

The attributes of the remaining Text1, Text2, Label1, Label2, Label3 are shown in Figure 8.4

Data1's RecordSetType property is 0 (Table)

Code:

Private sub flow_load ()

Data1.DatabaseName = "Biblio.mdb" "Book Management Database" Data1.Recordsource = "Select Distinct State from Publishers"

Data1.refresh

Do While Not Data1.Recordset.eof 'assigns COMBO1

Temp = Data1.Recordset ("State")

IF isnull (TEMP) THEN TEMP = ""

Combo1.addItem CSTR (TEMP)

Data1.Recordset.Movenext

Loop

Data1.Recordsource = "publicishers" 'changering Recordset as full table

Data1.refresh

Text1.datafield = "name"

Text2.datafield = "city"

Combo1.Datafield = "state"

End Sub

Display total records and current records in the control DATAI

Set the global variable firstflag first, and set to True in Formloy,

Private sub Data1_Reposition () 'Displays the record number when repositioning the record

If firstflag dam, if it is used for the first time

Data1.caption = "" "DATA1 Title Box Shows Blank

Firstflag = false

Else 'If it is not used for the first time,

'DATA1 Title Box Display Record Number

Data1.caption = "total record number:" & data1.recordset.recordcount _

& "Current records:" & data1.recordset.absolutePosition 1

END IF

Implement data entry / delete with database controls

Place control: Form1: Data1; Text1, 2; Lbel1, 2; Command1, 2, 3, 4, 5; Frame1

Property setting:

Data1: 〖DatabaseName〗 = "nwind.mdb", 〖rodsource〗 = Products

Text1: 〖DataSource〗 = DATA1, 〖Datafield〗 = ProductID, 〖Tabindex〗 = 0

Text2: 〖Datasource〗 = DATA1, 〖Datafield〗 = ProductName, 〖TabINDEX〗 = 1

Command1: 〖Name〗 = cmdadd, 〖caption〗 = increase

Command2: 〖Name〗 = cmddelete, 〖CAPTION〗 = Delete

Command3: 〖name〗 = cmdexit, 〖caption〗 = Exit

Command4: 〖Name〗 = cmdupdate, 〖caption〗 = OK

Command5: 〖name〗 = cmdcancel, 〖caption〗 = Abandon

Frame1 contains CommAND4, 5

The location attributes of the remaining Text1, 2, Label1, 2, and Command1, 2, 3, 4, 5 are shown in Figure 8.5

Code:

Option expedition

DIM FIRSTFLAG AS BOOLEAN 'First Tag Private Sub Cmdadd_Click ()' Add record

Data1.Recordset.AddNew

Frame1.visible = true 'makes the main button group are invisible

Data1.caption = "record:" & data1.recordset.recordcount 1

Text1.setfocus

End Sub

Private subdcancel_click () 'Abandoning the recorded record

Data1.Recordset.cancelupdate

Frame1.visible = false 'makes the main button group visible

Data1.Recordset.movelast 'Back to the last record

End Sub

Private subdupdate_click () 'Determines the recorded record is valid

Data1.Recordset.Update

Frame1.visible = false 'makes the main button group visible

Data1.RecordSet.moveLast 'Display Enter Content

End Sub

Private sub Data1_Reposition () 'Displays the record number when repositioning the record

If firstflag dam, if it is used for the first time

Data1.caption = "" "DATA1 Title Box Shows Blank

Firstflag = false

Else 'If it is not used for the first time,

'DATA1 Title Box Display Record Number

Data1.caption = "total record number:" & data1.recordset.recordcount _

& "Current records:" & data1.recordset.absolutePosition 1

END IF

End Sub

PRIVATE SUB CMDDELETE_CLICK () 'Delete

Data1.Recordset.delete

Data1.recordset.moveprevious' Back to the previous record

End Sub

Private subdexit_click ()

Unload me

End Sub

Private sub flow_load ()

Firstflag = true 'first use

Frame1.visible = false 'makes the main button group visible

End Sub

Several controls linkage

Place Control: Form1: Data1; Text1, Combo1, List1

Property setting:

Data1: 〖DatabaseName〗 = "db2.mdb", 2 tables such as subsequent station information, runfall flow tables.

Private sub combo1_click ()

DIM Li, LSTR, LSTR1

For Li = 1 to list1.listcount

List1.clear

Data1.Recordsource = "SELECT station code from station information WHERE test station name = '" & combo1 & "'" data1.refresh

LSTR = DATA1.Recordset! Sensation station code

Data1.Recordsource = "Runoff Form"

Data1.refresh

Do While Not Data1.Recordset.eof

LSTR1 = DATA1.RecordSet! Sensation station code

IF lstr1 = lstr kil

List1.addItem data1.recordset! Measurement date

END IF

Data1.Recordset.Movenext

Loop

End Sub

Private sub list1_click ()

DIM LSTR, SQL1

Data1.Recordsource = "SELECT station code from station information WHERE test station name = '" & combo1 & "'"

Data1.refresh

LSTR = DATA1.Recordset! Sensation station code

SQL1 = "SELECT * FROM radio table WHERE test station code = '" & lstr & "' and measurement date = '" & list1 & "'"

Data1.Recordsource = SQL1

Data1.refresh

TEXT1 = DATA1.RecordSet! Runoff

End Sub

Private sub flow_load ()

TEXT1 = ""

Data1.Recordsource = "Station Information"

Data1.refresh

Combo1 = Data1.Recordset! Sensation station name

Do While Not Data1.Recordset.eof

Combo1.additem data1.recordset! Sensation station name

Data1.Recordset.Movenext

Loop

End Sub

Note: The measurement date is a character type;

Use the DataGrid control

With the FlexGrid control, you cannot connect the AdodC data control, and then use the DataGrid control. When using the ADODC control name in the DataSource property, you can automatically display the entire data table.

To cancel the function of DataGrid's change record, right-click control, cancel the [Allow Update] in [Properties]. To make the first unit data appear, select [Lock] in the [Split] tab.

Field names and fonts can also be changed in the interface design. At this time, add a field with [Add] and select or enter it.

Set the color of each row of mshflexgrid

Public Sub SetRowColor (ByRef MSHFlexGrid As Object) Dim j, i, objName objName = TypeName (MSHFlexGrid) If StrConv (Trim (objName), vbUpperCase) <> "MSHFLEXGRID" Then Exit Sub End If MSHFlexGrid.FillStyle = 1 For i = 1 To MSHFlexGrid.Rows - 1 MSHFlexGrid.Row = i If i Mod 2 = 0 Then MSHFlexGrid.Col = 0 MSHFlexGrid.ColSel = MSHFlexGrid.Cols - 1 MSHFlexGrid.CellBackColor = & H80FFFF End If Next i MSHFlexGrid.FillStyle = 0 MSHFlexGrid.Row = 0 mshflexgrid.col = 0nd subquerry results in the DataGrid control

DIM RS1

Private sub flow_load ()

DIM FPATH2

'fpath2 = "DBQ = // sans / office2000 / demo / db1.mdb; defaultdir = c: / vb / demi; driver = {Microsoft Access driver (* .mdb)}; driverid = 281; FIL = MS Access; FiledSn = C: / Program files / common files / odbc / data sources / test00.dsn; maxbuffersize = 2048; MaxScanRows = 8; pagetimeout = 5; safTransactions = 0; threads = 3; uid = admin; "UserCommitsync = yes;"

Fpath2 = "dbq = c: /vb/demo/db1.mdb; defaultdir = c: / vb / demiver = {Microsoft Access Driver (* .mdb)}; driverid = 281; FIL = MS Access; fileDSN = C : / Program files / common files / odbc / data sources / test00.dsn; maxbuffersize = 2048; maxScanrows = 8; pagetimeou t = 5; safTransactions = 0; threads = 3; uid = admin; "UserCommitsync

Adodc1.connectionstring = "provider = msdasql.1; persist security info = false; extended profment =" & fpath2

Adodc1.recordsource = "addvdata"

Adodc1.refresh

Do While Not Adodc1.Recordset.eof

List1.additem adodc1.recordset! Year

Adodc1.recordset.movenext

Loop

End Sub

Private sub list1_click () text1 = list1.listindex

Adodc1.refresh

SET RS1 = adodc1.recordset

While Not Rs1.eof

IF RS1! Year = list1 Then

DataGrid1.selbookmarks.add rs1.bookmark

END IF

RS1.MOVENEXT

Wend

DataGrid1.scroll 0, -3

End Sub

Advanced instances using the DataGrid control

This example uses the DataGrid1 control to display the actual precipitation in the first few months, and then use the historical data to calculate the precipitation in the DataGrid2 control in the DataGrid2 control. Finally, write the annual data into the second table.

Place Control: Form1: Command1, Command2, List1, Adodc1, DataGrid1, AdodC2, DataGrid2, Text1, etc.

'Estimated the precipitation of the year, and implemented the display function with the DataGrid control by xue wei 10/20/2001

Option expedition

Const mmax = 13

DIM MJ 'has data deadline

'drop out

Private submmand1_click ()

'Join the previous input data

DIM II

Adodc1.Recordsource = "HydnetData1"

Adodc1.refresh

Adodc2.recordsource = "HydnetData2"

Adodc2.refresh

While Not Adodc2.Recordset.eof

For ii = 2 to mj 1

Adodc2.recordset.fields (ii) = adodc1.recordset.fields (ii)

Next II

Adodc1.recordset.movenext

Adodc2.recordset.movenext

Wend

Unload me

End Sub

'Calculate an arithmetic mean for excessive precipitation this year

Function Calyp () AS INTEGER

DIM MI, II, QI

'Adodc1.Recordset.movefirst

'While Not Adodc1.Recordset.eof

Mi = 2

MJ = 0

Qi = 0

For ii = mi to mmax

If not isnull (Adodc1.Recordset.fields (ii)) THEN

Qi = Qi Adodc1.Recordset.fields (ii)

MJ = MJ 1

END IF

Next II

Calyp = int (qi / mj)

'Adodc1.Recordset.Movenext

'Wend

END FUNCTION

'Calculate an arithmetic mean for many years of monthly precipitation

Function Calyd () AS INTEGER

DIM II, YD1

YD1 = 0

'Msgbox "CAL =" & CALYM (1, 2)

For ii = 1 to MJ

YD1 = YD1 CALYM (II, 2)

Next II

Calyd = YD1 / MJ

END FUNCTION

Private sub fascist2_click ()

DIM II

For ii = 0 to 4

List1.selected (ii) = true

Callist1 (List1.List (II))

Next II

End Sub

SUB Callist1 (ListSelected)

DIM MI, II, QI

Dim Yp 'has an arithmetic average of the monthly precipitation

DIM YM 'Many years agrost precipitation

Dim Yd 'Arithmetic Average of Average Detapsuits in the Month Month

DIM YK 'ratio coefficient

DIM YDN 'Many years average precipitation

Dim yy 'estimated precipitation

Dim ymj 'estimated monthly reduction

'Check if there is a value for the first month

Adodc1.recordset.movefirst

IF isnull (Adodc1.Recordset) "

"MsgBox" There is no previous month for the previous month, you can't perform the precipitation estimate of the year "

Unload me

END IF

'Find the record based on the selected stream name

While Adodc1.Recordset ("Water Basin Name" <> listSelected

Adodc1.recordset.movenext

Wend

Adodc2.recordsource = "HydnetData2"

Adodc2.refresh

While Adodc2.RecordSet.fields (0) <> adodc1.recordset ("code")

Adodc2.recordset.movenext

Wend

'Estimate the precipitation of the year

Yp = caryp

Yd = caryd

Ydn = caalydn (2)

YK = YP / YD

'yy = int (YDN * YK)

'Adodc2.recordset.fields (mmax 1) = yy

Adodc2.recordset! Total = YY

Adodc2.recordset.Update

'Msgbox "yy =" & yy & "mj =" & mj

'Estimated follow-up monthly precipitation

YY = 0

For ii = mj 1 to mmax - 1

YMJ = CALYM (II, 2) * YK

YY = YY YMJ

Adodc2.recordset.fields (ii 1) = ymj

Adodc2.recordset.Update

Next II

'Get an estimated annual precipitation

YY = yy yp * mj

Adodc2.recordset.fields (mmax 1) = yy

Adodc2.recordset.Update

Adodc2.refresh

Adodc2.recordsource = "SELECT HYDNETDATA2.HYDNETCD AS code, HYDNET.HYDNETNM AS Basin Name, HydnetData2.jan AS Jan, HydnetData2.Feb AS February, HydnetData2.Mar AS March" & _

", Hydnetdata2.may as in May, HydnetData2.jun As July, HydnetData2.Aug As in July, HydnetData2.Sep AS, HYDNETDATA2.SEP AS SUST, HYDNETDATA2.OCT AS October "& _

", HYDNETDATA2.NOV AS November, HydnetData2.Dec AS December, HydnetData2.Total AS Annual Precipitation" & _

"from hydnetdata2, hydnet where hydnet.hydnetcd = hydnetdata2.hydnetcd" 'and hydnet.hydnetcd = '01' "adodc2.refresh

End Sub

Private sub list1_click ()

Callist1 (List1)

End Sub

Private sub flow_load ()

DIM II, TEMP

Adodc1.connectionstring = "provider = msdasql.1; persist security info = false; extended profment =" & fpath2

Adodc1.Recordsource = "HydnetData1"

Adodc1.refresh

Text1 = adodc1.recordset! Year1

Adodc2.connectionstring = "provider = msdasql.1; persist security info = false; extended profment =" & fpath2

Adodc2.recordsource = "HydnetData2"

Adodc2.refresh

While Not Adodc2.Recordset.eof

Adodc2.recordset.delete

Adodc2.recordset.movenext

Wend

While Not Adodc1.Recordset.eof

Adodc2.recordset.addnew

Adodc2.recordset.fields (0) = Adodc1.Recordset.fields (0)

Adodc2.recordset.fields (1) = Adodc1.Recordset.fields (1)

Adodc2.recordset.Update

Adodc1.recordset.movenext

Wend

Adodc1.recordsource = "SELECT HYDNETDATA1.HYDNETCD AS code, HYDNET.HYDNETNM AS Basin Name, HydnetData1.jan AS Jan, HydnetData1.Feb AS February, HydnetData1.Mar AS March" & _

", HydnetData1.May AS, HYDNETDATA1.AUL AS JULY, HYDNETDATA1.AUG AS AS Embles "& _

", HydNetData1.Nov As November, HydnetData1.Dec AS Decades, HydnetData1.Total AS Annual Precipitation" & _

"from hydnetdata1, hydnet where hydnet.hydnetcd = hydnetdata1.hydnetcd" 'and hydnet.hydnetcd = '01' "

Adodc1.refresh

While Not Adodc1.Recordset.eof

List1.additem adodc1.recordset ("Watershed Name")

Adodc1.recordset.movenext

Wend

Adodc2.refresh

Adodc2.Recordsource = "SELECT HYDNETDATA2.HYDNETCD AS code, HYDNET.HYDNETNM AS Basin Name, HydnetData2.jan AS Jan, HydnetData2.Feb AS February, HydnetData2.Mar AS March" & _ ", HydnetData2.APR AS Apr , HydnetData2.May AS, HydnetData2.jun As July, HydnetData2.jul As July, HydnetData2.Aug As April, HydnetData2.Sep AS September, HydnetData2.Oct As October "& _

", HYDNETDATA2.NOV AS November, HydnetData2.Dec AS December, HydnetData2.Total AS Annual Precipitation" & _

"from hydnetdata2, hydnet where hydnet.hydnetcd = hydnetdata2.hydnetcd" 'and hydnet.hydnetcd = '01' "

Adodc2.refresh

GFLAG = FALSE

IF giscd <> "" "

GFLAG = TRUE

Setdb

Set rst2 = new adoDb.recordset

Rst2.open "Select * from Hydnet Where Trim (HYDNETCD) = '" & TRIM (GISCD) & "'", CNN

ON Error ResMe next

Temp = RST2 ("HydNetnm")

IF err.number> 0 THEN

Msgbox "call errors, return"

Unload me

END IF

List1.enabled = false

Callist1 (TEMP)

END IF

End Sub

The code used in the common module is as follows:

Public const fpath2 = "dbq = // WebGIS / share / precipitation file /raindb.mdb; DEFAULTDIR = C: / VB / DEMO; driver = {Microsoft Access Driver (* .mdb)}; driverId = 281; FIL = MS Access; FILEDSN = C: / Program Files / Common Files / ODBC / Data Sources / test00.dsn; MaxBufferSize = 2048; MaxScanRows = 8; PageTimeout = 5; SafeTransactions = 0; Threads = 3; UID = admin; UserCommitSync = Yes; "

Public CNN As Adodb.Connection 'Database Connection

Public RST1 as adodb.recordset 'record set, combined with SET

Public RST2 as adodb.recordset 'record set, and SET combination

Public const year0 = 1950 'earliest record years

Public giscd as string 'GIS Calculation partition number

Public gflag as boolean 'determines whether it is GIS call' connection database

Public SUB setDb ()

DIM FPATH2

Set cnn = new adodb.connection

FPATH2 = "DBQ = // WebGIS / Share / Precipitation File /raindb.mdb; DEFAULTDIR = C: / VB / Demo; Driver = {Microsoft Access Driver (* .mdb)}; driverId = 281; FIL = MS Access; FILEDSN = C: / Program Files / Common Files / ODBC / Data Sources / test00.dsn; MaxBufferSize = 2048; MaxScanRows = 8; PageTimeout = 5; SafeTransactions = 0; Threads = 3; UID = admin; UserCommitSync = Yes; "

CNN.Open "provider = msdasql.1; persist security info = false; extended Properties =" & fpath2

End Sub

'Month year average precipitation, YM1 is the month number, YM2 is type: 1-measure station, 2-basin, 3-reservoir, 4-district

Public Function Calym (YM1, YM2) AS Single

DIM RST0 As New Adodb.Recordset

DIM TEMP, TI

Setdb

SELECT CASE YM2

Case 2

RST0.Open "Select * from hydnetdata", CNN

Temp = 0

Ti = 0

While Not Rst0.eof

IF isnull (RST0.Fields (YM1 1)) THEN RST0.FIELDS (YM1 1) = 0

Temp = Temp RST0.Fields (YM1 1)

Ti = Ti 1

'Msgbox "Ti =" & TI & "TEMP =" & TEMP

Rst0.Movenext

Wend

End SELECT

Rst0.close

CALYM = INT (Temp * 100 / Ti) / 100

END FUNCTION

Implement chart display with database controls

Add tab control SSTAB1 on the Form, placed in the MSChart control (CHART0, 1, 2) and MSFLEXGRID (MFGRID0, 1, 2) controls:

Code:

Option expedition

DIM CODETYPE (2) AS STRING

Dim Colfield (7) AS STRING

DIM Collabel (5) AS String

DIM strsum (50)

DIM ArrchartData ()

Private submmand1_click ()

Unload me

End Sub

Private sub flow_load ()

'Call public connection database

Setdb

'Tab array

CODETYPE (0) = "Watershed"

CodeType (2) = "Reservoir"

CodeType (1) = "District and counties"

'Grid horizon array

Colfield (1) = "Calculated Area" Colfield (2) = "Multi-year average precipitation"

Colfield (3) = "Average annual average precipitation amount"

Colfield (4) = "20%"

Colfield (5) = "50%"

Colfield (6) = "75%"

Colfield (7) = "95%"

'Chart control horizon array

Collabel (1) = "Average annual average precipitation amount"

Collabel (2) = "20%"

Collabel (3) = "50%"

Collabel (4) = "75%"

Collabel (5) = "95%"

End Sub

Private sub sstab1_click (Previoustab As Integer)

DIM STRSQL AS STRING

DIM I

SELECT CASE SSTAB1.TAB

'Basin Table

Case 0

Set rst1 = new adoDb.recordset

strsql = "Select * from hydnet where hydnetcd in (SELECT HYDNETCD from HyDnetData"

Rst1.open Strsql, CNN

Reportset 0, MFGrid0, Chart0

Rst1.close

'District county table

Case 1

Set rst1 = new adoDb.recordset

strsql = "Select * from addv where addvcd in (select addvcd from addvdata"

Rst1.open Strsql, CNN

ReportSet 1, MFGrid1, Chart1

Rst1.close

'Reservoir table

Case 2

Set rst1 = new adoDb.recordset

strsql = "Select * from shuiku where shuikucd in (select shuikucd from shuikudata)"

Rst1.open Strsql, CNN

ReportSet 2, MFGrid2, Chart2

Rst1.close

End SELECT

End Sub

'Calculation and assignment

Sub ReportSet (K, MFGrid, Chart As Object)

DIM I, J, H

WITH MFGRID

.Col = 0

.Row = 0

.Text = CODETYPE (K)

For i = 1 to 7

.Col = i

.COLWIDTH (i) = 1450

.Text = Colfield (i)

Next i

End with

J = 0

IF RST1.EOF THEN

Msgbox "no data"

EXIT SUB

Else

Rst1.movefirst

Do While Not Rst1.eof

J = J 1

Rst1.movenext

Loop

END IF

Redim ArrchartData (1 to J, 1 to 5)

Rst1.movefirst

i = 1

Do While Not Rst1.eof

strsum (8) = rst1.fields (0) 'CODE

'Multi-year average precipitation total calculation

strsum (0) = RST1.Fields (1) 'NameStrsum (1) = RST1! Area' Area

STRSUM (2) = CALYDN2 (strsum (8), k 2) 'call calculation for many years average precipitation functions

Strsum (3) = ClNG (strsum (2)) * ClNG (strsum (1)) / 100000

Strsum (4) = Calduoping (strsum (8), strsum (1), 0.2, k) 'calls to calculate a function of a frequency drop in water

Strsum (5) = Calduoping (strsum (8), strsum (1), 0.5, k)

Strsum (6) = Calduoping (strsum (8), strsum (1), 0.75, k)

Strsum (7) = Calduoping (strsum (8), strsum (1), 0.95, k)

'Assign a value to the Chart control

ArrchartData (I, 1) = strsum (3)

ArrchartData (i, 2) = strsum (4)

ArrchartData (I, 3) = strsum (5)

ArrchartData (I, 4) = strsum (6)

ArrchartData (I, 5) = strsum (7)

Chart.chartData = ArrchartData

'Table display

WITH MFGRID

.Row = i

For h = 0 to 7

.Col = h

.Text = Format (strsum (h), "0.00")

Next h

End with

i = i 1

Rst1.movenext

Loop

'Write Chart Right Series Tags

Chart.rowcount = j

Chart.columnlabelcount = j

Rst1.movefirst

For i = 1 to j

Chart.row = i

Chart.rowLabel = RST1.Fields (1)

Rst1.movenext

Next i

'Write Chart horizontal

Chart.columncount = 5

FOR i = 1 to 5

Chart.column = i

Chart.columnlabel = Colfield (i 2)

Next i

Chart.refresh

End Sub

Database control uninstall

SET DATA1.Recordset = Nothing

Nine ADO database programming

Open MDB database

Setting: in [Project] ‖ [Quote] "MS DAO 2.5 / 3.51 Compatibility Library"

Code:

Public cnn1 as adodb.connection

Public RST1 As Recordset

Public RST2 as Recordset

Sub mdbopen ()

DIM STRCNN AS STRING

Text2 = "Panx.mdb"

Fpath2 = "c: / fxfx / pan /"

Strcnn = "provider = microsoft.jet.OleDb.3.51; persist security info = false;" & _

"Data Source =" & fpath2 & text2

SET CNN1 = New Adodb.connection

CNN1.Open STRCNN

End Sub Opens DBF Database

Setting: in [Project] ‖ [Quote] "MS DAO 2.5 / 3.51 Compatibility Library"

Code:

Public CNN2 as adodb.connection

Public RST1 As Recordset

Public RST2 as Recordset

SUB DBFOPEN ()

DIM STRCNN AS STRING

Fpath2 = "c: / fxfx / pan /"

Strcnn = "provider = msdasql.1; persist security info = false;" & _

"Data Source = FoxPro Files; Initial Catalog =" & fpath2

SET CNN2 = New Adodb.connection

CNN2.Open STRCNN

End Sub

Connect the SQL database

DIM CNN As Adodb.Connection 'Database Connection

DIM RST2 As Adodb.Recordset

Private submmand1_click ()

Set cnn = new adodb.connection

Si = "provider = SQLOLEDB.1; Integrated Security = SSPI; PERSIST Security Info = False; Initial Catalog =" & _

TEXT5.TEXT & "Data Source =" & Text4.Text

CNN.Open Si

Set rst2 = new adoDb.recordset

Si = "Select * from" & text3.text

Rst2.open Si, CNN, AdoPENDYNAMIC, ADLOCKOPTIMISTIC 'Open a writable table

......

End Sub

Private sub flow_load ()

Text3.text = "BIAO2" 'Name

TEXT4.TEXT = "Temp" 'Database Group

TEXT5.TEXT = "Xue01" 'Database

End Sub

Read database

MDBopen

Set rst1 = new adoDb.recordset

Rst1.open "Shuku", CNN1

Do While Not Rst1.eof

IF RST1! SDANJIA = 100 THEN

List1.additem rst1! Sname

END IF

Rst1.movenext

Loop

Rst1.close

Write database

MDBopen

Set rst2 = new adoDb.recordset

Rst2.cursortype = adopenkeyset

Rst2.lockType = AdlockOptimistic

Rst2.open "SHU0", CNN1,, Adcmdtable

Do While Not Rst1.eof

IF RST1! SDANJIA <0 THEN

Rst1! SDANJIA = 0

Rst1.update

END IF

Rst1.movenext

Loop

Rst2.close

Clear database

MDBopen

Set rst2 = new adoDb.recordset

Rst2.cursortype = adopenkeyset

Rst2.lockType = AdlockOptimistic

Rst2.open "SHU0", CNN1,, Adcmdtable

Do While Not Rst2.eof

Rst2.delete

Rst2.movenext

Loop

Pour the DBF library into the MDB library

First establish the MDB database according to the field of DBF, and open the two libraries.

Do While Not Rst2.eof

Rst1.addnew

For i = 0 to rst1.fields.count - 1

Rst1.fields (i) = rst2.fields (i)

Next i

Rst1.update

Rst2.movenext

Loop

Rst1.close

Rst2.close

Use SQL language

MDBopen

S1 = "Select * from shuku where sdanjia = 100"

Set rst1 = new adoDb.recordset

Rst1.open S1, CNN1

Do While Not Rst1.eof

List1.additem rst1! Sname

Rst1.movenext

Loop

Rst1.close

Reverse query

Rst1.open "SELECT DISTINCT rainstock data table. Annual from rainstock station data table ORDER BY DESC", CNN

Add a new record

Setdb

Set rst1 = new adoDb.recordset

Rst1.open "Decision Information Table", CNN, AdopenKeyset, Adpmdtable '(1, 3, 2)

Rst1.addnew

RST1! Decision code = JCDAIMA

RST1! Registered = Zhuce

RST1! Decision start time = Date

Rst1.update

SET RST1 = Nothing

Where the setDB program is:

Public SUB setDb ()

Set cnn = new adodb.connection

Fpath3 = "c: / my documents / decision"

Fpath2 = "DBQ =" & fpath3 & "; defaultdir = c: / vb / demo; driver = {Microsoft Access Driver (* .mdb)}; driverid = 281; FIL = MS Access; fileDSN = C: / Program Files / Common files / odbc / data sources / test00.dsn; MaxBuffersize = 2048; MaxScanRows = 8; PageTimeout = 5; SafeTransactions = 0; Threads = 3; UID = admin; "UserCommitsync

CNN.Open "provider = msdasql.1; persist security info = false; extended Properties =" & fpath2

End Sub

Modify record

STRN = "SELECT * FROM decision information table WHERE decision code = '" & jcdaima & "'"

Rst1.open Strn, CNN, 1, 3

Rst1! Fanwei0 = Fanwei

Rst1! Year0 = DYEAR

Rst1.update

Set RST1 = Nothing Find Record Public Process

Public Sub Rseek (SS1 AS STRING, SS2 AS STRING, RST AS AdoDB.Recordset)

DIM BBB

BBB = TRUE

rst.movefirst 'RST cannot be empty, otherwise an error occurs

Do While Not Rst.eof and BBB

IF RST (SS1) = SS2 THEN

BBB = FALSE

Else

Rst.movenext

END IF

Loop

IF bbb then

'Msgbox "did not find record!"

BRSL = TRUE

END IF

End Sub

When calling, just use

RSeek ("unit price", "51.5", RST1)

It can be found in a record (first) of a single price of 51.5 yuan.

If you want to use BRSL to find out if you find it, set BRSL = FALSE.

Note that RST cannot be empty, available

IF RST1.Recordnum> 0 Then Rseek ("unit price", "51.5", RST1)

Judgment.

When using RSeek multiple times, the speed is slow. At this time, it is best to use SQL queries:

SS1 = "SELECT * from shu0 where scode = '" & rst2! scode & "'"

Set rst1 = new adoDb.recordset

Rst1.open SS1, CNN1

Query and modify data

Place Control: Form1: Command1 (by price), Command2 (by book name), Command3 (according to the code), List1

Code:

Option expedition

DIM S11 AS SINGLE, S12 AS STRING

SUB INPUTP1 ()

DIM S2

S2 = ""

ON Error Goto Head

HEAD1:

S2 = INPUTBOX ("Please enter a single price:")

IF S2 = "" "

Msgbox "Press 'to determine' Abandon"

Else

S11 = S2

END IF

EXIT SUB

HEAD:

Msgbox "Enter wrong! Please re-enter"

RESUME HEAD1

End Sub

Sub Listdelete ()

DIM I

For i = 0 to list1.listcount - 1

List1.clear

End Sub

SUB Listshow1 ()

DIM ST, S3, I

Rst1.movefirst

i = 1

Do While Not Rst1.eof

IF RST1! SDANJIA = S11 THEN

S3 = LEN3 (STR (I), 8) & Len3 (RST1! Scode, 10) & Len3 (Rst1! Sname, 42) &_

"" & Len3 (STR (S11), 8) & Len3 (Rst1! Syear, 12) & Len3 (Rst1! SKWH, 12) & Len3 (Rst1! SBAG, 6)

List1.additem s3

i = i 1

END IF

Rst1.movenext

Loop

IF (i = 1) THEN

Msgbox "Didn't find!"

END IF

End Sub

PRIVATE SUB Command1_Click () Inputp1

Listdelete

IF S11 <> 0 THEN

Listshow1

END IF

End Sub

Sub Listshow2 ()

DIM ST, S3, I

Rst1.movefirst

i = 1

Do While Not Rst1.eof

ST = MID (TRIM (RST1! Sname), 1, LEN (S12))

IF st = S12 THEN

S3 = LEN3 (STR (I), 8) & Len3 (RST1! Scode, 10) & Len3 (Rst1! Sname, 42) &_

"" & Len3 (Rst1! SDanjia, 8) & len3 (Rst1! Syear, 12) & Len3 (Rst1! SKWH, 12) & Len3 (Rst1! SBAG, 6)

List1.additem s3

i = i 1

END IF

Rst1.movenext

Loop

IF i = 1 THEN

Msgbox "Didn't find!"

END IF

End Sub

SUB INPUTP2 ()

DIM S2

S12 = ""

S2 = INPUTBOX ("Please enter the first few words of the book name:")

IF S2 = "" "

Msgbox "Press 'to determine' Abandon"

Else

S12 = S2

END IF

End Sub

Private sub fascist2_click ()

INPUTP2

Listdelete

IF S12 <> "" "

Listshow2

END IF

End Sub

SUB Listshow3 ()

DIM ST, S3, I

Rst1.movefirst

i = 1

Do While Not Rst1.eof

ST = MID (TRIM (RST1! Scode), 1, LEN (S12))

IF st = S12 THEN

S3 = LEN3 (STR (I), 8) & Len3 (RST1! Scode, 10) & Len3 (Rst1! Sname, 42) &_

"" & Len3 (Rst1! SDanjia, 8) & len3 (Rst1! Syear, 12) & Len3 (Rst1! SKWH, 12) & Len3 (Rst1! SBAG, 6)

List1.additem s3

i = i 1

END IF

Rst1.movenext

Loop

IF i = 1 THEN

Msgbox "Didn't find!"

END IF

End Sub

SUB INPUTP3 ()

DIM S2

S12 = ""

S2 = INPUTBOX ("Please enter the first few words for the code:")

IF S2 = "" "

Msgbox "Press 'to determine' Abandon"

Else

S12 = S2

END IF

End Sub

Private submmand3_click ()

INPUTP3

Listdelete

IF S12 <> "" "

Listshow3

END IF

End Sub

Private sub fascist4_click ()

CNN1.Close

Unload me

End Sub

Private sub list1_click ()

DIM Li1, S1, S2

Li1 = MID (List1, 9, 8)

S1 = INPUTBOX ("Please enter the book" & Trim (li1) & "new library bit number:")

IF S1 = "" "

"MSGBOX" does not enter the library bit number, please re-enter. "

EXIT SUB

Else

Call Rseek ("Scode", TRIM (Li1), RST1)

S2 = RST1! SKWH

RST1! SKWH = S1

Rst1.update

Rst2.addnew

Rst2! knum = TNUM

Rst2! kdate = DATE

Rst2! Kcode = RST1! Scode

Rst2! kh1 = s2

Rst2! kh2 = S1

Rst2.update

END IF

Rst1.close

Rst2.close

CNN1.Close

Load fkuweip

Fkuweip.pp1

Msgbox ("This time the library is processed. Press" OK "to exit")

Unload me

End Sub

Private sub flow_load ()

DIM STRCNN

DIM IT AS Integer

DIM K, S2

Strcnn = "provider = microsoft.jet.OleDb.3.51; persist security info = false;" & _

"Data Source =" & fpath1 & "shukux.mdb"

SET CNN1 = New Adodb.connection

CNN1.Open STRCNN

Set rst1 = new adoDb.recordset

Rst1.cursortype = adopenkeyset

Rst1.lockType = AdlockOptimistic

Rst1.open "SHU0", CNN1,, Adcmdtable

Set rst2 = new adoDb.recordset

Rst2.cursortype = adopenkeyset

Rst2.lockType = AdlockOptimistic

Rst2.open "KWh", CNN1,, Adcmdtable

IF Rst2.Recordcount <1 THEN

TNUM = "k00001"

Else

Rst2.movelast

S2 = RST2! KNUM

S2 = MID (S2, 2, 6)

S2 = TRIM (STR (INT) 1))

Do while len (S2) <5

S2 = "0" S2

Loop

Tnum = "k" & s2

END IF

End Sub

Connect remote database

1. Connect remote database with Adodc controls

After using the file DSN, after the connection is established, add an ADODC control, a list1 control, the program is as follows:

Private sub flow_load ()

Fpath2 = "DBQ = // sans / office2000 / demo / db1.mdb; defaultdir = C: / VB / DEMO; driver = {microsoft access driver (* .mdb)}; driverid = 281; FIL = MS Access; fileDSN = C: / Program Files / Common Files / ODBC / Data Sources / test00.dsn; MaxBufferSize = 2048; MaxScanRows = 8; PageTimeout = 5; SafeTransactions = 0; Threads = 3; UID = admin; UserCommitSync = Yes; "Adodc1.ConnectionString = "Provider = msdasql.1; persist security info = false; extended Properties =" & fpath2

Adodc1.recordsource = "addvdata"

Adodc1.refresh

Do While Not Adodc1.Recordset.eof

List1.additem adodc1.recordset! Addvcd

Adodc1.recordset.movenext

Loop

End Sub

2. Connect remote database with program

In [Project] ‖ [Reference] "MS DAO 2.5 / 3.51 Compatibility Library" and "MS ADO 2, 0 Library", add one LIST1 control, the program is as follows:

Public CNN As Adodb.Connection

Private sub flow_load ()

DIM STRCNN, FPATH2

DIM RST1 AS New Adodb.Recordset

Set cnn = new adodb.connection

Fpath2 = "DBQ = // sans / office2000 / demo / db1.mdb; defaultdir = C: / VB / DEMO; driver = {microsoft access driver (* .mdb)}; driverid = 281; FIL = MS Access; fileDSN = C: / program files / common files / odbc / data sources / test00.dsn; maxBuffersize = 2048; maxScanrows = 8; pagetimeout = 5; safTransactions = 0; threads = 3; UID = admin; "UserCommitsync = YES;"

CNN.Open "provider = msdasql.1; persist security info = false; extended Properties =" & fpath2

Rst1.open "Select * from addvdata", CNN

Do While Not Rst1.eof

List1.additem rst1! Addvcd

Rst1.movenext

Loop

Rst1.close

End Sub

Data entry instance

This is an enrollment with Text under several control options (subtitles and annual), if the record value, enter the UPDATE state, if there is no value, enter the AddNew status. The final sum can be input or calculated. Press [Confirm] to prompt the total sum of the user to input according to the calculation results (more than 5%), then write to the database, and turn the station to the next. 'Sensation station annual data entry

Option expedition

DIM RAINSTATCD AS STRING

DIM flag as boolean 'judgments if the record is worth

Private Sub Cmdcancel_Click (INDEX AS INTEGER)

Combo_year_click

End Sub

Private subdexit_click ()

Unload me

End Sub

Private Sub Cmdjisuan_Click (INDEX AS INTEGER)

DIM I as integer

DIM TXTBOX As TextBox

For Each TxtBox in Me.Text1

IF txtbox.text = "" ""

TXTBOX.TEXT = "0"

END IF

TEXT1 (12) = "0"

For i = 0 TO 11

TEXT1 (12) = VAL (Text1 (12)) VAL (Text1 (i))

Next i

TEXT1 (12) .Setfocus

End Sub

Private sub cmdsubmit_click (index as integer)

DIM I as integer

DIM SUM AS Long

DIM TXTBOX As TextBox

ON Error Goto ERR

For Each TxtBox in Me.Text1

IF txtbox.text = "" ""

TXTBOX.TEXT = "0"

END IF

SUM = 0

For i = 0 TO 11

SUM = SUM VAL (Text1 (i))

Next i

If SUM = 0 THEN

Msgbox "No Data cannot be submitted", "Tips"

EXIT SUB

END IF

IF (SUM - VAL (Text1 (12))) / SUM> 0.05 OR (VAL (TEXT1 (12)) - SUM) / SUM> 0.05 THEN

IF msgbox ("The annual precipitation is 5% of each month, is it amended?", VBQuestion Vbyesno, "Tips") = Vbyes Then

Text1 (12) .text = TRIM (Str $ (SUM))

TEXT1 (12) .Setfocus

EXIT SUB

END IF

Set rst2 = new adoDb.recordset

Set rst1 = new adoDb.recordset

Rst1.open "SELECT RAINSTAT. * From rainstat where rainstat.rainstatnm = '" & combo_nm.text & "'", CNN

RainStatcd = RST1 ("RainStatcd")

Rst1.close

'Cnn.begintrans

IF flag = false kilst2.open "Select * from Statdata", CNN, AdopenStatic, AdlockOptimistic

'Rst2.movelast

Rst2.addnew

Else

Rst2.open "Select * from statdata where rainstatcd = '" & rainstatcd & "' and year1 =" & valockoptimistic, AdlockTiMistic, AdlockOptiMistics

END IF

RST2 ("rainstatcd") = rainstatcd

RST2 ("Year1") = Combo_Year

For i = 0 TO 12

Rst2.fields (i 2) = text1 (i) .Text

Next i

Rst2.update

'Rst2.Requery

'Cnn.committrans

If Combo_nm.listIndex

Combo_nm.listindex = Combo_nm.listIndex 1

Else

Combo_nm.listIndex = 0

END IF

IF gflag dam

'Msgbox "gflag =" & gflag

Unload me

EXIT SUB

Else

Calenter2 Combo_nm.list (combo_nm.listindex) "To the next test station

END IF

TEXT1 (0) .SETFOCUS

EXIT SUB

Err:

MsgBox Err.Description

End Sub

Private sub combo_nm_change ()

'Combo_Year_Click

End Sub

Private sub combo_nm_click ()

Combo_year_click

End Sub

Private sub combo_year_click ()

DIM I

Flag = false

Set rst1 = new adoDb.recordset

Rst1.open "Select * from rainstat where rainstatnm = '" & combo_nm & "'", CNN

Set rst2 = new adoDb.recordset

Rst2.open "Select * from statdata where rainstatcd = '" & rst1! Rainstatcd & "' and year1 =" & val (combo_year), CNN

i = 0

While Not Rst2.eof

i = i 1

Rst2.movenext

Wend

IF i> 0 THEN

Rst2.movefirst

RainStatcd = RST2 ("RainStatcd")

Flag = TRUE

For i = 0 TO 12

IF not isnull (Rst2.fields (i 2)) THEN

Text1 (i) = Rst2.fields (i 2)

Else

TEXT1 (0) = ""

END IFNext I

Else

For i = 0 TO 12

TEXT1 (I) = "" "

Next i

Flag = false

END IF

Rst1.close

Rst2.close

End Sub

Sub Calenter2 (RainName)

Combo_nm = rainname

Combo_year_click

End Sub

Private sub flow_load ()

DIM J AS INTEGER

DIM TEMP

Setdb

Set rst2 = new adoDb.recordset

Rst2.open "Rainstat", CNN

While Not Rst2.eof

Combo_nm.additem RST2 ("RainStatNM")

Rst2.movenext

Wend

Combo_year = year (date) - 1

For j = year0 to year (date) - 1

Combo_Year.Additem J

NEXT J

Rst2.movefirst

Temp = RST2 ("RainStatNM")

Combo_nm.listIndex = 0

'Call this form from the outside

GFLAG = FALSE

IF giscd <> "" "

GFLAG = TRUE

Set rst2 = new adoDb.recordset

Rst2.open "Select * from rainstat where trim (rainstatcd) = '" & trim (giscd) & "'", CNN

ON Error ResMe next

Temp = RST2 ("RainStatNM")

IF err.number> 0 THEN

Msgbox "call errors, return"

Unload me

END IF

Combo_nm.enabled = false

END IF

'Rst2.close

Calenter2 Temp

End Sub

Private sub text1_keypress (INDEX AS INTEGER, Keyascii AS Integer)

DIM STRVALID AS STRING

Strvalid = "0123456789."

IF keyascii> 26 THEN

IF INSTR (STRVALID, CHR (Keyascii) = 0 THEN

Keyascii = 0

END IF

IF keyascii = 13 THEN

IF Index <11 THEN

TEXT1 (INDEX 1) .Setfocus

END IF

IF index = 11 THEN

cmdjisuan (0) .SETFOCUS

END IF

IF index = 12 THEN

cmdsubmit (1) .Setfocus

END IF

End Sub

The program also uses public module code:

Public RST1 as adodb.recordset 'record set, combined with SET

Public RST2 as adodb.recordset 'record set, and SET combination

Public const year0 = 1950 'earliest record years

PUBLIC GISCD AS STRING 'GIS Calculation Partition number public gflag as boolean' determines if it is GIS call

Public SUB setDb ()

DIM FPATH2

Set cnn = new adodb.connection

Fpath2 = "DBQ = // WebGIS / Share / Precipitation File /raindb.mdb; DEFAULTDIR =c:/vb/demo; DRIVE R = {Microsoft Access Driver (* .mdb)}; driverId = 281; Fil = MS Access ; FILEDSN = C: / Program Files / Common Files / ODBC / Data Sources / test00.dsn; MaxBufferSize = 2048; MaxScanRows = 8; PageTimeout = 5; SafeTransactions = 0; Threads = 3; UID = admin; UserCommitSync = Yes; "

CNN.Open "provider = msdasql.1; persist security info = false; extended Properties =" & fpath2

End Sub

Ten file processing

Read the file with the OPEN method

Open S1 for Input AS # 1

Do While Not Eof (1)

LINE INPUT # 1, S2

Msgbox S2

loop

Close # 1

Write files with open

Rewrite

Open S1 for Output AS # 1

Print # 1, S2

Close # 1

Additional

Open s1 for append as # 1

Print # 1, S2

Close # 1

Read and write files with FSO objects

Quote Microsoft Scripting Runtime before using the FSO object

DIM FSO AS New FileSystemObject

DIM TS1, TS2 AS TEXTSTREAM

Set ts1 = fso.opentextfile (fs1, forreading)

Set ts2 = fso.opentextfile (fs2, forwriting)

i = 0

Do while not ts1.atendofstream

S0 = ts1.readline

Ts2.writeLine S0

i = i 1

Loop

m = i

TS1.Close

TS2.Close

Delete Files

DIM FSO AS New FileSystemObject

Fso.Deletefile FName1

Set file2 = fso.getfile (T1)

File2.delete

Document name

Turn the file T1 to T2

T1 = "c: /logs/station.dbf..dbf"

T2 = "C: /LOGS/station1.dbf"

IF fso.fileexists (t1) THEN

Set file2 = fso.getfile (T1)

IF not fso.fileexists (t2) THEN

File2.Move T2

END IF

Else

MsgBox "Database File" & T1 & "Does not exist!"

End

END IF

Copy file

Copy the file T1 into T2

T1 = "c: /logs/station.dbf..dbf"

T2 = "C: /LOGS/station1.dbf" if fso.fileexists (t1) THEN

Set file2 = fso.getfile (T1)

IF not fso.fileexists (t2) THEN

File2.copy T2

END IF

Else

MsgBox "Database File" & T1 & "Does not exist!"

End

END IF

Delete expired files

Add a file1 control to manage all files. First set file1.path

For i = 0 to file1.listcount - 1

Fn = file1.path "/" file1.list (i)

Set file2 = fso.getfile (fn)

Tt = file2.dateLastModified

If Today - TT> 10 Then 'Deletes 10 days ago

File2.delete

END IF

Ele 1 sent and 12 E-mail

Send e-mail

Call: [Parts] Microsoft Mapi Control 6.0

Place Control: Form1: Command1, MapiseSession1, Mapimestages1

Property Settings: 〖Mapisession1. Name〗 = Mapis, 〖MapIMessages1. Name〗 = Mapim

Description: 1. The mapisession control is used to connect and log in, and the Mapimestages control is used to perform the operation of sending and receiving E-mail.

2. Enter E-mail content to mapims ,.msgnottext when sending. To enter multiple lines, use mapims.msgnotext = line1 & vbcrlf & line2.

Code:

Private submmand1_click ()

WITH MAPIS

.Downloadmail = true 'Using boot download

.Logonui = true 'can be handled manually when sending addresses

. Signon 'established a session

End with

With mapim

.SessionId = mapis.sessionID 'Specifies the dialog number with sessionid, default is 0

.Compose 'write new news

.Recipaddress = "shuku@waterpub.com.cn" wrote recipient address

.AddressResolveui = true 'uses verification mode

.Resolvename 'Verify the recipient address

.Msgsubject = "head" 'Write E-mail theme

.Msgnotetext = "text" 'Write E-mail content

.Send 'sends

End with

Mapis.signoff 'end session

Msgbox ("After sending.")

End Sub

Receive e-mail

Call: [Parts] Microsoft Mapi Control 6.0

Place Control: Form1: Command1, MapiseSession1, Mapimances1, Text1, Text2, Text3 Property Settings: 〖Mapisession1. Name〗 = Mapis, 〖MapIMessages1. Name = Mapim

Description: 1. This example is an example of receiving an e-mail;

2. To open Outlook Express first, and automatically accept mail. The program reads the letter from the Outlook Express's inbox.

Code:

Private submmand1_click ()

WITH MAPIS

.Downloadmail = true 'Using boot download

.Logonui = true 'can be handled manually when sending addresses

. Signon 'established a session

End with

With mapim

.SessionId = mapis.sessionID 'Specifies the dialog number with sessionid, default is 0

.Fetch '

TEXT3 = .msgcount 'Letter number

Text1 = .msgsubject 'Theme

Text2 = .msgnotext 'content

'. Deleted deletion

End with

Mapis.signoff 'end session

End Sub

Receive multiple E-mail

Place the control and attribute settings as before.

To open Outlook Express first, and automatically accept mail. The program reads the letter from the Outlook Express's inbox.

DIM I

Fpath3 = "c: / asp / temp /"

WITH MAPIS

.Downloadmail = TRUE

.Logonui = TRUE

.Signon

End with

With mapim

.SessionId = mapis.sessionID

Fetch

For i = 0 to .msgcount - 1

.Msgindex = i

S1 = fpath3 & .msgsubject

Open S1 for Output AS # 1

Print # 1, .msgnotetext

Close # 1

For i = 0 to .msgcount - 1

. Delete

End with

Mapis.SIGNOFF

Select to send multiple E-mail

Place the control and attribute settings to increase the Fiel1 control.

When using dial-up Internet access, you must first open Outlook Express and have dial-up Internet access, which is faster. Otherwise, each time you send a number.

Option expedition

Dim fscount, i, j

DIM FS1 (200) AS STRING

DIM FSO AS New FileSystemObject

DIM file2 as file

Function Disfile (SS1 AS STRING)

DIM SK

Disfile = ""

Open file1.path & "/" & ss1 for input as # 1

Do While Not Eof (1)

Line INPUT # 1, SK

Disfile = Disfile & SK & VBCRLF

Loop

Close # 1

End functionSub mapisend ()

DIM FS2 AS STRING

WITH MAPIS

.Downloadmail = false

.Logonui = TRUE

.Signon

End with

With mapim

.SessionId = mapis.sessionID

.Compose

For i = 0 to fscount - 1

'.Msgindex = i

.Recipaddress = "wrf@waterpub.com.cn"

.AddressResolveui = TRUE

.Resolvename

FS2 = fs1 (i)

'fs2 = "4bu0020.ppp"

.Msgsubject = fs2

.Msgnotext = dispile (fs2)

Ssend

Next i

End with

Msgbox "After sending"

End Sub

Sub mfilemove ()

DIM FNAME1

For i = 0 to fscount - 1

FNAME1 = file1.path & "/" & fs1 (i)

'MSGBOX FNAME1

Fso.Deletefile FName1

End Sub

Private submmand1_click ()

J = 0

For i = 0 to file1.listcount - 1

If file1.selected (i) THEN

FS1 (j) = file1.list (i)

J = J 1

END IF

fscount = j

IF fscount <1 THEN

Msgbox "No file you want to send!"

EXIT SUB

Else

For i = 0 to fscount - 1

FS1 (i) = file1.list (i)

Next i

END IF

Mapisend

Mfilemove

Mapis.SIGNOFF

Unload me

End Sub

Private sub fascist2_click ()

Unload me

End Sub

Private sub flow_load ()

Fpath1 = "c: / fxfx / kfb /"

File1.path = fpath1 & "email"

End Sub

Twelve ActiveX control

Establish a simple ActiveX control

This is an example of display time.

1. New ActiveX control project

Place the control: UserControl1: frame1, timer1, label1 (hours), label2 (minute), label3 (second), make the frame tolerant other controls

Property settings: 〖Timer1.Interval〗 = 100 'ms

Code:

Private sub timer1_timer ()

Label1.caption = HOUR (TIME) & ";"

Label2.caption = Minute (TIME) & ";"

Label3.caption = second (time)

End Sub

Private sub UserControl_initialize ()

Label1.caption = HOUR (TIME) & ";"

Label2.caption = minute (time) & "; label3.caption = second (time)

End Sub

Then save the file and generate an OCX file.

2. New standard EXE project, click [Project] / [Part] to find the "Engineering 1" part generated, select it, then add it from the toolbox to Form1. At this time, you can see this control is already running. Then you can release this control.

Improve the interface of the ActiveX control

Select the "ActiveX Interface Wizard" load in [Add Program] / [Add), open the Wizard dialog, follow the prompts to do.

Publish and apply ActiveX controls

Select the "Package and Expand Wizard" in [Add Package] / [Add ", open the Wizard dialog, select [Package], select [Internet], select" Publish to No VB in Options On the computer, then you can generate a CAB file in the specified folder, you can be installed on other computers.

At this point, a HTML file with the same name is also generated, copy it on the Object code, put it on other pages, you can apply this control on the Internet.

Establish a complicated one example

This is an example of adding new properties and methods.

Create a new ActiveX control engineering, place control: UserControl1: command1, label1.

Open "ActiveX Interface Wizard", select CAPTION (corresponding to Label1) and Click (Cordless Command1), then create a property LeftX (corresponding Label1).

At this time, the userControl1 automatically produces several pieces of code, modify the following, and then use the next step to debug the method for online debugging.

'Setting the properties of Leftx (setting the assignment and assignment by LET and GET)

Public Property Let Leftx (ByVal New_leftx As Integer)

Label1.Left = new_leftx

PropertyChanged "Leftx"

End Property

'note! Don't delete or modify the following is commented!

'MemberInfo = 7, 0, 0, 0

Public property get leftx () AS Integer

Leftx = label1.Left

End Property

'Modify Click event

Private submmand1_click ()

Me.caption = me.leftx

Me.leftx = me.leftx 50

RaiseEvent Click

End Sub

'Add an initial value setting (no use, just exercises)

Private sub UserControl_initialize ()

Me.caption = "" "

End Sub

Development and debugging

First click [Project] / [Add Project] to add a test project;

Turn off UserControl, then the UserControl control appears in the toolbox, add it to Form1, you can run this program.

If there is no test engineering, IE can also call the IE.

To join this control on the web, check the HTML source file when running, copy the following instructions, paste into the webpage: