[Урок] Да си напишем лупа с VB6.

[crio]

Да си напишем лупа с VB6.

 

1. Интерфейс

a)Създаваме стандартен проект, и му добавяме само един Timer контрол.

http://pics.softvisia.com/design/pics/5756/1.png

http://pics.softvisia.com/design/pics/5756/2.png

 

b) Променяме следните свойства на формата.

AutoRedraw = True 'Абсолютно задължително, изчиства картината при обновяване, както и изчиства пространството извън екрана от "замазване".

BorderStyle = 0 - None 'Премахва рамката на прозореца...

Width = 1920 (15 twips = 1 pixel) 'Това са 128 пиксела

Height = 1920

 

c) Променяме следните свойства на таймера.

Interval = 50 'Нормален интервал... не се усеща никакво забавяне.

 

2. Кодът

а) WinAPI

Добавяме няколко API Функции, които ще ми помагат с взимането на картината от екрана, разтягането й и влаченето на лупата по екрана...

 

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long

Private Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Declare Function GetCursorPos Lib "user32.dll" ( ByRef lpPoint As POINTAPI) As Long

Private Declare Function GetWindowDC Lib "user32.dll" ( ByVal hwnd As Long) As Long

Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

 

Private Type POINTAPI

X

As Long

Y

As Long

End Type

Dim pa As POINTAPI

 

1. SendMessage: Функция чрез която изпращам съобщения до Формата, в този случай WM_NCLBUTTONDOWN и HTCAPTION.
   
2. ReleaseCapture: Освобождава мишката от формата след натискането на десния бутон, комбинирано с горната функция ми позволява да влача прозореца.
   
3. StretchBlt: Оразмерява избран район екрана и го копира в паметта от там го копира в избрания прозорец.
   
4. GetCursorPos: Взимам позицията на мишката като POINTAPI структура
   
5. GetWindowDC: Нужна функция за да взема DC на екрана/десктоп-а.
   
6. POINTAPI: Структура която съдъжда X и Y като стойности, стандартна за GetCursorPos функцията.
   
7. SetWindowPos: Променя позицията на прозореца, размерите му и Z индекса му... в този случай ползвам само Z индекс-а...
   

 

б) Влачене на формата.

Не е проблем да направя заедно с обновяването на (картината в) лупата, прозореца да се мести заедно с мишката, но мисля че така е по-удобно.

 

Ето кодът:

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Call ReleaseCapture

Call SendMessage(Me.hwnd, 161, 2, 0)

End Sub

Където 161 и 2 са съответно WM_NCLBUTTONDOWN и HTCAPTION константите, просто ми е по-лесно да ползвам числата .

 

в) Лупата! (най-накрая)

 

Ето как съм измислил кодът. (Предполагам, че и другите които са писали лупи са го написали по подобен начин де...)

 

Private Sub Timer1_Timer()

GetCursorPos pa

StretchBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, GetWindowDC(0), pa.x - 16, pa.y - 16, 33, 33, vbSrcCopy

Me.DrawMode = 1

Me.Line (0, 0)-(Me.ScaleWidth - 1, Me.ScaleHeight - 1), , B

Me.DrawMode = 6

Me.Line (62, 62)-(65, 65), , B

Me.DrawMode = 1

End Sub

Където pa е променливата декларирана в "а)".

Ето какво прави кодът:

1. Взимам координатите на мишката
   
2. Копирам региона около нея и го оразмерява в размера на формата, след това го поставя на нея (всичко това само с StretchBlt - яко, а?)
   
3. Рисувам рамката около лупата.
   
4. Променям DrawMode на така, че да променя цвета в противоположния му (черно->бяло) и рисувам квадратчето което показва къде се намира показалеца на мишката.
   
5. Връщам DrawMode обратно на 1.
   
6. Това се повтаря на всеки 0.05 секунди.
   

 

г) Малко допълнителен код:

Тъй като формата е без рамка затварянето и трябва да се прави през Task Manager или някоя друга програма която да убие процеса. Направих лупата да се затваря след двойно кликване на върху самата лупа (доста е удобно според мен).

Ето кодът:

Private Sub Form_DblClick()

If MsgBox("Are you sure you wish to exit?", vbYesNo + vbQuestion) = vbYes Then End

End Sub

 

Също като лупа, няма да е лошо (дори е задължително) да се постави формата над другите прозорци. Ето как става това:

Private Sub Form_Load()

Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 1 Or 2)

End Sub

Където -1 е HWND_TOPMOST, а 1 и 2 (последните аргументи) са съответно SWP_NOSIZE и SWP_NOMOVE константите.

 

3. Заключение

Ако питате мен, VB не е толкова "слаб" език... просто зависи дали знаеш как да го изполваш. В комбинация с API-тата на Windows за мен той е един от най-добрите. С 30 реда код имам напълно функционална лупа с (ако не се лъжа) 4 кратно увеличение.

 

Ето резултатът:

http://pics.softvisia.com/design/pics/5756/3.png

 

Ето VB6 Проектът: lupa.zip

Ето и Архив с компилирания код (*.exe) magnify.zip

 

Всички права върху текущата тема, картинките и кодът включени в нея са собственост на автора им и нямат право да бъдат възпроизвеждани под каквато и да е форма без изричното съгласие на автора.

Автор: Милен Иванов / crio(@)Softvisia.com /

[fern]

Суппер THX. Таман се чудех как да си направя такава, че ми трябва !