Форум программистов, компьютерный форум, киберфорум
Visual Basic
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
0 / 0 / 0
Регистрация: 30.10.2007
Сообщений: 37
1

Picture Zoom для Zoog (...ну и вообще кому интересно...)

14.11.2007, 13:17. Просмотров 601. Ответов 2
Метки нет (Все метки)

Сразу извенюсь... в прошлый раз забыл про SetStretchBltMode.
Кидаю API объявления...вроде ниче не забыл ...) и функцию для Zoom.
Параметры PictureZoom:
TargetPicObj - объект PictureBox, где надо выполнять рисование.
SourcePic - объект IPictureDisp содержащий картинку которую будем рисовать.
ScaleVal - масштаб в процентах
X - координата X в пикселах, для смещения картинки в объкте TargetPicObj.
Y - координата Y в пикселах, для смещения картинки в объкте TargetPicObj.
Возвращает True при успешном выполнении.
Некоторые условия:
1. Иконки не рисуем.
2. Работает в True Color режимах, и с True Color картинками. Чтобы применять картинки с 256 и 16 цветами, надо добавить работу с палитрой. Попробуй сделать сам, если конечно это надо....хотя, для самообразования неплохо!!!)

Visual Basic
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
45
46
47
48
49
50
51
52
53
54
Private Const DIB_RGB_COLORS = 0
Private Const GMEM_MOVEABLE = &H2
Private Const BI_RGB = 0&
Private Const SRCCOPY = &HCC0020
Private Const BLACKONWHITE = 1
Private Const STRETCH_DELETESCANS = 3
 
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
 
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 BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End Type
 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Declare Function BitBlt Lib 'gdi32' (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib 'gdi32' (ByVal hdc As Long) As Long
Private Declare Function StretchDIBits Lib 'gdi32' (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 wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib 'gdi32' (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib 'gdi32' (ByVal hObject As Long) As Long
Private Declare Function GetDIBits Lib 'gdi32' (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GlobalAlloc Lib 'kernel32' (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib 'kernel32' (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib 'kernel32' (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib 'kernel32' (ByVal hMem As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib 'gdi32' (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetStretchBltMode Lib 'gdi32' (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function FillRect Lib 'user32' (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetClientRect Lib 'user32'
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.11.2007, 13:17
Ответы с готовыми решениями:

Сделал COM компонент для 1С на C#, кому интересно смотрите
Сдесь все написано. Отпишите потом если понравится и если не понравится. мне это необходимо.!!!...

Ищу консультанта/учителя С под Linux, Для тех,кому интересно делиться знаниями
Здравствуйте! Начал изучать Си под Linux при решении реальных задач. Ищу человека, для изучения...

Кому интересно. Покер
Вообщем, давно ничего не кодил и на днях накатал немного говно кода на тему Покера. Кому будет...

Кому интересно поломать голову
Привет! Сейчас на работе думал с ума схожу - есть код, который (с виду) работать не должен, но...

2
0 / 0 / 0
Регистрация: 30.10.2007
Сообщений: 37
14.11.2007, 18:49  [ТС] 2
В предыдушем сообщении надо добавить объявление
Private Declare Function DeleteDC Lib 'gdi32' (ByVal hdc As Long) As Long

и все что ниже метки заменить на:
f_Clear:
GlobalUnlock hMem
GlobalFree hMem

SelectObject memDC, prevBmp
DeleteObject memBmp
DeleteObject hb

DeleteDC memDC
0
0 / 0 / 0
Регистрация: 30.10.2007
Сообщений: 37
14.11.2007, 18:56  [ТС] 3
Еще один примерчик - параметры как и у предыдущей функции, только работает с контекстом, а не битмапой... Палитру тоже не делал....
Одно приемущество, что в True Color режимах нормально хавает 256 и 16 цветную графику.....и сама задача не падает...
Можешь на нее заменить!

Private Const DIB_RGB_COLORS = 0
Private Const GMEM_MOVEABLE = &H2
Private Const BI_RGB = 0&
Private Const SRCCOPY = &HCC0020
Private Const BLACKONWHITE = 1
Private Const STRETCH_DELETESCANS = 3

Private Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type

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 BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function BitBlt Lib 'gdi32' (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib 'gdi32' (ByVal hdc As Long) As Long
Private Declare Function StretchDIBits Lib 'gdi32' (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 wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib 'gdi32' (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib 'gdi32' (ByVal hObject As Long) As Long
Private Declare Function GetDIBits Lib 'gdi32' (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GlobalAlloc Lib 'kernel32' (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib 'kernel32' (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib 'kernel32' (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib 'kernel32' (ByVal hMem As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib 'gdi32' (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetStretchBltMode Lib 'gdi32' (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function FillRect Lib 'user32' (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetClientRect Lib 'user32' (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Sub OleTranslateColor Lib 'oleaut32.dll' (ByVal ColorIn As Long, ByVal hPal As Long, ByRef RGBColorOut As Long)
Private Declare Function CreateSolidBrush Lib 'gdi32' (ByVal crCol
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
14.11.2007, 18:56

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Бинарные деревья ! кому интересно , сюда!;)
задание : Описать процедуру или функцию которая : а) печатает запись, встречающуюся в дереве один...

Задание с собеса. Может кому интересно
Определите ошибку в приведенном коде.

Открыта вакансия Программиста 1С - кому интересно?
Добрый день! Меня зовут Анна и я являюсь представителем кадровой компании, работаю как официальный...

прога странно работает=) кому интересно покопать?
написал прогу по подсчету crc-16 (сама функция с википедии).. так вот... когда скармливаю файл...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.