Студопедия

Главная страница Случайная страница

Разделы сайта

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






Бегущая строка 2






Простая бегущая строка может комута годится. И так На форму кинте Textbox(назавите t1), CommandButton(назавите Комманда 1), Label (Назавите statusbar), Timer (название таки оставим timer1, интервал - 100) и вот код:

Private Type snaplablabel As String End Type Private mega As snaplab Public Sub go1(lab)statusbar.Caption = " " 'очищаем mega.label = labtimer1.Enabled = -1 'включаем таймер End SubPrivate Sub Form_Unload(Cancel As Integer) EndEnd SubPrivate Sub timer1_Timer() 'считывание a1 = Len(mega.label)a2 = Len(statusbar.Caption) If a1 = a2 Then 'если уже конец: -( timer1.Enabled = FalseExit SubEnd If 'смотрим: чаво бы добавить? a3 = Left(mega.label, a2 + 1)statusbar.Caption = a3 End SubPrivate Sub Комманда1_Click()go1 t1.Text 'вызываем строку End Sub

 

Калькулятор на одном TextBox

Option Explicit Dim sngBufA As Single Dim sngBufB As Single Dim strZnak As String Private Sub Command1_Click() On Error Resume Next sngBufB = Val(Me. txtCalc.Text) Select Case strZnak Case Is = (" +") Me. txtCalc.Text = (sngBufA + sngBufB) Case Is = (" -") Me. txtCalc.Text = (sngBufA - sngBufB) Case Is = (" /") Me. txtCalc.Text = (sngBufA / sngBufB) Case Is = (" *") Me. txtCalc.Text = (sngBufA * sngBufB) End SelectEnd Sub Private Sub cmdPlus_Click() If Me. txtCalc.Text = (" ") Then MsgBox " Укажите число! ", 32, " Info..." Exit Sub End If sngBufA = Val(Me. txtCalc.Text) strZnak = (" +") Me. txtCalc.Text = (" "): Me. txtCalc.SetFocus End Sub Private Sub Command2_Click() If Me. txtCalc.Text = (" ") Then MsgBox " Укажите число! ", 32, " Info..." Exit Sub End If sngBufA = Val(Me. txtCalc.Text) strZnak = (" -") Me. txtCalc.Text = (" "): Me. txtCalc.SetFocus End Sub Private Sub Command3_Click() If Me. txtCalc.Text = (" ") Then MsgBox " Укажите число! ", 32, " Info..." Exit Sub End If sngBufA = Val(Me. txtCalc.Text) strZnak = (" /") Me. txtCalc.Text = (" "): Me. txtCalc.SetFocus End Sub Private Sub Command4_Click() If Me. txtCalc.Text = (" ") Then MsgBox " Укажите число! ", 32, " Info..." Exit Sub End If sngBufA = Val(Me. txtCalc.Text) strZnak = (" *") Me. txtCalc.Text = (" "): Me. txtCalc.SetFocus End Sub Private Sub txtCalc_Change() Dim stxtCalc As String stxtCalc = Me. txtCalc.Text If Not IsNumeric(stxtCalc) Then Me. txtCalc.Text = (" ") End IfEnd Sub Private Sub Form_Load() With Me. Caption = (" Каклькулятор").txtCalc.Text = (" ") End WithEnd Sub

 

Получение своего IP

Option Explicit Dim HTMLCode As String 'переменная для хранения кода страницы Private Sub Command1_Click() Winsock1.RemotePort = 80 ' устанавливаем порт сервера 80 Winsock1.RemoteHost = " ippages.com" 'Хост Winsock1.Connect ' Подключаемся Label4.Caption = Winsock2.LocalIPEnd Sub Function CutIP(HTML As String) As StringDim p1 As Integer p1 = InStr(HTML, " Content-Type: text/html") CutIP = Trim(Mid(HTML, p1 + 27, Len(HTML) - p1 - 23))End Function Private Sub Label1_Click() End Sub Private Sub Winsock1_Close() 'Событие генерируется при закрытии Канала связи Form1.Caption = " Не подключен" 'Просто сообщаем о том что не подключены Winsock1.CloseEnd Sub Private Sub Winsock1_Connect() 'Событие генерируется при подключении Form1.Caption = " Подключение" 'Подключены 'Посылаем запрос на сервер выдающему наш IP Winsock1.SendData " GET " + " /simple/" + " HTTP/1.0" + Chr(10) + Chr(10)End Sub 'Событие генерируется когда нам приходят данныеPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)Dim Temp As String Winsock1.GetData HTMLCode Label1.Caption = CutIP(HTMLCode)End Sub

 

Чтение и изменение имени компьютера

'API для чтения имени компьютераPrivate Declare Function GetComputerName Lib " kernel32" Alias " GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long' API для изменения имени компьютераPrivate Declare Function SetComputerName Lib " kernel32" Alias " SetComputerNameA" _ (ByVal lpComputerName As String) As Long 'Изменяем имя компьютераPrivate Sub Command1_Click() Call SetComputerName(" Напишите новое имя компьютера")End Sub 'Читаем имя компьютераPrivate Sub Form_Load() strComputerNmame$ = Space(255) lngBuf& = GetComputerName(strComputerNmame$, 255) strComputerNmame$ = Trim(strComputerNmame$) Label1.Caption = (strComputerNmame)End Sub

 

Узнаем разрешение экрана

Private Sub Form_Load() Dim lngX As Single, lngY As Single lngX = Screen.Width / Screen.TwipsPerPixelX lngY = Screen.Height / Screen.TwipsPerPixelY Me. Label1.Caption = (lngX & " x " & lngY) End Sub

 






© 2023 :: MyLektsii.ru :: Мои Лекции
Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав.
Копирование текстов разрешено только с указанием индексируемой ссылки на источник.