2003-12-31 07:24

' written by Mark  Kica and improved by John Kelly
' This is Pcx Viewer -images in 256 color version ,, 5
' PC Paintbrush and includes 24-bit .PCX files


     $INCLUDE "RAPIDQ.INC"
     $APPTYPE GUI
     $TYPECHECK ON


     DECLARE SUB formPaint
     DECLARE SUB LoadPCXfile
     DECLARE SUB ExitApp


     TYPE PcxHeaderType
      MAN 		AS STRING * 1
      VER 		AS STRING * 1
      ENC 		AS STRING * 1
      BIT 		AS STRING * 1
      Xmin 		AS SHORT
      Ymin 		AS SHORT
      XMax 		AS SHORT
      YMax 		AS SHORT
      HRE 		AS SHORT
      VRE 		AS SHORT
      COL 		AS STRING * 48
      RES 		AS STRING * 1
      nplanes		AS STRING * 1
      bytesperline AS SHORT
      PAL 		AS SHORT
      FIL 		AS STRING * 58
     END TYPE

     DIM TheFileName AS STRING
     DIM field AS QBITMAP			'doesn' have a parent class don't put in create statements

     CREATE Form AS QFORM
      CAPTION="PCX Viewer"
      Height=444
      Width=603
	'Borderstyle = bsToolWindow		'user can't resize
      Center
      OnClick = LoadPCXfile
      OnPaint = formPaint
      CREATE MainMenu AS QMAINMENU
       CREATE FileMenu AS QMENUITEM					'***** FILE  MENUS ********
        CAPTION = "  &File"
        CREATE OpenItem AS QMENUITEM
         CAPTION = "  &Open PCX File"
         OnClick = LoadPCXfile
        END CREATE
        CREATE ExitItem AS QMENUITEM
         CAPTION = "  E&xit"
         OnClick = ExitApp
        END CREATE
       END CREATE
      END CREATE
     END CREATE

     form.SHOWMODAL


     SUB formPaint
      Form.draw(0, 0, field.bmp)
     END SUB


     SUB LoadPCXfile
      DIM PCX AS PcxHeaderType
      DIM xsize AS INTEGER, Ysize AS INTEGER, Totalbytes AS INTEGER, I AS INTEGER
      DIM r AS INTEGER, g AS INTEGER, b AS INTEGER			'rgb intensity values
      DIM x AS INTEGER, y AS INTEGER
      DIM RepeatPix AS INTEGER, PCXpixel AS INTEGER, DoLne AS INTEGER
      DIM PCXcolors(0 TO 255)		AS INTEGER
      DIM TheFile 				AS QFILESTREAM
      DIM OpenDialog  			AS QOPENDIALOG

      OpenDialog.CAPTION = "Open PCX graphics file"
      OpenDialog.Filename = ""
      OpenDialog.Filter = "PCX Files (*.PCX)|*.PCX"
      OpenDialog.FilterIndex = 1                    ' Of course Use ".PCX" as our default
      IF OpenDialog.EXECUTE THEN
       TheFileName = OpenDialog.FileName
       IF FILEEXISTS(TheFileName)<> True THEN
        SHOWMESSAGE "File " + TheFileName + " doesn't exist"
        EXIT SUB
       END IF
      ELSE
       EXIT SUB
      END IF
      Form.CAPTION="PCX Viewer" + TheFileName
      Form.Cursor = crHourGlass					'rapidq ain't so rapid
      TheFile.OPEN(TheFileName,fmOpenRead)
      TheFile.position = TheFile.size - 768		'last portion of file has color index 3 * 256
      FOR i=0 TO 255
       r = TheFile.readnum(1)					'may also represent color index value, NOT RGB 0-255!!!
       g = TheFile.readnum(1)					'you must load color first since most forms will not be
       b = TheFile.readnum(1)					'in 8-bit color mode
       PCXColors(i)=RGB(r,g,b)					'if so this will recolor the picture wrong
      NEXT i

      TheFile.position = 0						'reset to start
      TheFile.ReadUDT(PCX)					'Read in header information
      xsize = PCX.xmax - PCX.xmin + 1			'Find size of image
      ysize = PCX.ymax - PCX.ymin + 1
      totalbytes = ASC(PCX.nplanes) * PCX.bytesperline
      field.height = ysize					'resize form and bitmap to fit it
      field.width = xsize
      form.height = ysize + 60				'border around picture
      form.width = xsize + 20

      x=0
      y=0
      DO
       PCXpixel = TheFile.readnum(1)				'read each byte
       IF PCXpixel <192 THEN
        IF x < xsize THEN INC x
        IF x = xsize THEN x = 0 : INC y
        field.pset(x,y,PCXColors(PCXpixel))
       END IF
       IF PCXpixel >192 AND PCXpixel <= 255 THEN	'run length encoded
        Dolne = PCXpixel - 192					'number of pixels the same
        RepeatPix = TheFile.readnum(1) 		'pixel that indexes the color (byte)
        DEC Dolne
        FOR i = DoLne TO 0 STEP -1
         IF x < xsize THEN INC x
         IF x = xsize THEN x = 0 : INC y		'wrap to image size
         field.pset(x, y ,PCXColors(RepeatPix))
        NEXT i
       END IF
      LOOP UNTIL y =ysize
      TheFile.CLOSE
      Form.Cursor = crDefault
      formPaint
     END SUB

     SUB ExitApp
      Application.Terminate
     END SUB

2003-12-31 07:24