forum.clarionlife.net

Код: Выделить всё

 PROGRAM

! Common equates
HANDLE                       EQUATE(UNSIGNED)
HWND                         EQUATE(HANDLE)
HBITMAP                      EQUATE(HANDLE)
HDC                          EQUATE(HANDLE)
HGDIOBJ                      EQUATE(HANDLE)
HBRUSH                       EQUATE(HANDLE)
WPARAM                       EQUATE(UNSIGNED)
LPARAM                       EQUATE(LONG)

GWL_WNDPROC                  EQUATE(-4)

SB_HORZ                      EQUATE(0)
SB_VERT                      EQUATE(1)
SB                           EQUATE(3)
WM_HSCROLL                   EQUATE(0114h)
WM_CTLCOLORSCROLLBAR            EQUATE(0137h)



 MAP
   PaintArea_WndProc         (HWND hWnd, UNSIGNED wMsg, WPARAM wParam, LPARAM lParam),LONG,PASCAL

   MODULE('Windows API')
     CallWindowProc          (LONG lpPrevWndFunc, HWND hWnd, UNSIGNED wMsg, WPARAM wParam, LPARAM lParam),LONG,PASCAL,NAME('CallWindowProcA')
     GetScrollPos            (HWND hWnd, SIGNED nBar),SIGNED,PASCAL
     SetScrollPos            (HWND hWnd, SIGNED nBar, SIGNED Pos, BOOL),SIGNED,PASCAL
     SetWindowLong           (HWND hWnd, SIGNED nIndex, LONG dwNewLong),LONG,PROC,PASCAL,NAME('SetWindowLongA')
     SetScrollRange          (HWND, SIGNED, SIGNED, SIGNED, BOOL),PASCAL
   END
 END

PaintArea_WndProc_Addr       LONG                               ! Адрес оригинальной процедуры окна

PaintArea_hWnd               HWND                               ! Handle окна области просмотра
PaintArea_hDC                HDC                                ! Контекст области просмотра
PaintArea_hMemDC             HDC                                ! Контекст в памяти с картинкой
PaintArea_hBitMap            HBITMAP                            ! Битовая карта изображения
PaintArea_hOldBitMap         HBITMAP                            ! Предыдущая битовая карта контекста

PaintArea_HScrollPos         SIGNED                             ! Текущая позиция (0-255) горизонтального скролбара
PaintArea_VScrollPos         SIGNED                             ! Текущая позиция (0-255) вертикального скролбара

DataQueue          QUEUE,PRE()
Level1                LONG
Level2                LONG
Level3                LONG
Level4                LONG
                   END

PaintArea:Win                WINDOW('Paint Area'),AT(,,300,200),FONT('MS Sans Serif',8),CENTER,GRAY,DOUBLE,SYSTEM
                               !LIST,AT(0,0,100,100),USE(?List),FULL,HVSCROLL,IMM
                               LIST,AT(0,0,200,100),USE(?List),FORMAT('80L(2)|M~Level1~@s20@80L(2)|M~Level2~@s20@80L(2)|M~Level3~@s20@80L(2)|M~Level4~@s20@'),FROM(DataQueue) ,HVSCROLL,IMM
                               !IMAGE('Blank_500x500.gif'),AT(5,5,125,105),USE(?PaintArea:Image),HVSCROLL
                               PROMPT('Horz:'),AT(5,116)
                               STRING(@s6),AT(28,116),USE(PaintArea_HScrollPos)
                               PROMPT('Vert:'),AT(74,116)
                               STRING(@s6),AT(94,116),USE(PaintArea_VScrollPos)

                             END
!*************************************************************************************************
 CODE
 OPEN(PaintArea:Win)

 Level1 = 1
 Level2 = 2
 Level3 = 3
 Level4 = 4
 add (DataQueue)
 ?List{PROP:From} = DataQueue
! PaintArea_hWnd = ?PaintArea:Image{PROP:Handle}
 PaintArea_hWnd = ?List{PROP:Handle}
 ! Сабклассинг области просмотра
 PaintArea_WndProc_Addr = SetWindowLong(PaintArea_hWnd, GWL_WNDPROC, ADDRESS(PaintArea_WndProc))

          ! Цикл работы с окном
          ACCEPT
          END


 CLOSE(PaintArea:Win)

!*************************************************************************************************
PaintArea_WndProc            PROCEDURE(HWND hWnd, UNSIGNED wMsg, WPARAM wParam, LPARAM lParam)

hDC                          HDC
hWndDC                       HDC
!PStruct                      LIKE(PAINTSTRUCT)
!DrawRect                     LIKE(RECT)                         ! Координаты области для просмотра

PosX                         LONG                               ! Координаты левого верхнего угла
PosY                         LONG                               ! отображаемой части картинки
res                          BYTE

 CODE
 CASE wMsg
   OF WM_CTLCOLORSCROLLBAR!WM_HSCROLL


       ! Просто для информации позиция скролбара
       !SetScrollRange (hWnd, SB_HORZ, 0, 255, TRUE)
       PaintArea_HScrollPos = GetScrollPos(hWnd, SB_HORZ)
       PaintArea_HScrollPos = SetScrollPos(hWnd, SB_HORZ,20,true)
       PaintArea_VScrollPos = GetScrollPos(hWnd, SB_VERT)
       PaintArea_HScrollPos = SetScrollPos(hWnd, SB_VERT,40,true)
      ! PaintArea_VScrollPos = GetScrollPos(hWnd, SB)
      ! PaintArea_HScrollPos = SetScrollPos(hWnd, SB,40,true)

       DISPLAY(?PaintArea_HScrollPos)
       DISPLAY(?PaintArea_VScrollPos)

       RETURN FALSE
 END
 RETURN CallWindowProc(PaintArea_WndProc_Addr, hWnd, wMsg, wParam, lParam)