Return to imageinc.mst CVS log

Up to [WindowsNT SDKs] / mstools / mstest / sample

Microsoft Windows NT Build 511 (SDK Final Release) 07-24-1993

'******************************* IMAGEINC.MST  *********************************
'Required Files: IMAGEDIT.INC
'
'Uses:
''******************************************************************************



'Return when the window is gone
STATIC SUB WaitWhileWnd (Title$)
    WHILE WFndWndWait( Title$, FW_PART, 1 )
    WEND
END SUB

'Wait until the window is opened or 10 sec elapsed.
STATIC SUB WaitForWnd (Title$)
    IF WFndWndWait( Title$, FW_PART, 10 ) = 0 THEN
        PAUSE "Window " + Title$ + " could not be found!"
        END
    END IF
END SUB


'******************************************************************************
'SUB Bitmap32x32x16init
'******************************************************************************
SUB Bitmap32x32x16init STATIC
    WSetWndSiz WinHandle, 635 ,365
    PaletteShow( "ON" )   'Turn on the Color Palette
    PlacePalette 105, 370
    QueMouseClick VK_LBUTTON, 195, 10
    QueFlush  1

    DoKeys "%Fn"                'Open new file
    WaitForWnd "Resource Type"
' Get the wnd handle without changing its activation state	
    hWndResType% = WFndWnd( "Resource Type", FW_PART )
    if hWndResType% <> WGetActWnd( 0 ) then
        pause "ERROR hWndResType not active!!!"
        end
    end if
    if not WOptionExists ("&Bitmap") then
        pause "ERROR (bitmap)!!!"
        end
    end if
    WOptionClick("&Bitmap")     'select Bitmap
    if not WButtonExists ("OK") then
        pause "ERROR!!!"
        end
    end if
    WbuttonClick "OK"
    DoKeys "%w32"               'select a 32x32 bit 32 color map
    DoKeys "%h32"
    DoKeys "%c"
    WOptionClick( "16 Color" )
    WbuttonClick "OK"
    PlaceViewWindow("32x32")
    SetBrushSize( "2x2" )
END SUB
'******************************************************************************
' SUB  PlaceToolBox Places the tool bar at the coordintes passed to the
' in tx and ty
'******************************************************************************
SUB PlaceToolBox(tx%,ty%) STATIC
   ToolHandle = FindWindow ("Toolbox", "")
   WSetWndPos ToolHandle, Tx, Ty
END SUB

'******************************************************************************
' SUB  PlacePalette Places the Palette at the coordintes passed to the
' SUB in px and py
'******************************************************************************
SUB PlacePalette(px%,py%) STATIC
   PaletteHandle = FindWindow ("#32770", "")
   WSetWndPos PaletteHandle, px, py
END SUB

'******************************************************************************
' SUB  PlaceViewWndow places the view window in a standard place
' for various sizes.
'******************************************************************************
SUB PlaceViewWindow(BoxSize$) STATIC
    SELECT CASE BoxSize
        CASE "16x16"
            ViewBox_x = 575
            ViewBox_y = 275

            ViewHandle = FindWindow ("View", "")
            IF ViewHandle = 0 THEN
    	        PRINT "ViewHandle was NULL"
            END IF
            WSetWndPos ViewHandle, ViewBox_x, ViewBox_y

        CASE "32x32"
            ViewBox_x = 585
            ViewBox_y = 275
            ViewHandle = FindWindow ("View", "")
    	    IF ViewHandle = 0 THEN
                PRINT "ViewHandle was NULL"
            END IF
            WSetWndPos ViewHandle, ViewBox_x, ViewBox_y
        CASE "54x54"
            ViewBox_x = 550
            ViewBox_y = 275
            ViewHandle = FindWindow ("View", "")
            IF ViewHandle = 0 THEN
                PRINT "ViewHandle was NULL"
            END IF
    	    WSetWndPos ViewHandle, ViewBox_x, ViewBox_y
        CASE ELSE
            PRINT "Error in PlaceViewWindow UNEXPECTED SIZE: ", BoxSize
            END

    END SELECT

END SUB

'******************************************************************************
' SUB GridShow Turns the Grid on or off.
'******************************************************************************
SUB GridShow(State$) STATIC
    SELECT CASE State
        CASE "ON"
             WMenu "&Options"
             If WMenuChecked( "&Grid" ) = FALSE THEN
             	DoKeys "G"
             End If
	     WMenuEnd
        CASE "OFF"
             WMenu "&Options"
             If WMenuChecked( "&Grid" ) THEN
                 DoKeys "G"
             End If
	     WMenuEnd
        CASE ELSE
            PRINT "Error in GridShow UNEXPECTED STATE: ", State
            END

    END SELECT

END SUB

'******************************************************************************
' SUB ToolBoxShow Turns the Tool Bar on or off.
'******************************************************************************
SUB ToolBoxShow(State$) STATIC
    SELECT CASE State
        CASE "ON"
             WMenu "&Options"
             If WMenuChecked( "Show &Toolbox" ) = FALSE THEN
                 DoKeys "T"
             End If
     	     WMenuEnd
        CASE "OFF"
             WMenu "&Options"
             If WMenuChecked( "Show &Toolbox" ) THEN
                 DoKeys "T"
             End If
     	     WMenuEnd
        CASE ELSE
            PRINT "Error in ToolBoxShow UNEXPECTED STATE: ", State
            END

    END SELECT

END SUB

'******************************************************************************
' SUB ViewWindowShow turns the View Window on or off.
'******************************************************************************
SUB ViewWindowShow(State$) STATIC
    SELECT CASE State
        CASE "ON"
             WMenu "&Options"
             If WMenuChecked( "Show &View Window" ) = FALSE THEN
                 DoKeys "V"
             End If
     	     WMenuEnd
        CASE "OFF"
             WMenu "&Options"
             If WMenuChecked( "Show &View Window" ) THEN
                 DoKeys "V"
             End If
     	     WMenuEnd
        CASE ELSE
            PRINT "Error in ViewWindowShow UNEXPECTED STATE: ", State
            END

    END SELECT

END SUB

'******************************************************************************
' SUB PaletteShow turns the pallete on or off.
'******************************************************************************
SUB PaletteShow(State$) STATIC
    SELECT CASE State
        CASE "ON"
            PaletteHandle = FindWindow ("#32770", "")
            IF PaletteHandle = 0 THEN
                PRINT "PaletteHandle is NULL"
            End If
            IF NOT WIsVisible( PaletteHandle ) THEN
                DoKeys "^{F7}"
            End If
            IF NOT WIsVisible( PaletteHandle ) THEN
                PRINT "Error: Palette wnd not visible!"
            END IF
        CASE "OFF"
            PaletteHandle = FindWindow ("#32770", "")
            IF WIsVisible( PaletteHandle ) THEN
                DoKeys "^{F7}"
            End If
            IF WIsVisible( PaletteHandle ) THEN
               PRINT "Error: Palette wnd is visible!"
            END IF
        CASE ELSE
            PRINT "Error in PaletteShow UNEXPECTED STATE: ", State
            END

    END SELECT
END SUB

'$ifdef NASTYBUG
'******************************************************************************
' SUB PaletteShow turns the pallete on or off.
'******************************************************************************
SUB PaletteShow(State$) STATIC
    WSetActWnd WinHandle
    SELECT CASE State
        CASE "ON"
             WMenu "&Options"
             	If WMenuChecked( "Show &Color Palette" ) = FALSE THEN
                DoKeys "C"
             End If
     	     WMenuEnd
             PaletteHandle = FindWindow ("#32770", "")
    	     IF NOT WIsVisible( PaletteHandle ) THEN
                 PRINT "Error: Palette wnd not visible!"
             END IF

        CASE "OFF"
             WMenu "&Options"
             If WMenuChecked( "Show &Color Palette" ) THEN
                 DoKeys "C"
             End If
     	     WMenuEnd
             PaletteHandle = FindWindow ("#32770", "")
             IF WIsVisible( PaletteHandle ) THEN
             	 PRINT "Error: Palette wnd is visible!"
             END IF

        CASE ELSE
            PRINT "Error in PaletteShow UNEXPECTED STATE: ", State
            END

    END SELECT
END SUB
'$endif

'******************************************************************************
' SUB SetBrushSize Set the brush size to one of the four possibilities
' (2x2, 3x3, 4x4, 5x5)
'******************************************************************************
SUB SetBrushSize(Size$) STATIC
    SELECT CASE Size
        CASE "2x2"
             WMenu "&Options"
             WMenu "&Brush Size"
             If WMenuChecked( "&2x2" ) = FALSE THEN
                 DoKeys "2"
             End If
     	     WMenuEnd
        CASE "3x3"
             WMenu "&Options"
             WMenu "&Brush Size"
             If WMenuChecked( "&3x3" ) = FALSE THEN
                 DoKeys "3"
             End If
     	     WMenuEnd
        CASE "4x4"
             WMenu "&Options"
             WMenu "&Brush Size"
             If WMenuChecked( "&4x4" ) = FALSE THEN
                 DoKeys "4"
             End If
     	     WMenuEnd
        CASE "5x5"
             WMenu "&Options"
             WMenu "&Brush Size"
             If WMenuChecked( "&5x5" ) = FALSE THEN
                 DoKeys "5"
             End If
     	     WMenuEnd
        CASE ELSE
            PRINT "Error in SetBrushSize UNEXPECTED SIZE: ", Size
            END

    END SELECT

END SUB


'******************************************************************************
' *** Determine the golden file name used. Default is now VRAM1024.scn.
'******************************************************************************
'$ifdef MIPS1280
Const GoldenFile$ = "mips1280.scn"
'$else
Const GoldenFile$ = "VRAM1024.scn"
'$endif


'******************************************************************************
' Sub ProcessResults determines what to do at the end of the test routine
' Default is verification.
'******************************************************************************

' For testing now
'''''$define CREATEGOLDEN

SUB ProcessResults( FileName$, SubName$, DumpIndex% ) STATIC
'$ifdef CREATEGOLDEN
    CreateGolden FileName$, SubName$, DumpIndex%
'$else
    Verify FileName$, SubName$, DumpIndex%
'$endif
END SUB


'******************************************************************************
' Sub CreateGolden compares window with golden window and Saves it to image.dmp        file can be loaded and saved properly.
'******************************************************************************
SUB CreateGolden( FileName$, SubName$, DumpIndex% ) STATIC

    IF NOT FileName$ = "" THEN
        IF NOT EXISTS(FileName) THEN
            DoKeys "%FA"
            DoKeys FileName
            WButtonClick "OK"
        ELSE
            DoKeys "%FA"
            DoKeys FileName
            WButtonClick "OK"
            DoKeys "y"
        END IF

        QueMouseMove 110, 224
        QueMouseMove 110, 324
        QueFlush 1
    END IF

    ret2% = fDumpWindow( GoldenFile$, WinHandle, 1, DumpIndex, FALSE)
    IF ret2% > 0 THEN
        Print #1, "Window dump failed in routine " SubName$ " Error #:" ret2%
        Print #1,
        ErrCount = ErrCount + 1
    ELSE
        Print #1, SubName,,, " golden generated OK."
    ENDIF
END SUB


'******************************************************************************
' Sub VERIFY saves the area and compares the window with golden window in
' gimage.scn. If there is a descrepency then the window is then dumped to
' image.scn
'******************************************************************************
SUB Verify(FileName$, SubName$, DumpIndex%) STATIC

    IF NOT FileName$ = "" THEN
        IF NOT EXISTS(FileName) THEN
            DoKeys "%FA"
            DoKeys FileName
            WButtonClick "OK"
        ELSE
            DoKeys "%FA"
            DoKeys FileName
            WButtonClick "OK"
            DoKeys "y"
        END IF

        QueMouseMove 110, 224
        QueMouseMove 110, 324
        QueFlush 1
    END IF

    ret% = fCompWindow( GoldenFile$, WinHandle, DumpIndex, FALSE, FALSE)
    IF ret% > 0 THEN
        Print #1, "Construction failed for " SubName " Error #:" ret%
        Print #1, "Dumping Window at index:" DumpIndex%
        Print #1,
        ErrCount = ErrCount + 1
        ret2% = fDumpWindow("imagdump.scn", WinHandle, 1, DumpIndex, FALSE)
        IF ret2% > 0 THEN
            Print #1, "Window dump failed for " SubName " Error #:" ret2%
            Print #1,
            ErrCount = ErrCount + 1
        ENDIF
    ELSE
        Print #1, SubName,,, " PASSED"
    ENDIF
END SUB



'******************************************************************************
'SUB ToolTest. Set up and mouse control for bimap tool test.
'******************************************************************************
SUB ToolTest(Width$) STATIC
    Bitmap32x32x16init
    SetBrushSize( Width$ )
    QueMouseClick VK_LBUTTON, 591, 111  'Select the pen
    QueMouseClick VK_LBUTTON, 333, 442  'Select Dithered Blue
    QueMouseClick VK_RBUTTON, 282, 426  'Select Yellow
    QueMouseDn VK_LBUTTON, 10, 74       'Draw diagonal line
    QueMouseUp VK_LBUTTON, 258, 322
    QueMouseClick VK_LBUTTON, 592, 165  'Select the outline box.
    QueMouseDn VK_RBUTTON, 258, 74      'Draw square
    QueMouseUp VK_RBUTTON, 146, 186
    QueMouseClick VK_LBUTTON, 257, 426  'Select Red
    QueMouseClick VK_RBUTTON, 291, 426  'Select Green
    QueMouseClick VK_LBUTTON, 592, 191  'Select the outline circle.
    QueMouseDn VK_RBUTTON, 114, 210     'Draw circle
    QueMouseUp VK_RBUTTON, 10, 322
    QueMouseClick VK_LBUTTON, 618, 111  'Select the Brush
    QueMouseClick VK_LBUTTON, 202, 266  'Draw dots
    QueMouseClick VK_LBUTTON, 134, 198
    QueMouseClick VK_LBUTTON,  66, 130
    QueMouseClick VK_LBUTTON, 619, 191  'Select Fill Circle.
    QueMouseDn VK_LBUTTON, 110, 314     'Clears size: field and sets postion:
    QueKeys "{ESC}"                     'field to a standerd number
    QueMouseUp VK_LBUTTON, 110, 324
    QueMouseClick VK_LBUTTON, 618, 111  'Select The Brush.
    QueFlush 1
END SUB

'******************************************************************************
'SUB IToolTest. Set up and mouse control for icon tool test.
'******************************************************************************
SUB IToolTest(Width$) STATIC
    WSetWndSiz WinHandle, 635 ,365
    PaletteShow( "ON" )                 'Turn on the color palette
    PlacePalette 105, 370
'   QueMouseClick VK_LBUTTON, 195, 10
'   QueFlush  1
    WSetActWnd( WinHandle )
    DoKeys "%Fn"                        'Open new file
    WOptionClick("&Icon")               'Select bitmap
    WbuttonClick "OK"
    WListItemClkT "&Target Device:", "CGA 2-Color 32x16"
    WbuttonClick "OK"
    PlaceViewWindow("32x32")
    SetBrushSize( Width$ )
    QueMouseClick VK_LBUTTON, 360, 426  'Set screen and inverse colors to
    QueMouseClick VK_LBUTTON, 611, 321  'gray shades
    QueMouseClick VK_LBUTTON, 591, 111  'select the pen
    QueMouseClick VK_LBUTTON, 224, 442  'select Black
    QueMouseDn VK_LBUTTON, 10, 74       'Draw diagonal line
    QueMouseUp VK_LBUTTON, 542, 334
    QueMouseClick VK_LBUTTON, 592, 165  'Select the outline box.
    QueMouseDn VK_LBUTTON, 543, 78      'Draw square
    QueMouseUp VK_LBUTTON, 406, 215
    QueMouseClick VK_LBUTTON, 592, 191  'Select the outline Circle.
    QueMouseDn VK_LBUTTON, 15, 334      'Draw circle
    QueMouseUp VK_LBUTTON, 150, 198
    QueMouseClick VK_LBUTTON, 618, 111  'Select the Brush
    QueMouseClick VK_LBUTTON, 458, 283  'Draw dots
    QueMouseClick VK_LBUTTON, 278, 206
    QueMouseClick VK_LBUTTON,  99, 130
    QueMouseClick VK_LBUTTON, 619, 191  'Select Fill Circle.
    QueMouseDn VK_LBUTTON, 110, 314
    QueKeys "{ESC}"
    QueMouseUp VK_LBUTTON, 110, 324
    QueMouseClick VK_LBUTTON, 618, 111  'Select The Brush.
    QueFlush 1
END SUB

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.