powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / c QB на VB
7 сообщений из 7, страница 1 из 1
c QB на VB
    #35594323
snapp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
помогите перекодить с 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
c QB на VB
    #35594661
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Автор , вы понимаете, что 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
c QB на VB
    #35594681
White Owl
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AndreTM Автор , вы понимаете, что QB - это структура, а VB - это ООП?Чего-чего??? Что такое QB?
...
Рейтинг: 0 / 0
c QB на VB
    #35594732
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
White OwlAndreTM Автор , вы понимаете, что QB - это структура, а VB - это ООП?Чего-чего??? Что такое QB?
Ну, неправильно выразился, с кем не бывает... :) Имелось ввиду структурное и объектно-ориентированное программирование.
...
Рейтинг: 0 / 0
c QB на VB
    #35595403
Фотография Бенедикт
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
c QB на VB
    #35599136
snapp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
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
c QB на VB
    #35599324
Фотография Бенедикт
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
7 сообщений из 7, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / c QB на VB
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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