home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH4 / SRC / COMPOSE.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-01-03  |  14.8 KB  |  458 lines
  1. VERSION 4.00
  2. Begin VB.Form CompositeForm 
  3.    Caption         =   "Composite"
  4.    ClientHeight    =   5895
  5.    ClientLeft      =   1215
  6.    ClientTop       =   585
  7.    ClientWidth     =   6510
  8.    Height          =   6300
  9.    Left            =   1155
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   393
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   434
  14.    Top             =   240
  15.    Width           =   6630
  16.    Begin VB.PictureBox DestPict 
  17.       AutoRedraw      =   -1  'True
  18.       AutoSize        =   -1  'True
  19.       Height          =   375
  20.       Left            =   6120
  21.       ScaleHeight     =   21
  22.       ScaleMode       =   3  'Pixel
  23.       ScaleWidth      =   21
  24.       TabIndex        =   7
  25.       Top             =   1440
  26.       Visible         =   0   'False
  27.       Width           =   375
  28.    End
  29.    Begin VB.PictureBox Mask2Pict 
  30.       AutoRedraw      =   -1  'True
  31.       AutoSize        =   -1  'True
  32.       Height          =   375
  33.       Left            =   6120
  34.       ScaleHeight     =   21
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   21
  37.       TabIndex        =   6
  38.       Top             =   960
  39.       Visible         =   0   'False
  40.       Width           =   375
  41.    End
  42.    Begin VB.PictureBox Mask1Pict 
  43.       AutoRedraw      =   -1  'True
  44.       AutoSize        =   -1  'True
  45.       Height          =   375
  46.       Left            =   6120
  47.       ScaleHeight     =   21
  48.       ScaleMode       =   3  'Pixel
  49.       ScaleWidth      =   21
  50.       TabIndex        =   5
  51.       Top             =   480
  52.       Visible         =   0   'False
  53.       Width           =   375
  54.    End
  55.    Begin VB.PictureBox SourcePict 
  56.       AutoRedraw      =   -1  'True
  57.       AutoSize        =   -1  'True
  58.       Height          =   375
  59.       Left            =   6120
  60.       ScaleHeight     =   21
  61.       ScaleMode       =   3  'Pixel
  62.       ScaleWidth      =   21
  63.       TabIndex        =   4
  64.       Top             =   0
  65.       Visible         =   0   'False
  66.       Width           =   375
  67.    End
  68.    Begin VB.PictureBox DisplaySwin 
  69.       Height          =   5655
  70.       Left            =   0
  71.       ScaleHeight     =   373
  72.       ScaleMode       =   3  'Pixel
  73.       ScaleWidth      =   413
  74.       TabIndex        =   2
  75.       Top             =   0
  76.       Width           =   6255
  77.       Begin VB.PictureBox DisplayPict 
  78.          AutoRedraw      =   -1  'True
  79.          Height          =   5535
  80.          Left            =   0
  81.          Picture         =   "COMPOSE.frx":0000
  82.          ScaleHeight     =   365
  83.          ScaleMode       =   3  'Pixel
  84.          ScaleWidth      =   405
  85.          TabIndex        =   3
  86.          Top             =   0
  87.          Width           =   6135
  88.       End
  89.    End
  90.    Begin VB.HScrollBar DisplayHBar 
  91.       Enabled         =   0   'False
  92.       Height          =   255
  93.       Left            =   0
  94.       TabIndex        =   1
  95.       Top             =   5640
  96.       Width           =   6285
  97.    End
  98.    Begin VB.VScrollBar DisplayVBar 
  99.       Enabled         =   0   'False
  100.       Height          =   5655
  101.       Left            =   6240
  102.       TabIndex        =   0
  103.       Top             =   0
  104.       Width           =   255
  105.    End
  106. Attribute VB_Name = "CompositeForm"
  107. Attribute VB_Creatable = False
  108. Attribute VB_Exposed = False
  109. Option Explicit
  110. Dim SysPalSize As Integer
  111. Dim NumStaticColors As Integer
  112. Dim StaticColor1 As Integer
  113. Dim StaticColor2 As Integer
  114. Dim bytes_source() As Byte
  115. Dim bytes_dest() As Byte
  116. Dim bytes_mask1() As Byte
  117. Dim bytes_mask2() As Byte
  118. Dim wid(0 To 3) As Long
  119. Dim hgt(0 To 3) As Long
  120. Dim palentry(0 To 255) As PALETTEENTRY
  121. ' ************************************************
  122. ' Create and display the composite image.
  123. ' ************************************************
  124. Public Sub MakeComposite(xoff As Integer, yoff As Integer)
  125. Dim xmin As Integer
  126. Dim ymin As Integer
  127. Dim xmax As Integer
  128. Dim ymax As Integer
  129. Dim x As Integer
  130. Dim y As Integer
  131. Dim black As Integer
  132. Dim white As Integer
  133. Dim status As Long
  134.     WaitStart
  135.     SourcePict.Visible = False
  136.     DestPict.Visible = False
  137.     Mask1Pict.Visible = False
  138.     Mask2Pict.Visible = False
  139.     ' See where source and destination overlap.
  140.     xmin = 1 + xoff
  141.     If xmin < 1 Then xmin = 1
  142.     ymin = 1 + yoff
  143.     If ymin < 1 Then ymin = 1
  144.     xmax = wid(0) + xoff
  145.     If xmax > wid(1) Then xmax = wid(1)
  146.     ymax = hgt(0) + yoff
  147.     If ymax > hgt(1) Then ymax = hgt(1)
  148.     ' Overlay the source on the destination over
  149.     ' pixels where the source mask is black and
  150.     ' the destination mask is white.
  151.     black = StaticColor1 + 1
  152.     white = StaticColor2 - 1
  153.     For y = ymin To ymax
  154.         For x = xmin To xmax
  155.             If bytes_mask2(x, y) = white And _
  156.                bytes_mask1(x - xoff, y - yoff) = black Then
  157.                 bytes_dest(x, y) = bytes_source(x - xoff, y - yoff)
  158.             End If
  159.         Next x
  160.     Next y
  161.     DisplayPict.Move 0, 0, DestPict.Width, DestPict.Height
  162.     DoEvents
  163.     status = SetBitmapBits(DisplayPict.Image, wid(1) * hgt(1), bytes_dest(1, 1))
  164.     DisplayPict.Refresh
  165.     DisplayPict.Picture = DisplayPict.Image
  166.     ResetScrollBars
  167.     WaitEnd
  168. End Sub
  169. ' ************************************************
  170. ' Return the index of the nonstatic gray closest
  171. ' to the given value (assuming the non-static
  172. ' colors are a gray scale created by
  173. ' MatchGrayPalette).
  174. ' ************************************************
  175. Function NearestNonstaticGray(c As Integer) As Integer
  176. Dim dgray As Single
  177.     If c < 0 Then
  178.         c = 0
  179.     ElseIf c > 255 Then
  180.         c = 255
  181.     End If
  182.     dgray = 255 / (StaticColor2 - StaticColor1 - 2)
  183.     NearestNonstaticGray = c / dgray + StaticColor1 + 1
  184. End Function
  185. ' ***********************************************
  186. ' Load the indicated file and prepare to work
  187. ' with its palette.
  188. ' ***********************************************
  189. Public Sub LoadFiles(source_name As String, dest_name As String, mask1_name As String, mask2_name As String)
  190. Dim fname As String
  191. Dim i As Integer
  192.     WaitStart
  193.     ' Create DisplayPict's palette.
  194.     MatchGrayPalette 0, DisplayPict, bytes_source
  195.     DoEvents    ' Don't be a total CPU hog.
  196.     ' Load the source file.
  197.     fname = source_name
  198.     SourcePict.Move 0, 0
  199.     SourcePict.Visible = True
  200.     On Error GoTo LoadFileError
  201.     SourcePict.Picture = LoadPicture(fname)
  202.     On Error GoTo 0
  203.     MatchGrayPalette 0, SourcePict, bytes_source
  204.     DoEvents    ' Don't be a total CPU hog.
  205.     ' Load the destination file.
  206.     fname = dest_name
  207.     DestPict.Move 0, 0
  208.     DestPict.Visible = True
  209.     On Error GoTo LoadFileError
  210.     DestPict.Picture = LoadPicture(fname)
  211.     On Error GoTo 0
  212.     MatchGrayPalette 1, DestPict, bytes_dest
  213.     DoEvents    ' Don't be a total CPU hog.
  214.     ' Load mask1.
  215.     fname = mask1_name
  216.     Mask1Pict.Move 0, 0
  217.     Mask1Pict.Visible = True
  218.     On Error GoTo LoadFileError
  219.     Mask1Pict.Picture = LoadPicture(fname)
  220.     On Error GoTo 0
  221.     MatchGrayPalette 2, Mask1Pict, bytes_mask1
  222.     DoEvents    ' Don't be a total CPU hog.
  223.     ' Load mask2.
  224.     fname = mask2_name
  225.     Mask2Pict.Move 0, 0
  226.     Mask2Pict.Visible = True
  227.     On Error GoTo LoadFileError
  228.     Mask2Pict.Picture = LoadPicture(fname)
  229.     On Error GoTo 0
  230.     MatchGrayPalette 3, Mask2Pict, bytes_mask2
  231.     DoEvents    ' Don't be a total CPU hog.
  232.     ' Rerealize each palette.
  233.     SourcePict.ZOrder
  234.     DoEvents
  235.     DestPict.ZOrder
  236.     DoEvents
  237.     Mask1Pict.ZOrder
  238.     DoEvents
  239.     Mask2Pict.ZOrder
  240.     DoEvents
  241.     WaitEnd
  242.     Exit Sub
  243. LoadFileError:
  244.     Beep
  245.     MsgBox "Error loading file " & fname & "." & _
  246.         vbCrLf & Error$
  247.     WaitEnd
  248.     Exit Sub
  249. End Sub
  250. ' ***********************************************
  251. ' Load the control's palette so the non-static
  252. ' colors are grays. Map the logical palette to
  253. ' match the system palette. Convert the image to
  254. ' use the non-static grays.
  255. ' Set the following module global variables.
  256. '   palentry()  Image logical palette entries.
  257. '   wid         Width of image.
  258. '   hgt         Height of image.
  259. '   bytes(1 To wid, 1 To hgt)
  260. '               Image pixel values.
  261. ' ***********************************************
  262. Sub MatchGrayPalette(Index As Integer, pic As Control, bytes() As Byte)
  263. Dim logpal As Integer
  264. Dim sys(0 To 255) As PALETTEENTRY
  265. Dim i As Integer
  266. Dim bm As BITMAP
  267. Dim hbm As Integer
  268. Dim status As Long
  269. Dim x As Integer
  270. Dim y As Integer
  271. Dim gray As Single
  272. Dim dgray As Single
  273. Dim c As Integer
  274. Dim clr As Integer
  275.     ' Make sure pic has the foreground palette.
  276.     pic.ZOrder
  277.     i = RealizePalette(pic.hdc)
  278.     DoEvents
  279.     ' Get the system palette entries.
  280.     i = GetSystemPaletteEntries(pic.hdc, 0, SysPalSize, sys(0))
  281.         
  282.     ' Get the image pixels.
  283.     hbm = pic.Image
  284.     status = GetObject(hbm, BITMAP_SIZE, bm)
  285.     wid(Index) = bm.bmWidthBytes
  286.     hgt(Index) = bm.bmHeight
  287.     ReDim bytes(1 To wid(Index), 1 To hgt(Index))
  288.     status = GetBitmapBits(hbm, wid(Index) * hgt(Index), bytes(1, 1))
  289.     ' Make the logical palette as big as possible.
  290.     logpal = pic.Picture.hPal
  291.     If ResizePalette(logpal, SysPalSize) = 0 Then
  292.         Beep
  293.         MsgBox "Error resizing logical palette.", _
  294.             vbExclamation
  295.         Exit Sub
  296.     End If
  297.     ' Blank the non-static colors.
  298.     For i = 0 To StaticColor1
  299.         palentry(i) = sys(i)
  300.     Next i
  301.     For i = StaticColor1 + 1 To StaticColor2 - 1
  302.         With palentry(i)
  303.             .peRed = 0
  304.             .peGreen = 0
  305.             .peBlue = 0
  306.             .peFlags = PC_NOCOLLAPSE
  307.         End With
  308.     Next i
  309.     For i = StaticColor2 To 255
  310.         palentry(i) = sys(i)
  311.     Next i
  312.     i = SetPaletteEntries(logpal, 0, SysPalSize, palentry(0))
  313.     ' Insert the non-static grays.
  314.     gray = 0
  315.     dgray = 255 / (StaticColor2 - StaticColor1 - 2)
  316.     For i = StaticColor1 + 1 To StaticColor2 - 1
  317.         c = gray
  318.         gray = gray + dgray
  319.         With palentry(i)
  320.             .peRed = c
  321.             .peGreen = c
  322.             .peBlue = c
  323.         End With
  324.     Next i
  325.     i = SetPaletteEntries(logpal, StaticColor1 + 1, StaticColor2 - StaticColor1 - 1, palentry(StaticColor1 + 1))
  326.     ' Recreate the image using the new colors.
  327.     For y = 1 To hgt(Index)
  328.         For x = 1 To wid(Index)
  329.             clr = bytes(x, y)
  330.             With sys(clr)
  331.                 c = (CInt(.peRed) + .peGreen + .peBlue) / 3
  332.             End With
  333.             bytes(x, y) = NearestNonstaticGray(c)
  334.         Next x
  335.     Next y
  336.     status = SetBitmapBits(hbm, wid(Index) * hgt(Index), bytes(1, 1))
  337.     ' Realize the gray palette.
  338.     i = RealizePalette(pic.hdc)
  339.     pic.Refresh
  340. End Sub
  341. ' ***********************************************
  342. ' Set the Max and LargeChange properties for the
  343. ' image scroll bars.
  344. ' ***********************************************
  345. Sub ResetScrollBars()
  346.     ' DisplayHBar.
  347.     DisplayHBar.Value = 0
  348.     If DisplaySwin.ScaleWidth >= DisplayPict.Width Then
  349.         DisplayHBar.Enabled = False
  350.     Else
  351.         DisplayHBar.Max = DisplayPict.Width - DisplaySwin.ScaleWidth
  352.         DisplayHBar.LargeChange = DisplaySwin.ScaleWidth
  353.         DisplayHBar.Enabled = True
  354.     End If
  355.     ' DisplayVBar.
  356.     DisplayVBar.Value = 0
  357.     If DisplaySwin.ScaleHeight >= DisplayPict.Height Then
  358.         DisplayVBar.Enabled = False
  359.     Else
  360.         DisplayVBar.Max = DisplayPict.Height - DisplaySwin.ScaleHeight
  361.         DisplayVBar.LargeChange = DisplaySwin.ScaleHeight
  362.         DisplayVBar.Enabled = True
  363.     End If
  364. End Sub
  365. ' ***********************************************
  366. ' Give the form and all the picture boxes an
  367. ' hourglass cursor.
  368. ' ***********************************************
  369. Sub WaitStart()
  370.     MousePointer = vbHourglass
  371.     DisplayPict.MousePointer = vbHourglass
  372.     SourcePict.MousePointer = vbHourglass
  373.     DestPict.MousePointer = vbHourglass
  374.     Mask1Pict.MousePointer = vbHourglass
  375.     Mask2Pict.MousePointer = vbHourglass
  376.     DoEvents
  377. End Sub
  378. ' ***********************************************
  379. ' Restore the mouse pointers for the form and all
  380. ' the picture boxes.
  381. ' ***********************************************
  382. Sub WaitEnd()
  383.     MousePointer = vbDefault
  384.     DisplayPict.MousePointer = vbDefault
  385.     SourcePict.MousePointer = vbDefault
  386.     DestPict.MousePointer = vbDefault
  387.     Mask1Pict.MousePointer = vbDefault
  388.     Mask2Pict.MousePointer = vbDefault
  389. End Sub
  390. Private Sub Form_Load()
  391.     ' Make sure the screen supports palettes.
  392.     If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
  393.         Beep
  394.         MsgBox "This monitor does not support palettes.", _
  395.             vbCritical
  396.         End
  397.     End If
  398.     ' Get system palette size and # static colors.
  399.     SysPalSize = GetDeviceCaps(hdc, SIZEPALETTE)
  400.     NumStaticColors = GetDeviceCaps(hdc, NUMRESERVED)
  401.     StaticColor1 = NumStaticColors \ 2 - 1
  402.     StaticColor2 = SysPalSize - NumStaticColors \ 2
  403.     ' Remove the borders from DisplayPict.
  404.     DisplayPict.BorderStyle = vbTransparent
  405.     SourcePict.BorderStyle = vbTransparent
  406.     DestPict.BorderStyle = vbTransparent
  407.     Mask1Pict.BorderStyle = vbTransparent
  408.     Mask2Pict.BorderStyle = vbTransparent
  409. End Sub
  410. ' ***********************************************
  411. ' Make the picture as large as possible.
  412. ' ***********************************************
  413. Private Sub Form_Resize()
  414. Dim hgt As Single
  415. Dim wid As Single
  416.     If WindowState = vbMinimized Then Exit Sub
  417.         
  418.     hgt = ScaleHeight - DisplayHBar.Height - 1
  419.     wid = ScaleWidth - DisplayVBar.Width - 1
  420.     ' Place the controls.
  421.     DisplaySwin.Move 0, 0, wid, hgt
  422.     DisplayVBar.Move _
  423.         DisplaySwin.Left + DisplaySwin.Width + 1, _
  424.         0, DisplayVBar.Width, hgt
  425.     DisplayHBar.Move _
  426.         DisplaySwin.Left, DisplaySwin.Height + 1, _
  427.         wid
  428.     ' Set the scroll bar limits.
  429.     ResetScrollBars
  430. End Sub
  431. ' ***********************************************
  432. ' Move DisplayPict within DisplaySwin.
  433. ' ***********************************************
  434. Private Sub DisplayHBar_Change()
  435.     DisplayPict.Left = -DisplayHBar.Value
  436. End Sub
  437. ' ***********************************************
  438. ' Move DisplayPict within DisplaySwin.
  439. ' ***********************************************
  440. Private Sub DisplayHBar_Scroll()
  441.     DisplayPict.Left = -DisplayHBar.Value
  442. End Sub
  443. ' ***********************************************
  444. ' Move DisplayPict within DisplaySwin.
  445. ' ***********************************************
  446. Private Sub DisplayVBar_Change()
  447.     DisplayPict.Top = -DisplayVBar.Value
  448. End Sub
  449. ' ***********************************************
  450. ' Move DisplayPict within DisplaySwin.
  451. ' ***********************************************
  452. Private Sub DisplayVBar_Scroll()
  453.     DisplayPict.Top = -DisplayVBar.Value
  454. End Sub
  455. Private Sub Form_Unload(Cancel As Integer)
  456.     End
  457. End Sub
  458.