Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Visual Basic (VB).

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

Открыть новую тему     Написать ответ в эту тему

NEOMATRIX



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору


Данный топик предназначен только для обсуждения типовых задач на Visual Basic.
Обсуждение задач на VBA (а именно, Excel, Word, Access) строго запрещено!
Пишите в соответствующих топиках.

 
Родственные топики:
  • Excel VBA - часть 1, часть 2 - все вопросы по Excel VBA туда
  • Word VBA все вопросы по Word VBA туда
  • Access все вопросы по программированию в Access туда
  • VBScript - программирование "удобняшек" на VBScript
  • QBasic - типовые задачи на QBasic
     
  • Date Time Functions In Visual Basic
  • VB6's Trig, Math, Financial, Boolean, and Random functions
  • Visual Basic 6 String Functions
  • VB6 Number System Functions (Hex, Oct, Etc)
  • VB6's DateAdd function
     
  • Functions (Visual Basic)
  • Keywords and Members by Task
  • Visual Basic Reference
     
  • Visual Basic String Manipulation Tutorials
     
  • Top 10 Visual Basic Sins

     
    Учебники:
    Visual Basic для студентов и школьников. Культин Н. (2010)
    Занимательное программирование на Visual Basic.NET. Климов А. (2005)
    Visual Basic в задачах и примерах. Сафронов (2009)
    Visual Basic 2012 на примерах. Зиборов В. (2012)

  • Всего записей: 202 | Зарегистр. 29-12-2004 | Отправлено: 19:30 16-11-2005 | Исправлено: XPerformer, 10:07 28-10-2014
    AndVGri

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Grindylow
    Держи, горе луковое
     
    Public Sub TestMenders(ByVal a As Double, ByVal b As Double, ByVal c As Double, _
                           ByVal t As Double, ByVal k As Double, _
                           ByVal X As Double, ByVal Y As Double)
        Dim Yb As Double, Yc As Double, Result As Boolean
         
        If t = k Then MsgBox "Параметры t и k совпадают", vbExclamation, "Ошибка": Exit Sub
        If b = c Then MsgBox "Параметры b и с совпадают", vbExclamation, "Ошибка": Exit Sub
        Result = True
        'Проверка изделия по диапазону X
        If t < k Then
            If (X < t) Or (X > k) Then Result = False
        Else
            If (X < k) Or (X > t) Then Result = False
        End If
         
        'Проверка изделия по диапазону Y
        If Result Then
            Yb = a * X + b
            Yc = a * X + c
            If Yb < Yc Then
                If (Y < Yb) Or (Y > Yc) Then Result = False
            Else
                If (Y < Yc) Or (Y > Yb) Then Result = False
            End If
        End If
        'Вывод результата
        If Result Then
            MsgBox "Норма", vbInformation, "Результат"
        Else
            MsgBox "Брак", vbInformation, "Результат"
        End If
    End Sub

    Всего записей: 750 | Зарегистр. 14-12-2005 | Отправлено: 11:14 12-03-2007
    DLysenko



    Newbie
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Господа,
    подскажите плиз в какую сторону копать...
    есть файл, в котором существуют координаты в виде 11111-11111
    Так же через двоеточие ставиться исследованы ли эти координаты или нет...
    То есть 11111-11111:1
    Так вот, нужно сделать карту в формате x-y соответственно каждой координате взятой из файла будет соответствовать рисунок (исследовано, неисследовано)
    Собственно теперь вопрос
    Какие для этого использовать функции и где можно нарыть подобные примеры.
    Я просто перерыл несколько форумов, несколько сайтов с исходниками, пододбного ничего не нашел.
    Пытался сделать данную фишку через Frame1. Незнаю прально ли я "копаю" или нет.
    Словом подскажите плиз.

    Всего записей: 21 | Зарегистр. 19-03-2006 | Отправлено: 05:41 15-03-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    В чем проблема то? Берешь массив, заполняешь его элементами. На основе размера массива делаешь DC для карты. Размер карты по х = размер рисунка по х * количество элементов карты по х, размер карты по y = размер рисунка по y * количество элементов карты по y.
    В цикле прогоняешь BitBlt, координаты расчитывай как номер элемента * размер элемента

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 10:13 15-03-2007
    DLysenko



    Newbie
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    хм, не совсем понял что значит кол-во элементов по х и у.
    Просто таких "точек" на карте будет несколько тысяч. (где то порядка 80000)
    Координаты от 0 до 45000. То же самое и по у.
    Насколько обработка будет быстрой???

    Всего записей: 21 | Зарегистр. 19-03-2006 | Отправлено: 11:02 15-03-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    карта состоит из квадратов 45000*45000, а быстрее BitBlt только прямое копирование памяти.
    Вообще хотелось бы понять что за карта, ее размеры в пикселях, размеры наносимых рисунков, и соответствуют ли единицы измерения координат пикселам?

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 09:44 16-03-2007
    DLysenko



    Newbie
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    ну соответствовать врят ли все будет, так как рисунки будут занимать тоже определенный размер пикселей...
    Сегодня попробую выложить у себя на сайте графический русунок части карты....

    Всего записей: 21 | Зарегистр. 19-03-2006 | Отправлено: 09:02 19-03-2007
    ROWDYEST

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    DroN_S
     
    дай ссылку на книжку решил учиться [если не в лом]....
     

    Всего записей: 6 | Зарегистр. 19-03-2007 | Отправлено: 21:56 19-03-2007
    lapulechka

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Ребят, помогите, plz, совсем не шарю в VB 06!!! Задачка: Найти наименьшее общее кратное 3 заданных натуральных чисел.

    Всего записей: 20 | Зарегистр. 26-03-2007 | Отправлено: 22:48 26-03-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    lapulechka
    математический алгоритм дай, сделаем в бейсике
     
     

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 18:02 28-03-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    AndronH
    раскладываешь на множители и сравниваешь (выкидываешь лишние) -- вот и весь алгоритм
     
    lapulechka

    Код:
     
    Option Base 1
    Option Explicit
    'определение трёх глобальных динамических массивов, в которых будут храниться множители
    Dim tA() As Integer, tB() As Integer, tC() As Integer
     
    Private Sub Form_Load()
        'Найти наименьшее общее кратное 3 заданных натуральных чисел.
        'Integer -- -32,768 .. 32,767
        'Currency (scaled integer) -- -922,337,203,685,477.5808 .. 922,337,203,685,477.5807
        Dim a As Integer, b As Integer, c As Integer, i As Integer, s As Currency
         
        'инициализация переменных... Задаём 3 натуральных числа
        a = 7
        b = 17
        c = 34
         
        'начинается поиск множителей НОК трёх чисел
        Call srcNOK(a, b, c)
         
        'перемножение найденных множителей
        s = 1
         
        For i = 1 To UBound(tA)
         
            s = s * tA(i)
         
        Next i
         
        'Form1.Hide
         
        'результат перемножения выводится на экран
        MsgBox s, vbOKOnly + vbInformation, "Результат"
         
        'выход из программы
        End
     
    End Sub
     
    Sub srcNOK(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer)
     
        'проверка исходных данных
        'если числа не натуральные, выдаётся сообщение об ошибке и производится выход из программы
        If (a < 1) Or (b < 1) Or (c < 1) Then MsgBox "Wrong values": Exit Sub
         
        'инициализация массивов
        ReDim tA(1): tA(1) = 1
        ReDim tB(1): tB(1) = 1
        ReDim tC(1): tC(1) = 1
         
        'заполнение массивов множителями соответствующих чисел
        Call fillArray(a, tA)
        Call fillArray(b, tB)
        Call fillArray(c, tC)
         
        'сравнение множителей чисел a и b
        'результат -- множители НОК -- будет сохранён в массиве tA
        Call cmpArr(tA, tB)
        'сортировка массива tA
        Call sortArr(tA)
        'сравнение промежуточного результата (массив tA) с массивом множителей числа c
        Call cmpArr(tA, tC)
     
    End Sub
     
    'ищутся множители числа
    Sub fillArray(ByVal n As Integer, ByRef tN() As Integer)
        Dim i As Integer, k As Integer
         
        i = 2
        k = 2
         
        Do While (n > 1) And (i <= n)
         
            If (n Mod i) = 0 Then
             
                'если число без остатка делится на текущее значение
                'целочисленной переменной i,
                'значит i -- один из множителей числа
                ReDim Preserve tN(k)
                tN(k) = i
                k = k + 1
                 
                'далее проверяется результат деления числа на множитель
                n = n / i
                 
                'целочисленная переменная i инициализируется заново
                i = 2
                 
            Else
             
                'если число не делится на i, переходим к следующему i
                i = i + 1
             
            End If
         
        Loop
     
    End Sub
     
    'сравнение массивов
    Sub cmpArr(ByRef tN1() As Integer, ByRef tN2() As Integer)
        Dim i1 As Integer, i2 As Integer, k As Integer, j As Integer
         
        'инициализация индексов массивов
        i1 = 1
        i2 = 1
         
        Do While (i1 <= UBound(tN1)) And (i2 <= UBound(tN2))
         
            'если элементы массивов (множители) одинаковы,
            'элемент второго массива зануляется,
            'производится переход к следующим элементам обоих массивов
            If tN1(i1) = tN2(i2) Then
             
                i1 = i1 + 1
                tN2(i2) = 0
                i2 = i2 + 1
             
            'если текущий элемент первого массива больше текущего элемента
            'второго массива, то производится переход к следующему элементу
            'второго массива
            ElseIf tN1(i1) > tN2(i2) Then
             
                i2 = i2 + 1
             
            'если текущий элемент второго массива больше текущего элемента
            'первого массива, то производится переход к следующему элементу
            'первого массива
            Else
             
                i1 = i1 + 1
             
            End If
         
        Loop
         
        i1 = UBound(tN1)
        k = 0
         
        'проверяется число ненулевых элементов второго массива
        For i2 = 1 To UBound(tN2)
         
            If tN2(i2) > 0 Then k = k + 1
         
        Next i2
         
        'если во втором массиве есть ненулевые элементы, то
        'переопределяется размер первого массива (увеличивается --
        'ровно на количество ненулевых элементов второго массива)
        'и ненулевые элементы второго массива добавляются в конец первого массива
        '(во втором массиве занулены элементы/множители, которые уже были в первом массиве)
        If k > 0 Then
             
            ReDim Preserve tN1(i1 + k)
             
            j = 1
            i2 = 1
             
            For i2 = 1 To UBound(tN2)
             
                If tN2(i2) > 0 Then
                 
                    tN1(i1 + j) = tN2(i2)
                    j = j + 1
                 
                End If
             
            Next i2
             
        End If
     
    End Sub
     
    'сортировка массивов
    Sub sortArr(ByRef tN() As Integer)
        Dim i As Integer, j As Integer, k As Integer
         
        'если в массиве всего один элемент -- сортировка не производится
        '(выход из процедуры сортировки)
        If UBound(tN) = 1 Then Exit Sub
         
        For i = 2 To UBound(tN)
         
            For j = 1 To i - 1
             
                If tN(j) > tN(i) Then
                     
                    k = tN(i)
                    tN(i) = tN(j)
                    tN(j) = k
                     
                End If
             
            Next j
         
        Next i
     
    End Sub
     
     

     
    мне таки лень было писать разумные комментарии, так что какие есть

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 14:13 29-03-2007
    Molvino

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Молодые люди, помогите, пожалуйста, бедной девушке с курсовиком))
     
    Решите  две  задачки, а?  Они  нетрудные,наверное, даже очень легкие но это не мое. Буду очень благодарна.
     
    Задача №1
     
    Напечатать первые n натуральных чисел, которве при удалении последней  цифры уменьшаются в челое число раз. Вывести на экран эти числа с указанием во сколько раз они уменьшаются.
     
    Забача №2
     
    Дан массив n целых чисел. Если  в массиве четные и нечетные числа чередуются, то создается новый массив, все члены которого умножаются на его минимальный элемент, в противном случае новый массив не содается. Для вывода массива пользоваться элементом управления LIST
     

    Всего записей: 2 | Зарегистр. 29-03-2007 | Отправлено: 23:50 29-03-2007
    lapulechka

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ОГРОМНОЕ СПАСИБИЩЕ!!!

    Всего записей: 20 | Зарегистр. 26-03-2007 | Отправлено: 00:54 30-03-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Molvino

    Цитата:
    Забача №2
    ...
    Для вывода массива пользоваться элементом управления LIST

    оО
    Что в листбокс-то выводится?.. Только новый массив, если таковой должен будет быть?..
     

    Цитата:
    Задача №1


    Код:
     
    Private Sub Form_Load()
         
        'поиск первых 27 членов требуемой последовательности
        Call fun1(27)
     
    End Sub
     
    Sub fun1(ByVal n As Integer)
        'Напечатать первые n натуральных чисел, которве при удалении последней
        'цифры уменьшаются в челое число раз. Вывести на экран эти числа с
        'указанием во сколько раз они уменьшаются.
        Dim i As Integer, k As Integer
         
        If n < 1 Then
         
            MsgBox "Wrong values", vbOKOnly + vbCritical, "Warning"
            Exit Sub
         
        End If
         
        'первое проверяемое число -- 10, по вполне понятным причинам
        'но можно начинать и с i=1, только при этом придётся изменить
        'цикл while следующим образом:
        '
        '    Do While k < n
        '    
        '        If i >= 10 Then
        '    
        '            If (i Mod (i \ 10)) = 0 Then
        '            
        '                k = k + 1
        '                MsgBox i & " (уменьшается во столько раз: " & (i \ (i \ 10)) & ")", _
        '                vbOKOnly + vbInformation, k & "-й член последовательности"
        '            
        '            End If
        '            
        '        End If
        '        
        '        i = i + 1
        '    
        '    Loop
        '
        i = 10
        k = 0
         
        Do While k < n
         
            If (i Mod (i \ 10)) = 0 Then
             
                k = k + 1
                MsgBox i & " (уменьшается во столько раз: " & (i \ (i \ 10)) & ")", _
                vbOKOnly + vbInformation, k & "-й член последовательности"
             
            End If
             
            i = i + 1
         
        Loop
     
    End Sub
     

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 07:57 31-03-2007
    Molvino

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Legio,   Спасибо))
     
    Насчет второй..не очень поняла вопрос...но в листбокс выволится массив, который получился)) Я ответила?)))

    Всего записей: 2 | Зарегистр. 29-03-2007 | Отправлено: 20:34 31-03-2007
    lapulechka

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Дорогой Legio,  спасибо тебе, за решение задачки, она действует! Но в универе её не оценили. Короче сказали сделать попроще- без массивов и чтобы эти натуральные числа можно было вводить. Я честно билась над этим 2 ночи (к тебе опять неудобно было обращаться).  Но ничего не получилось. И поэтому я, такая бессовестная личность, молю тебя о помощи! ray

    Всего записей: 20 | Зарегистр. 26-03-2007 | Отправлено: 00:40 02-04-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    lapulechka
    А без массивов скучно... =__=
     
    (Соответственно, чтобы оно работало на форме должны быть три TextBox'а -- называющиеся Text1, Text2 и Text3; и CommandButton -- Command1)

    Код:
    Option Explicit
     
    Private Sub Command1_Click()
        Dim tRes As Integer
         
        'если в текстовых полях введены числа, вычисляется НОК
        'в противном случае выводится сообщение об ошибке
        If IsNumeric(Text1.Text) And IsNumeric(Text2.Text) And IsNumeric(Text3.Text) Then
             
            'контроля ввода нет:
            'если в текстовое поле будет введено не натуральное число,
            'оно будет окрулено до целого (вроде бы )
            tRes = srcNOK(Text1.Text, Text2.Text, Text3.Text)
             
            'если НОК не равен нулю, результат вычисления выводится на экран
            If tRes > 0 Then MsgBox "НОК данных чисел равно " & tRes
         
        Else
             
            MsgBox "Wrong values", vbOKOnly + vbCritical, "Warning"
         
        End If
     
    End Sub
     
    Private Sub Form_Load()
         
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
     
    End Sub
     
    Function srcNOK(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer) As Currency
        Dim i As Integer, tRes As Currency
         
        'если любое из заданных чисел окажется меньше единицы
        'выдаётся сообщение об ошибке и возвращается
        If a < 1 Or b < 1 Or c < 1 Then
             
            MsgBox "Wrong values", vbOKOnly + vbCritical, "Warning"
            srcNOK = 0
            Exit Function
         
        End If
         
        i = 2
         
        tRes = 1
         
        'пока хоть одно из чисел больше, чем i, продолжается поиск множителей
        Do While (i <= a) Or (i <= b) Or (i <= c)
             
            'если хоть одно число делится на i без остатка
            'значит это
            If ((a Mod i) * (b Mod i) * (c Mod i)) = 0 Then
                 
                'тогда программа пытается каждое из чисел разделить на i
                If a Mod i = 0 Then a = a \ i
                If b Mod i = 0 Then b = b \ i
                If c Mod i = 0 Then c = c \ i
                 
                'потом умножает промежуточный результат на переменную i
                tRes = tRes * i
                 
                'и сбрасывает значение переменной i в значение 2
                i = 2
             
            Else
                 
                'в противном случае проверяется следующее значение переменной i (увеличенное на 1)
                i = i + 1
             
            End If
         
        Loop
         
        'окончательный результат возвращается
        srcNOK = tRes
     
    End Function

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 18:31 04-04-2007
    KRIVIZNA

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    привет,помогите написать програму!!!
    совсем горю!
    Нужно определить функцию,устанавливающую вид взаимного расположения двух прямых на плоскости.
    препод сказал,что выглядит примерно это так:
    у=k1x1+b1
    y2=k2x2+b2

    Всего записей: 1 | Зарегистр. 03-04-2007 | Отправлено: 21:34 04-04-2007
    lapulechka

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Legio, Ты просто мой Спаситель! Мне вообще это назавтра надо, я сёдня все книги перерыла,  кое-что получилось, но кое-что и глючило. А теперь с твоей помощью я завтра всё успешно сдам!

    Всего записей: 20 | Зарегистр. 26-03-2007 | Отправлено: 00:29 05-04-2007
    AndronH



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Если без массива то примерно так
     
     
    Option Explicit
    Private Sub Form_Load()
        Dim a As Integer, b As Integer, c As Integer, i As Integer, s As Currency
        'инициализация переменных... Задаём 3 натуральных числа
        a = 7
        b = 17
        c = 34
    For s = 1 To a * b * c
        If (s Mod a = 0) And (s Mod b = 0) And (s Mod c = 0) Then
            MsgBox s: Exit For
        End If
    Next s
    End Sub
     
    только работает медленней и при очень больших числах переполнение
     
    Добавлено:
    KRIVIZNA
    а какой результат должна возвращать функция? пересекаются ли? под каким углом? в какой точке?
     

    Всего записей: 21 | Зарегистр. 14-12-2006 | Отправлено: 16:19 06-04-2007 | Исправлено: AndronH, 16:22 06-04-2007
    Legio



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    AndronH

    Цитата:
    только работает медленней и при очень больших числах переполнение

    Не должно быть переполнения. Currency ажно в несколько десятков раз перекрывает Integer в кубе.

    Всего записей: 695 | Зарегистр. 01-08-2003 | Отправлено: 18:52 06-04-2007
    Открыть новую тему     Написать ответ в эту тему

    Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

    Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Задачи на Visual Basic (VB).


    Реклама на форуме Ru.Board.

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.B0ard
    © Ru.B0ard 2000-2024

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru