Отправляет email-рассылки с помощью сервиса Sendsay

Русский_Проект: Изучение Visual Basic

Подписаться Бесплатная «Серебряная» новостная рассылка . Подписчиков 3.885 RSS
←   Июнь 2002   →
 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


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusproject.narod.ru/
Открыта: 06-01-2001

Автор
Русский_Проект

Статистика

3.885 подписчиков
0 за неделю
←   Все выпуски   →

Русский_Проект: Изучение Visual Basic


Информационный Канал Subscribe.Ru
Русский_Проект: Рассылка Вступление
Разбор прошлых заданий
Советы

Вступление

Сегодняшний выпуск будет коротким. Наступило лето - время каникул и отпусков. Состояние у многих расслабленное. Чтобы не напрягать вас сложной информацией, обойдемся без решений новых задачек.

Разбор прошлых заданий

В прошлом выпуске я просил вас изобразить вращение маленькой окружности вокруг большой по часовой стрелке. Первым правильный ответ прислал Alexandr Kholodovitch aka DarkAngel (vartovsk@...). Вот его решение: 
Option Explicit

Dim rad As Single       'переменая угла
Const R = 2400          'радиус вращения
Const EarthR = 500      'радиус Земли
Const MoonR = 100       'радиус Луны
Const EarthX = 2700     'X-смешение Земли
Const EarthY = 2700     'Y-смешение Земли

Private Sub Form_Load()
 'Чтоб не мелькал
  If Not Me.AutoRedraw Then Me.AutoRedraw = True
  'Чтоб влез
  If Me.ScaleWidth < EarthX + MoonR + R Then Me.Width = EarthX + MoonR + R + 120
  If Me.ScaleHeight < EarthY + MoonR + R Then Me.Height = EarthY + MoonR + R + 405
Timer1.Interval = 10
  Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()
Dim x, y
rad = rad - (2 * 3.14) / 100  ' Поворачиваем
  If rad = -6.28 Then rad = 0   ' обнуляем, чтоб не свихнулся
  Me.Cls                        ' зачищаем плацдарм
  Me.Circle (EarthX, EarthY), EarthR, vbBlue ' рисуем Землю
  x = EarthX - MoonR + R * Sin(rad)  ' X-смешение Луны
  y = EarthY - MoonR + R * Cos(rad)  ' Y-смешение Луны
  Me.Circle (x, y), MoonR, vbYellow           ' рисуем Луну

End Sub

Снова разберем задачу на перестановки. Итак, даны 5 букв. Нужно из них составить все возможные слова
Продолжают поступать решения из прошлых заданий. Вот и Иван aka Atlanoff (atlanoff@...) считает, что его решение лучше предложенного в прошлом выпуске 

Option Explicit
'Рекурсивная функция с двумя операндами
'adds - накопляемая строка
's - остающаяся строка
'принцип действия:
'исходное состояние - "abcis" и ""
'Она прокручивает все буквы слова первого операнда
'и вызывает себя соответствующее число раз
'перекидывая букву из первого операнда во второй.
'в результате запусков функции
'образуют дерево всех решений задачи
'и когда остаётся одна буква, то можно остановиться
Sub Roll(ByVal s As String, ByVal adds As String)
    Dim i 'счётчик
    If Len(s) = 1 Then
        'если осталась одна буква,
        'то один результат готов.
        'складываем и переправляем на печать
        Debug.Print adds & s
    Else
        'прокручиваем цикл по всем оставшимся буквам
        For i = 1 To Len(s)
            'из s убираем i-букву
            'в adds добавляем i-букву из оставшихся
            Roll Mid(s, 1, i - 1) & Mid(s, i + 1), adds & Mid(s, i, 1)
        Next i
    End If
End Sub

Private Sub Command1_Click()
    'накоплено - ничего
    'осталось прокручивать всю строку
    Roll "abcis", ""
End Sub
Выбирайте сами, чье решение лучше.

Советы

В одном из прошлых выпусков мы уже рассказывали, как развернуть окно на весь экран, включая и панель задач. Для этого нам приходилось присваивать свойству формы BorderStyle значение None. Если же вам необходимо развернуть на весь экран форму с заголовком, то используем функцию GetSystemMetrics: 
' Код для Form_Load
Dim wid As Long
Dim hgt As Long

' Получим размеры экрана, включая панель задач
wid = GetSystemMetrics(SM_CXSCREEN)
hgt = GetSystemMetrics(SM_CYSCREEN)

' Подгоняем форму под этот размер
Move 0, 0, _
        ScaleX(wid, vbPixels, vbTwips), _
        ScaleY(hgt, vbPixels, vbTwips)

Вот и все на сегодня!

Присылайте ваши предложения по адресу vbasic@rambler.ru
Посетите сайт Русский_Проект, где вы найдете другую интересную информацию
Давайте делать рассылку вместе! Счастливого вам программирования!

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное