Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/bmpkit/bmpkit.frm

Visual Basic Form | 1995-05-08 | 10.7 KB | 315 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4020
   ClientLeft      =   1125
   ClientTop       =   2010
   ClientWidth     =   7365
   Height          =   4425
   Left            =   1065
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   2.792
   ScaleMode       =   5  'Inch
   ScaleWidth      =   5.115
   Top             =   1665
   Width           =   7485
   Begin CommandButton Command4
      Caption         =   "Show Original "
      Height          =   375
      Left            =   5640
      TabIndex        =   12
      Top             =   3480
      Width           =   1335
   End
   Begin CommandButton Command5
      Caption         =   "Hide Original"
      Height          =   375
      Left            =   5640
      TabIndex        =   13
      Top             =   3000
      Width           =   1335
   End
   Begin CommandButton Command3
      Caption         =   "Print"
      Height          =   375
      Left            =   6480
      TabIndex        =   2
      Top             =   2520
      Width           =   735
   End
   Begin CommandButton Command2
      Caption         =   "Display"
      Height          =   375
      Left            =   5640
      TabIndex        =   1
      Top             =   2520
      Width           =   735
   End
   Begin HScrollBar HScroll1
      Height          =   255
      Left            =   5160
      TabIndex        =   6
      Top             =   960
      Width           =   1215
   End
   Begin OptionButton Option2
      Caption         =   "Size"
      Height          =   255
      Left            =   5160
      TabIndex        =   9
      Top             =   600
      Width           =   855
   End
   Begin PictureBox Picture2
      AutoRedraw      =   -1  'True
      Height          =   1335
      Left            =   840
      ScaleHeight     =   0.906
      ScaleMode       =   5  'Inch
      ScaleWidth      =   0.906
      TabIndex        =   4
      Top             =   600
      Width           =   1335
   End
   Begin OptionButton Option1
      Caption         =   "Move"
      Height          =   255
      Left            =   5160
      TabIndex        =   8
      Top             =   240
      Width           =   855
   End
   Begin VScrollBar VScroll1
      Height          =   1095
      Left            =   6480
      TabIndex        =   7
      Top             =   120
      Width           =   255
   End
   Begin CommandButton Command1
      Caption         =   "Exit"
      Height          =   375
      Left            =   4080
      TabIndex        =   0
      Top             =   120
      Width           =   735
   End
   Begin PictureBox Picture1
      AutoSize        =   -1  'True
      Height          =   495
      Left            =   120
      ScaleHeight     =   0.323
      ScaleMode       =   5  'Inch
      ScaleWidth      =   0.323
      TabIndex        =   3
      Top             =   120
      Width           =   495
   End
   Begin Label Label3
      AutoSize        =   -1  'True
      Height          =   195
      Left            =   5160
      TabIndex        =   11
      Top             =   2160
      Width           =   75
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      Height          =   195
      Left            =   5160
      TabIndex        =   10
      Top             =   1800
      Width           =   75
   End
   Begin Label Label1
      Alignment       =   2  'Center
      Caption         =   "Scaled Image"
      Height          =   255
      Left            =   840
      TabIndex        =   5
      Top             =   120
      Width           =   1335
   End
Sub Command1_Click ()
End Sub
Sub command2_click ()
'Make sure we have valid scaling values
If scalex = 0 Then scalex = 1
If scaley = 0 Then scaley = 1
'Set picture2.width to match picture1, with scaling.
'The 3.14 divisor matches inch dimension with the
'640X480 screen dimensions. Change for other display
'adapters.
Picture2.width = (picture1.width / 3.14) * scalex
Picture2.height = (picture1.height / 3.14) * scaley
'*Set constants for GDI calls
Const NULL = 0&
Const SRCCOPY = &HCC0020
Const NEWFRAME = 1
Const pixel = 3
'*Display scaled version in Picture2
'*StretchBlt requires pixel coordinates.
picture1.scalemode = 3
Picture2.scalemode = 3
'Set Dimensions for Picture2
Picture2.scalewidth = picture1.scalewidth / 3.14 * scalex
Picture2.scaleheight = picture1.scaleheight / 3.14 * scaley
'*Do not change the order of these statements.
hMemoryDC% = CreateCompatibleDC(picture1.hDC)
hOldBitMap% = SelectObject(hMemoryDC%, picture1.Picture)
'Variables for the StretchBlt function:
'1. Source of image HMemeoryDC% -- set above from original picture
'2,3. Positioning on output object. Must be integer, in pixels.
'4,5. Width, height of output image. Here we use the values set above.
'6, Source of image...in this case the memory image set by CreateCompatibleDC% function
'7,8. Don't know. Set to 0 works just fine! Experiment and let me know.
'9,10. X/Y coordinates for how much of original to put in new object. You can use
'these values for cropping, if you like.
'11. SRCCOPY, as set in constants above. Change at own risk.
ApiError% = StretchBlt(Picture2.hDC, Int(Picture2.left), Int(Picture2.top), Picture2.scalewidth, Picture2.scaleheight, hMemoryDC%, 0, 0, picture1.scalewidth, picture1.scaleheight, SRCCOPY)
hOldBitMap% = SelectObject(hMemoryDC%, hOldBitMap%)
ApiError% = DeleteDC(hMemoryDC%)
Picture2.Refresh
'*Reset scalemodes to previous inch values
picture1.scalemode = 5
Picture2.scalemode = 5
End Sub
Sub Command3_Click ()
'* Print all items other than the image first.
printer.scalemode = 5
printer.currentx = 3
printer.currenty = 3
printer.Print "Hello"
printer.currenty = 4
printer.currentx = 1
printer.drawwidth = 5
printer.Line -Step(printer.currentx + 2, 0)
'*After printing all other elements include your BMP
'printing routine, as below.
'* Print Scaled Image
'*Make certain we have valid scaling values
If scalex = 0 Then scalex = 1
If scaley = 0 Then scaley = 1
'*Set GDI Constants
Const NULL = 0&
Const SRCCOPY = &HCC0020
Const NEWFRAME = 1
Const pixel = 3
'* StretchBlt requires pixel coordinates.
picture1.scalemode = pixel
printer.scalemode = pixel
'*First two variables are the x,y coordinates (in Pixels)
'for the placement of images on the printed page. Since the
'form's ScaleMode is 5 for inches, multiply by 300 to
'match the the current inch positions of Picture2 on
'the 300 DPI device.
'*Second pair of variables set the height and width of the
'graphic to match the pixel size of the original picture
'in the invisible Picture1 box.
printgraphicx% = Picture2.left * 300
printgraphicy% = Picture2.top * 300
printer.scalewidth = picture1.scalewidth * scalex
printer.scaleheight = picture1.scaleheight * scaley
'*Do not change the order of these statements.
hMemoryDC% = CreateCompatibleDC(picture1.hDC)
hOldBitMap% = SelectObject(hMemoryDC%, picture1.Picture)
'Variables for the StretchBlt function:
'1. Source of image HMemeoryDC% -- set above from original picture
'2,3. Positioning on output object. Must be integer, in pixels.
'4,5. Width, height of output image. Here we use the values set above.
'6, Source of image...in this case the memory image set by CreateCompatibleDC% function
'7,8. Don't know. Set to 0 works just fine! Experiment and let me know.
'9,10. X/Y coordinates for how much of original to put in new object. You can use
'these values for cropping, if you like.
'11. SRCCOPY, as set in constants above. Change at own risk.
ApiError% = StretchBlt(printer.hDC, printgraphicx%, printgraphicy%, printer.scalewidth, printer.scaleheight, hMemoryDC%, 0, 0, picture1.scalewidth, picture1.scaleheight, SRCCOPY)
hOldBitMap% = SelectObject(hMemoryDC%, hOldBitMap%)
ApiError% = DeleteDC(hMemoryDC%)
'*Send image and text to printer
printer.NewPage
printer.EndDoc
End Sub
Sub Command4_Click ()
picture1.visible = -1
command2_click
End Sub
Sub Command5_Click ()
picture1.visible = 0
End Sub
Sub Form_Load ()
'*set form and picture ScaleModes
picture1.scalemode = 5
Picture2.scalemode = 5
form1.scalemode = 5
'set the Move option
option1.value = -1
'set initial picture width
Picture2.width = 1
Picture2.height = 1
'*Setup scroll bar values
hscroll1.min = -400
hscroll1.max = 400
hscroll1.smallchange = 1
hscroll1.largechange = 10
'*Set Horizontal Scrollbar to center
hscroll1.value = 0
vscroll1.min = -400
vscroll1.max = 400
vscroll1.smallchange = 1
vscroll1.largechange = 10
'*Set Vertical Scrollbar to center
vscroll1.value = 0
'*Make Picture1 box invisible...This picture box, which
'holds the basic image, does not have to show.  Note that
'we'll use the printer resolution of this box for sizing.
'For example, a 300X300 pixel image will print as 1X1 inch
'on a laser printer.
picture1.visible = 0
'*Load bitmap into Picture1 ... put PAPER.BMP, a Windows
'background image in the VB directory, or in the default
'directory, or change the filespec to match it's location.
'Choose your own, or let user load.
picture1.Picture = LoadPicture("RIBBONS.BMP")
'*Set scaling factors to 1 for full-size image.
'To reduce or enlarge the original when first displayed,
'change these figures.
scalex = 1
scaley = 1
'*Display Picture in Picture2
command2_click
End Sub
Sub HScroll1_Change ()
'*If the Move option is selected (default) then add the positive or
'negative Value of Hscroll1 to the top left of the picture,
'redraw. Notice that the multiplier is .01 to deal with the
'inch settings. Scroll Values must be integers., so we can
'move in .01 inch increments.
If option1.value = -1 Then
    Picture2.left = Picture2.left + (hscroll1.value * .01)
    command2_click
    hscroll1.value = 0
    End If
'If the Size option is selected, then add the positive or
'negative Value of Hscroll1 to the scalex variable, then
'redraw. Notice that the multiplier is .01 to deal with the
'inch settings. Scroll Values must be integers., so we can
'move in .01 inch increments.
If option2.value = -1 Then
    scalex = 1 + (hscroll1.value * .01)
    command2_click
    End If
End Sub
Sub VScroll1_Change ()
'*See Hscroll1_Change for explanations.
If option1.value = -1 Then
    Picture2.top = Picture2.top + (vscroll1.value * .01)
    command2_click
    vscroll1.value = 0
    End If
If option2.value = -1 Then
    scaley = 1 + (vscroll1.value * .01)
    command2_click
    End If
End Sub