| 6 |
kaklik |
1 |
Attribute VB_Name = "Nasroj"
|
|
|
2 |
Public ClrSet As ColorConstants
|
|
|
3 |
Public dravv
|
|
|
4 |
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
|
|
|
5 |
Public Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
|
|
|
6 |
Private Declare Function StretchBlt Lib "gdi32" (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
|
|
|
7 |
Public ha As Double
|
|
|
8 |
Public Type BITMAPINFOHEADER
|
|
|
9 |
biSize As Long
|
|
|
10 |
biWidth As Long
|
|
|
11 |
biHeight As Long
|
|
|
12 |
biPlanes As Integer
|
|
|
13 |
biBitCount As Integer
|
|
|
14 |
biCompression As Long
|
|
|
15 |
biSizeImage As Long
|
|
|
16 |
biXPelsPerMeter As Long
|
|
|
17 |
biYPelsPerMeter As Long
|
|
|
18 |
biClrUsed As Long
|
|
|
19 |
biClrImportant As Long
|
|
|
20 |
End Type
|
|
|
21 |
|
|
|
22 |
Public Type RGBQUAD
|
|
|
23 |
rgbBlue As Byte
|
|
|
24 |
rgbGreen As Byte
|
|
|
25 |
rgbRed As Byte
|
|
|
26 |
rgbReserved As Byte
|
|
|
27 |
End Type
|
|
|
28 |
|
|
|
29 |
Public Type rgb
|
|
|
30 |
R As Byte
|
|
|
31 |
g As Byte
|
|
|
32 |
b As Byte
|
|
|
33 |
End Type
|
|
|
34 |
|
|
|
35 |
Public Type BITMAPINFO
|
|
|
36 |
bmiHeader As BITMAPINFOHEADER
|
|
|
37 |
bmiColors As RGBQUAD
|
|
|
38 |
End Type
|
|
|
39 |
|
|
|
40 |
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
|
|
|
41 |
Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
|
|
|
42 |
Public 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
|
|
|
43 |
Public Declare Function SetDIBitsToDevice 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 Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
|
|
|
44 |
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
|
|
|
45 |
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
|
|
|
46 |
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
|
|
|
47 |
Public 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
|
|
|
48 |
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
|
|
|
49 |
Public Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal Clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long
|
|
|
50 |
|
|
|
51 |
'TUZKA
|
|
|
52 |
|
|
|
53 |
Public Sub Pencil(Img As PictureBox, x As Single, y As Single, Width As Long, Button As Integer, Clr As Long)
|
|
|
54 |
Img.DrawWidth = Width
|
|
|
55 |
Img.AutoRedraw = True
|
|
|
56 |
If Button = 1 Then
|
|
|
57 |
If dravv = False Then
|
|
|
58 |
dravv = True
|
|
|
59 |
Img.Line (x, y)-(x, y)
|
|
|
60 |
Else
|
|
|
61 |
Img.Line -(x, y), Clr
|
|
|
62 |
End If
|
|
|
63 |
Img.Refresh
|
|
|
64 |
Else
|
|
|
65 |
dravv = False
|
|
|
66 |
End If
|
|
|
67 |
End Sub
|
|
|
68 |
'Pencil Picture1, X, Y, 3, Button,&H0
|
|
|
69 |
|
|
|
70 |
'KULATY ST.
|
|
|
71 |
|
|
|
72 |
Public Sub Brush2(Img As PictureBox, x As Single, y As Single, Button As Integer, Clr As Long, Clr2 As Long, Value As Long)
|
|
|
73 |
If Button = 1 Then
|
|
|
74 |
Img.Refresh
|
|
|
75 |
Img.AutoRedraw = True
|
|
|
76 |
a = (Value / 2)
|
|
|
77 |
Do
|
|
|
78 |
Img.Circle (x + 1, y + 1), a, Clr
|
|
|
79 |
a = a - 1
|
|
|
80 |
Loop Until a = 0
|
|
|
81 |
a = (Value / 2)
|
|
|
82 |
Do
|
|
|
83 |
Img.Circle (x + 1, y), a, Clr
|
|
|
84 |
a = a - 1
|
|
|
85 |
Loop Until a = 0
|
|
|
86 |
a = (Value / 2)
|
|
|
87 |
Do
|
|
|
88 |
Img.Circle (x, y + 1), a, Clr
|
|
|
89 |
a = a - 1
|
|
|
90 |
Loop Until a = 0
|
|
|
91 |
a = (Value / 2)
|
|
|
92 |
Do
|
|
|
93 |
Img.Circle (x, y), a, Clr
|
|
|
94 |
a = a - 1
|
|
|
95 |
Loop Until a = 0
|
|
|
96 |
Img.AutoRedraw = False
|
|
|
97 |
End If
|
|
|
98 |
|
|
|
99 |
If Button = 2 Then
|
|
|
100 |
Img.Refresh
|
|
|
101 |
Img.AutoRedraw = True
|
|
|
102 |
a = (Value / 2)
|
|
|
103 |
Do
|
|
|
104 |
Img.Circle (x + 1, y + 1), a, Clr2
|
|
|
105 |
a = a - 1
|
|
|
106 |
Loop Until a = 0
|
|
|
107 |
a = (Value / 2)
|
|
|
108 |
Do
|
|
|
109 |
Img.Circle (x + 1, y), a, Clr2
|
|
|
110 |
a = a - 1
|
|
|
111 |
Loop Until a = 0
|
|
|
112 |
a = (Value / 2)
|
|
|
113 |
Do
|
|
|
114 |
Img.Circle (x, y + 1), a, Clr2
|
|
|
115 |
a = a - 1
|
|
|
116 |
Loop Until a = 0
|
|
|
117 |
a = (Value / 2)
|
|
|
118 |
Do
|
|
|
119 |
Img.Circle (x, y), a, Clr2
|
|
|
120 |
a = a - 1
|
|
|
121 |
Loop Until a = 0
|
|
|
122 |
Img.AutoRedraw = False
|
|
|
123 |
End If
|
|
|
124 |
|
|
|
125 |
If Button = 0 Then
|
|
|
126 |
Img.Refresh
|
|
|
127 |
Img.AutoRedraw = False
|
|
|
128 |
a = (Value / 2)
|
|
|
129 |
Do
|
|
|
130 |
Img.Circle (x + 1, y + 1), a, Clr
|
|
|
131 |
a = a - 1
|
|
|
132 |
Loop Until a = 0
|
|
|
133 |
a = (Value / 2)
|
|
|
134 |
Do
|
|
|
135 |
Img.Circle (x + 1, y), a, Clr
|
|
|
136 |
a = a - 1
|
|
|
137 |
Loop Until a = 0
|
|
|
138 |
a = (Value / 2)
|
|
|
139 |
Do
|
|
|
140 |
Img.Circle (x, y + 1), a, Clr
|
|
|
141 |
a = a - 1
|
|
|
142 |
Loop Until a = 0
|
|
|
143 |
a = (Value / 2)
|
|
|
144 |
Do
|
|
|
145 |
Img.Circle (x, y), a, Clr
|
|
|
146 |
a = a - 1
|
|
|
147 |
Loop Until a = 0
|
|
|
148 |
|
|
|
149 |
End If
|
|
|
150 |
End Sub
|
|
|
151 |
|
|
|
152 |
|
|
|
153 |
'HRANATY ST.
|
|
|
154 |
|
|
|
155 |
Public Sub Brush1(Img As PictureBox, x As Single, y As Single, Button As Integer, Clr As Long, Clr2 As Long, Value As Long)
|
|
|
156 |
If Button = 1 Then
|
|
|
157 |
Img.Refresh
|
|
|
158 |
Img.AutoRedraw = True
|
|
|
159 |
Do
|
|
|
160 |
a = a + 1
|
|
|
161 |
Img.Line (x + a, y)-(x + a, y + Value), Clr
|
|
|
162 |
Loop Until a >= Value
|
|
|
163 |
Img.AutoRedraw = False
|
|
|
164 |
End If
|
|
|
165 |
|
|
|
166 |
If Button = 2 Then
|
|
|
167 |
Img.Refresh
|
|
|
168 |
Img.AutoRedraw = True
|
|
|
169 |
Do
|
|
|
170 |
a = a + 1
|
|
|
171 |
Img.Line (x + a, y)-(x + a, y + Value), Clr2
|
|
|
172 |
Loop Until a >= Value
|
|
|
173 |
Img.AutoRedraw = False
|
|
|
174 |
End If
|
|
|
175 |
|
|
|
176 |
If Button = 0 Then
|
|
|
177 |
Img.Refresh
|
|
|
178 |
Img.AutoRedraw = False
|
|
|
179 |
Do
|
|
|
180 |
a = a + 1
|
|
|
181 |
Img.Line (x + a, y)-(x + a, y + Value), Clr
|
|
|
182 |
Loop Until a >= Value
|
|
|
183 |
End If
|
|
|
184 |
End Sub
|
|
|
185 |
'Brush1 Picture1, X, y, button, &H0, &HFF, 10
|
|
|
186 |
|
|
|
187 |
'PLECHOVKA
|
|
|
188 |
|
|
|
189 |
Public Sub Vybarvi(Img As PictureBox, x As Single, y As Single, mode As Boolean, Clr As Long)
|
|
|
190 |
'On Error Resume Next
|
|
|
191 |
Imgp = Img.Point(x, y)
|
|
|
192 |
Img.FillColor = Clr
|
|
|
193 |
Img.FillStyle = vbSolid
|
|
|
194 |
If mode = True Then
|
|
|
195 |
rtn = ExtFloodFill(Img.hdc, x, y, Clr2, 0)
|
|
|
196 |
End If
|
|
|
197 |
If mode = False Then
|
|
|
198 |
rtn = ExtFloodFill(Img.hdc, x, y, Imgp, 1)
|
|
|
199 |
End If
|
|
|
200 |
'Vybarvi Picture1, x, y, False, Picture2.BackColor
|
|
|
201 |
End Sub
|
|
|
202 |
|
|
|
203 |
'text:
|
|
|
204 |
|
|
|
205 |
Public Sub Textwr(Img As PictureBox, x As Single, y As Single, Text As TextBox, Size As Long, Font As ComboBox, Tucne As CheckBox, Kurziva As CheckBox, Podtrzene As CheckBox, Preskrtle As CheckBox, Transparent As CheckBox, Clr As Long, Clr2 As Long)
|
|
|
206 |
Img.CurrentX = x
|
|
|
207 |
Img.CurrentY = y
|
|
|
208 |
Img.Font.Name = Font
|
|
|
209 |
Img.Font.Size = Size
|
|
|
210 |
If Tucne = 0 Then Img.FontBold = False
|
|
|
211 |
If Tucne = 1 Then Img.FontBold = True
|
|
|
212 |
If Kurziva = 0 Then Img.FontItalic = False
|
|
|
213 |
If Kurziva = 1 Then Img.FontItalic = True
|
|
|
214 |
If Podtrzene = 0 Then Img.FontUnderline = False
|
|
|
215 |
If Podtrzene = 1 Then Img.FontUnderline = True
|
|
|
216 |
If Preskrtle = 0 Then Img.FontStrikethru = False
|
|
|
217 |
If Preskrtle = 1 Then Img.FontStrikethru = True
|
|
|
218 |
If Transparent = 0 Then Img.FontTransparent = False
|
|
|
219 |
If Transparent = 1 Then Img.FontTransparent = True
|
|
|
220 |
Img.ForeColor = Clr
|
|
|
221 |
Img.AutoRedraw = True
|
|
|
222 |
Img.Print Property.tBox
|
|
|
223 |
Img.Refresh
|
|
|
224 |
Img.AutoRedraw = False
|
|
|
225 |
End Sub
|
|
|
226 |
'Textwr Picture1, X, Y, Text1, 10, Combo1, Check3, Check4, Check5, Check6, Check7, &H0, &HFF
|
|
|
227 |
|
|
|
228 |
'spray:
|
|
|
229 |
|
|
|
230 |
Public Sub spray(Img As PictureBox, x As Single, y As Single, Button As Integer, Area As Long, Density As Long, Clr As Long)
|
|
|
231 |
Randomize Timer
|
|
|
232 |
If Button = 1 Then
|
|
|
233 |
Img.DrawWidth = 1
|
|
|
234 |
For a = 0 To (Density / 10) * Area
|
|
|
235 |
t = Int(Rnd * 10)
|
|
|
236 |
C = Int(Rnd * 10)
|
|
|
237 |
If t <= 5 Then ttf = -1
|
|
|
238 |
If t >= 5 Then ttf = 1
|
|
|
239 |
If C <= 5 Then ttb = -1
|
|
|
240 |
If C >= 5 Then ttb = 1
|
|
|
241 |
Img.PSet (x + (Rnd * Area) * ttf, y + (Rnd * Area) * ttb), Clr
|
|
|
242 |
Next a
|
|
|
243 |
End If
|
|
|
244 |
'spray Picture1, X, Y, Button, 40, 10, &H0
|
|
|
245 |
End Sub
|
|
|
246 |
|
|
|
247 |
|
|
|
248 |
'GuMa
|
|
|
249 |
|
|
|
250 |
Public Sub rubber(Img As PictureBox, Xa As Single, Ya As Single, Big As Long, Button As Integer)
|
|
|
251 |
Img.Refresh
|
|
|
252 |
Img.AutoRedraw = False
|
|
|
253 |
Img.Line (Xa, Ya)-(Xa - Big, Ya - Big), &HFFFFFF, BF
|
|
|
254 |
If Button = 1 Then
|
|
|
255 |
Img.AutoRedraw = True
|
|
|
256 |
Img.Line (Xa, Ya)-(Xa - Big, Ya - Big), &HFFFFFF, BF
|
|
|
257 |
Img.AutoRedraw = False
|
|
|
258 |
End If 'rubber Picture1, X, Y, 10, Button
|
|
|
259 |
End Sub
|
|
|
260 |
|
|
|
261 |
|
|
|
262 |
'kapatkoo:
|
|
|
263 |
|
|
|
264 |
Public Sub Droper(Img As PictureBox, GetClr As PictureBox, Clr1 As PictureBox, Clr2 As PictureBox, Button As Integer, x As Single, y As Single, RGBr As TextBox, RGBg As TextBox, RGBb As TextBox)
|
|
|
265 |
RGBmax = 256
|
|
|
266 |
i = StretchBlt(GetClr.hdc, 0, 0, 80, 80, Img.hdc, x, y, 1, 1, 13369376)
|
|
|
267 |
Imgp = GetClr.Point(5, 5)
|
|
|
268 |
RGBb = Imgp \ RGBmax \ RGBmax
|
|
|
269 |
RGBg = (Imgp \ RGBmax) Mod RGBmax
|
|
|
270 |
RGBr = Imgp Mod RGBmax
|
|
|
271 |
If Button = 1 Then Clr1.BackColor = GetClr.Point(5, 5)
|
|
|
272 |
If Button = 2 Then Clr2.BackColor = GetClr.Point(5, 5)
|
|
|
273 |
End Sub 'Droper Picture1, Picture2, Picture3, Picture4, Button, X, Y, Text1, Text2, Text3
|
|
|
274 |
|
|
|
275 |
'lupa::
|
|
|
276 |
|
|
|
277 |
|
|
|
278 |
Public Sub lupa(Img As PictureBox, outImg As PictureBox, x As Single, y As Single, zveceni As Byte)
|
|
|
279 |
i = StretchBlt(outImg.hdc, 0, 0, outImg.ScaleWidth, outImg.ScaleHeight, Img.hdc, x, y, outImg.ScaleWidth / zveceni, outImg.ScaleHeight / zveceni, 13369376)
|
|
|
280 |
End Sub
|
|
|
281 |
'lupa Picture1, Picture4, X, Y, 2
|
|
|
282 |
|
|
|
283 |
|
|
|
284 |
'AIRBRUSH::
|
|
|
285 |
Public Sub Airbrush(Img As PictureBox, x As Single, y As Single, radius As Long, color As Long, hard As Long, Button As Integer)
|
|
|
286 |
Dim iBitmap As Long
|
|
|
287 |
Dim iDC As Long
|
|
|
288 |
Dim i As Integer
|
|
|
289 |
Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte
|
|
|
290 |
Dim Cnt As Long
|
|
|
291 |
Dim xC As Long
|
|
|
292 |
Dim yC As Long
|
|
|
293 |
Dim Clr As rgb
|
|
|
294 |
Dim DimtmpRad As String
|
|
|
295 |
If Button = 1 Then
|
|
|
296 |
Clr = getRGB(color)
|
|
|
297 |
Img.AutoRedraw = True
|
|
|
298 |
|
|
|
299 |
tmpRad = CStr(radius)
|
|
|
300 |
For i = 1 To 9 Step 2
|
|
|
301 |
If Right(tmpRad, 1) = i Then
|
|
|
302 |
radius = radius + 1
|
|
|
303 |
Exit For
|
|
|
304 |
End If
|
|
|
305 |
Next
|
|
|
306 |
|
|
|
307 |
With bi24BitInfo.bmiHeader
|
|
|
308 |
.biBitCount = 24
|
|
|
309 |
.biCompression = 0&
|
|
|
310 |
.biPlanes = 1
|
|
|
311 |
.biSize = Len(bi24BitInfo.bmiHeader)
|
|
|
312 |
.biWidth = CLng(radius * 2)
|
|
|
313 |
.biHeight = CLng(radius * 2)
|
|
|
314 |
End With
|
|
|
315 |
|
|
|
316 |
ReDim bBytes(1 To (bi24BitInfo.bmiHeader.biWidth + 1) * (bi24BitInfo.bmiHeader.biHeight + 1) * 3) As Byte
|
|
|
317 |
|
|
|
318 |
iDC = CreateCompatibleDC(0)
|
|
|
319 |
iBitmap = CreateDIBSection(iDC, bi24BitInfo, 0, ByVal 0&, ByVal 0&, ByVal 0&)
|
|
|
320 |
|
|
|
321 |
SelectObject iDC, iBitmap
|
|
|
322 |
BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, Img.hdc, x - radius, y - radius, vbSrcCopy
|
|
|
323 |
|
|
|
324 |
|
|
|
325 |
GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, 0
|
|
|
326 |
|
|
|
327 |
Cnt = 1
|
|
|
328 |
For yC = -radius To radius - 1
|
|
|
329 |
For xC = -radius To radius - 1
|
|
|
330 |
|
|
|
331 |
If (xC * xC) + (yC * yC) <= (radius * radius) - 1 Then
|
|
|
332 |
aplha = CByte((255 * ((Sqr((radius * radius)) - Sqr((xC * xC) + (yC * yC))) / radius)) / 100 * hard)
|
|
|
333 |
|
|
|
334 |
bBytes(Cnt) = getAlpha(CByte(aplha), CLng(Clr.b), CLng(bBytes(Cnt)))
|
|
|
335 |
bBytes(Cnt + 1) = getAlpha(CByte(aplha), CLng(Clr.g), CLng(bBytes(Cnt + 1)))
|
|
|
336 |
bBytes(Cnt + 2) = getAlpha(CByte(aplha), CLng(Clr.R), CLng(bBytes(Cnt + 2)))
|
|
|
337 |
|
|
|
338 |
End If
|
|
|
339 |
Cnt = Cnt + 3
|
|
|
340 |
Next xC
|
|
|
341 |
Next yC
|
|
|
342 |
|
|
|
343 |
SetDIBitsToDevice Img.hdc, x - radius, y - radius, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, 0
|
|
|
344 |
DeleteDC iDC
|
|
|
345 |
DeleteObject iBitmap
|
|
|
346 |
Img.Refresh
|
|
|
347 |
End If
|
|
|
348 |
End Sub
|
|
|
349 |
|
|
|
350 |
Private Function getAlpha(Alpha As Byte, Clr1 As Long, Clr2 As Long)
|
|
|
351 |
getAlpha = Clr2 + (((Clr1 * Alpha) / 255) - ((Clr2 * Alpha) / 255))
|
|
|
352 |
End Function
|
|
|
353 |
|
|
|
354 |
Private Function getRGB(C As Long) As rgb
|
|
|
355 |
getRGB.R = CByte(C Mod 255)
|
|
|
356 |
getRGB.g = CByte((C \ 255) Mod 255)
|
|
|
357 |
getRGB.b = CByte(C \ 255 \ 255)
|
|
|
358 |
End Function
|
|
|
359 |
|
|
|
360 |
'Airbrush Picture1, X, Y, 30, &H0, 21, button
|
|
|
361 |
|
|
|
362 |
|
|
|
363 |
|