'===========================================================================
' Subject: CLIP PIECES FROM .PCX             Date: 12-18-97 (23:15)       
' Author:  Bert van Dam                      Code: QB, PDS                
' Origin:  bd1rsd@usa.net                  Packet: GRAPHICS.ABC
'===========================================================================
'CLIP.BAS

'Program to cut (clip) pieces out of .PCX files. The selected parts will be
'copied with GET and saved to disk. Change the screen and filenames to your
'liking. You need PICEM to make this program work.

'Mark the top lefthand corner by pressing the right mouse button. Then mark
'the bottom right hand corner with the left mouse button. Press space to
'check the result. If you like it press S to save the clip to disk, or
'press Q to quit without saving.

'If the text on the screen is in the way you can move it, or prevent it
'from being shown.

'This source is donated to the public domain by Bert van Dam. I can be
'reached at Fido 2:285/705.16 of the net BD1RSD@USA.NET


' $INCLUDE: 'qb.bi'
SCREEN 9
CLS

DIM Reg AS RegTypeX

'Vertical screen position for text (change if the text is in the way)
VertOff = 1

'Filename for the clipped part of the screen
Bewaar$ = "c:\qb45\pictures\test.dat"

'Source (.PCX) file name
source$ = "c:\qb45\games\tafels\kop1.pcx"

'Do you want text on the screen (1 = yes)
ToonTekst = 1

'If your copy of Picem is in a different directory modify the next line.
SHELL "c:\qb45\utils\picem\picem /e /k " + source$


LOCATE 1, 1
IF ToonTekst = 1 THEN PRINT "QB4.5 picture clipper                                1996 Bert van Dam"

Reg.ax = 7      'Horizontal limit
Reg.cx = 0      'Min
Reg.dx = 632    'Max
CALL INTERRUPTX(&H33, Reg, Reg)
Reg.ax = 8      'Vertical limit
Reg.cx = 0      'Min
Reg.dx = 478    'Max
CALL INTERRUPTX(&H33, Reg, Reg)
Reg.ax = 1      'Switch on
CALL INTERRUPTX(&H33, Reg, Reg)

'Main
DO
        Reg.ax = 3
        CALL INTERRUPTX(&H33, Reg, Reg)
        LOCATE VertOff + 6, 20
        IF ToonTekst = 1 THEN PRINT "Status & pixel position "; Reg.bx; Reg.cx; Reg.dx; "                  "
        Positie = INT((Reg.cx / 8) + 1)
        Regel = INT((Reg.dx / 20) + 1)
        LOCATE VertOff + 7, 20
        IF ToonTekst = 1 THEN PRINT "'Locate' coordinates    "; Positie; Regel; "                       "
        LOCATE VertOff + 8, 20
        IF Reg.bx = 1 AND neehoor = 0 THEN
                x1 = Reg.cx
                y1 = Reg.dx
                neehoor = 1
                LOCATE VertOff + 9, 20
                IF ToonTekst = 1 THEN PRINT "Lefthand top corner    "; x1; y1; "                       "
        END IF
        IF Reg.bx = 2 AND neehoor = 1 THEN
                x2 = Reg.cx
                y2 = Reg.dx
                neehoor = 0
                RectHeight = ABS(y2 - y1) + 1
                RectWidth = ABS(x2 - x1) + 1
                ByteSize = 4 + RectHeight * 1.4 * INT((RectWidth * 4 + 7) / 8)
                PicSize = INT(ByteSize / 2)
                REDIM Image(1 TO PicSize)  AS INTEGER
                GET (x1, y1)-(x2, y2), Image
                LOCATE VertOff + 10, 20
                IF ToonTekst = 1 THEN PRINT "Righthand bottom corner"; x2; y2; "                       "
                LOCATE VertOff + 11, 20
                IF ToonTekst = 1 THEN PRINT "Image is recorded, press space                            "
                plaatje = 1
        END IF
LOOP UNTIL INKEY$ <> ""
'Switch mouse off
Reg.ax = 2
CALL INTERRUPTX(&H33, Reg, Reg)
CLS
LOCATE 1, 1
PRINT "QB4.5 picture clipper                                1996 Bert van Dam"
IF plaatje = 1 THEN
        PUT (50, 50), Image
        LOCATE VertOff + 8, 20
        PRINT "Press S to save clip, or Q to quit without saving."
        antw$ = INPUT$(1)
        IF UCASE$(antw$) = "S" THEN
                OPEN Bewaar$ FOR OUTPUT AS #1
                PRINT #1, PicSize
                FOR t = 1 TO PicSize
                        PRINT #1, Image(t)
                NEXT t
                CLOSE #1
        END IF
ELSE
        LOCATE 10, 10
        PRINT "No clip has been made."
END IF