2013-06-19 07:46

'
' Load Part Of a Large Bitmap in A Canvas
' Scroll Up, Down, Left, Right with Direction Keys
'
' By J.Philippe, April 2003
'
     $ESCAPECHARS ON
     $TYPECHECK ON
'
     DECLARE SUB Paint
     DECLARE SUB OnForm_KeyDown (Key AS BYTE, Shift AS INTEGER)
'
     DEFSTR Help = "       SCROLL WITH : Up, Down, Left, Right   And   ZOOM WITH  +, -  Keys"
'
     DIM Bitmap AS QBITMAP
'
     CREATE Form AS QFORM
      WindowState = 2 ' wsMaximized
      OnKeyDown = OnForm_KeyDown
      CAPTION = Help
      CREATE Canvas AS QCANVAS
       Align = 5 ' alClient
       OnPaint = Paint
      END CREATE
     END CREATE
'
' --------------------------------------------------------------------
' New Code API Call that lets RapidQ programs minimize to the task bar
     DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" (hWnd AS LONG, _
      nIndex AS LONG, dwNewLong AS LONG) AS LONG
'      ----- API Constants and Functions
     CONST GWL_HWNDPARENT = (-8)                   'Minimize to task bar
     CONST HWND_DESKTOP = 0
     setwindowlong(Form.handle, GWL_HWNDPARENT, HWND_DESKTOP)
     setwindowlong(application.handle, GWL_HWNDPARENT, Form.handle)
' --------------------------------------------------------------------
'
' *********************************
     Form.Show
' *********************************
     DIM Source AS QRECT
     DIM Destination AS QRECT
     DEFINT bmpTop = 1, bmpLeft = 1, Busy = 0
     DEFSNG Zoom = 1
'
     Bitmap.BMP = "test.bmp"
     Paint
'
' *********************************
     Form.Visible = 0 ' False
     Form.SHOWMODAL
' *********************************
'
     SUB Paint
      WITH Source
       .Top = bmpTop       ' Increase to scroll Left
       .Left = bmpLeft     ' Increase to Scroll Up
       .Right = (Canvas.Width * Zoom) + bmpLeft
       .Bottom = (Canvas.Height * Zoom) + bmpTop
      END WITH
      WITH Destination
       .Top = 0
       .Left = 0
       .Right = Canvas.Width
       .Bottom = Canvas.Height
      END WITH
'    Canvas.FillRect 0,0 ,Form.ClientWidth,Form.ClientHeight,&H999999
      Canvas.CopyRect(Destination, Bitmap, Source)
     END SUB
'
     SUB OnForm_KeyDown (Key AS BYTE, Shift AS INTEGER)
    ' ShowMessage (Str$(Key))
      IF Busy = 1 THEN EXIT SUB
      Busy = 1
      SELECT CASE Key
      CASE 37   ' Left
       Form.CAPTION = "Last Key Hit : LEFT = " & STR$(Key) & "    Zoom = " & STR$(Zoom) & Help
       bmpLeft = bmpLeft - 25
      CASE 38   ' Up
       Form.CAPTION = "Last Key Hit : UP= " & STR$(Key) & "    Zoom = " & STR$(Zoom) & Help
       bmpTop = bmpTop - 25
      CASE 39   ' Right
       Form.CAPTION = "Last Key Hit : RIGHT = " & STR$(Key) & "    Zoom = " & STR$(Zoom) & Help
       bmpLeft = bmpLeft + 25
      CASE 40   ' Down
       Form.CAPTION = "Last Key Hit : DOWN = " & STR$(Key) & "    Zoom = " & STR$(Zoom) & Help
       bmpTop = bmpTop + 25
      CASE 107   ' ZOOM +
       Zoom = Zoom / 2
       Form.CAPTION = "Last Key Hit : ZOOM + = " & STR$(Key) & "    Zoom = " & STR$(Zoom) & Help
      CASE 109   ' ZOOM -
       Zoom = Zoom * 2
       Form.CAPTION = "Last Key Hit : ZOOM - = " & STR$(Key) & "    Zoom = " & STR$(Zoom) & Help
      CASE ELSE
       Busy = 0
       EXIT SUB
      END SELECT
      IF bmpTop < 0 THEN BmpTop = 0
      IF bmpLeft < 0 THEN bmpLeft = 0
      Paint
      Busy = 0
     END SUB
'

2013-06-19 07:46