You have absolutely wrong idea of use of real mode callbacks.
Actually everything is a little more difficult.
Code: Select all
'Использование звонковых точек реального режима для получения событий от мыши.
'$LANG: "fblite"
'$INCLUDE: 'dos\go32.bi'
'$INCLUDE: 'dos\dpmi.bi'
'$INCLUDE: 'dos\conio.bi'
TYPE RealModePtr FIELD = 1
ROffs AS USHORT
RSegm AS USHORT
END TYPE
TYPE VbeInfoBlock FIELD = 1
VbeSignature AS UINTEGER 'VBE Signature
VbeVersion AS USHORT 'VBE Version
OemStringPtr AS RealModePtr 'Pointer to OEM String
Capabilities AS UINTEGER 'Capabilities of graphics cont.
VideoModePtr AS RealModePtr 'Pointer to Video Mode List
TotalMemory AS USHORT 'Number of 64kb memory blocks
OemSoftwareRev AS USHORT 'VBE implementation Software revision
OemVendorNamePtr AS RealModePtr 'Pointer to Vendor Name String
OemProductNamePtr AS RealModePtr 'Pointer to Product Name String
OemProductRevPtr AS RealModePtr 'Pointer to Product Revision String
VSReserved (0 TO 221) AS UBYTE 'Reserved for VBE implementation scratch area
OemData (0 TO 255) AS UBYTE 'Data Area for OEM Strings
END TYPE
TYPE ModeInfoBlock FIELD = 1
'Mandatory information for all VBE revisions
ModeAttributes AS USHORT 'mode attributes
WinAAttributes AS UBYTE 'window A attributes
WinBAttributes AS UBYTE 'window B attributes
WinGranularity AS USHORT 'window granularity
WinSize AS USHORT 'window size
WinASegment AS USHORT 'window A start segment
WinBSegment AS USHORT 'window B start segment
WinFuncPtr AS RealModePtr 'pointer to window function
BytesPerScanLine AS USHORT 'bytes per scan line
'Mandatory information for VBE 1.2 and above
XResolution AS USHORT 'horizontal resolution in pixels or chars
YResolution AS USHORT 'vertical resolution in pixels or chars
XCharSize AS UBYTE 'character cell width in pixels
YCharSize AS UBYTE 'character cell height in pixels
NumberOfPlanes AS UBYTE 'number of memory planes
BitsPerPixel AS UBYTE 'bits per pixel
NumberOfBanks AS UBYTE 'number of banks
MemoryModel AS UBYTE 'memory model type
BankSize AS UBYTE 'bank size in KB
NumberOfImagePages AS UBYTE 'number of images
MBReserved AS UBYTE 'reserved for page function
'Direct Color fields (required for direct/6 and YUV/7 memory models)
RedMaskSize AS UBYTE 'size of direct color red mask in bits
RedFieldPosition AS UBYTE 'bit position of lsb of red mask
GreenMaskSize AS UBYTE 'size of direct color green mask in bits
GreenFieldPosition AS UBYTE 'bit position of lsb of green mask
BlueMaskSize AS UBYTE 'size of direct color blue mask in bits
BlueFieldPosition AS UBYTE 'bit position of lsb of blue mask
RsvdMaskSize AS UBYTE 'size of direct color reserved mask in bits
RsvdFieldPosition AS UBYTE 'bit position of lsb of reserved mask
DirectColorModeInfo AS UBYTE 'direct color mode attributes
'Mandatory information for VBE 2.0 and above
PhysBasePtr AS UINTEGER 'physical address for flat frame buffer
OffScreenMemOffset AS UINTEGER 'pointer to start of off screen memory
OffScreenMemSize AS USHORT 'amount of off screen memory in 1k units
MB2Reserved (0 TO 205) AS UBYTE 'remainder of ModeInfoBlock
END TYPE
TYPE PaletteType FIELD = 1
BlueByte AS UBYTE
GreenByte AS UBYTE
RedByte AS UBYTE
ReservedByte AS UBYTE
END TYPE
TYPE MouseHandlerDataType
MouseCursorMoved AS INTEGER
ButtonPressed AS INTEGER
ButtonStatus AS USHORT
MouseCursorX AS USHORT
MouseCursorY AS USHORT
END TYPE
CONST GFX_NULL = -1
DIM SHARED DOSBlock AS USHORT, DOSBlockAddr AS UINTEGER, regs AS __dpmi_regs
DIM SHARED VBEI AS VbeInfoBlock, VMDI AS ModeInfoBlock, CurNum%, ModeList(1 TO 256) AS USHORT
DIM SHARED TmpUI AS UINTEGER, UseSelector%, CSSelector%, CSAlias%, MouseImg AS ANY PTR, MouseSav AS ANY PTR
DIM SHARED RunCatArr(1 TO 100, 1 TO 4) AS ANY PTR, StayCatArr(1 TO 100) AS ANY PTR
DIM SHARED RGBPal(0 TO 255) AS PaletteType
'$STATIC
DIM SHARED MouseDataStart AS BYTE
DIM SHARED CallBackRegs AS __dpmi_regs, CallBackAddr AS __dpmi_raddr
DIM SHARED MouseHandlerData AS MouseHandlerDataType
DIM SHARED MouseDataEnd AS BYTE
MouseCursor:
DATA 0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
DATA 0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2
DATA 0,1,0,2,2,2,2,2,2,2,2,2,2,2,2,2
DATA 0,1,1,0,2,2,2,2,2,2,2,2,2,2,2,2
DATA 0,1,1,1,0,2,2,2,2,2,2,2,2,2,2,2
DATA 0,1,1,1,1,0,2,2,2,2,2,2,2,2,2,2
DATA 0,1,1,1,1,1,0,2,2,2,2,2,2,2,2,2
DATA 0,1,1,1,1,1,1,0,2,2,2,2,2,2,2,2
DATA 0,1,1,1,1,1,1,1,0,2,2,2,2,2,2,2
DATA 0,1,1,1,1,1,0,0,0,2,2,2,2,2,2,2
DATA 0,1,0,0,1,1,0,2,2,2,2,2,2,2,2,2
DATA 0,0,2,2,0,1,1,0,2,2,2,2,2,2,2,2
DATA 2,2,2,2,0,1,1,0,2,2,2,2,2,2,2,2
DATA 2,2,2,2,0,0,0,0,2,2,2,2,2,2,2,2
DATA 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
DATA 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
SUB MouseSelectorStore
'В теле этой процедуры будет храниться селектор сегмента данных программы
A% = 2 * B%
B% = 2 * A%
END SUB
SUB MouseHandler NAKED ()
'При вызове прерывания запрещены
'CS:EIP = указывает на эту процедуру
'DS:ESI = указывает на стек реального режима
'ES:EDI = указывает на структуру со значениями регистров при вызове (CallBackRegs)
'SS:ESP = фиксированный стек защищенного режима
ASM
pusha
push ds
push es
'Имитируем возврат из процедуры обработчика дальним возвратом (RETF) реального режима
mov eax, [esi] 'выбираем из стека реального режима адрес возврата
mov es:[edi + OffsetOf(__dpmi_regs, x.ip)], eax 'заносим адрес возврата в регистровую пару CS:IP
add word ptr es:[edi + OffsetOf(__dpmi_regs, x.sp)], 4 'удаляем адрес возврата из стека реального режима
lea ebx, [MouseSelectorStore]
mov ds, word ptr cs:[ebx] 'восстанавливаем селектор сегмента данных
lea ebx, [MouseHandlerData] 'в ebx будет храниться адрес области памяти для сохранения
'сохраняем новое состояние мыши
mov ax, word ptr es:[edi + OffsetOf(__dpmi_regs, x.bx)]
mov [ebx + OffsetOf(MouseHandlerDataType, ButtonStatus)], ax
mov ax, word ptr es:[edi + OffsetOf(__dpmi_regs, x.cx)]
mov [ebx + OffsetOf(MouseHandlerDataType, MouseCursorX)], ax
mov ax, word ptr es:[edi + OffsetOf(__dpmi_regs, x.dx)]
mov [ebx + OffsetOf(MouseHandlerDataType, MouseCursorY)], ax
mov cx, 6 'в cx номер текущего бита маски событий
LoopHandleEvent:
bt word ptr es:[edi + OffsetOf(__dpmi_regs, x.ax)], cx
jnc EventNotHappen
cmp cx, 5
je EventPressButton
cmp cx, 3
je EventPressButton
cmp cx, 1
je EventPressButton
or cx, cx
jnz EventNotHappen
'увеличиваем счетчик событий перемещения курсора
inc dword ptr [ebx + OffsetOf(MouseHandlerDataType, MouseCursorMoved)]
jmp EventNotHappen
EventPressButton:
'увеличиваем счетчик событий нажатия
inc dword ptr [ebx + OffsetOf(MouseHandlerDataType, ButtonPressed)]
EventNotHappen:
sub cx, 1
jnc LoopHandleEvent 'еще не все значащие биты проверены
pop es
pop ds
popa
iret
END ASM
END SUB
FUNCTION BMPLoad (FileName$) AS ANY PTR
DIM img AS ANY PTR
'' open BMP file
ERR = 0: BMPLoad = NULL
FileNum% = FREEFILE
OPEN FileName$ FOR BINARY AS #FileNum%
IF ERR <> 0 THEN EXIT FUNCTION
'' retrieve BMP dimensions
GET #FileNum%, 19, bmpwidth&
GET #FileNum%, 23, bmpheight&
CLOSE #FileNum%
'' create image with BMP dimensions
img = IMAGECREATE(bmpwidth&, ABS(bmpheight&), 0, 8)
IF img = NULL THEN EXIT FUNCTION
'' load BMP file into image buffer
BLOAD FileName$, img
IF ERR <> 0 THEN IMAGEDESTROY(img): EXIT FUNCTION
BMPLoad = img
END FUNCTION
FUNCTION MyTimer&
DIM BIOSTimer AS UINTEGER
DOSMEMGET &H46C, 4, @BIOSTimer 'read BIOS timer counter
MyTimer& = BIOSTimer AND &H7FFFFFFF
END FUNCTION
FUNCTION AllocDOSMem (BYVAL NeedSize%) AS USHORT
ParSize% = NeedSize% \ 16
IF (NeedSize% MOD 16) <> 0 THEN ParSize% = ParSize% + 1
IF (ParSize% > 65535) OR (ParSize% <= 0) THEN AllocDOSMem = 0: EXIT FUNCTION
regs.x.ax = &H4800: regs.x.bx = ParSize%: __dpmi_int(&H21, @regs)
IF BIT(regs.x.flags, 0) THEN AllocDOSMem = 0: ERR = 255: EXIT FUNCTION
ERR = 0: AllocDOSMem = regs.x.ax 'сегмент выделенного блока
END FUNCTION
FUNCTION FreeDOSMem (BYVAL BlockSegm AS USHORT) AS USHORT
regs.x.ax = &H4900: regs.x.es = BlockSegm: __dpmi_int(&H21, @regs)
FreeDOSMem = BIT(regs.x.flags, 0)
END FUNCTION
FUNCTION VSScreenList (NDepth% = 0) AS UINTEGER
STATIC CurDepth%
VSScreenList = 0
IF NDepth% > 0 THEN 'это первое обращение - получаем список доступных режимов
CurDepth% = 0: CurNum% = 0: tmp$ = "VBE2"
DOSMEMPUT STRPTR(tmp$), 4, DOSBlockAddr
regs.x.ax = &H4F00: regs.x.es = DOSBlock: regs.x.di = 0: __dpmi_int(&H10, @regs)
IF regs.x.ax <> &H4F THEN ERR = 254: EXIT FUNCTION
DOSMEMGET DOSBlockAddr, LEN(VBEI), @VBEI
IF VBEI.VbeSignature <> CVL("VESA") THEN ERR = 253: EXIT FUNCTION 'нет верной сигнатуры
IF VBEI.VbeVersion < &H200 THEN ERR = 252: EXIT FUNCTION 'версия VESA меньше 2.0 - линейный кадровый буфер не поддерживается
'Считываем список доступных видеорежимов
DOSMEMGET (CUINT(VBEI.VideoModePtr.RSegm) SHL 4) + VBEI.VideoModePtr.ROffs, 512, @ModeList(1)
CurDepth% = NDepth%
END IF
'Процедура не вызывалась ранее с явным указанием NDepth% или при построении списка режимов произошла ошибка
IF CurDepth% <= 0 THEN ERR = 251: EXIT FUNCTION
DO
CurNum% = CurNum% + 1
IF (CurNum% < LBOUND(ModeList)) OR (CurNum% > UBOUND(ModeList)) THEN EXIT DO
IF ModeList(CurNum%) = -1 THEN CurDepth% = 0: EXIT DO 'список доступных видеорежимов закончен
'получим информацию о текущем видеорежиме
regs.x.ax = &H4F01: regs.x.cx = ModeList(CurNum%)
regs.x.es = DOSBlock: regs.x.di = 0: __dpmi_int(&H10, @regs)
IF regs.x.ax <> &H4F THEN CONTINUE DO
DOSMEMGET DOSBlockAddr, LEN(VMDI), @VMDI 'получаем блок информации о режиме
'режим не поддерживается или он неграфический - не подходит
IF NOT (BIT(VMDI.ModeAttributes, 0) AND BIT(VMDI.ModeAttributes, 0)) THEN CONTINUE DO
'недоступен режим с линейным кадровым буфером
IF (NOT BIT(VMDI.ModeAttributes, 7)) OR (VMDI.PhysBasePtr = 0) THEN CONTINUE DO
'неподходящая модель цветности (поддерживаются только упаук ованные пиксели или "прямой цвет")
IF (VMDI.MemoryModel <> 4) AND (VMDI.MemoryModel <> 6) THEN CONTINUE DO
IF (VMDI.NumberOfBanks <> 1) OR (VMDI.NumberOfPlanes <> 1) THEN CONTINUE DO
'количество разрядов цветности не совпадает с искомым
IF VMDI.BitsPerPixel <> CurDepth% THEN CONTINUE DO
VSScreenList = (CUINT(VMDI.XResolution) SHL 16) + VMDI.YResolution: EXIT DO
LOOP
IF (CurNum% < LBOUND(ModeList)) OR (CurNum% > UBOUND(ModeList)) THEN CurDepth% = 0 'список доступных видеорежимов закончен
ERR = 0
END FUNCTION
SUB VSScreenRes (NWidth%, NHeight%, NDepth%)
DIM VModeParam AS UINTEGER, minfo as __dpmi_meminfo, UseSize AS UINTEGER
VModeParam = VSScreenList(NDepth%)
DO UNTIL VModeParam = 0
IF (HiWord(VModeParam) = NWidth%) AND (LoWord(VModeParam) = NHeight%) THEN EXIT DO
VModeParam = VSScreenList
LOOP
IF (HiWord(VModeParam) <> NWidth%) OR (LoWord(VModeParam) <> NHeight%) THEN
ERR = 255: EXIT SUB 'подходящего под требования режима не найдено
END IF
'Требуемый режим найден - его номер ModeList(CurNum%). Блок VMDI также уже заполнен.
UseSelector% = __dpmi_allocate_ldt_descriptors(1)
IF UseSelector% = 0 THEN ERR = 254: EXIT SUB
'Создаем дескриптор для обращения к кадровому буферу
UseSize = VMDI.BytesPerScanLine * VMDI.YResolution
IF (UseSize MOD &H1000) <> 0 THEN UseSize = ((UseSize \ &H1000) + 1) * &H1000 'выравниваем размер по целым страницам
minfo.address = VMDI.PhysBasePtr: minfo.size = UseSize
IF __dpmi_physical_address_mapping (@minfo) <> 0 THEN
ERR = 253: EXIT SUB 'не удалось картировать видеобуфер в линейное адресное пространство
END IF
IF __dpmi_set_segment_base_address(UseSelector%, minfo.address) <> 0 THEN
ERR = 252: EXIT SUB 'ошибка установки базового адреса
END IF
IF __dpmi_set_segment_limit(UseSelector%, UseSize - 1) <> 0 THEN
ERR = 251: EXIT SUB 'ошибка установки предела сегмента
END IF
'Видеобуфер к работе подготовлен, соответствующий ему селектор настроен
'Теперь устанавливаем собственно сам графический режим
regs.x.ax = &H4F02: regs.x.bx = BITSET(ModeList(CurNum%), 14): __dpmi_int(&H10, @regs) 'режим с плоским буфером
IF regs.x.ax <> &H4F THEN ERR = 250: EXIT SUB
IF NDepth% = 8 THEN 'для 8-битовых видеорежимов установим стандартную RGB332 палитру
FOR r% = 0 TO 255 'заполняем палитру
WITH RGBPal(r%)
.RedByte = (63 / 7) * ((r% \ 32) AND 7)
.GreenByte = (63 / 7) * ((r% \ 4) AND 7)
.BlueByte = (63 / 3) * (r% AND 3)
END WITH
NEXT r%
regs.x.ax = &H4F08: regs.x.bx = &H600: __dpmi_int(&H10, @regs) 'установим размер палитры в 6 бит на канал
DOSMEMPUT @RGBPal(0), 256 * SIZEOF(RGBPal(0)), DOSBlockAddr
regs.x.ax = &H4F09: regs.x.bx = 0: regs.x.cx = 256: regs.x.dx = 0
regs.x.es = DOSBlock: regs.x.di = 0: __dpmi_int(&H10, @regs) 'передаем данные палитры оборудованию
END IF
ERR = 0
END SUB
SUB VSScreenReset ()
'Освобождаем селектор и устанавливаем стандартный текстовый режим
IF UseSelector% <> 0 THEN
__dpmi_free_ldt_descriptor(UseSelector%): UseSelector% = 0
END IF
regs.x.ax = 3: __dpmi_int(&H10, @regs) 'режим 3 - стандартный текстовый режим 80x25
END SUB
SUB VSPCopy
DIM ScrPtr AS ANY PTR
'Процедура переносит содержимое экранного буфера графической библиотеки в видеопамять
SCREENINFO , RowCount%, , , RowLength%: ScrPtr = SCREENPTR
IF VMDI.BytesPerScanLine < RowLength% THEN
MoveLength% = VMDI.BytesPerScanLine
ELSE
MoveLength% = RowLength%
END IF
SCREENLOCK
ASM
push es
pusha
cld
mov eax, [ScrPtr] 'хранилище начального адреса текущей строки буфера графической библиотеки
mov ebx, [RowCount] 'количество строк, которое еще не перенесено
xor edx, edx 'хранилище начального адреса текущей строки видеопамяти
mov es, word ptr [UseSelector]
RowLoopMove:
mov esi, eax
mov edi, edx
mov ecx, [MoveLength]
rep movsb
add eax, [RowLength]
movzx ecx, word ptr [VMDI + OffsetOf(ModeInfoBlock, BytesPerScanLine)]
add edx, ecx
dec ebx
jnz RowLoopMove 'еще не все строки перенесены
popa
pop es
END ASM
SCREENUNLOCK
END SUB
SUB GetMouseSav (UMouseSav AS ANY PTR, CurCursorX%, CurCursorY%)
CALL IMAGEINFO(UMouseSav, MouseWidth%, MouseHeight%)
SCREENINFO ScrWidth%, ScrHeight%
HiX% = CurCursorX%: HiY% = CurCursorY%
LoX% = HiX% + MouseWidth% - 1: LoY% = HiY% + MouseHeight% - 1
IF HiX% < 0 THEN HiX% = 0
IF HiY% < 0 THEN HiY% = 0
IF LoX% >= ScrWidth% THEN LoX% = ScrWidth% - 1
IF LoY% >= ScrHeight% THEN LoY% = ScrHeight% - 1
IF (HiX% > LoX%) OR (HiY% > LoY%) THEN EXIT SUB
GET (HiX%, HiY%) - (LoX%, LoY%), UMouseSav
END SUB
ErrMess$ = "": DOSBlock = AllocDOSMem(4096) 'выделяем блок нижней памяти в 4к
DOSBlockAddr = CUINT(DOSBlock) SHL 4 'линейный адрес выделенного блока
regs.x.ax = 0: __dpmi_int(&H33, @regs)
IF regs.x.ax <> &HFFFF THEN ErrMess$ = "Мышь не найдена": GOTO ImmExit5
IF _go32_dpmi_lock_data(@MouseDataStart, @MouseDataEnd - @MouseDataStart) <> 0 THEN
'не удалось зафиксировать область данных обработчика событий мыши
ErrMess$ = "Ошибка при фиксации данных обработчика событий мыши": GOTO ImmExit5
END IF
IF _go32_dpmi_lock_code(@MouseSelectorStore, CAST(BYTE PTR, @BMPLoad) - CAST(BYTE PTR, @MouseSelectorStore)) <> 0 THEN
ErrMess$ = "Ошибка при фиксации кода обработчика событий мыши": GOTO ImmExit5
END IF
CSSelector% = _my_cs: CSAlias% = 0
CSAlias% = __dpmi_create_alias_descriptor(CSSelector%)
IF CSAlias% = 0 THEN
ErrMess$ = "Не удалось создать псевдоним селектора сегмента кода": GOTO ImmExit5
END IF
ASM
push es
pusha
mov es, word ptr [CSAlias]
lea ebx, [MouseSelectorStore]
mov word ptr es:[ebx], ds
popa
pop es
END ASM
IF __dpmi_allocate_real_mode_callback(@MouseHandler, @CallBackRegs, @CallBackAddr) <> 0 THEN
ErrMess$ = "Не удалось выделить звонковую точку": GOTO ImmExit4
END IF
CALL VSScreenRes(640, 480, 8) 'режим 640x480x8
IF ERR <> 0 THEN
r% = ERR: ErrMess$ = "Ошибка при вызове ScreenRes -" + STR$(r%): GOTO ImmExit3
END IF
SCREEN 18, 8, , GFX_NULL 'режим 640x480x8 без использования физического видеооборудования
MouseImg = IMAGECREATE(16, 16, 0, 8): MouseSav = IMAGECREATE(16, 16, 0, 8)
IF (MouseImg = NULL) OR (MouseSav = NULL) THEN ErrMess$ = "Ошибка при создании курсора мыши": GOTO ImmExit2
RESTORE MouseCursor
FOR r% = 0 TO 15 'создаем изображение курсора мыши
FOR k% = 0 TO 15
READ PictVal%
SELECT CASE PictVal%
CASE 1: PSET MouseImg, (k%, r%), 255 'светлые точки
CASE 2: PSET MouseImg, (k%, r%), 0 'прозрачные точки
CASE ELSE: PSET MouseImg, (k%, r%), 1 'темные точки
END SELECT
NEXT k%, r%
c$ = DIR$("RUNCAT*.BMP"): RunCatCount% = 0: ErrMess$ = "Ошибка при загрузке анимации"
WHILE (LEN(c$) > 0) AND (RunCatCount% < UBOUND(RunCatArr))
RunCatCount% = RunCatCount% + 1: RunCatArr(RunCatCount%, 1) = BMPLoad(c$)
IF RunCatArr(RunCatCount%, 1) = NULL THEN GOTO ImmExit2
'Очередная картинка бегущего кота загружена успешно.
'Положим, что в исходном виде кот бежит слева направо. Получим котов, бегущих
'справа налево, сверху вниз и снизу вверх.
'Отразим зеркально кота для получения бега справа налево
'и повернем на 90 градусов для получения бега сверху вниз.
CALL IMAGEINFO(RunCatArr(RunCatCount%, 1), CatWidth%, CatHeight%)
RunCatArr(RunCatCount%, 2) = IMAGECREATE(CatWidth%, CatHeight%, 0, 8)
IF RunCatArr(RunCatCount%, 2) = NULL THEN GOTO ImmExit2
RunCatArr(RunCatCount%, 3) = IMAGECREATE(CatHeight%, CatWidth%, 0, 8)
IF RunCatArr(RunCatCount%, 3) = NULL THEN GOTO ImmExit2
RunCatArr(RunCatCount%, 4) = IMAGECREATE(CatHeight%, CatWidth%, 0, 8)
IF RunCatArr(RunCatCount%, 4) = NULL THEN GOTO ImmExit2
FOR r% = 0 TO CatHeight% - 1
FOR k% = 0 TO CatWidth% - 1
PictVal% = POINT(k%, r%, RunCatArr(RunCatCount%, 1))
PSET RunCatArr(RunCatCount%, 2), (CatWidth% - k% - 1, r%), PictVal%
PSET RunCatArr(RunCatCount%, 3), (r%, k%), PictVal%
PSET RunCatArr(RunCatCount%, 4), (r%, CatWidth% - k% - 1), PictVal%
NEXT k%, r%
c$ = DIR$
WEND
c$ = DIR$("STPCAT*.BMP"): StayCatCount% = 0
WHILE (LEN(c$) > 0) AND (StayCatCount% < UBOUND(StayCatArr))
StayCatCount% = StayCatCount% + 1: StayCatArr(StayCatCount%) = BMPLoad(c$)
IF StayCatArr(StayCatCount%) = NULL THEN GOTO ImmExit2
c$ = DIR$
WEND
IF (RunCatCount% < 1) OR (StayCatCount% < 1) THEN ErrMess$ = "Не найдено изображений анимации": GOTO ImmExit2
ErrMess$ = ""
'скрываем курсор мыши
regs.x.ax = 2: __dpmi_int(&H33, @regs)
'устанавливаем диапазон изменения координат мыши
regs.x.ax = 7: regs.x.cx = 0: regs.x.dx = 639: __dpmi_int(&H33, @regs)
regs.x.ax = 8: regs.x.cx = 0: regs.x.dx = 479: __dpmi_int(&H33, @regs)
'устанавливаем обработчик событий мыши
regs.x.ax = &HC: regs.x.cx = &H7F: regs.x.es = CallBackAddr.segment
regs.x.dx = CallBackAddr.offset16: __dpmi_int(&H33, @regs)
'основной цикл
AnimeMouseX% = 0: AnimeMouseY% = 0: LastAnimeTimer& = MyTimer&: AnimeMode% = 0
DO
IF kbhit <> 0 THEN IF getch = 27 THEN EXIT DO
IF MouseHandlerData.MouseCursorMoved <> 0 THEN MouseHandlerData.MouseCursorMoved = 0
IF MouseHandlerData.ButtonPressed <> 0 THEN MouseHandlerData.ButtonPressed = 0
IF AnimeMode% = 0 THEN 'если анимация не включена, проверим, требуется ли ее включать
IF (ABS(MouseHandlerData.MouseCursorX - AnimeMouseX%) > 3) OR (ABS(MouseHandlerData.MouseCursorY - AnimeMouseY%) > 3) THEN
'положение кота сильно отличается от текущего положения мыши - включаем анимацию бегущего кота
AnimeMode% = 1: CurAnimeCount% = 0
ELSE
'Если кот находится там же, где мышь, и нажата кнопка мыши - включаем анимацию стоящего кота
IF (MouseHandlerData.ButtonStatus AND 3) <> 0 THEN AnimeMode% = 2: CurAnimeCount% = 0
END IF
END IF
IF (AnimeMode% <> 0) AND (MyTimer& <> LastAnimeTimer&) THEN 'перерисовываем экран с очередным кадром анимации
CurAnimeCount% = CurAnimeCount% + 1
IF AnimeMode% = 1 THEN
IF CurAnimeCount% > RunCatCount% THEN CurAnimeCount% = 1
CLS
IF MouseHandlerData.MouseCursorX > AnimeMouseX% THEN
AnimeMouseX% = AnimeMouseX% + 1 'бежим слева направо
PUT (AnimeMouseX% - CatWidth%, AnimeMouseY%), RunCatArr(CurAnimeCount%, 1), PSET
ELSEIF MouseHandlerData.MouseCursorX < AnimeMouseX% THEN
AnimeMouseX% = AnimeMouseX% - 1 'бежим справа налево
PUT (AnimeMouseX%, AnimeMouseY%), RunCatArr(CurAnimeCount%, 2), PSET
ELSEIF MouseHandlerData.MouseCursorY > AnimeMouseY% THEN
AnimeMouseY% = AnimeMouseY% + 1 'бежим сверху вниз
PUT (AnimeMouseX%, AnimeMouseY% - CatHeight%), RunCatArr(CurAnimeCount%, 3), PSET
ELSEIF MouseHandlerData.MouseCursorY < AnimeMouseY% THEN
AnimeMouseY% = AnimeMouseY% - 1 'бежим снизу вверх
PUT (AnimeMouseX%, AnimeMouseY%), RunCatArr(CurAnimeCount%, 4), PSET
ELSE 'Если кошка догнала мышку
AnimeMode% = 0: PUT (AnimeMouseX%, AnimeMouseY%), StayCatArr(1), PSET
END IF
ELSEIF AnimeMode% = 2 THEN
IF (MouseHandlerData.ButtonStatus AND 3) = 0 THEN 'Проверим, не отпущена ли кнопка мыши
AnimeMode% = 0: CurAnimeCount% = 1 'кнопка отпущена - отключаем анимацию неподвижного кота
ELSE 'кнопка все еще нажата - выводим следующий кадр анимации
IF CurAnimeCount% > StayCatCount% THEN CurAnimeCount% = 1
END IF
CLS: PUT (AnimeMouseX%, AnimeMouseY%), StayCatArr(CurAnimeCount%), PSET
END IF
CurMouseCursorX% = MouseHandlerData.MouseCursorX: CurMouseCursorY% = MouseHandlerData.MouseCursorY
CALL GetMouseSav(MouseSav, CurMouseCursorX%, CurMouseCursorY%)
PUT (CurMouseCursorX%, CurMouseCursorY%), MouseImg, TRANS 'выведем курсор мыши
CALL VSPCopy: LastAnimeTimer& = MyTimer&
ELSE 'перерисовывать экран не нужно - просто обработаем перемещение мыши
IF (MouseHandlerData.MouseCursorX <> CurMouseCursorX%) OR (MouseHandlerData.MouseCursorY <> CurMouseCursorY%) THEN
PUT (CurMouseCursorX%, CurMouseCursorY%), MouseSav, PSET 'удалим курсор по старому положению
CurMouseCursorX% = MouseHandlerData.MouseCursorX: CurMouseCursorY% = MouseHandlerData.MouseCursorY
CALL GetMouseSav(MouseSav, CurMouseCursorX%, CurMouseCursorY%)
PUT (CurMouseCursorX%, CurMouseCursorY%), MouseImg, TRANS: CALL VSPCopy 'нарисуем курсор по новому положению
END IF
END IF
LOOP
WHILE kbhit <> 0: getch: WEND
ImmExit2:
'удаляем обработчик событий мыши
regs.x.ax = &HC: regs.x.cx = 0: regs.x.es = 0: regs.x.ds = 0: __dpmi_int(&H33, @regs)
'удаляем загруженные картинки анимации
FOR r% = 1 TO RunCatCount%
FOR k% = 1 TO 4
IF RunCatArr(r%, k%) <> NULL THEN IMAGEDESTROY(RunCatArr(r%, k%))
NEXT k%, r%
FOR r% = 1 TO StayCatCount%
IF StayCatArr(r%) <> NULL THEN IMAGEDESTROY(StayCatArr(r%))
NEXT r%
'удаляем курсор мыши
IF MouseImg <> NULL THEN IMAGEDESTROY(MouseImg)
CALL VSScreenReset: SCREEN 0
ImmExit3:
__dpmi_free_real_mode_callback(@CallBackAddr)
ImmExit4:
__dpmi_free_ldt_descriptor(CSAlias%)
ImmExit5:
DOSBlock = FreeDOSMem(DOSBlock)
IF LEN(ErrMess$) > 0 THEN PRINT ErrMess$
END
The program combines the using of the standard graphic FreeBASIC library, direct VESA access and obtaining mouse events.
See how it works. If something is unclear, ask questions here.
The program is absolutely foolish, but for demonstration quite approaches.
Unpack all files from archive in one directory and start the "catmouse.exe" file.
Move mouse a little and look what will occur.
