Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing Form4.frm (10.09 KB)
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form4
BorderStyle = 3 'Fixed Dialog
Caption = "Picture Functions"
ClientHeight = 4560
ClientLeft = 45
ClientTop = 330
ClientWidth = 8340
Icon = "Form4.frx":0000
LinkTopic = "Form4"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 304
ScaleMode = 3 'Pixel
ScaleWidth = 556
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command7
Caption = "SB Invert"
Height = 255
Left = 7200
TabIndex = 12
Top = 3960
Width = 975
End
Begin VB.CommandButton Command6
Caption = "Sunburst"
Height = 255
Left = 7200
TabIndex = 11
Top = 3600
Width = 975
End
Begin VB.Frame Frame1
Caption = "Gradient/Sunburst Colors"
Height = 735
Left = 4200
TabIndex = 7
Top = 3480
Width = 2895
Begin VB.PictureBox Picture3
BackColor = &H00000000&
ForeColor = &H00000000&
Height = 375
Left = 240
ScaleHeight = 315
ScaleWidth = 555
TabIndex = 10
Top = 240
Width = 615
End
Begin VB.PictureBox Picture4
BackColor = &H00FFFFFF&
Height = 375
Left = 960
ScaleHeight = 315
ScaleWidth = 555
TabIndex = 9
Top = 240
Width = 615
End
Begin VB.CommandButton Command5
Caption = "Swap"
Height = 375
Left = 1800
TabIndex = 8
Top = 240
Width = 855
End
End
Begin VB.CommandButton Command4
Caption = "Combine"
Height = 375
Left = 1440
TabIndex = 5
Top = 3960
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "Swap"
Height = 375
Left = 1560
TabIndex = 4
Top = 3480
Width = 975
End
Begin VB.CommandButton Command3
Caption = "Reset"
Height = 375
Left = 3120
TabIndex = 3
Top = 3480
Width = 975
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3600
Top = 3960
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DefaultExt = "*.*"
Filter = "All Image Files|*.bmp;*.jpeg;*.jpg;*.gif|All Files (*.*)|*.*"
End
Begin VB.CommandButton Command1
Caption = "Fade"
Height = 375
Left = 120
TabIndex = 2
Top = 3480
Width = 975
End
Begin VB.PictureBox Picture2
Height = 3255
Left = 4200
MousePointer = 2 'Cross
ScaleHeight = 213
ScaleMode = 3 'Pixel
ScaleWidth = 261
TabIndex = 1
ToolTipText = "Left Click to create gradient, Right Click to get color, and Middle Click to create sunburst."
Top = 120
Width = 3975
End
Begin VB.PictureBox Picture1
BackColor = &H00C0C0C0&
Height = 3255
Left = 120
MousePointer = 2 'Cross
ScaleHeight = 213
ScaleMode = 3 'Pixel
ScaleWidth = 261
TabIndex = 0
ToolTipText = "Left Click to create gradient, Right Click to get color, and Middle Click to create sunburst."
Top = 120
Width = 3975
End
Begin VB.Label Label1
AutoSize = -1 'True
Height = 195
Left = 120
TabIndex = 6
Top = 4080
Width = 45
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FName1 As String
Dim FName2 As String
Dim Swap As Boolean
Const SRCCOPY = &HCC0020
Const SRCINVERT = &H660046
Const SRCPAINT = &HEE0086
Const SRCAND = &H8800C6
Const SRCERASE = &H440328
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 Integer
Private Sub Command1_Click()
Dim Retcode As Long
Retcode = FadePicture(Picture1.hDC, Picture2.hDC, _
Val(InputBox("Enter the Width:", "Pic Fader", Picture1.ScaleWidth)), _
Val(InputBox("Enter the Height:", "Pic Fader", Picture1.ScaleHeight)), _
Val(InputBox("Enter the Fade Num (1-99):", "Pic Fader", "10")))
If Not Retcode Then MsgBox "An error had occurred during the fade", vbExclamation
End Sub
Private Sub Command2_Click()
Swap = Not Swap
Command3_Click
End Sub
Private Sub Command3_Click()
If Swap = False Then
Picture1.Picture = LoadPicture(FName1)
Picture2.Picture = LoadPicture(FName2)
Else
Picture1.Picture = LoadPicture(FName2)
Picture2.Picture = LoadPicture(FName1)
End If
End Sub
Private Sub Command4_Click()
Dim Width As Integer, Height As Integer
Dim Retcode As Long
Width = Val(InputBox("Enter the Width:", "Pic Fader", Picture1.ScaleWidth))
Height = Val(InputBox("Enter the Height:", "Pic Fader", Picture1.ScaleHeight))
Retcode = BitBlt(Picture1.hDC, 0, 0, Width, Height, _
Combine_hDC(Picture1.hDC, Picture2.hDC, Width, Height), 0, 0, SRCCOPY)
End Sub
Private Sub Command5_Click()
Dim C2 As Long
C2 = Picture4.BackColor
Picture4.BackColor = Picture3.BackColor
Picture3.BackColor = C2
End Sub
Private Sub Command6_Click()
Dim Retcode As Long
Retcode = PaintSunburst(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleWidth, Picture3.BackColor, Picture4.BackColor)
End Sub
Private Sub Command7_Click()
Dim Retcode As Long
Retcode = PaintSunburst(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleWidth, Picture3.BackColor, Picture4.BackColor)
Retcode = PaintSunburst(Picture2.hDC, 0, 0, Picture2.ScaleWidth, Picture2.ScaleWidth, Picture4.BackColor, Picture3.BackColor)
End Sub
Private Sub Form_Load()
CommonDialog1.Flags = cdlOFNOverwritePrompt + cdlOFNLongNames + cdlOFNHideReadOnly
CommonDialog1.FileName = ""
CommonDialog1.DialogTitle = "Picture 1"
CommonDialog1.ShowOpen
FName1 = CommonDialog1.FileName
Picture1.Picture = LoadPicture(FName1)
CommonDialog1.FileName = ""
CommonDialog1.DialogTitle = "Picture 2"
CommonDialog1.ShowOpen
FName2 = CommonDialog1.FileName
Picture2.Picture = LoadPicture(FName2)
Swap = False
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlCCRGBInit + cdlCCFullOpen
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Caption = ""
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Label1.Caption = X & "," & Y
If Button = 2 Then
Picture3.BackColor = GetPixel(Picture2.hDC, X, Y)
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim Retcode As Long
If Button = 1 Then
Retcode = PaintGradient(Picture1.hDC, _
Val(Trim(Str(X))), Val(Trim(Str(Y))), _
Val(InputBox("Width:", "Gradient", (Picture1.ScaleWidth - X))), _
Val(InputBox("Height:", "Gradient", (Picture1.ScaleHeight - Y))), _
Picture3.BackColor, Picture4.BackColor, Val(InputBox("Type:", "Gradient", "0")))
End If
If Button = 2 Then
Picture3.BackColor = GetPixel(Picture1.hDC, X, Y)
End If
If Button = 4 Then
Retcode = PaintSunburst(Picture1.hDC, _
Val(Trim(Str(X))), Val(Trim(Str(Y))), _
Val(InputBox("Width:", "Sunburst", (Picture1.ScaleWidth - X))), _
Val(InputBox("Height:", "Sunburst", (Picture1.ScaleHeight - Y))), _
Picture3.BackColor, Picture4.BackColor)
End If
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Label1.Caption = X & "," & Y
If Button = 2 Then
Picture4.BackColor = GetPixel(Picture2.hDC, X, Y)
End If
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim Retcode As Long
If Button = 1 Then
Retcode = PaintGradient(Picture2.hDC, _
Val(Trim(Str(X))), Val(Trim(Str(Y))), _
Val(InputBox("Width:", "Gradient", (Picture2.ScaleWidth - X))), _
Val(InputBox("Height:", "Gradient", (Picture2.ScaleHeight - Y))), _
Picture3.BackColor, Picture4.BackColor, Val(InputBox("Type:", "Gradient", "0")))
End If
If Button = 2 Then
Picture4.BackColor = GetPixel(Picture2.hDC, X, Y)
End If
If Button = 4 Then
Retcode = PaintSunburst(Picture2.hDC, _
Val(Trim(Str(X))), Val(Trim(Str(Y))), _
Val(InputBox("Width:", "Sunburst", (Picture2.ScaleWidth - X))), _
Val(InputBox("Height:", "Sunburst", (Picture2.ScaleHeight - Y))), _
Picture3.BackColor, Picture4.BackColor)
End If
End Sub
Private Sub Picture3_Click()
On Error GoTo FixErr
CommonDialog1.Color = Picture3.BackColor
CommonDialog1.ShowColor
Picture3.BackColor = CommonDialog1.Color
FixErr:
End Sub
Private Sub Picture4_Click()
On Error GoTo FixErr
CommonDialog1.Color = Picture4.BackColor
CommonDialog1.ShowColor
Picture4.BackColor = CommonDialog1.Color
FixErr:
End Sub