home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / RDBLIB.ZIP / RBSCRN.FRM < prev    next >
Text File  |  1994-02-05  |  3KB  |  100 lines
  1. VERSION 2.00
  2. Begin Form RBScrn 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Current Screen Print"
  5.    ClientHeight    =   4020
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1485
  8.    ClientWidth     =   7365
  9.    ControlBox      =   0   'False
  10.    Height          =   4425
  11.    Left            =   1035
  12.    LinkTopic       =   "Form2"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    MousePointer    =   11  'Hourglass
  16.    ScaleHeight     =   4020
  17.    ScaleWidth      =   7365
  18.    Top             =   1140
  19.    Width           =   7485
  20.    WindowState     =   2  'Maximized
  21.    Begin PictureBox Picture1 
  22.       AutoRedraw      =   -1  'True
  23.       Height          =   4035
  24.       Left            =   0
  25.       ScaleHeight     =   4005
  26.       ScaleWidth      =   7365
  27.       TabIndex        =   0
  28.       Top             =   0
  29.       Visible         =   0   'False
  30.       Width           =   7395
  31.    End
  32. End
  33.  
  34. Sub Form_Activate ()
  35.     mousepointer = HOURGLASS
  36.     RBScrn.WindowState = MINIMIZED
  37.     DoEvents
  38.     mousepointer = HOURGLASS
  39.     GrabScreen
  40.  
  41.     mousepointer = HOURGLASS
  42.     RBScrn.WindowState = MAXIMIZED
  43.     RBScrn.PrintForm
  44.     Unload RBScrn
  45.  
  46. End Sub
  47.  
  48. Sub GetTwipsPerPixel ()
  49.     ' Set a global variable with the Twips to Pixel ratio.
  50.     RBScrn.ScaleMode = 3
  51.     NumPix = RBScrn.ScaleHeight
  52.     RBScrn.ScaleMode = 1
  53.     TwipsPerPixel = RBScrn.ScaleHeight / NumPix
  54. End Sub
  55.  
  56. Sub GrabScreen ()
  57.  
  58.     Dim winSize As lrect
  59.  
  60.     ' Assign information of the source bitmap.
  61.     ' Note that BitBlt requires coordinates in pixels.
  62.     hwndSrc% = GetDesktopWindow()
  63.     hSrcDC% = GetDC(hwndSrc%)
  64.     XSrc% = 0: YSrc% = 0
  65.     Call GetWindowRect(hwndSrc%, winSize)
  66.     nWidth% = winSize.right             ' Units in pixels.
  67.  
  68.     nHeight% = winSize.bottom           ' Units in pixels.
  69.  
  70.     ' Assign informate of the destination bitmap.
  71.     hDestDC% = RBScrn.Picture1.hDC
  72.     x% = 0: Y% = 0
  73.  
  74.     ' Set global variable TwipsPerPixel and use to set
  75.     ' picture box to same size as screen being grabbed.
  76.     ' If picture box not the same size as picture being
  77.     ' BitBlt'ed to it, it will chop off all that does not
  78.     ' fit in the picture box.
  79.     GetTwipsPerPixel
  80.     RBScrn.Picture1.Top = 0
  81.     RBScrn.Picture1.Left = 0
  82.     RBScrn.Picture1.Width = (nWidth% + 1) * TwipsPerPixel
  83.     RBScrn.Picture1.Height = (nHeight% + 1) * TwipsPerPixel
  84.  
  85.     ' Assign the value of the constant SRCOPYY to the Raster operation.
  86.  
  87.     dwRop& = &HCC0020
  88.  
  89.     ' Note function call must be on one line:
  90.     Suc% = BitBlt(hDestDC%, x%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)
  91.  
  92.     ' Release the DeskTopWindow's hDC to Windows.
  93.     ' Windows may hang if this is not done.
  94.     Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)
  95.  
  96.     'Make the picture box visible.
  97.     RBScrn.Picture1.Visible = True
  98. End Sub
  99.  
  100.