VBNet - Форум - Очень просто и красиво!

Вопрос: Очень просто и красиво! Добавлено: 30.06.05 03:36

Автор вопроса: Morpheus | Web-сайт: xury.zx6.ru

это только малая часть. попробуйте нарисовать весь спектр и сделать savepicture!

Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Const st = 1 'step

Private Sub Form_Load()
Dim i As Long
Dim j As Long
Dim hd As Long
With Me
    .AutoRedraw = True
    .Width = 700 * Screen.TwipsPerPixelX
    .Height = 500 * Screen.TwipsPerPixelY
End With
hd = Form1.hdc
For j = 0 To 500 Step st 'max 4096
    For i = 0 To 700 Step st 'max 4096
        SetPixelV hd, Round(i / st), Round(j / st), i * j
    Next
Next
Form1.Refresh
End Sub

Ответить

Ответы Всего ответов: 8

Номер ответа: 1 Автор ответа: GSerg Вопросов: 0 Ответов: 1876	Профиль \| \| #1	Добавлено: 30.06.05 06:40
	Так быстрее... Option Explicit Private Declare Function SetDIBitsToDevice Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, ByRef Bits As Any, ByRef BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type Private Const DIB_RGB_COLORS As Long = 0 Private Const BI_RGB As Long = 0 Private Sub Form_Load() Dim i As Long, j As Long, t As Long Dim bi As BITMAPINFO Const Step As Long = 1 Const x As Long = 4000 'max 4096 Const y As Long = 4000 'max 4096 Dim c(0 To x - 1, 0 To y - 1) As Long With Me .AutoRedraw = True .Width = Me.ScaleX(700, vbPixels, vbTwips) .Height = Me.ScaleY(500, vbPixels, vbTwips) End With For j = LBound(c, 2) To UBound(c, 2) Step Step For i = LBound(c, 1) To UBound(c, 1) Step Step t = i * j 'меняем местами первый байт с третьим, потому что RGBQUAD инвертирована относительно COLORREF 'Впрочем, можно не менять, тогда картинка будет в синих тонах. c(CLng(i / Step), CLng(j / Step)) = (t And &HFF00FF00) Or (((t And &HFF& * &H10000) Or ((t And &HFF0000) / &H10000)) Next Next With bi.bmiHeader .biSize = Len(bi.bmiHeader) .biWidth = x .biHeight = -y .biPlanes = 1 .biBitCount = 32 .biCompression = BI_RGB End With SetDIBitsToDevice Me.hdc, 0, 0, x, y, 0, 0, 0, y, c(LBound(c, 1), LBound(c, 2)), bi, DIB_RGB_COLORS Me.Refresh End Sub Ответить

Номер ответа: 2 Автор ответа: ViktorZ ICQ: 271202919 Вопросов: 56 Ответов: 837	Профиль \| \| #2	Добавлено: 30.06.05 09:50
	ВЫ хоть выложите эту красоту где-нить, а то я на работе Вб не имею(и он меня тоже ))) Ответить

Номер ответа: 3 Автор ответа: Morpheus Вопросов: 224 Ответов: 3777	Web-сайт: xury.zx6.ru Профиль \| \| #3	Добавлено: 30.06.05 16:42
	2 Vik: Разве только экзешник... а то BMP занимает 48 метров... Ответить

Номер ответа: 4 Автор ответа: freeloader ICQ: 50804884 Вопросов: 72 Ответов: 642	Web-сайт: freeloader.folder-pro.net Профиль \| \| #4	Добавлено: 30.06.05 16:58
	в тему: "Очень просто и красиво!" и тормознуто Ответить

Номер ответа: 5 Автор ответа: Morpheus Вопросов: 224 Ответов: 3777	Web-сайт: xury.zx6.ru Профиль \| \| #5	Добавлено: 30.06.05 17:13
	а ты как хотел 16777216 пикселов думаешь легко нарисовать Ответить

Номер ответа: 6 Автор ответа: Progos ICQ: 311715784 Вопросов: 39 Ответов: 157	Web-сайт: html-expert.org.ru Профиль \| \| #6	Добавлено: 01.07.05 05:54
	2GSerg Между прочим первый пример у меня отработал быстрее... Ответить

Номер ответа: 7 Автор ответа: Morpheus Вопросов: 224 Ответов: 3777	Web-сайт: xury.zx6.ru Профиль \| \| #7	Добавлено: 01.07.05 06:01
	может потому, что у меня точек меньше гораздо рисуется? Ответить

Номер ответа: 8 Автор ответа: GSerg Вопросов: 0 Ответов: 1876	Профиль \| \| #8	Добавлено: 01.07.05 06:46
	Между прочим первый пример у меня отработал быстрее... Так и знал, что кто-нибудь скажет... может потому, что у меня точек меньше гораздо рисуется? Именно поэтому. А если убрать перестановку бит, то ещё вдвое быстрее получается. Ответить

Страница: 1 |