home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / articles / vbdev / source / pincle9.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-01-22  |  14.0 KB  |  426 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    Caption         =   "BitBlt Games"
  6.    ClientHeight    =   6660
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1485
  9.    ClientWidth     =   5490
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   7065
  21.    Left            =   1035
  22.    LinkTopic       =   "Form1"
  23.    ScaleHeight     =   6660
  24.    ScaleWidth      =   5490
  25.    Top             =   1140
  26.    Width           =   5610
  27.    Begin VB.TextBox txtUserDef 
  28.       Appearance      =   0  'Flat
  29.       Height          =   315
  30.       Left            =   2940
  31.       TabIndex        =   21
  32.       Top             =   5640
  33.       Width           =   2055
  34.    End
  35.    Begin VB.OptionButton Option1 
  36.       Appearance      =   0  'Flat
  37.       BackColor       =   &H80000005&
  38.       Caption         =   "WHITENESS"
  39.       ForeColor       =   &H80000008&
  40.       Height          =   315
  41.       Index           =   14
  42.       Left            =   1980
  43.       TabIndex        =   20
  44.       Top             =   5220
  45.       Width           =   1815
  46.    End
  47.    Begin VB.OptionButton Option1 
  48.       Appearance      =   0  'Flat
  49.       BackColor       =   &H80000005&
  50.       Caption         =   "BLACKNESS"
  51.       ForeColor       =   &H80000008&
  52.       Height          =   315
  53.       Index           =   13
  54.       Left            =   1980
  55.       TabIndex        =   19
  56.       Top             =   4860
  57.       Width           =   1815
  58.    End
  59.    Begin VB.OptionButton Option1 
  60.       Appearance      =   0  'Flat
  61.       BackColor       =   &H80000005&
  62.       Caption         =   "DSTINVERT"
  63.       ForeColor       =   &H80000008&
  64.       Height          =   315
  65.       Index           =   12
  66.       Left            =   1980
  67.       TabIndex        =   18
  68.       Top             =   4500
  69.       Width           =   1815
  70.    End
  71.    Begin VB.OptionButton Option1 
  72.       Appearance      =   0  'Flat
  73.       BackColor       =   &H80000005&
  74.       Caption         =   "PATINVERT"
  75.       ForeColor       =   &H80000008&
  76.       Height          =   315
  77.       Index           =   11
  78.       Left            =   1980
  79.       TabIndex        =   17
  80.       Top             =   4140
  81.       Width           =   1815
  82.    End
  83.    Begin VB.OptionButton Option1 
  84.       Appearance      =   0  'Flat
  85.       BackColor       =   &H80000005&
  86.       Caption         =   "PATPAINT"
  87.       ForeColor       =   &H80000008&
  88.       Height          =   315
  89.       Index           =   10
  90.       Left            =   1980
  91.       TabIndex        =   16
  92.       Top             =   3780
  93.       Width           =   1815
  94.    End
  95.    Begin VB.OptionButton Option1 
  96.       Appearance      =   0  'Flat
  97.       BackColor       =   &H80000005&
  98.       Caption         =   "PATCOPY"
  99.       ForeColor       =   &H80000008&
  100.       Height          =   315
  101.       Index           =   9
  102.       Left            =   1980
  103.       TabIndex        =   15
  104.       Top             =   3420
  105.       Width           =   1815
  106.    End
  107.    Begin VB.OptionButton Option1 
  108.       Appearance      =   0  'Flat
  109.       BackColor       =   &H80000005&
  110.       Caption         =   "MERGEPAINT"
  111.       ForeColor       =   &H80000008&
  112.       Height          =   315
  113.       Index           =   8
  114.       Left            =   1980
  115.       TabIndex        =   14
  116.       Top             =   3060
  117.       Width           =   1815
  118.    End
  119.    Begin VB.OptionButton Option1 
  120.       Appearance      =   0  'Flat
  121.       BackColor       =   &H80000005&
  122.       Caption         =   "MERGECOPY"
  123.       ForeColor       =   &H80000008&
  124.       Height          =   315
  125.       Index           =   7
  126.       Left            =   1980
  127.       TabIndex        =   13
  128.       Top             =   2700
  129.       Width           =   1815
  130.    End
  131.    Begin VB.OptionButton Option1 
  132.       Appearance      =   0  'Flat
  133.       BackColor       =   &H80000005&
  134.       Caption         =   "NOTSRCERASE"
  135.       ForeColor       =   &H80000008&
  136.       Height          =   315
  137.       Index           =   6
  138.       Left            =   1980
  139.       TabIndex        =   12
  140.       Top             =   2340
  141.       Width           =   1815
  142.    End
  143.    Begin VB.OptionButton Option1 
  144.       Appearance      =   0  'Flat
  145.       BackColor       =   &H80000005&
  146.       Caption         =   "NOTSRCCOPY"
  147.       ForeColor       =   &H80000008&
  148.       Height          =   315
  149.       Index           =   5
  150.       Left            =   1980
  151.       TabIndex        =   11
  152.       Top             =   1980
  153.       Width           =   1815
  154.    End
  155.    Begin VB.OptionButton Option1 
  156.       Appearance      =   0  'Flat
  157.       BackColor       =   &H80000005&
  158.       Caption         =   "SRCERASE"
  159.       ForeColor       =   &H80000008&
  160.       Height          =   315
  161.       Index           =   4
  162.       Left            =   1980
  163.       TabIndex        =   10
  164.       Top             =   1620
  165.       Width           =   1815
  166.    End
  167.    Begin VB.OptionButton Option1 
  168.       Appearance      =   0  'Flat
  169.       BackColor       =   &H80000005&
  170.       Caption         =   "SRCINVERT"
  171.       ForeColor       =   &H80000008&
  172.       Height          =   315
  173.       Index           =   3
  174.       Left            =   1980
  175.       TabIndex        =   9
  176.       Top             =   1260
  177.       Width           =   1815
  178.    End
  179.    Begin VB.OptionButton Option1 
  180.       Appearance      =   0  'Flat
  181.       BackColor       =   &H80000005&
  182.       Caption         =   "SRCAND"
  183.       ForeColor       =   &H80000008&
  184.       Height          =   315
  185.       Index           =   2
  186.       Left            =   1980
  187.       TabIndex        =   8
  188.       Top             =   900
  189.       Width           =   1815
  190.    End
  191.    Begin VB.OptionButton Option1 
  192.       Appearance      =   0  'Flat
  193.       BackColor       =   &H80000005&
  194.       Caption         =   "SRCPAINT"
  195.       ForeColor       =   &H80000008&
  196.       Height          =   315
  197.       Index           =   1
  198.       Left            =   1980
  199.       TabIndex        =   7
  200.       Top             =   540
  201.       Width           =   1815
  202.    End
  203.    Begin VB.OptionButton Option1 
  204.       Appearance      =   0  'Flat
  205.       BackColor       =   &H80000005&
  206.       Caption         =   "SRCCOPY"
  207.       ForeColor       =   &H80000008&
  208.       Height          =   315
  209.       Index           =   0
  210.       Left            =   1980
  211.       TabIndex        =   6
  212.       Top             =   180
  213.       Value           =   -1  'True
  214.       Width           =   1815
  215.    End
  216.    Begin VB.CommandButton cmdPatBlt 
  217.       Appearance      =   0  'Flat
  218.       BackColor       =   &H80000005&
  219.       Caption         =   "PatBlt"
  220.       Height          =   435
  221.       Left            =   2640
  222.       TabIndex        =   5
  223.       Top             =   6060
  224.       Width           =   1095
  225.    End
  226.    Begin VB.PictureBox picBrush 
  227.       Appearance      =   0  'Flat
  228.       BackColor       =   &H80000005&
  229.       ForeColor       =   &H80000008&
  230.       Height          =   495
  231.       Left            =   1500
  232.       ScaleHeight     =   465
  233.       ScaleWidth      =   945
  234.       TabIndex        =   3
  235.       Top             =   6060
  236.       Width           =   975
  237.    End
  238.    Begin VB.CommandButton cmdBitBlt 
  239.       Appearance      =   0  'Flat
  240.       BackColor       =   &H80000005&
  241.       Caption         =   "BitBlt"
  242.       Height          =   435
  243.       Left            =   3960
  244.       TabIndex        =   2
  245.       Top             =   6060
  246.       Width           =   1215
  247.    End
  248.    Begin VB.PictureBox picDest 
  249.       Appearance      =   0  'Flat
  250.       BackColor       =   &H80000005&
  251.       ForeColor       =   &H80000008&
  252.       Height          =   5355
  253.       Left            =   4140
  254.       ScaleHeight     =   355
  255.       ScaleMode       =   3  'Pixel
  256.       ScaleWidth      =   59
  257.       TabIndex        =   1
  258.       Top             =   180
  259.       Width           =   915
  260.    End
  261.    Begin VB.PictureBox picSource 
  262.       Appearance      =   0  'Flat
  263.       BackColor       =   &H80000005&
  264.       ForeColor       =   &H80000008&
  265.       Height          =   5355
  266.       Left            =   600
  267.       ScaleHeight     =   355
  268.       ScaleMode       =   3  'Pixel
  269.       ScaleWidth      =   59
  270.       TabIndex        =   0
  271.       Top             =   180
  272.       Width           =   915
  273.    End
  274.    Begin VB.Label labRes 
  275.       Appearance      =   0  'Flat
  276.       BackColor       =   &H80000005&
  277.       ForeColor       =   &H80000008&
  278.       Height          =   255
  279.       Left            =   180
  280.       TabIndex        =   23
  281.       Top             =   5640
  282.       Width           =   375
  283.    End
  284.    Begin VB.Label Label2 
  285.       Alignment       =   1  'Right Justify
  286.       Appearance      =   0  'Flat
  287.       BackColor       =   &H80000005&
  288.       Caption         =   "User Defined:"
  289.       ForeColor       =   &H80000008&
  290.       Height          =   255
  291.       Left            =   960
  292.       TabIndex        =   22
  293.       Top             =   5640
  294.       Width           =   1815
  295.    End
  296.    Begin VB.Label Label1 
  297.       Appearance      =   0  'Flat
  298.       BackColor       =   &H80000005&
  299.       Caption         =   "Current Brush:"
  300.       ForeColor       =   &H80000008&
  301.       Height          =   315
  302.       Left            =   120
  303.       TabIndex        =   4
  304.       Top             =   6120
  305.       Width           =   1275
  306.    End
  307. Attribute VB_Name = "Form1"
  308. Attribute VB_Creatable = False
  309. Attribute VB_Exposed = False
  310. Option Explicit
  311. ' Globals
  312. Dim CellHeight&     ' Height in pixels of one color cell
  313. Dim CurrentMouseY&  ' Current Y location
  314. Dim CurrentBrush%   ' Current brush to use
  315. Dim CurrentOption%
  316. ' API calls
  317. Private Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  318. Private Declare Function CreateSolidBrush% Lib "GDI" (ByVal crColor&)
  319. Private Declare Function PatBlt% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal dwRop&)
  320. Private Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  321. Private Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  322. ' The most common raster operations
  323. Dim RasterOps&(15)
  324. Const SRCCOPY = &HCC0020    ' (DWORD) dest = source
  325. Const SRCPAINT = &HEE0086   ' (DWORD) dest = source OR dest
  326. Const SRCAND = &H8800C6     ' (DWORD) dest = source AND dest
  327. Const SRCINVERT = &H660046  ' (DWORD) dest = source XOR dest
  328. Const SRCERASE = &H440328   ' (DWORD) dest = source AND (NOT dest )
  329. Const NOTSRCCOPY = &H330008 ' (DWORD) dest = (NOT source)
  330. Const NOTSRCERASE = &H1100A6 ' (DWORD) dest = (NOT src) AND (NOT dest)
  331. Const MERGECOPY = &HC000CA  ' (DWORD) dest = (source AND pattern)
  332. Const MERGEPAINT = &HBB0226 ' (DWORD) dest = (NOT source) OR dest
  333. Const PATCOPY = &HF00021    ' (DWORD) dest = pattern
  334. Const PATPAINT = &HFB0A09   ' (DWORD) dest = (Not source) or pattern or dest
  335. Const PATINVERT = &H5A0049  ' (DWORD) dest = pattern XOR dest
  336. Const DSTINVERT = &H550009  ' (DWORD) dest = (NOT dest)
  337. Const BLACKNESS = &H42&     ' (DWORD) dest = BLACK
  338. Const WHITENESS = &HFF0062  ' (DWORD) dest = WHITE
  339. Private Sub cmdBitBlt_Click()
  340.     Dim di%
  341.     Dim raster&
  342.     Dim oldbrush%
  343.     If Len(txtUserDef.Text) <> 0 Then
  344.         raster& = "&H" & txtUserDef.Text
  345.     Else
  346.         raster& = RasterOps(CurrentOption%)
  347.     End If
  348.         
  349.     Debug.Print raster&
  350.     oldbrush% = SelectObject(picDest.hDC, CurrentBrush%)
  351.     di% = BitBlt%(picDest.hDC, 0, 0, picDest.ScaleWidth, picDest.ScaleHeight, picSource.hDC, 0, 0, raster&)
  352.     oldbrush% = SelectObject(picDest.hDC, oldbrush%)
  353.     labRes.Caption = di%
  354. End Sub
  355. Private Sub cmdPatBlt_Click()
  356.     Dim di%
  357.     Dim raster&
  358.     Dim oldbrush%
  359.     If Len(txtUserDef.Text) <> 0 Then
  360.         raster& = "&H" & txtUserDef.Text
  361.     Else
  362.         raster& = RasterOps(CurrentOption%)
  363.     End If
  364.         
  365.     Debug.Print raster&
  366.     oldbrush% = SelectObject(picDest.hDC, CurrentBrush%)
  367.     di% = PatBlt%(picDest.hDC, 0, 0, picDest.ScaleWidth, picDest.ScaleHeight, raster&)
  368.     oldbrush% = SelectObject(picDest.hDC, oldbrush%)
  369.     labRes.Caption = di%
  370. End Sub
  371. Private Sub Form_Load()
  372.     ' Default to a white brush
  373.     CurrentBrush% = CreateSolidBrush(QBColor(15))
  374.     RasterOps(0) = SRCCOPY
  375.     RasterOps(1) = SRCPAINT
  376.     RasterOps(2) = SRCAND
  377.     RasterOps(3) = SRCINVERT
  378.     RasterOps(4) = SRCERASE
  379.     RasterOps(5) = NOTSRCCOPY
  380.     RasterOps(6) = NOTSRCERASE
  381.     RasterOps(7) = MERGECOPY
  382.     RasterOps(8) = MERGEPAINT
  383.     RasterOps(9) = PATCOPY
  384.     RasterOps(10) = PATPAINT
  385.     RasterOps(11) = PATINVERT
  386.     RasterOps(12) = DSTINVERT
  387.     RasterOps(13) = BLACKNESS
  388.     RasterOps(14) = WHITENESS
  389. End Sub
  390. Private Sub Form_Unload(Cancel As Integer)
  391.     Dim di%
  392.     If CurrentBrush% Then di% = DeleteObject(CurrentBrush%)
  393. End Sub
  394. Private Sub Option1_Click(Index As Integer)
  395.     CurrentOption% = Index
  396. End Sub
  397. Private Sub picSource_Click()
  398.     Dim usecolor%, di%
  399.     If CurrentBrush% Then di% = DeleteObject(CurrentBrush%)
  400.     usecolor% = CInt(CurrentMouseY \ CellHeight)
  401.     If usecolor% < 0 Then usecolor% = 0
  402.     If usecolor% > 15 Then usecolor% = 15
  403.     CurrentBrush% = CreateSolidBrush(QBColor(usecolor%))
  404.     picBrush.BackColor = QBColor(usecolor%)
  405. End Sub
  406. Private Sub picSource_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  407.     CurrentMouseY = y
  408. End Sub
  409. Private Sub picSource_Paint()
  410.     Dim x%
  411.     ' Determine the height of each block of color
  412.     CellHeight& = picSource.ScaleHeight \ 16
  413.     For x% = 0 To 15
  414.         picSource.Line (0, CellHeight * x)-(picSource.ScaleWidth, CellHeight * (x + 1)), QBColor(x%), BF
  415.     Next x%
  416. End Sub
  417. Private Sub txtUserDef_Change()
  418.     Dim txtEmpty%
  419.     Dim x%
  420.     txtEmpty% = Len(txtUserDef.Text) = 0
  421.     ' Set option button enabled status
  422.     For x% = 0 To 14
  423.         Option1(x%).Enabled = txtEmpty%
  424.     Next x%
  425. End Sub
  426.