Презентация на тему: Сборник программ на языке Visual Basic

Программирование на VB Сборник примеров программ

Программа «Привет» Private Sub cmdClear_Click() txtDisplay.Text = "" End Sub Private Sub cmdHello_Click() txtDisplay.Text = "Привет, мир" End Sub Private Sub cmdExit_Click() Beep End End Sub

Программа «Скорость» Private Sub hsbSpeed_Change() txtSpeed.Text = Str(hsbSpeed.Value) + "км/ч" End Sub Private Sub hsbSpeed_Scroll() hsbSpeed_Change End Sub Private Sub cmdExit_Click() End End Sub

Программа «Выбор» Option Explicit Private Sub chkColors_Click() UpdateLabel End Sub Private Sub chkMouse_Click() UpdateLabel End Sub Private Sub chkSound_Click() UpdateLabel End Sub Private Sub cmdExit_Click() End End Sub Private Sub optLevel1_Click() UpdateLabel End Sub Private Sub optLevel2_Click() UpdateLabel End Sub Private Sub optLevel3_Click() UpdateLabel End Sub Public Sub UpdateLabel() Dim Info Dim LFCR LFCR = Chr(13) + Chr(10) If chkSound.Value = 1 Then Info = "Звук выбран" Else Info = "Звук отвергнут" End If If chkMouse.Value = 1 Then Info = Info + LFCR + "Мышь выбрана" Else Info = Info + LFCR + "Мышь отвергнута" End If If chkColors.Value = 1 Then Info = Info + LFCR + "Цвет выбран" Else Info = Info + LFCR + "Цвет отвергнут" End If If optLevel1.Value = True Then Info = Info + LFCR + "Выбран уровень 1" End If If optLevel2.Value = True Then Info = Info + LFCR + "Выбран уровень 2" End If If optLevel3.Value = True Then Info = Info + LFCR + "Выбран уровень 3" End If lblChoice.Caption = Info End Sub

Программа «2х2» Option Explicit Private Sub cmdCalculate_Click() Multiply 2, 2 End Sub Public Sub Multiply(X As Integer, Y As Integer) Dim Z Z = X * Y txtResult.Text = Str(Z) End Sub Private Sub cmdExit_Click() End End Sub

Программа «Сумма» Option Explicit Private Sub cmdExit_Click() End End Sub Private Sub cmdSumIt_Click() Dim I Dim R For I = 1 To vsbNum.Value Step 1 R = R + I Next txtResult.Text = Str(R) End Sub Private Sub vsbNum_Change() lblNum = "Выбранное число: " + Str(vsbNum.Value) End Sub Private Sub vsbNum_Scroll() vsbNum_Change End Sub

Программа «Таймер» Option Explicit Dim gKeepTrack Private Sub cmdEnableDisable_Click() If gKeepTrack = 1 Then gKeepTrack = 0 cmdEnableDisable.Caption = "Включить" Else gKeepTrack = 1 cmdEnableDisable.Caption = "Выключить" End If End Sub Private Sub tmrTimer_Timer() If gKeepTrack = 1 Then Beep End If End Sub Private Sub cmdExit_Click() End End Sub

Программа «Как часто?» Option Explicit Private Sub Form_MouseMove(Button As Integer, Shift As Integer,_ X As Single, Y As Single) Circle (X, Y), 40, QBColor(4) End Sub Private Sub cmdExit_Click() End End Sub

Прграмма"Кнопка" Option Explicit Private Sub imgMouse_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then txtResult.Text = “Нажата левая кнопка" End If If Button = 2 Then txtResult.Text = “Нажата правая кнопка" End If If Button = 4 Then txtResult.Text = “Нажата средняя кнопка" End If End Sub Private Sub imgMouse_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) txtResult.Text = "" End Sub Private Sub cmdExit_Click() End End Sub

Программа «Кнопка2» Option Explicit Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If (Button And 1) = 1 Then chkLeft.Value = 1 Else chkLeft.Value = 0 End If If (Button And 2) = 2 Then chkRight.Value = 1 Else chkRight.Value = 0 End If If (Button And 4) = 4 Then chkMiddle.Value = 1 Else chkMiddle.Value = 0 End If End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then chkLeft.Value = 0 End If If Button = 2 Then chkRight.Value = 0 End If If Button = 4 Then chkMiddle.Value = 0 End If End Sub Private Sub cmdExit_Click() End End Sub

Программа «Прыжок» Option Explicit Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If optSpade.Value = True Then imgSpade.Move X, Y End If If optClub.Value = True Then imgClub.Move X, Y End If If optHeart.Value = True Then imgHeart.Move X, Y End If End Sub Private Sub cmdExit_Click() End End Sub

Программа «Рисовальщик» Option Explicit Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) frmDraw.CurrentX = X frmDraw.CurrentY = Y End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Line (frmDraw.CurrentX, frmDraw.CurrentY)-(X, Y), QBColor(0) End If End Sub Private Sub cmdExit_Click() End End Sub

Программа «Тащи-бросай» Option Explicit Private Sub cmdExit_DragOver(Source As Control, X As Single, Y As Single, State As Integer) Dim sInfo As String sInfo = "Перетаскиваем " sInfo = sInfo + Source.Tag sInfo = sInfo + " через кнопку выхода." sInfo = sInfo + "Параметр State = " sInfo = sInfo + Str(State) txtInfo.Text = sInfo End Sub Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) txtInfo.Text = "" Source.Move X, Y End Sub Private Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer) Dim sInfo As String sInfo = "Перетаскиваем " sInfo = sInfo + Source.Tag sInfo = sInfo + " через форму." sInfo = sInfo + "Параметр State = " sInfo = sInfo + Str(State) txtInfo.Text = sInfo End Sub

Программа «Безразмерное меню» Option Explicit Dim gLastElement As Integer Private Sub Form_Load() gLastElement = 0 mnuRemove.Enabled = False End Sub Private Sub mnuAdd_Click() gLastElement = gLastElement + 1 Load mnuItems(gLastElement) mnuItems(gLastElement).Caption = "Пункт" + Str(gLastElement) mnuRemove.Enabled = True End Sub Private Sub mnuItems_Click(Index As Integer) MsgBox "Вы выбрали пункт " + Str(Index) End Sub Private Sub mnuRemove_Click() Unload mnuItems(gLastElement) gLastElement = gLastElement - 1 If gLastElement = 0 Then mnuRemove.Enabled = False End If End Sub

Программа «Цвет» Option Explicit Private Sub Form_Load() mnuWhite.Enabled = False mnuSmall.Enabled = False End Sub Private Sub mnuBlue_Click() frmColors.BackColor = QBColor(1) mnuBlue.Enabled = False mnuRed.Enabled = True mnuWhite.Enabled = True End Sub Private Sub mnuLarge_Click() frmColors.WindowState = 2 mnuLarge.Enabled = False mnuSmall.Enabled = True End Sub Private Sub mnuRed_Click() frmColors.BackColor = QBColor(4) mnuRed.Enabled = False mnuBlue.Enabled = True mnuWhite.Enabled = True End Sub Private Sub mnuSmall_Click() frmColors.WindowState = 0 mnuSmall.Enabled = False mnuLarge.Enabled = True End Sub Private Sub mnuWhite_Click() frmColors.BackColor = QBColor(15) mnuWhite.Enabled = False mnuBlue.Enabled = True mnuRed.Enabled = True End Sub

Программа «Сообщение» Option Explicit Private Sub cmdExit_Click() Dim Message As String Dim ButtonsAndIcons As Integer Dim Title As String Dim Response As String Message = "Вы уверены, что хотите выйти?" ButtonsAndIcons = vbYesNo + vbQuestion Title = "Сообщение программы Сообщение" Response = MsgBox(Message, ButtonsAndIcons, Title) If Response = vbYes Then End End If End Sub Private Sub cmdMessage_Click() Dim Message As String Dim ButtonsAndIcons As Integer Dim Title As String Message = "Сообщение просто так, для примера!" ButtonsAndIcons = vbOKOnly + vbExclamation Title = "Демонстрация окна сообщения" MsgBox Message, ButtonsAndIcons, Title End Sub

Программа «Общий диалог» Option Explicit Private Sub mnuColor_Click() On Error GoTo ColorError CommonDialog1.Action = 3 frmCommon.BackColor = CommonDialog1.Color Exit Sub ColorError: MsgBox "Вы закрыли диалог Цвет кнопкой Cancel(Отмена)!" Exit Sub End Sub Private Sub mnuOpen_Click() Dim Filter As String On Error GoTo OpenError Filter = "Все файлы (*.*)|*.* |" Filter = Filter + "Текстовые файлы (*.txt)|*.txt |" Filter = Filter + "Пакетные файлы (*.bat)|*.bat" CommonDialog1.Filter = Filter CommonDialog1.FilterIndex = 2 CommonDialog1.Action = 1 MsgBox "Вы выбрали: " + CommonDialog1.FileName Exit Sub OpenError: MsgBox "Вы закрыли диалог Open кнопкой Cancel(Отмена)!" Exit Sub End Sub

Программа «Фигура» Option Explicit Private Sub cmdCircle_Click() shpAllShapes.Shape = 3 End Sub Private Sub cmdExit_Click() End End Sub Private Sub cmdOval_Click() shpAllShapes.Shape = 2 End Sub Private Sub cmdRectangle_Click() shpAllShapes.Shape = 0 End Sub Private Sub cmdRndRect_Click() shpAllShapes.Shape = 4 End Sub Private Sub cmdRndSqr_Click() shpAllShapes.Shape = 5 End Sub Private Sub cmdSquare_Click() shpAllShapes.Shape = 1 End Sub Private Sub hsbWidth_Change() shpAllShapes.BorderWidth = hsbWidth.Value End Sub Private Sub hsbWidth_Scroll() shpAllShapes.BorderWidth = hsbWidth.Value End Sub