| Вопрос: Расчет биоритмов | Добавлено: 16.01.09 13:57 |
Автор вопроса:  Андрей
|
|
Сегодня для сотрудницы написал программку, рассчитывающую биоритмы. Хотел удалить, но подумал, вдруг, кто-то учтет восход-заход солнца, лунные фазы, движение планет и… выдаст небольшую программу. Чтоб как в РПГ торчал индикатор на рабочем столе и, дергаясь, показывал уровень здоровья и количество маны.
Обязательное условие: самая нижняя полоска должна показывать УДАЧУ! Чтоб посмотрел – и пошел играть на Forex’е)) На форму кинуть один CommandButton и три ComboBox. Dim i As Double Dim Date0 As Date Private Sub Form_Load() i = Year(Date) - 100: Do While i <= Year(Date) Combo1.AddItem i i = i + 1: Loop i = 1: Do While i <= 12 Combo2.AddItem MonthName(i) i = i + 1: Loop Combo1.ListIndex = 100 - 26 '26 лет исполнися в текущем году Combo2.ListIndex = 2 - 1 '2-ой месяц Date0 = "1." & Combo2.ListIndex + 1 & "." & Year(Date) - 100 + Combo1.ListIndex i = 1: Do While i <= Day(DateAdd("d", -1, (DateSerial(Combo1.Text, Month(DateAdd("M", 1, Date0)), 1)))) Combo3.AddItem i i = i + 1: Loop Combo3.ListIndex = 7 - 1 '7-ой день End Sub Private Sub Combo2_Click() 'изменение количества дней в месяце Date0 = "1." & Combo2.ListIndex + 1 & "." & Year(Date) - 100 + Combo1.ListIndex i = 1: Do While i <= Day(DateAdd("d", -1, (DateSerial(Combo1.Text, Month(DateAdd("M", 1, Date0)), 1)))) Combo3.AddItem i i = i + 1: Loop End Sub Private Sub Command1_Click() Date0 = Combo3.Text & "." & Combo2.Text & "." & Combo1.Text Cls Scale (-CDbl(16), CDbl(100))-(CDbl(16), -CDbl(100)) 'устанавливаем пределы шкалы 'рисуем сетку и шкалу i = -16: Do While i <= 16 DoEvents ForeColor = &HE0E0E0 Line (i, -80)-(i, 100) 'рисуем сетку ForeColor = &H0& Line (i, -80)-(i, -83) 'рисуем деления шкалы FontName = "Times New Roman": FontSize = 5 CurrentX = i - 0.1: CurrentY = -85 'подписываем деления шкалы Dim Days As Double 'количество дней в текущем месяце Days = Day(DateAdd("d", -1, (DateSerial(Year(Date), Month(DateAdd("M", 1, Date)), 1)))) If i + Day(Date) > Days Then Print i + Day(Date) - Days Else If i + Day(Date) <= 0 Then Print i + Day(Date) + Days Else Print i + Day(Date) End If End If i = i + 1: Loop Line (-16, -80)-(16, -80) 'рисуем шкалу ForeColor = &HE0E0E0 Line (-16, 0)-(16, 0) 'рисуем ось абсцисс 'интуитивный цикл ForeColor = &HFFFF& CurrentX = -16 CurrentY = Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + CurrentX) / 37.901499) * 50 i = -16: Do While i <= 16 DoEvents Line -(i, Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + i) / 37.901499) * 50) i = i + 0.1: Loop 'физический цикл ForeColor = &HFF& CurrentX = -16 CurrentY = Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + CurrentX) / 23.688437) * 50 i = -16: Do While i <= 16 DoEvents Line -(i, Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + i) / 23.688437) * 50) i = i + 0.1: Loop 'эмоциональный цикл ForeColor = &HFF00& CurrentX = -16 CurrentY = Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + CurrentX) / 28.426125) * 50 i = -16: Do While i <= 16 DoEvents Line -(i, Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + i) / 28.426125) * 50) i = i + 0.1: Loop 'интеллектуальный цикл ForeColor = &HFF0000 CurrentX = -16 CurrentY = Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + CurrentX) / 33.163812) * 50 i = -16: Do While i <= 16 DoEvents Line -(i, Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + i) / 33.163812) * 50) i = i + 0.1: Loop 'рисуем линию соответствующею текущему времени ForeColor = &H40C0& Line (1 / 24 * Hour(Time), -70)-(1 / 24 * Hour(Time), 70) ForeColor = &H0& FontName = "Times New Roman": FontSize = 7 Form1.Caption = "Биоритмы на " & LCase(MonthName(Month(Date))) & " " & Year(Date) & "года" PSet (-15, 95) Print "Прожитых дней: " & Format(DateDiff("d", Date0, Date) + Hour(Time) * 1 / 24, "0.000") PSet (-15, 90) Print "Прожитых часов: " & Format(DateDiff("h", Date0, Date) + Hour(Time) + Minute(Time) * 1 / 60, "0.000") PSet (-15, 85) Print "Прожитых минут: " & Format(DateDiff("n", Date0, Date) + Minute(Time) + Second(Time) * 1 / 60, "0.000") PSet (-15, 80) Print "Прожитых секунд: " & DateDiff("s", Date0, Date) + Second(Time) PSet (0, -90) Print "Сегодня: " & Date & " " & WeekdayName(Weekday(Date, vbMonday)) ForeColor = RGB(255, 0, 0) PSet (0, 95) Print "Физический: " & Format(Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + (Hour(Time) * 1 / 24) + (Minute(Time) * 1 / 60) / 100 + (Second(Time) * 1 / 60) / 10000) / 23.688437), "0.000 000%") ForeColor = RGB(0, 205, 0) PSet (0, 90) Print "Эмоциональный: " & Format(Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + (Hour(Time) * 1 / 24) + (Minute(Time) * 1 / 60) / 100 + (Second(Time) * 1 / 60) / 10000) / 28.426125), "0.000 000%") ForeColor = RGB(0, 0, 255) PSet (0, 85) Print "Интеллектуальный: " & Format(Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + (Hour(Time) * 1 / 24) + (Minute(Time) * 1 / 60) / 100 + (Second(Time) * 1 / 60) / 10000) / 33.163812), "0.000 000%") ForeColor = RGB(255, 225, 0) PSet (0, 80) Print "Интуитивный: " & Format(Sin(2 * 3.14159265358979 * (DateDiff("d", Date0, Date) + (Hour(Time) * 1 / 24) + (Minute(Time) * 1 / 60) / 100 + (Second(Time) * 1 / 60) / 10000) / 37.901499), "0.000 000%") End Sub |
| Ответы | Всего ответов: 8 |
|
Номер ответа: 1 Автор ответа:  Alex Вопросов: 10 Ответов: 131 |
Профиль | | #1 | Добавлено: 16.01.09 15:30 |
| Похоже на пример работы с графиками ))) +1 | ||
|
Номер ответа: 2 Автор ответа: Sharp Лидер форума ICQ: 216865379 Вопросов: 106 Ответов: 9979 |
Web-сайт: Профиль | | #2 | Добавлено: 16.01.09 17:06 |
| Шарлатанов-то сколько развелось... | ||
|
Номер ответа: 3 Автор ответа:  Андрей Вопросов: 8 Ответов: 42 |
Профиль | | #3 | Добавлено: 16.01.09 18:10 |
|
Оказывается – я не первый описал ритмы на VB6. Ссылка: http://arbuz.uz/w_bioritm.html
Шарлатан не я: «Так, предприятие «Биоритм компьютерс Инкорпорейтед»… ежемесячно продает по тысяче графиков с личными биоритмами стоимостью 9 долларов 95 центов за штуку…» (с) В. А. Доскин «Ритмы жизни» Японцы и американцы до сих пор верят. Я лишь хочу «ИНДИКАТОР УДАЧИ»!!! Написал бы сам, но не стал бы верить в него после этого)))) |
||
|
Номер ответа: 4 Автор ответа: FatherВопросов: 0 Ответов: 159 |
Профиль | | #4 | Добавлено: 16.01.09 18:31 |
Мне понравилось
+1 |
||
|
Номер ответа: 5 Автор ответа: AlexВопросов: 10 Ответов: 131 |
Профиль | | #5 | Добавлено: 16.01.09 20:10 |
| луче кога индикатор удачи по формуле x^2 | ||
|
Номер ответа: 6 Автор ответа: VβÐВопросов: 15 Ответов: 194 |
Web-сайт: Профиль | | #6 | Добавлено: 18.01.09 17:40 |
| Жжоте, уважаемый | ||
|
Номер ответа: 7 Автор ответа: Imperial KashakICQ: 479713821 Вопросов: 10 Ответов: 57 |
Профиль | | #7 | Добавлено: 21.01.09 20:09 |
| Я эту вещь ещё в учебнике каком-то видел по VB... Вот только не помню, в каком. Сам факт - эту программу в качестве примера показывали. Хотя мне эти биоритмы, пардон... #####)) не нравилась задумка, но копания кода впечатляют! Автор программы уже из-за многописания заслуживает уважения. | ||
|
Номер ответа: 8 Автор ответа: ArtyomРазработчик Вопросов: 130 Ответов: 6602 |
Профиль | | #8 | Добавлено: 01.02.09 11:26 |
| Продам гербалайф | ||
Страница: 1 |