Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / c QB на VB / 7 сообщений из 7, страница 1 из 1
14.10.2008, 18:25
    #35594323
snapp
snapp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
помогите перекодить с QBasic на VB

вот исходник QBasic

SCREEN 12
For i = 0 To 5
For j = 0 To 5
Line (10 + j * 40, 10 + j * 40)-(210 + j * 40, 10 + j * 40), 7
Line (10 + i * 40, 10)-(210 + i * 40, 210), 7
Next j
Next i

For i = 0 To 4
For j = 0 To 4
x = 50 + i * 40 + j * 40
y = 30 + i * 40
s = (i + j) Mod 2
If s = 0 Then Paint (x,y),5,7
Next j
Next i

на QB первый цикл создает сетку из паралелограммов.. а второй цикл - закрашивает их через один. как добиться такого же резульата в VB. и как правильно его там оформить чтобы просмотреть результат.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
14.10.2008, 23:47
    #35594661
AndreTM
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
Автор , вы понимаете, что QB - это структура, а VB - это ООП?
Вы определились на чем вы будете рисовать? Объект нужен...

Попробовал изобразить на VBA. В Экзеле. Но непринципиально - хоть как объекты будут Shapes. Получилось сначала это:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Set objDraw = ActiveSheet
objDraw.Cells.Delete

Dim i As Byte, j As Byte

For i =  0  To  5 
    For j =  0  To  5 
        With objDraw.Shapes.AddLine( 10  + j *  40 ,  10  + j *  40 ,  210  + j *  40 ,  10  + j *  40 ).Line
            .ForeColor.RGB = vbRed
        End With
        With objDraw.Shapes.AddLine( 10  + i *  40 ,  10 ,  210  + i *  40 ,  210 ).Line
            .ForeColor.RGB = vbRed
        End With
    Next j
Next i

Set objDraw = Nothing

Дошло, что Paint'а в VB нет :-) Заливать в этом случае нечего - линии "висят" над полем, параллелограммы мы визуально ощущаем, но как объекты - они не существуют.

Переписал:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
Set objDraw = ActiveSheet
objDraw.Cells.Delete

Dim i As Byte, j As Byte

Dim dW As Single, dH As Single
dW =  40 
dH =  40 

For i =  0  To  4 
    For j =  0  To  4 
        With objDraw.Shapes.AddShape(msoShapeParallelogram, _
             10  + Int((i + j) * dW),  10  + Int(i * dH), dW, dH)
            .Line.ForeColor.RGB = vbRed
            .Flip msoFlipHorizontal
            .ScaleWidth  2 , msoFalse
            .Adjustments( 1 ) =  0 . 5 
            If (i + j) Mod  2  =  0  Then .Fill.ForeColor.RGB = vbRed
        End With
    Next j
Next i

Set objDraw = Nothing
Вроде около дела :-)

Автору : Не надо переносить задания (или примеры) из QB в VB, ибо при ООП многое строится с использованием объктной модели.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.10.2008, 00:09
    #35594681
White Owl
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
AndreTM Автор , вы понимаете, что QB - это структура, а VB - это ООП?Чего-чего??? Что такое QB?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.10.2008, 02:09
    #35594732
AndreTM
AndreTM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
White OwlAndreTM Автор , вы понимаете, что QB - это структура, а VB - это ООП?Чего-чего??? Что такое QB?
Ну, неправильно выразился, с кем не бывает... :) Имелось ввиду структурное и объектно-ориентированное программирование.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.10.2008, 12:17
    #35595403
Бенедикт
Бенедикт
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
snapp,
это переводится почти напрямую в VB4-6. В чём вопрос - "помогите", или "сделайте за меня"?
Запусти VB. Создай новый проект типа Standard Exe. Нажми F7. Скопируй и вставь приведённый ниже код. Нажми F5.
Код: plaintext
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.
Option Explicit

Private Enum FloodFillType
   FLOODFILLBORDER =  0 
   FLOODFILLSURFACE =  1 
End Enum
Private Declare Function ExtFloodFill Lib "gdi32" ( _
   ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _
   ByVal crColor As Long, ByVal wFillType As FloodFillType) As Long

Private Sub Form_Load()
 Dim i As Long, j As Long, s As Long
 Dim x As Long, y As Long
 
 AutoRedraw = True
 ScaleMode = vbPixels
 
 For i =  0  To  5 
    For j =  0  To  5 
       Line ( 10  + j *  40 ,  10  + j *  40 )-( 210  + j *  40 ,  10  + j *  40 ), vbRed
       Line ( 10  + i *  40 ,  10 )-( 210  + i *  40 ,  210 ), vbRed
    Next j
 Next i

 FillColor = vbGreen
 FillStyle = vbSolid
 For i =  0  To  4 
    For j =  0  To  4 
       x =  50  + i *  40  + j *  40 
       y =  30  + i *  40 
       s = (i + j) Mod  2 
       If s =  0  Then ExtFloodFill hDC, x, y, vbRed, FLOODFILLBORDER
    Next j
 Next i
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
16.10.2008, 18:17
    #35599136
snapp
snapp
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
GOOD :) спасибо
переделал под другую задачку
на QB так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
CLS 
SCREEN  12  
R =  200 : n =  16 : k =  10 : h = R \ k 
pi =  4  * ANT( 1 ) 
u =  2  * pi / n 

FOR i =  1  TO n 
xi =  320  + R * cos (i * u) 
yi =  240  + R * sin (i * u) 
LINE ( 320 ,  240 )-(xi,yi), 5  
next i 

for j =  1  to k 
circle( 320 ,  240 ), j * h ,  5  
next j 

for j =  0  to k -  1  
for i =  1  to n 
x= 320  + (h/ 2  +j*h)*cos(u/ 2 +i*u) 
y= 240  + (h/ 2  +j*h)*sin(u/ 2 +i*u) 
s=(i+j) MOD  2  
if s= 0  then paint (x,y), 11  , 5  
next j 
next i 
paint ( 320  + R +  2 ,  240 ),  2 ,  5

на VB вышло так
Код: plaintext
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.
Option Explicit 

Private Enum FloodFillType 
FLOODFILLBORDER =  0  
FLOODFILLSURFACE =  1  
End Enum 
Private Declare Function ExtFloodFill Lib "gdi32" ( _ 
ByVal hDC As Long, ByVal x As Long, ByVal y As Long, _ 
ByVal crColor As Long, ByVal wFillType As FloodFillType) As Long 

Private Sub Form_Load() 
Dim i As Long, j As Long, s As Long 
Dim x As Long, y As Long 
Dim R As Long, n As Long, k As Long 
Dim h As Single, u As Single, pi As Single 
Dim xi As Single, yi As Single 

AutoRedraw = True 
ScaleMode = vbPixels 

R =  200 : n =  16 : k =  10 : h = R \ k 
pi =  4  * Atn( 1 ) 
u =  2  * pi / n 

For i =  1  To n 
xi =  320  + R * Cos(i * u) 
yi =  240  + R * Sin(i * u) 
Line ( 320 ,  240 )-(xi, yi), vbBlack 
Next i 

For j =  1  To k 
Circle ( 320 ,  240 ), j * h, vbBlack 
Next j 

FillColor = vbRed 
FillStyle = vbSolid 
For j =  0  To k -  1  
For i =  1  To n 
x =  320  + (h /  2  + j * h) * Cos(u /  2  + i * u) 
y =  240  + (h /  2  + j * h) * Sin(u /  2  + i * u) 
s = (i + j) Mod  2  
If s =  0  Then ExtFloodFill hDC, x, y, vbBlack, FLOODFILLBORDER 
Next i 
Next j 
End Sub
чертит 10 колец и разбивает их лучами из середины.. разбивы в кольцах закрашивает через один.. для 9и колец все нормально выплняется, а для 10ого кольца нет.. Где ошибка?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
16.10.2008, 20:16
    #35599324
Бенедикт
Бенедикт
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
c QB на VB
snappчертит 10 колец и разбивает их лучами из середины.. разбивы в кольцах закрашивает через один.. для 9и колец все нормально выплняется, а для 10ого кольца нет.. Где ошибка?Видно при увеличении, что не все радиусы доходят до внешней окружности, в эти дырки и просачивается заливка. Увеличь длину радиуса на немного:
Код: plaintext
1.
xi =  320  + (R +  0 . 5 ) * Cos(i * u) 
yi =  240  + (R +  0 . 5 ) * Sin(i * u)

Ещё: вместо vbSolid лучше написать vbFSSolid, хоть они и равны. Для профилактики.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / c QB на VB / 7 сообщений из 7, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 493ms
Закрыть
start [/forum/topic.php?fid=60&tablet=1&tid=2161730]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 192ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 28ms
get tp. blocked users:
 1ms
others: 235ms
total:  493ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]