Apollo 18: The Moon Missions/990125_1647.ISO/Landing/PCX/LANDING.FRM

Text File | 1996-04-29 | 15KB | 443 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "landing trial"
   ClientHeight    =   5355
   ClientLeft      =   1095
   ClientTop       =   1530
   ClientWidth     =   4965
   Height          =   5760
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   5355
   ScaleWidth      =   4965
   Top             =   1185
   Width           =   5085
   Begin VB.CheckBox chkFlickerless
      Caption         =   "flickerless"
      Height          =   510
      Left            =   2235
      TabIndex        =   10
      Top             =   60
      Width           =   1080
   End
   Begin VB.HScrollBar HScroll1
      Height          =   270
      LargeChange     =   12
      Left            =   795
      TabIndex        =   9
      Top             =   4965
      Width           =   480
   End
   Begin VB.VScrollBar VScroll1
      Height          =   640
      LargeChange     =   12
      Left            =   4560
      TabIndex        =   8
      Top             =   810
      Width           =   285
   End
   Begin VB.PictureBox picBackground
      BackColor       =   &H00FFFFFF&
      Height          =   4110
      Left            =   630
      ScaleHeight     =   272
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   245
      TabIndex        =   7
      Top             =   675
      Width           =   3705
   End
   Begin VB.PictureBox picWork
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   360
      Left            =   210
      ScaleHeight     =   24
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   21
      TabIndex        =   6
      Top             =   2355
      Width           =   315
   End
   Begin VB.PictureBox picSave
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   345
      Left            =   210
      ScaleHeight     =   23
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   22
      TabIndex        =   5
      Top             =   1785
      Width           =   330
   End
   Begin VB.Timer Timer2
      Interval        =   55
      Left            =   5145
      Top             =   90
   End
   Begin VB.Timer Timer1
      Interval        =   55
      Left            =   4605
      Top             =   90
   End
   Begin VB.PictureBox crosshairMask
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   285
      Left            =   210
      Picture         =   "LANDING.frx":0000
      ScaleHeight     =   19
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   19
      TabIndex        =   4
      Top             =   1320
      Width           =   285
   End
   Begin VB.PictureBox crosshair
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   285
      Left            =   240
      Picture         =   "LANDING.frx":01C8
      ScaleHeight     =   19
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   19
      TabIndex        =   3
      Top             =   855
      Width           =   285
   End
   Begin VB.CommandButton btnGo
      Caption         =   "Move Sprite"
      Height          =   435
      Left            =   315
      TabIndex        =   2
      Top             =   135
      Width           =   1215
   End
   Begin VB.PictureBox landsite
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      ForeColor       =   &H0000FFFF&
      Height          =   7230
      Left            =   5775
      Picture         =   "LANDING.frx":0394
      ScaleHeight     =   7200
      ScaleWidth      =   9600
      TabIndex        =   1
      Top             =   1035
      Width           =   9630
   End
   Begin VB.PictureBox landcompare
      Height          =   495
      Left            =   330
      Picture         =   "LANDING.frx":4B7D4
      ScaleHeight     =   465
      ScaleWidth      =   1185
      TabIndex        =   0
      Top             =   6255
      Width           =   1215
   End
   Begin VB.Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Primary Target"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   3210
      TabIndex        =   12
      Top             =   4905
      Width           =   1080
   End
   Begin VB.Label AltReadOut
      BackStyle       =   0  'Transparent
      Caption         =   "10000"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   2160
      TabIndex        =   11
      Top             =   4950
      Width           =   600
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'--------------------------------------------
' PROJLAND.FRM
' This program is test for graphics to be used in
' landing routines.
' displaying bitmaps and sprites.
' -------------------------------------------


' The number of pixels to offset the sprite
' each time it is moved.
Const INCREMENT = 3

' Constants for Raster Operations used by BitBlt function.
Const SRCAND = &H8800C6      ' dest = source AND dest
Const SRCCOPY = &HCC0020     ' dest = source
Const SRCPAINT = &HEE0086    ' dest = source OR dest

' The BitBlt Windows API call.
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

' The x and y coordinates for the Sprite
Dim SpriteX As Integer
Dim SpriteY As Integer

' The x and y coordinates for the upper left corner
' of the large bitmap (landSite).
Dim BackgroundX As Integer
Dim BackgroundY As Integer

' The width and height of the work area bitmap (picWork).
Dim WorkWidth As Integer
Dim WorkHeight As Integer

Dim Hght As Integer


Private Sub btnGo_Click()
  '-----------------------------------------------------
' Start the simple sprite demonstration when this
' button is pushed.
'-----------------------------------------------------
Dim rc As Integer

    ' We're running.
    If Timer1.Enabled Then
        Timer1.Enabled = False
        ' Restore BG
        If chkFlickerless = 0 Then
            rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY)
        Else
            VScroll1_Change
        End If
    ' We're stopped.
    Else
        ' Save BG
        If chkFlickerless = 0 Then rc = BitBlt(picSave.hDC, 0, 0, picSave.ScaleWidth, picSave.ScaleHeight, picBackground.hDC, SpriteX, SpriteY, SRCCOPY)
        Timer1.Enabled = True
    End If

End Sub


Private Sub Form_Load()
  '-----------------------------------------------------
'
'-----------------------------------------------------
Dim rc As Integer

    Me.Show

    'chkAutoRedraw.Value = 1

    ' Set the limits of the scroll bars.
    HScroll1.Max = landsite.ScaleWidth - picBackground.ScaleWidth
    VScroll1.Max = landsite.ScaleHeight - picBackground.ScaleHeight

    ' Only enable the scrollers if landSite is larger than
    ' the picBackground bitmap.
    If landsite.ScaleWidth <= picBackground.ScaleWidth Then HScroll1.Enabled = False
    If landsite.ScaleHeight <= picBackground.ScaleHeight Then VScroll1.Enabled = False

    ' Save this initial section of the background. It may be
    ' needed for the flickering sprite demo.
    rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, landsite.hDC, HScroll1, VScroll1, SRCCOPY)

    ' Set the dimensions of the work bitmap.
    WorkWidth = (crosshair.Width / 15) + (INCREMENT * 2)