home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / olympus / ik32_15t / vb4.shr / SCANLN.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-08-07  |  10.5 KB  |  328 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Appearance      =   0  'Flat
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Scanline"
  6.    ClientHeight    =   3255
  7.    ClientLeft      =   1680
  8.    ClientTop       =   3600
  9.    ClientWidth     =   9375
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   3975
  21.    Left            =   1620
  22.    LinkTopic       =   "Form1"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   217
  26.    ScaleMode       =   3  'Pixel
  27.    ScaleWidth      =   625
  28.    Top             =   2940
  29.    Width           =   9495
  30.    Begin VB.TextBox txtyPixel 
  31.       BackColor       =   &H00FFFFFF&
  32.       BeginProperty Font 
  33.          name            =   "MS Sans Serif"
  34.          charset         =   0
  35.          weight          =   400
  36.          size            =   8.25
  37.          underline       =   0   'False
  38.          italic          =   0   'False
  39.          strikethrough   =   0   'False
  40.       EndProperty
  41.       Height          =   288
  42.       Left            =   1560
  43.       TabIndex        =   2
  44.       Text            =   "txtyPixel"
  45.       Top             =   720
  46.       Width           =   972
  47.    End
  48.    Begin VB.TextBox txtXpixel 
  49.       BackColor       =   &H00FFFFFF&
  50.       BeginProperty Font 
  51.          name            =   "MS Sans Serif"
  52.          charset         =   0
  53.          weight          =   400
  54.          size            =   8.25
  55.          underline       =   0   'False
  56.          italic          =   0   'False
  57.          strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   288
  60.       Left            =   1560
  61.       TabIndex        =   1
  62.       Text            =   "txtxPixel"
  63.       Top             =   240
  64.       Width           =   972
  65.    End
  66.    Begin VB.CommandButton cmdPerformScanline 
  67.       Appearance      =   0  'Flat
  68.       BackColor       =   &H00C0C0C0&
  69.       Caption         =   "&Perform Scanline"
  70.       BeginProperty Font 
  71.          name            =   "MS Sans Serif"
  72.          charset         =   0
  73.          weight          =   400
  74.          size            =   8.25
  75.          underline       =   0   'False
  76.          italic          =   0   'False
  77.          strikethrough   =   0   'False
  78.       EndProperty
  79.       Height          =   375
  80.       Left            =   120
  81.       TabIndex        =   0
  82.       Top             =   2760
  83.       Width           =   2415
  84.    End
  85.    Begin ik32Lib.Picbuf PicbufDest 
  86.       Height          =   2895
  87.       Left            =   6000
  88.       TabIndex        =   8
  89.       Top             =   240
  90.       Width           =   3255
  91.       _Version        =   65536
  92.       _ExtentX        =   5741
  93.       _ExtentY        =   5106
  94.       _StockProps     =   253
  95.       BackColor       =   0
  96.       Appearance      =   1
  97.    End
  98.    Begin ik32Lib.Picbuf PicbufSrc 
  99.       Height          =   2895
  100.       Left            =   2640
  101.       TabIndex        =   7
  102.       Top             =   240
  103.       Width           =   3255
  104.       _Version        =   65536
  105.       _ExtentX        =   5741
  106.       _ExtentY        =   5106
  107.       _StockProps     =   253
  108.       BackColor       =   0
  109.       Appearance      =   1
  110.    End
  111.    Begin VB.Shape Shape1 
  112.       BackStyle       =   1  'Opaque
  113.       Height          =   645
  114.       Left            =   180
  115.       Top             =   1440
  116.       Width           =   2355
  117.    End
  118.    Begin VB.Label Label4 
  119.       Caption         =   "Mask Color:"
  120.       BeginProperty Font 
  121.          name            =   "MS Sans Serif"
  122.          charset         =   0
  123.          weight          =   400
  124.          size            =   8.25
  125.          underline       =   0   'False
  126.          italic          =   0   'False
  127.          strikethrough   =   0   'False
  128.       EndProperty
  129.       Height          =   285
  130.       Left            =   90
  131.       TabIndex        =   10
  132.       Top             =   1170
  133.       Width           =   1275
  134.    End
  135.    Begin MSComDlg.CommonDialog CommonDialog1 
  136.       Left            =   2160
  137.       Top             =   2160
  138.       _Version        =   65536
  139.       _ExtentX        =   847
  140.       _ExtentY        =   847
  141.       _StockProps     =   0
  142.    End
  143.    Begin VB.Label Label3 
  144.       Alignment       =   2  'Center
  145.       Caption         =   "Click on the Source Picbuf to choose a transparency color."
  146.       BeginProperty Font 
  147.          name            =   "MS Sans Serif"
  148.          charset         =   0
  149.          weight          =   400
  150.          size            =   8.25
  151.          underline       =   0   'False
  152.          italic          =   0   'False
  153.          strikethrough   =   0   'False
  154.       EndProperty
  155.       Height          =   495
  156.       Left            =   240
  157.       TabIndex        =   9
  158.       Top             =   2160
  159.       Width           =   2175
  160.    End
  161.    Begin VB.Label Label2 
  162.       Appearance      =   0  'Flat
  163.       Caption         =   "Destination Picbuf"
  164.       BeginProperty Font 
  165.          name            =   "MS Sans Serif"
  166.          charset         =   0
  167.          weight          =   400
  168.          size            =   8.25
  169.          underline       =   0   'False
  170.          italic          =   0   'False
  171.          strikethrough   =   0   'False
  172.       EndProperty
  173.       ForeColor       =   &H80000008&
  174.       Height          =   255
  175.       Left            =   6000
  176.       TabIndex        =   6
  177.       Top             =   0
  178.       Width           =   2655
  179.    End
  180.    Begin VB.Label Label1 
  181.       Appearance      =   0  'Flat
  182.       Caption         =   "Source Picbuf (Transparency)"
  183.       BeginProperty Font 
  184.          name            =   "MS Sans Serif"
  185.          charset         =   0
  186.          weight          =   400
  187.          size            =   8.25
  188.          underline       =   0   'False
  189.          italic          =   0   'False
  190.          strikethrough   =   0   'False
  191.       EndProperty
  192.       ForeColor       =   &H80000008&
  193.       Height          =   255
  194.       Left            =   2640
  195.       TabIndex        =   5
  196.       Top             =   0
  197.       Width           =   2775
  198.    End
  199.    Begin VB.Label lblYpixel 
  200.       Appearance      =   0  'Flat
  201.       Caption         =   "Mask Color Pixel Y:"
  202.       BeginProperty Font 
  203.          name            =   "MS Sans Serif"
  204.          charset         =   0
  205.          weight          =   400
  206.          size            =   8.25
  207.          underline       =   0   'False
  208.          italic          =   0   'False
  209.          strikethrough   =   0   'False
  210.       EndProperty
  211.       ForeColor       =   &H80000008&
  212.       Height          =   255
  213.       Left            =   90
  214.       TabIndex        =   4
  215.       Top             =   720
  216.       Width           =   1455
  217.    End
  218.    Begin VB.Label LblXpixel 
  219.       Appearance      =   0  'Flat
  220.       Caption         =   "Mask Color Pixel X:"
  221.       BeginProperty Font 
  222.          name            =   "MS Sans Serif"
  223.          charset         =   0
  224.          weight          =   400
  225.          size            =   8.25
  226.          underline       =   0   'False
  227.          italic          =   0   'False
  228.          strikethrough   =   0   'False
  229.       EndProperty
  230.       ForeColor       =   &H80000008&
  231.       Height          =   255
  232.       Left            =   90
  233.       TabIndex        =   3
  234.       Top             =   240
  235.       Width           =   1575
  236.    End
  237.    Begin VB.Menu mnuFile 
  238.       Caption         =   "&File"
  239.       Begin VB.Menu mnuLoadSrc 
  240.          Caption         =   "Load &Source..."
  241.       End
  242.       Begin VB.Menu mnuLoadDest 
  243.          Caption         =   "Load &Destination..."
  244.       End
  245.       Begin VB.Menu mnuSaveDest 
  246.          Caption         =   "&Save Destination..."
  247.       End
  248.       Begin VB.Menu mnuSpacer 
  249.          Caption         =   "-"
  250.       End
  251.       Begin VB.Menu mnuExit 
  252.          Caption         =   "E&xit"
  253.       End
  254.    End
  255.    Begin VB.Menu mnuReload 
  256.       Caption         =   "&Reload"
  257.    End
  258. Attribute VB_Name = "Form1"
  259. Attribute VB_Creatable = False
  260. Attribute VB_Exposed = False
  261. Option Explicit
  262. Private Sub cmdperformscanline_Click()
  263.     Dim Index, Index2 As Integer
  264.     Dim MaskColor As Double
  265.     ReDim srcscanline(0 To PicbufSrc.Xresolution - 1) As Long
  266.     ReDim destscanline(0 To PicbufDest.Xresolution - 1) As Long
  267.         
  268.     If PicbufSrc.ColorDepth > PicbufDest.ColorDepth Then
  269.         PicbufDest.IncreaseColors PicbufSrc.ColorDepth
  270.     End If
  271.         
  272.     If PicbufSrc.ColorDepth < PicbufDest.ColorDepth Then
  273.         PicbufSrc.IncreaseColors PicbufDest.ColorDepth
  274.     End If
  275.         
  276.     If PicbufSrc.ColorDepth < 24 Then
  277.         PicbufDest.DitherPal PicbufSrc
  278.         MaskColor = PicbufSrc.GetPalIndex(Val(TxtXPixel), Val(TxtYPixel))
  279.     Else
  280.         MaskColor = PicbufSrc.GetColor(Val(TxtXPixel), Val(TxtYPixel))
  281.     End If
  282.     For Index = 0 To PicbufSrc.Yresolution - 1
  283.         PicbufSrc.GetScanLine Index, srcscanline(0)
  284.         PicbufDest.GetScanLine Index, destscanline(0)
  285.         For Index2 = 0 To PicbufSrc.Xresolution - 1
  286.             If srcscanline(Index2) <> MaskColor Then
  287.                 destscanline(Index2) = srcscanline(Index2)
  288.             End If
  289.         Next
  290.         PicbufDest.PutScanLine Index, destscanline(0)
  291.     Next
  292.     MsgBox "Done!"
  293. End Sub
  294. Private Sub Form_Load()
  295.     InitPicbuf PicbufSrc, True, "Bambi1.bmp"
  296.     InitPicbuf PicbufDest, True, "Winlogo1.bmp"
  297.     PicbufSrc.MousePointer = 2
  298.     TxtXPixel.Text = "0"
  299.     TxtYPixel.Text = "0"
  300. End Sub
  301. Private Sub mnuExit_Click()
  302.     ExitProgram
  303. End Sub
  304. Private Sub mnuLoadDest_Click()
  305.     LoadImage PicbufDest, commondialog1
  306. End Sub
  307. Private Sub mnuLoadSrc_Click()
  308.     LoadImage PicbufSrc, commondialog1
  309. End Sub
  310. Private Sub mnuReload_Click()
  311.     PicbufSrc.Load
  312.     PicbufDest.Load
  313. End Sub
  314. Private Sub mnuSaveDest_Click()
  315.     SaveImage PicbufDest, commondialog1
  316. End Sub
  317. Private Sub PicbufSrc_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  318.     TxtXPixel = Format$(x \ Screen.TwipsPerPixelX)
  319.     TxtYPixel = Format$(y \ Screen.TwipsPerPixelY)
  320.     cmdperformscanline.Enabled = True
  321. End Sub
  322. Private Sub TxtXPixel_Change()
  323.     Shape1.BackColor = PicbufSrc.GetColor(Val(TxtXPixel.Text), Val(TxtYPixel.Text))
  324. End Sub
  325. Private Sub TxtYPixel_Change()
  326.     Shape1.BackColor = PicbufSrc.GetColor(Val(TxtXPixel.Text), Val(TxtYPixel.Text))
  327. End Sub
  328.