Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.06.2009, 05:59   #21
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию Стробоскопию — в массы!

Дальнейшее развитие «ежетворения». Вводить лучше числа порядка нескольких сотен. Запуск по Alt-G.

Код:
Sub Precession() 'Макрос записан 18.06.2009'
'Рисует в документе (при нечётном N) N "кручёных" линий либо N/2 линий (при N чётном).'
    Const RoX = 200, RoY = 200, pi = 3.1415926535898
    Static unite As Integer, ShiftX As Boolean, ShiftY As Boolean
    Dim x() As Single, y() As Single                        'массивы абсцисс и ординат'
    Dim k As Integer, Nn As Integer, N As Integer, nS As String
    
    nS = Val(InputBox("How many lines (3 " & Chr(151) & " 1111)?", "InputBox", 111))
    If IsNumeric(nS) = False Then Exit Sub          'ВЫХОД, если ввели не число'
    N = CInt(nS)                'размерность массивов получает целые значения (N + 1)'
    If nS < 3 Then Exit Sub
    
    If N > 1111 Then If MsgBox(FAQ(1), vbCritical + vbYesNo) = vbNo Then Exit Sub
    
    If Not (ShiftX Or ShiftY) Then
    If MsgBox(FAQ(2), vbQuestion + vbYesNo) = vbYes Then ShiftX = True: ShiftY = True
    End If
    
    ReDim x(N) 'установка размерности - количество вычисляемых точек = N + 1'
    ReDim y(N) '(от нулевой - начальной - до N-й, с координатами (x(N);y(N))'
    
    
    Select Case ShiftX And ShiftY 'выбор того, перемещать ли центр рисуемых отрезков'
    Case True
            For Nn = 0 To N
            x(Nn) = RoX * Cos(Nn * 2 * pi / N) + 200 + Nn / 8
            y(Nn) = RoY * Sin(Nn * 2 * pi / N) + 220
            Next
    Case False
            For Nn = 0 To N
            x(Nn) = RoX * Cos(Nn * 2 * pi / N) + 300
            y(Nn) = RoY * Sin(Nn * 2 * pi / N) + 220
            Next
    End Select
    
    With ActiveDocument.Shapes
            For k = 1 To N / (2 - N Mod 2)
                .AddLine(x(k) + k Mod 20, y(k), _
                x((k + N \ 2) Mod N) + k Mod 20, y((k + N \ 2) Mod N)).Select
                
                If k Mod 10 = 0 Then
                Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, k Mod 255)
                'окрашивание каждой 20-й линии'
                End If
            Next
        If Not unite = vbYes Then unite = MsgBox(FAQ(3), vbQuestion + vbYesNo)
        If unite = vbYes Then .SelectAll: Selection.ShapeRange.Group.Select
    End With
End Sub


Function FAQ(QNumber) As String
    Select Case Application.Keyboard 'индикатор раскладки клавиатуры'
    Case 68748313 'русская раскладка'
        Select Case QNumber
        Case 1: FAQ = "Это много! Надо?"
        Case 2: FAQ = "Перемещать центр вращения?"
        Case 3: FAQ = "Группировать стороны?"
        End Select
    Case Else
        Select Case QNumber
        Case 1: FAQ = "It needs time! Sure?"
        Case 2: FAQ = "Wanna add moving axe?"
        Case 3: FAQ = "Group lines forever?"
        End Select
    End Select
End Function
При вводе 2222 (а это 1111 линий) у меня рисуется, на чистом экране, секунд за 8 (при 2,3 ГГц). Затем ещё секунды 4 линии группируются — и становятся видимыми.

Вообще, все другие фигуры, перед запуском, лучше стирать, иначе они тоже сгруппируются.
Вложения
Тип файла: doc Strobo.doc (40.5 Кб, 26 просмотров)
Тип файла: doc Stroboline.doc (36.0 Кб, 26 просмотров)

Последний раз редактировалось Sasha_Smirnov; 18.06.2009 в 04:44. Причина: усовершенствание.
Sasha_Smirnov вне форума Ответить с цитированием
Старый 18.06.2009, 04:49   #22
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию

Код:
If k Mod 10 = 0 Then
Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, k Mod 255)
'окрашивание каждой 10-й линии'
End If
А всё такое никчёмно-заумное есть в том числе и на http://arbuz.uz/!

Последний раз редактировалось Sasha_Smirnov; 18.06.2009 в 06:16. Причина: поправка комментария в предыдущем листинге.
Sasha_Smirnov вне форума Ответить с цитированием
Старый 18.06.2009, 20:42   #23
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию „Полёт шмеля” в векторной графике

Придумал как изобразить полёт биты. Или бумеранга.

С т. зр. программирования — ещё пара приёмчиков. Просмотр кода по Alt-F11.

Напоминаю, что перед запуском (по Ctrl-S) старый рисунок лучше удалять, — так быстрее.
Вложения
Тип файла: doc Strobolines.doc (94.5 Кб, 29 просмотров)

Последний раз редактировалось Sasha_Smirnov; 19.06.2009 в 02:23. Причина: поменял Ctrl-G на Ctrl-S. Спасибо Sazary! (Заодно и учтём полезную команду Ctrl-G!)
Sasha_Smirnov вне форума Ответить с цитированием
Старый 19.06.2009, 02:02   #24
Sazary
В тени
Старожил
 
Аватар для Sazary
 
Регистрация: 19.12.2008
Сообщений: 5,788
По умолчанию

Красивые картинки получаются )




Цитата:
Сообщение от Sasha_Smirnov
Напоминаю, что перед запуском (по Ctrl-G)
Наверное, все-таки по Ctrl-S )
Вполне очевидно, чтобы что-то понять, необходимо книги читать.
Не нужно плодить бессмысленных тем. Вас Поиск избавит от многих проблем.

___________________________________ ___________________________________ _______
[=Правила форума=]_____[Поиск]_____[Литература по С++]____[Литература. Паскаль]
Sazary вне форума Ответить с цитированием
Старый 20.10.2011, 13:52   #25
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию Формула сосновой шишки

Тот же генератор, что вначале, но другие настройки. Запуск по F12.

Нечто напоминающее шишки таксодиевых (http://ru.wikipedia.org/wiki/Таксодиевые), особенно если залить буро-зелёным, не так ли?
Вложения
Тип файла: doc k=99_A=50.doc (87.0 Кб, 15 просмотров)
Sasha_Smirnov вне форума Ответить с цитированием
Старый 20.10.2011, 14:13   #26
Пименов Александр
Форумчанин
 
Регистрация: 17.11.2010
Сообщений: 222
По умолчанию

Вообще, ребята Вы меня поражаете!!! Текстовый редактор загружать такими проблемами, установите Corel, он использует тоже VBA редактор и развлекайтесььььььььььь...........
Пименов Александр вне форума Ответить с цитированием
Старый 20.10.2011, 16:25   #27
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию

Спасибо, тёзка. Отнесли меня к каким-то ребятам! Аналогов (пока) нет. Ну есть там виджет для Оперы (спирограф), но он не лучше, притом тормозит (из-за анимации), вот как тут: http://ru.wikipedia.org/wiki/Гипоциклоида

Я бы с радостью запустил его под Corel Draw, — да как его тогда посмотреть... а Word имеет всяк сюда зашедший.

Последний раз редактировалось Sasha_Smirnov; 21.10.2011 в 14:07. Причина: ссылка.
Sasha_Smirnov вне форума Ответить с цитированием
Старый 26.02.2014, 22:51   #28
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию Орденская лента

Пока Corel не Draw, продолжу-таки развлечения в Word.

Исправил* баг с треугольной фигурой из документа раскидай (http://programmersforum.ru/showthread.php?t=72695#9).

Открыть. Нажать F5... Отпустить F5:
___________
* ещё в 2013-м
Вложения
Тип файла: doc F5_рис.doc (36.5 Кб, 10 просмотров)
Sasha_Smirnov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вытаскивание слов из автофигур Busine2009 Microsoft Office Word 4 28.05.2009 07:15
Рисование графиков в Microsoft Word AleksP Microsoft Office Word 1 19.09.2008 07:50
Как настроить печать автофигур в ms word??? 181988 Помощь студентам 1 08.09.2008 13:42
Кто может скинуть инфу о XmL-документах Parcenson Общие вопросы Delphi 4 27.08.2008 15:34