Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / transp1a / frmmain.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1999-05-28 | 28.3 KB | 715 lines

VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" Object = "{38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0"; "COMCT332.OCX" Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx" Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX" Begin VB.Form frmMain AutoRedraw = -1 'True Caption = "Transparency/Translucency Mask and Image Creator" ClientHeight = 4350 ClientLeft = 165 ClientTop = 720 ClientWidth = 7065 Icon = "frmMain.frx":0000 LinkTopic = "Form1" MinButton = 0 'False ScaleHeight = 290 ScaleMode = 3 'Pixel ScaleWidth = 471 StartUpPosition = 3 'Windows Default Begin VB.PictureBox pImageView Align = 1 'Align Top AutoRedraw = -1 'True BackColor = &H00800000& BorderStyle = 0 'None Height = 3105 Left = 0 ScaleHeight = 207 ScaleMode = 3 'Pixel ScaleWidth = 471 TabIndex = 4 Top = 1245 Width = 7065 End Begin MSComDlg.CommonDialog cDia Left = 2700 Top = 1860 _ExtentX = 847 _ExtentY = 847 _Version = 393216 CancelError = -1 'True DialogTitle = "Select Image" Filter = "Bitmap Files (*.bmp)|*.bmp" Flags = 4 End Begin ComCtl3.CoolBar cbTB Align = 1 'Align Top Height = 1245 Left = 0 TabIndex = 0 Top = 0 Width = 7065 _ExtentX = 12462 _ExtentY = 2196 FixedOrder = -1 'True _CBWidth = 7065 _CBHeight = 1245 _Version = "6.0.8169" Child1 = "tbGen" MinHeight1 = 26 Width1 = 7 NewRow1 = 0 'False Child2 = "pOptions" MinHeight2 = 23 Width2 = 9 NewRow2 = -1 'True Child3 = "tbView" MinHeight3 = 26 Width3 = 7 NewRow3 = -1 'True Begin VB.PictureBox pOptions BorderStyle = 0 'None Height = 345 Left = 165 ScaleHeight = 23 ScaleMode = 3 'Pixel ScaleWidth = 454 TabIndex = 12 Top = 450 Width = 6810 Begin VB.ComboBox cboStyle Height = 315 ItemData = "frmMain.frx":014A Left = 3450 List = "frmMain.frx":0154 Style = 2 'Dropdown List TabIndex = 15 Top = 30 Width = 2115 End Begin VB.CheckBox chkUseTransL Caption = "Use Translucency" Height = 255 Left = 1710 TabIndex = 14 Top = 60 Value = 1 'Checked Width = 1635 End Begin VB.CheckBox chkUseTransP Caption = "Use Transparency" Height = 255 Left = 0 TabIndex = 13 Top = 60 Value = 1 'Checked Width = 1635 End End Begin MSComctlLib.Toolbar tbView Height = 390 Left = 165 TabIndex = 3 Top = 825 Width = 6810 _ExtentX = 12012 _ExtentY = 688 ButtonWidth = 609 ButtonHeight = 582 ImageList = "imlToolbarIcons(1)" _Version = 393216 BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} NumButtons = 4 BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} Enabled = 0 'False Key = "Starting Image" Object.ToolTipText = "View Starting Image" ImageKey = "cimage" Style = 2 Value = 1 EndProperty BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} Enabled = 0 'False Key = "Compiled Image" Object.ToolTipText = "View Compiled Image" ImageKey = "cimage2" Style = 2 EndProperty BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} Enabled = 0 'False Key = "Mask" Object.ToolTipText = "View Mask" ImageKey = "cmask" Style = 2 EndProperty BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} Enabled = 0 'False Key = "Put-together Image" Object.ToolTipText = "View Put-together Image" ImageKey = "finished" Style = 2 EndProperty EndProperty End Begin MSComctlLib.Toolbar tbGen Height = 390 Left = 30 TabIndex = 1 Top = 30 Width = 6945 _ExtentX = 12250 _ExtentY = 688 ButtonWidth = 609 ButtonHeight = 582 ImageList = "imlToolbarIcons(0)" _Version = 393216 BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} NumButtons = 10 BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} Key = "Open" Object.ToolTipText = "Open" ImageKey = "Open" EndProperty BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} Key = "Save" Object.ToolTipText = "Save" ImageKey = "Save" EndProperty BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} Enabled = 0 'False Key = "Compile" Object.ToolTipText = "Compile Images" ImageKey = "Compile" EndProperty BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} Key = "TransPColorPH" Style = 4 Object.Width = 1635 EndProperty BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} Key = "TransLColorPH" Style = 4 Object.Width = 1635 EndProperty BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} Style = 3 EndProperty BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} Key = "TransLLevelPH" Style = 4 Object.Width = 1425 EndProperty EndProperty Begin VB.PictureBox pTranslLevelP BorderStyle = 0 'None Height = 315 Left = 5160 ScaleHeight = 315 ScaleWidth = 1425 TabIndex = 16 Top = 60 Width = 1425 Begin VB.TextBox txtTransLP Height = 315 Left = 0 TabIndex = 18 Text = "50" Top = 0 Width = 1050 End Begin MSComCtl2.UpDown UDTransLP Height = 315 Left = 1051 TabIndex = 17 Top = 0 Width = 195 _ExtentX = 344 _ExtentY = 556 _Version = 393216 Value = 50 AutoBuddy = -1 'True BuddyControl = "txtTransLP" BuddyDispid = 196615 OrigLeft = 1020 OrigRight = 1215 OrigBottom = 315 Max = 100 Min = 1 SyncBuddy = -1 'True BuddyProperty = 65547 Enabled = -1 'True End Begin VB.Label Label1 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "%" Height = 195 Left = 1275 TabIndex = 19 Top = 30 Width = 120 End End Begin VB.PictureBox pTransLColorP BorderStyle = 0 'None Height = 255 Left = 3060 ScaleHeight = 255 ScaleWidth = 1635 TabIndex = 9 Top = 90 Width = 1635 Begin VB.PictureBox pTransLColorB BackColor = &H007595FF& Height = 180 Left = 0 ScaleHeight = 120 ScaleWidth = 225 TabIndex = 10 ToolTipText = "Double Click To Change &H7595FF&" Top = 0 Width = 285 End Begin VB.Label lPTransLColorB AutoSize = -1 'True Caption = "Translucent Color" Height = 195 Left = 300 TabIndex = 11 Top = 0 Width = 1245 End End Begin VB.PictureBox pTransPColorP BorderStyle = 0 'None Height = 255 Left = 1230 ScaleHeight = 255 ScaleWidth = 1635 TabIndex = 6 Top = 90 Width = 1635 Begin VB.PictureBox pTransPColorB BackColor = &H002D2D2D& Height = 255 Left = 0 ScaleHeight = 195 ScaleWidth = 225 TabIndex = 8 ToolTipText = "Double Click To Change &H2D2D2D" Top = 0 Width = 285 End Begin VB.Label lPTransPColorB AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Transparent Color" Height = 195 Left = 330 TabIndex = 7 Top = 30 Width = 1260 End End End End Begin MSComctlLib.ImageList imlToolbarIcons Index = 0 Left = 3660 Top = 3150 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 393216 BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} NumListImages = 3 BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":0178 Key = "Open" EndProperty BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":028A Key = "Save" EndProperty BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":039C Key = "Compile" EndProperty EndProperty End Begin MSComctlLib.ImageList imlToolbarIcons Index = 1 Left = 1605 Top = 1965 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 393216 BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} NumListImages = 5 BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":04F8 Key = "cimage" EndProperty BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":06D2 Key = "cimage2" EndProperty BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":08AC Key = "cmask" EndProperty BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":0A86 Key = "ctrans" EndProperty BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} Picture = "frmMain.frx":0C60 Key = "finished" EndProperty EndProperty End Begin VB.PictureBox pWork AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 900 Left = 4200 ScaleHeight = 60 ScaleMode = 3 'Pixel ScaleWidth = 105 TabIndex = 2 Top = 2910 Visible = 0 'False Width = 1575 End Begin VB.PictureBox pWSize AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 525 Left = 1560 ScaleHeight = 35 ScaleMode = 3 'Pixel ScaleWidth = 83 TabIndex = 5 Top = 2850 Visible = 0 'False Width = 1245 End Begin MSComDlg.CommonDialog cDiaColor Left = 2700 Top = 1980 _ExtentX = 847 _ExtentY = 847 _Version = 393216 CancelError = -1 'True End Begin VB.Timer tEnableCheck Interval = 200 Left = 1620 Top = 1980 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileSave Caption = "&Save" Shortcut = ^S End Begin VB.Menu mnuFileOpen Caption = "&Open" Shortcut = ^O End Begin VB.Menu mnuFileS2 Caption = "-" End Begin VB.Menu mnuFileExit Caption = "E&xit" End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Quitting As Boolean Private nB As StdPicture Private nFileName As String Private Changed As Boolean Private nCIQ As New CImgQuad Private nView As String Private Compiled As Boolean Private Const mDCTC As String = "Double Click To Change" Private Sub cboStyle_Click() nCIQ.Style = cboStyle.ListIndex End Sub Private Sub chkUseTransL_Click() nCIQ.UseTranslucency = chkUseTransL.Value And 1 End Sub Private Sub chkUseTransP_Click() nCIQ.UseTransparency = chkUseTransP.Value And 1 End Sub Private Sub Form_Load() Set nB = LoadResPicture("Backdrop", 0) End Sub Private Sub pTransLColorB_DblClick() cDiaColor.Flags = cdlCCFullOpen + cdlCCRGBInit cDiaColor.Color = pTransLColorB.BackColor On Error Resume Next cDiaColor.ShowColor If Err = cdlCancel Then _ Exit Sub pTransLColorB.BackColor = cDiaColor.Color pTransLColorB.ToolTipText = mDCTC & " &H" & Hex(pTransLColorB.BackColor) End Sub Private Sub pTransLColorP_Resize() pTransLColorB.Height = pTransLColorP.Height lPTransLColorB.Top = pTransLColorP.Height / 2 - lPTransLColorB.Height / 2 End Sub Private Sub pTransPColorB_DblClick() cDiaColor.Flags = cdlCCFullOpen + cdlCCRGBInit cDiaColor.Color = pTransPColorB.BackColor On Error Resume Next cDiaColor.ShowColor If Err = cdlCancel Then _ Exit Sub pTransPColorB.BackColor = cDiaColor.Color pImageView.BackColor = pTransPColorB.BackColor pTransPColorB.ToolTipText = mDCTC & " &H" & Hex(pTransPColorB.BackColor) End Sub Private Sub pTransPColorP_Resize() pTransPColorB.Height = pTransPColorP.Height lPTransPColorB.Top = pTransPColorP.Height / 2 - lPTransPColorB.Height / 2 End Sub Private Sub tbView_ButtonClick(ByVal Button As MSComctlLib.Button) On Error Resume Next nView = Button.Key End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) cMSave End Sub Private Sub Form_Resize() pImageView.Move pImageView.Left, pImageView.Top, pImageView.Width, ScaleHeight - cbTB.Height pTransPColorP.Move tbGen.Buttons("TransPColorPH").Left, tbGen.Buttons("TransPColorPH").Top, tbGen.Buttons("TransPColorPH").Width, tbGen.Buttons("TransPColorPH").Height pTransLColorP.Move tbGen.Buttons("TransLColorPH").Left, tbGen.Buttons("TransLColorPH").Top, tbGen.Buttons("TransLColorPH").Width, tbGen.Buttons("TransLColorPH").Height pTranslLevelP.Move tbGen.Buttons("TransLLevelPH").Left, tbGen.Buttons("TransLLevelPH").Top, tbGen.Buttons("TransLLevelPH").Width, tbGen.Buttons("TransLLevelPH").Height End Sub Private Sub mnuFileExit_Click() cExit End Sub Private Sub mnuFileOpen_Click() cOpen End Sub Private Sub mnuFileSave_Click() cSave End Sub Private Sub tbGen_ButtonClick(ByVal Button As MSComctlLib.Button) pWork.Cls On Error Resume Next Select Case Button.Key Case "Open" cOpen Case "Save" cSave Case "Compile" MousePointer = vbHourglass Dim m_lngLoopH As Long, m_lngLoopW As Long pWSize = nCIQ.ImageStart pWork.Move pWork.Left, pWork.Top, pWSize.Width, pWSize.Height For m_lngLoopH = 0 To pWSize.Height For m_lngLoopW = 0 To pWSize.Width If nCIQ.UseTransparency Then If pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransPColorB.BackColor Then pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(15) Else pWork.PSet (m_lngLoopW, m_lngLoopH), 0 End If Else If Not pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransLColorB.BackColor Then pWork.PSet (m_lngLoopW, m_lngLoopH), 0 Else pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(15) End If End If If nCIQ.UseTranslucency Then If nCIQ.Style = [TransL!=Solid] Then If Not (Not pWSize.Point(m_lngLoopW, m_lngLoopH) = 0 And Not pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransLColorB.BackColor) Then If Not pWSize.Point(m_lngLoopW, m_lngLoopH) = 0 Then pWork.PSet (m_lngLoopW, m_lngLoopH), ReturnPercentageColor(pWSize.Point(m_lngLoopW, m_lngLoopH), 100 - txtTransLP) Else pWork.PSet (m_lngLoopW, m_lngLoopH), 0 End If End If Else If Not (pWSize.Point(m_lngLoopW, m_lngLoopH) = 0 Or pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransLColorB.BackColor) Then 'pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(15) If pWSize.Point(m_lngLoopW, m_lngLoopH) = 0 And Not pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransPColorB.BackColor Then pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(0) Else If pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransPColorB.BackColor Then pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(15) Else pWork.PSet (m_lngLoopW, m_lngLoopH), ReturnPercentageColor(pWSize.Point(m_lngLoopW, m_lngLoopH), 100 - txtTransLP) End If End If End If End If End If Next Next Set nCIQ.ImageMask = pWork.Image pWork.Cls pWSize = nCIQ.ImageStart For m_lngLoopH = 0 To pWSize.Height For m_lngLoopW = 0 To pWSize.Width If nCIQ.UseTransparency Then If pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransPColorB.BackColor Then pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(15) Else pWork.PSet (m_lngLoopW, m_lngLoopH), pWSize.Point(m_lngLoopW, m_lngLoopH) End If Else If Not pWSize.Point(m_lngLoopW, m_lngLoopH) = pTransLColorB.BackColor Then pWork.PSet (m_lngLoopW, m_lngLoopH), pWSize.Point(m_lngLoopW, m_lngLoopH) Else pWork.PSet (m_lngLoopW, m_lngLoopH), QBColor(15) End If End If Next Next Set nCIQ.ImageCompiled = pWork.Image ' ' Compiled = True Changed = True End Select MousePointer = 0 End Sub Public Sub cSave() If Not Changed Then _ Exit Sub If Len(nFileName) = 0 Then Exit Sub On Error Resume Next cDia.Flags = 4 + cdlOFNOverwritePrompt cDia.DialogTitle = "Select the Compiled Image Filename" cDia.FileName = "image.bmp" cDia.ShowSave If Err = cdlCancel Then _ Exit Sub SavePicture nCIQ.ImageCompiled, cDia.FileName If nCIQ.UseTransparency Then cDia.DialogTitle = "Select the Image Mask Filename" cDia.FileName = "mask.bmp" cDia.ShowSave If Err = cdlCancel Then _ Exit Sub SavePicture nCIQ.ImageMask, cDia.FileName End If Changed = False End Sub Public Sub cOpen() cMSave On Error Resume Next cDia.DialogTitle = "Select the Image to Open" cDia.Flags = 4 + cdlOFNFileMustExist cDia.ShowOpen If Err = cdlCancel Then _ Exit Sub nFileName = cDia.FileName Set nCIQ = New CImgQuad chkUseTransL.Value = nCIQ.UseTranslucency And 1 chkUseTransP.Value = nCIQ.UseTransparency And 1 cboStyle.ListIndex = nCIQ.Style Set nCIQ.ImageStart = LoadPicture(nFileName) Changed = False End Sub Public Sub cMSave() If Changed Then If MsgBox("Do you wish to save changes to your compiled images?", vbYesNo + vbQuestion, App.Title & " - Question") = vbYes Then cSave End If If Quitting Then _ Changed = False End If End Sub Public Sub cExit() Quitting = True cMSave Unload Me End Sub Private Sub tEnableCheck_Timer() Dim nButton As Button Set nButton = tbGen.Buttons("Compile") IfNotThenEnable nButton, (nButton.Enabled = CBool(Not Len(nFileName) = 0)) For Each nButton In tbView.Buttons IfNotThenEnable nButton, (nButton.Enabled = CBool((Not Len(nFileName) = 0) And Compiled)) Next If Not Compiled Then _ Exit Sub UpdateImage End Sub Public Sub IfNotThenEnable(Object As Object, Value As Boolean) If Not Value Then _ Object.Enabled = True End Sub Public Sub UpdateImage() If nCIQ Is Nothing Then _ Compiled = False: _ Exit Sub If Not Compiled Then Exit Sub pImageView.Cls On Error Resume Next Select Case nView Case "Starting Image" pWSize.Picture = nCIQ.ImageStart pImageView.PaintPicture nCIQ.ImageStart, pImageView.ScaleWidth / 2 - pWSize.Width / 2, pImageView.ScaleHeight / 2 - pWSize.ScaleHeight / 2 Case "Compiled Image" pWSize.Picture = nCIQ.ImageStart pImageView.PaintPicture nCIQ.ImageCompiled, pImageView.ScaleWidth / 2 - pWSize.Width / 2, pImageView.ScaleHeight / 2 - pWSize.ScaleHeight / 2 Case "Mask" pWSize.Picture = nCIQ.ImageStart pImageView.PaintPicture nCIQ.ImageMask, pImageView.ScaleWidth / 2 - pWSize.Width / 2, pImageView.ScaleHeight / 2 - pWSize.ScaleHeight / 2 Case "Put-together Image" Dim nWid As Integer nWid = pImageView.ScaleWidth / 16 Dim m_lngLoop As Long pWSize.Picture = nB TileImage pImageView, pWSize pWSize.Picture = nCIQ.ImageStart pImageView.Line (0, 0)-(pWSize.Width * 2, pWSize.Height * 2), QBColor(2), BF pImageView.PaintPicture nCIQ.ImageMask, 0, 0, , , , , , , vbMergePaint pImageView.PaintPicture nCIQ.ImageCompiled, pWSize.Width, 0, , , , , , , vbSrcAnd pImageView.PaintPicture nCIQ.ImageMask, 0, pWSize.Height pImageView.PaintPicture nCIQ.ImageCompiled, pWSize.Width, pWSize.Height pWSize.Picture = nCIQ.ImageStart pImageView.PaintPicture nCIQ.ImageMask, pImageView.ScaleWidth / 2 - pWSize.Width / 2, pImageView.ScaleHeight / 2 - pWSize.ScaleHeight / 2, , , , , , , vbMergePaint pWSize.Picture = nCIQ.ImageStart pImageView.PaintPicture nCIQ.ImageCompiled, pImageView.ScaleWidth / 2 - pWSize.Width / 2, pImageView.ScaleHeight / 2 - pWSize.ScaleHeight / 2, , , , , , , vbSrcAnd End Select End Sub Public Function ReturnPercentageColor(Color As OLE_COLOR, Percent As Byte) As OLE_COLOR Dim R As Byte, G As Byte, B As Byte R = (CLng((Color Mod 256) * Percent)) \ 100 G = (CLng((Color \ 256 Mod 256) * Percent)) \ 100 B = (CLng((Color \ 256 \ 256 Mod 256) * Percent)) \ 100 ReturnPercentageColor = RGB(R, G, B) End Function