Subversion Repositories svnkaklik

Attribute VB_Name = "Nasroj"
Public ClrSet As ColorConstants
Public dravv
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
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
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
Public ha As Double
Public 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

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

Public Type rgb
R As Byte
g As Byte
b As Byte
End Type

Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
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
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
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
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
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
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal Clr As OLE_COLOR, ByVal palet As Long, col As Long) As Long

'TUZKA

Public Sub Pencil(Img As PictureBox, x As Single, y As Single, Width As Long, Button As Integer, Clr As Long)
Img.DrawWidth = Width
Img.AutoRedraw = True
If Button = 1 Then
If dravv = False Then
dravv = True
Img.Line (x, y)-(x, y)
Else
Img.Line -(x, y), Clr
End If
Img.Refresh
Else
dravv = False
End If
End Sub
'Pencil Picture1, X, Y, 3, Button,&H0

'KULATY ST.

Public Sub Brush2(Img As PictureBox, x As Single, y As Single, Button As Integer, Clr As Long, Clr2 As Long, Value As Long)
If Button = 1 Then
Img.Refresh
Img.AutoRedraw = True
a = (Value / 2)
Do
Img.Circle (x + 1, y + 1), a, Clr
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x + 1, y), a, Clr
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x, y + 1), a, Clr
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x, y), a, Clr
a = a - 1
Loop Until a = 0
Img.AutoRedraw = False
End If

If Button = 2 Then
Img.Refresh
Img.AutoRedraw = True
a = (Value / 2)
Do
Img.Circle (x + 1, y + 1), a, Clr2
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x + 1, y), a, Clr2
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x, y + 1), a, Clr2
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x, y), a, Clr2
a = a - 1
Loop Until a = 0
Img.AutoRedraw = False
End If

If Button = 0 Then
Img.Refresh
Img.AutoRedraw = False
a = (Value / 2)
Do
Img.Circle (x + 1, y + 1), a, Clr
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x + 1, y), a, Clr
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x, y + 1), a, Clr
a = a - 1
Loop Until a = 0
a = (Value / 2)
Do
Img.Circle (x, y), a, Clr
a = a - 1
Loop Until a = 0

End If
End Sub


'HRANATY ST.

Public Sub Brush1(Img As PictureBox, x As Single, y As Single, Button As Integer, Clr As Long, Clr2 As Long, Value As Long)
If Button = 1 Then
Img.Refresh
Img.AutoRedraw = True
Do
a = a + 1
Img.Line (x + a, y)-(x + a, y + Value), Clr
Loop Until a >= Value
Img.AutoRedraw = False
End If

If Button = 2 Then
Img.Refresh
Img.AutoRedraw = True
Do
a = a + 1
Img.Line (x + a, y)-(x + a, y + Value), Clr2
Loop Until a >= Value
Img.AutoRedraw = False
End If

If Button = 0 Then
Img.Refresh
Img.AutoRedraw = False
Do
a = a + 1
Img.Line (x + a, y)-(x + a, y + Value), Clr
Loop Until a >= Value
End If
End Sub
'Brush1 Picture1, X, y, button, &H0, &HFF, 10

'PLECHOVKA

Public Sub Vybarvi(Img As PictureBox, x As Single, y As Single, mode As Boolean, Clr As Long)
'On Error Resume Next
Imgp = Img.Point(x, y)
Img.FillColor = Clr
Img.FillStyle = vbSolid
If mode = True Then
rtn = ExtFloodFill(Img.hdc, x, y, Clr2, 0)
End If
If mode = False Then
rtn = ExtFloodFill(Img.hdc, x, y, Imgp, 1)
End If
'Vybarvi Picture1, x, y, False, Picture2.BackColor
End Sub

'text:

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)
Img.CurrentX = x
Img.CurrentY = y
Img.Font.Name = Font
Img.Font.Size = Size
If Tucne = 0 Then Img.FontBold = False
If Tucne = 1 Then Img.FontBold = True
If Kurziva = 0 Then Img.FontItalic = False
If Kurziva = 1 Then Img.FontItalic = True
If Podtrzene = 0 Then Img.FontUnderline = False
If Podtrzene = 1 Then Img.FontUnderline = True
If Preskrtle = 0 Then Img.FontStrikethru = False
If Preskrtle = 1 Then Img.FontStrikethru = True
If Transparent = 0 Then Img.FontTransparent = False
If Transparent = 1 Then Img.FontTransparent = True
Img.ForeColor = Clr
Img.AutoRedraw = True
Img.Print Property.tBox
Img.Refresh
Img.AutoRedraw = False
End Sub
'Textwr Picture1, X, Y, Text1, 10, Combo1, Check3, Check4, Check5, Check6, Check7, &H0, &HFF

'spray:

Public Sub spray(Img As PictureBox, x As Single, y As Single, Button As Integer, Area As Long, Density As Long, Clr As Long)
Randomize Timer
If Button = 1 Then
Img.DrawWidth = 1
For a = 0 To (Density / 10) * Area
t = Int(Rnd * 10)
C = Int(Rnd * 10)
If t <= 5 Then ttf = -1
If t >= 5 Then ttf = 1
If C <= 5 Then ttb = -1
If C >= 5 Then ttb = 1
Img.PSet (x + (Rnd * Area) * ttf, y + (Rnd * Area) * ttb), Clr
Next a
End If
'spray Picture1, X, Y, Button, 40, 10, &H0
End Sub


'GuMa

Public Sub rubber(Img As PictureBox, Xa As Single, Ya As Single, Big As Long, Button As Integer)
Img.Refresh
Img.AutoRedraw = False
Img.Line (Xa, Ya)-(Xa - Big, Ya - Big), &HFFFFFF, BF
If Button = 1 Then
Img.AutoRedraw = True
Img.Line (Xa, Ya)-(Xa - Big, Ya - Big), &HFFFFFF, BF
Img.AutoRedraw = False
End If 'rubber Picture1, X, Y, 10, Button
End Sub


'kapatkoo:

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)
RGBmax = 256
i = StretchBlt(GetClr.hdc, 0, 0, 80, 80, Img.hdc, x, y, 1, 1, 13369376)
Imgp = GetClr.Point(5, 5)
RGBb = Imgp \ RGBmax \ RGBmax
RGBg = (Imgp \ RGBmax) Mod RGBmax
RGBr = Imgp Mod RGBmax
If Button = 1 Then Clr1.BackColor = GetClr.Point(5, 5)
If Button = 2 Then Clr2.BackColor = GetClr.Point(5, 5)
End Sub 'Droper Picture1, Picture2, Picture3, Picture4, Button, X, Y, Text1, Text2, Text3

'lupa::


Public Sub lupa(Img As PictureBox, outImg As PictureBox, x As Single, y As Single, zveceni As Byte)
i = StretchBlt(outImg.hdc, 0, 0, outImg.ScaleWidth, outImg.ScaleHeight, Img.hdc, x, y, outImg.ScaleWidth / zveceni, outImg.ScaleHeight / zveceni, 13369376)
End Sub
'lupa Picture1, Picture4, X, Y, 2


'AIRBRUSH::
Public Sub Airbrush(Img As PictureBox, x As Single, y As Single, radius As Long, color As Long, hard As Long, Button As Integer)
Dim iBitmap As Long
Dim iDC As Long
Dim i As Integer
Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte
Dim Cnt As Long
Dim xC As Long
Dim yC As Long
Dim Clr As rgb
Dim DimtmpRad As String
If Button = 1 Then
Clr = getRGB(color)
Img.AutoRedraw = True

tmpRad = CStr(radius)
For i = 1 To 9 Step 2
If Right(tmpRad, 1) = i Then
radius = radius + 1
Exit For
End If
Next

With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = 0&
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = CLng(radius * 2)
.biHeight = CLng(radius * 2)
End With

ReDim bBytes(1 To (bi24BitInfo.bmiHeader.biWidth + 1) * (bi24BitInfo.bmiHeader.biHeight + 1) * 3) As Byte

iDC = CreateCompatibleDC(0)
iBitmap = CreateDIBSection(iDC, bi24BitInfo, 0, ByVal 0&, ByVal 0&, ByVal 0&)

SelectObject iDC, iBitmap
BitBlt iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, Img.hdc, x - radius, y - radius, vbSrcCopy


GetDIBits iDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, 0

Cnt = 1
For yC = -radius To radius - 1
For xC = -radius To radius - 1

If (xC * xC) + (yC * yC) <= (radius * radius) - 1 Then
aplha = CByte((255 * ((Sqr((radius * radius)) - Sqr((xC * xC) + (yC * yC))) / radius)) / 100 * hard)

bBytes(Cnt) = getAlpha(CByte(aplha), CLng(Clr.b), CLng(bBytes(Cnt)))
bBytes(Cnt + 1) = getAlpha(CByte(aplha), CLng(Clr.g), CLng(bBytes(Cnt + 1)))
bBytes(Cnt + 2) = getAlpha(CByte(aplha), CLng(Clr.R), CLng(bBytes(Cnt + 2)))

End If
Cnt = Cnt + 3
Next xC
Next yC

SetDIBitsToDevice Img.hdc, x - radius, y - radius, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, 0
DeleteDC iDC
DeleteObject iBitmap
Img.Refresh
End If
End Sub

Private Function getAlpha(Alpha As Byte, Clr1 As Long, Clr2 As Long)
getAlpha = Clr2 + (((Clr1 * Alpha) / 255) - ((Clr2 * Alpha) / 255))
End Function

Private Function getRGB(C As Long) As rgb
getRGB.R = CByte(C Mod 255)
getRGB.g = CByte((C \ 255) Mod 255)
getRGB.b = CByte(C \ 255 \ 255)
End Function

'Airbrush Picture1, X, Y, 30, &H0, 21, button