home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCTV3N3.ZIP / SCROLL.LST < prev    next >
Encoding:
File List  |  1992-06-09  |  4.5 KB  |  189 lines
  1. ' SCROLL.FRM
  2. ' Demonstration of a scrollable picture viewer.
  3.  
  4. DefInt A-Z
  5.  
  6. Const TRUE = -1
  7. Const FALSE = Not TRUE
  8.  
  9. ' Declarations for Windows API functions.
  10.  
  11. Declare Function StretchBlt% Lib "GDI" (ByVal hDstDC%, ByVal XDst%,
  12.                ByVal YDst%, ByVal DstWidth%, ByVal DstHeight%,
  13.            ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%,
  14.            ByVal SrcWidth%, ByVal SrcHeight%, ByVal dwRop&)
  15.  
  16. Declare Function SetStretchBltMode% Lib "GDI"
  17.                    (ByVal hDC%, ByVal mode%)
  18.  
  19.  
  20. Sub Form_Load ()
  21.  
  22. On Local Error Resume Next
  23.  
  24. ' When the form is loaded, load the desired picture file.
  25. ' Insert your own bitmap file or Windows metafile path and
  26. ' name.
  27.  
  28. FileName$ = "d:\windows\my.bmp"
  29.  
  30. pboxHold.picture = LoadPicture(FileName$)
  31.  
  32. ' Check for errors.
  33.  
  34. If Err Then
  35.     If Err = 53 Then
  36.     msg$ = "File " + FileName$ + " not found."
  37.     MsgBox (msg$)
  38.     End
  39.     Else
  40.     msg$ = "Error retrieving " + FileName$
  41.     MsgBox (msg$)
  42.     End
  43.     End If
  44. End If
  45.  
  46. End Sub
  47.  
  48.  
  49. Sub Form_Resize ()
  50.  
  51. On Local Error Resume Next
  52.  
  53. ' This event procedure is executed when the form is first
  54. ' displayed and whenever it is resized.
  55.  
  56. ' Insure that the form is 1.6 times as wide as it is high.
  57.  
  58. Width = 1.6 * Height
  59.  
  60. ' Move the child picture box to the upper
  61. ' left corner of the form.
  62.  
  63. pboxHold.Move 0, 0
  64.  
  65. ' Move the parent picture box to the top left of the
  66. ' form. Make it square, large enough to fill the form
  67. ' vertically, leaving room for the horizontal scroll bar.
  68.  
  69. BoxHeight = ScaleHeight - HScroll1.Height
  70. BoxWidth = BoxHeight
  71.  
  72. pboxView.Move 0, 0, BoxWidth, BoxHeight
  73.  
  74. ' Position the scroll bars at the the bottom and
  75. ' right edges of the parent picture box.
  76.  
  77. HScroll1.left = 0
  78. HScroll1.Top = pboxView.Height
  79. HScroll1.Width = pboxView.Width
  80. VScroll1.Top = 0
  81. VScroll1.left = pboxView.Width
  82. VScroll1.Height = pboxView.Height + HScroll1.Height
  83.  
  84. ' Set the horizontal scroll bar Max property so that full travel
  85. ' of the scroll bar represents scrolling across the full width
  86. ' of the picture.
  87.  
  88. HScroll1.Max = pboxHold.Width - pboxView.Width
  89.  
  90. ' Do the same for the vertical scroll bar.
  91.  
  92. VScroll1.Max = pboxHold.Height - pboxView.Height
  93.  
  94. ' Set the scroll bar change properties so that a large change
  95. ' scrolls a distance equal to the width or height of the
  96. ' viewing window, and a small change scrolls 1/10th of
  97. ' a large change.
  98.  
  99. HScroll1.LargeChange = HScroll1.Max \
  100.                          (pboxHold.Width \ pboxView.Width)
  101. HScroll1.SmallChange = HScroll1.LargeChange \ 10
  102. VScroll1.LargeChange = VScroll1.Max \
  103.                          (pboxHold.Height \ pboxView.Height)
  104. VScroll1.SmallChange = VScroll1.LargeChange \ 10
  105.  
  106. ' Enable the horizontal scroll bar only if the full width
  107. ' of the picture is not already showing.
  108.  
  109. If (pboxView.Width < pboxHold.Width) Then
  110.     HScroll1.Enabled = TRUE
  111. Else
  112.     HScroll1.Enabled = FALSE
  113. End If
  114.  
  115. ' Enable the vertical scroll bar only if the full height
  116. ' of the picture is not already showing.
  117.  
  118. If (pboxView.Height < pboxHold.Height) Then
  119.     VScroll1.Enabled = TRUE
  120. Else
  121.     VScroll1.Enabled = FALSE
  122. End If
  123.  
  124. VScroll1.Refresh
  125. HScroll1.Refresh
  126.  
  127. ' Place pboxImage in the center of the blank area
  128. ' on the right side of the form.
  129.  
  130. BoxWidth = .9 * (ScaleWidth - (pboxView.Width + VScroll1.Width))
  131. BoxHeight = BoxWidth
  132.  
  133. BoxX = pboxView.Width + VScroll1.Width + BoxWidth * .05
  134. BoxY = (ScaleHeight - BoxHeight) / 2
  135.  
  136. pboxImage.Move BoxX, BoxY, BoxWidth, BoxHeight
  137.  
  138. ' Copy/compress the image to pboxImage.
  139.  
  140. XSrc% = 0
  141. YSrc% = 0
  142. XDst% = 0
  143. YDst% = 0
  144.  
  145. SrcWidth% = pboxHold.ScaleWidth
  146. SrcHeight% = pboxHold.ScaleHeight
  147. DstWidth% = pboxImage.ScaleWidth
  148. DstHeight% = pboxImage.ScaleHeight
  149.  
  150. ' Use StretchBlt copy method to &HCC0020 so that source
  151. ' is copied to destination with no special transformations.
  152.  
  153. dwRop& = &HCC0020
  154.  
  155. ' Set StretchBlt mode to ColorOnColor (2) for best copy of
  156. ' a color image.
  157.  
  158. Result = SetStretchBltMode(pboxImage.hDC, 2)
  159.  
  160. Result = StretchBlt(pboxImage.hDC, XDst%, YDst%, DstWidth%,
  161.             DstHeight%, pboxHold.hDC, XSrc%, YSrc%,
  162.                         SrcWidth%, SrcHeight%, dwRop&)
  163.  
  164. pboxImage.picture = pboxImage.Image
  165.  
  166. On Local Error GoTo 0
  167.  
  168. End Sub
  169.  
  170.  
  171. Sub HScroll1_Change ()
  172.  
  173. ' Move the child picture box to reflect the new position
  174. ' of the horizontal scroll bar.
  175.  
  176. pboxHold.left = -(HScroll1.Value)
  177.  
  178. End Sub
  179.  
  180.  
  181. Sub VScroll1_Change ()
  182.  
  183. ' Move the child picture box to reflect the new position
  184. ' of the vertical scroll bar.
  185.  
  186. pboxHold.Top = -(VScroll1.Value)
  187.  
  188. End Sub
  189.