home *** CD-ROM | disk | FTP | other *** search
/ Apollo 18: The Moon Missions / 990125_1647.ISO / Panels / RADARLM / LMRADAR.FRM < prev    next >
Text File  |  1996-08-17  |  5KB  |  142 lines
  1. VERSION 4.00
  2. Begin VB.Form frmMain 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H00FFFFFF&
  6.    Caption         =   "Scrolling Background Example"
  7.    ClientHeight    =   4950
  8.    ClientLeft      =   1425
  9.    ClientTop       =   1665
  10.    ClientWidth     =   4770
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   1
  14.       weight          =   700
  15.       size            =   8.25
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H00000000&
  21.    Height          =   5355
  22.    Left            =   1365
  23.    LinkTopic       =   "Form1"
  24.    Picture         =   "LMRADAR.frx":0000
  25.    ScaleHeight     =   4950
  26.    ScaleWidth      =   4770
  27.    Top             =   1320
  28.    Width           =   4890
  29.    Begin VB.VScrollBar VScroll1 
  30.       Height          =   2055
  31.       Left            =   2310
  32.       TabIndex        =   2
  33.       Top             =   1755
  34.       Width           =   270
  35.    End
  36.    Begin VB.Timer Timer1 
  37.       Left            =   9015
  38.       Top             =   135
  39.    End
  40.    Begin VB.PictureBox Picture2 
  41.       Appearance      =   0  'Flat
  42.       BackColor       =   &H80000005&
  43.       BorderStyle     =   0  'None
  44.       ForeColor       =   &H80000008&
  45.       Height          =   6495
  46.       Left            =   6240
  47.       Picture         =   "LMRADAR.frx":4B440
  48.       ScaleHeight     =   6495
  49.       ScaleWidth      =   2235
  50.       TabIndex        =   1
  51.       Top             =   15
  52.       Visible         =   0   'False
  53.       Width           =   2235
  54.    End
  55.    Begin VB.PictureBox Picture1 
  56.       Appearance      =   0  'Flat
  57.       BackColor       =   &H80000005&
  58.       ForeColor       =   &H80000008&
  59.       Height          =   1680
  60.       Left            =   2715
  61.       ScaleHeight     =   1650
  62.       ScaleWidth      =   2445
  63.       TabIndex        =   0
  64.       Top             =   2055
  65.       Width           =   2475
  66.    End
  67. End
  68. Attribute VB_Name = "frmMain"
  69. Attribute VB_Creatable = False
  70. Attribute VB_Exposed = False
  71. Option Explicit
  72.  
  73. Const SRCCOPY = &HCC0020
  74. Const PIXELS = 3
  75.  
  76. Private Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  77.  
  78. Private Sub Form_Load()
  79.  
  80.     ' Set the ScaleMode of both PictureBox controls to
  81.     ' pixels, the units expected by the BitBlt function.
  82.     Picture1.ScaleMode = PIXELS
  83.     Picture2.ScaleMode = PIXELS
  84.  
  85.     ' Picture2 holds the entire background bitmap. Setting
  86.     ' AutoSize lets the control resize itself to the same
  87.     ' dimensions as the bitmap it contains.
  88.     Picture2.AutoSize = True
  89.  
  90.     ' Setting AutoRedraw to true creates a persistent bitmap,
  91.     ' which can be BitBlted even if it's not visible in the
  92.     ' window.
  93.     Picture2.AutoRedraw = True
  94.  
  95.     ' Make sure Picture1 is the same height as Picture2.
  96.     Picture1.Width = Picture2.Width
  97.  
  98.     ' The maximum scrolling rate will be 20 pixels at a time.
  99.     VScroll1.Max = 20
  100.     VScroll1.LargeChange = 2
  101.  
  102.     Me.Width = (Me.Width - Me.ScaleWidth) + Picture1.Left + Picture1.Width + VScroll1.Left
  103.  
  104.     ' Setting the timer interval causes timer events to begin.
  105.     Timer1.Interval = 55
  106. End Sub
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113. Private Sub Timer1_Timer()
  114. Static Y As Integer
  115. Dim AHeight As Integer
  116. Dim rc As Integer
  117.  
  118.     ' Calculate the next x position for Picture2.
  119.     Y = Y - VScroll1
  120.     'If Y > Picture2.ScaleHeight Then Y = 480
  121.     If Y < 0 Then Y = Picture2.ScaleHeight
  122.     
  123.     If Y > (Picture2.ScaleHeight - Picture1.ScaleHeight) Then
  124.         AHeight = Picture2.ScaleHeight - Y
  125.         ' When y gets close to the bottom edge of Picture2's bitmap,
  126.         ' two sections of Picture2 need to be copied into Picture1.
  127.         ' The first BitBlt copies whatever remains below
  128.         ' position x in Picture2. The second BitBlt will copy from
  129.         ' the top side of Picture2 to fill in the remaining
  130.         ' area to the right of Picture1.
  131. rc = BitBlt(Picture1.hDC, 0, 0, Picture2.ScaleWidth, AHeight, Picture2.hDC, 0, Y, SRCCOPY)
  132. rc = BitBlt(Picture1.hDC, 0, AHeight, Picture2.ScaleWidth, Picture1.ScaleHeight - AHeight, Picture2.hDC, 0, 0, SRCCOPY)
  133.     Else
  134.         ' Normally, only one BitBlt is required to copy the section
  135.         ' of Picture2 into Picture1.
  136. rc = BitBlt(Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture2.ScaleHeight, Picture2.hDC, 0, Y, SRCCOPY)
  137.     End If
  138. End Sub
  139.  
  140.  
  141.  
  142.