Отправлено: 27.07.08 11:26. Заголовок: ASM

Есть функция написанная на asm для Clipper
Как портировать ее в Xharbour

цитата:

INCLUDE EXTENDA.INC CODESEG CLpublic <IsKey> ; CLfunc int IsKey CLcode PUSH DS MOV AX,40h MOV DS,AX MOV AL,BYTE PTR DS:[17h] MOV AH,BYTE PTR DS:[18h] MOV BX,1000 TEST AL,1 JNZ EX_ISKEY MOV BX,1001 TEST AL,2 JNZ EX_ISKEY TEST AL,4 JZ TEST_ALT MOV BX,1002 TEST AH,1 JZ EX_ISKEY MOV BX,1003 JMP EX_ISKEY TEST_ALT: TEST AL,8 JZ C MOV BX,1004 TEST AH,2 JZ EX_ISKEY MOV BX,1005 JMP EX_ISKEY C: MOV BX,0 EX_ISKEY: POP DS CLret BX ; END

 Отправлено: 28.07.08 14:16. Заголовок: примерно так if K_S..

примерно так

if K_SH_RIGHT return 1000
elseif K_SH_LEFT return 1001
elseif K_CTRL_RIGHT return 1002
elseif K_CTRL_LEFT return 1003
elseif K_ALT_RIGHT return 1004
elseif K_ALT_LEFT return 1005
else
return 0
endif

а состояние клавиш alt-shift-ctrl надо прочитать функциями ct/nf

 Отправлено: 28.07.08 16:41. Заголовок: Pasha пишет: надо п..

Pasha пишет:

цитата:

надо прочитать функциями ct/nf

Например какими ?

 Отправлено: 28.07.08 17:09. Заголовок: KbdStat() из ct, и F..

KbdStat() из ct, и FT_CTRL(), FT_ALT(), FT_Shift() из nf

 Отправлено: 28.07.08 17:16. Заголовок: Спасибо Павел !!!..

Спасибо Павел !!!

 Отправлено: 05.10.08 16:37. Заголовок: В Clipper работает ,..

В Clipper работает , в Xharbour , нет
Что не так сделал ?
do while .t.
Inkey(0.1)
IF ISBIT(KBDSTAT(), 4)
? "ALT"
elseif ISBIT(KBDSTAT(), 1)
? "SHIFT"
else
? " "
ENDIF
enddo

 Отправлено: 05.10.08 17:16. Заголовок: Вот пример написанны..

Вот пример написанный Przemek -ом (Przemyslaw Czerpak)

Sample code below. It uses two different methods to extract
cotnrol key state. But please remember that not all GTs
can support such functionality.

best regards,
Przemek


#include "inkey.ch"
#include "hbgtinfo.ch"
proc main()
local cStatus, iStatus, nKey
clear screen
while ( nKey := inkey( 0.1 ) ) != K_ESC
iStatus := hb_gtInfo( HB_GTI_KBDSHIFTS )
cStatus := ""
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_SHIFT ) != 0, ;
"SHIFT ", " " )
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_CTRL ) != 0, ;
"CTRL ", " " )
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_ALT ) != 0, ;
"ALT ", " " )
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_SCROLOCK ) != 0, ;
"SCRLOCK ", " " )
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_NUMLOCK ) != 0, ;
"NUMLOCK ", " " )
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_CAPSLOCK ) != 0, ;
"CAPSLOCK ", " " )
cStatus += iif( HB_BITAND( iStatus, HB_GTI_KBD_INSERT ) != 0, ;
"INSERT ", " " )
@ 1, 0 say cStatus

cStatus := ""
cStatus += iif( KSETINS(), "INS ", " " )
cStatus += iif( KSETCAPS(), "CAPS ", " " )
cStatus += iif( KSETNUM(), "NUM ", " " )
cStatus += iif( KSETSCROLL(), "SCROLL ", " " )
@ 2, 0 say cStatus
if nKey==asc("C") .or. nKey==asc("c")
KSETCAPS(!KSETCAPS())
elseif nKey==asc("I") .or. nKey==asc("i")
KSETINS(!KSETINS())
elseif nKey==asc("N") .or. nKey==asc("n")
KSETNUM(!KSETNUM())
elseif nKey==asc("S") .or. nKey==asc("s")
KSETSCROLL(!KSETSCROLL())
endif
enddo
return


KSETSCROLL - это из СТ

 Отправлено: 05.10.08 17:48. Заголовок: Петр Спасибо за при..

Петр
Спасибо за пример , но что то мне не удалось из него добиться чего хотел.
Нужно следующее.
Есть мой переделанный браузер на основе tbrowse (clipper)
Вот тут я ловлю нажатия клавиш
do while .t.

nKey:=inkey()

if nKey#0
exit
endif
isnkey:=iskey()
if isnkey#0
nKey:=isnkey
exit
endif
enddo

В Clipper это конечно работает.
Смысл в том что наряду с отлавливанием обычных клавиш мне нужно ловить alt, shift,ctrl
я целый год не программил и конечно отстал по полной программе и многое подзабыл.
Честно говоря я не понял что я должен был увидеть в примере.
Собрал , запустил , поклацал alt , shift и тд , и ни чего не произошло на экране.
Правда если запускать прогу с нажатым Shift , тогда видно что при первом запуске был нажат Shift

 Отправлено: 05.10.08 20:34. Заголовок: Инет вырубило - прош..

Инет вырубило - прошу извинения за задержку с ответом.

Dima пишет:

цитата:

Честно говоря я не понял что я должен был увидеть в примере.

Ну, наверное мы увидели подтверждение слов "But please remember that not all GTs can support such functionality".

Я с консолью работаю мало. Из того, что вспоминаю - на форуме такими вещами интересовались Андрей и Лукашевский.
Могу предложить попробовать поработать с WinAPI, в частности с GetKeyState

Возвращаемые значения
Если функция завершается успешно, величина возвращаемого значения определяет состояние данной виртуальной клавиши. Если старший бит равен 1, клавиша нажата; иначе она отпущена. Если младший бит равен 1, клавиша переключилась. Клавиша, такая как CAPS LOCK, переключается, если она является включенной. Клавиша выключена и не переключает, если младший бит равен 0. Когда клавиша переключается, индикатор переключения клавиши на клавиатуре (если он есть) должен быть включен, и отключен, когда клавиша не переключается.

#include "inkey.ch"  
  
 PROCEDURE main()  
 LOCAL iStatus, nKey  
  
    CLEAR SCREEN 
  
    WHILE ( nKey := inkey( 0.1 ) ) != K_ESC  
       iStatus := GetLShiftState()  
       @ 1, 0 say "LShift: "+Num2Bit( iStatus ) 
       iStatus := GetRShiftState()  
       @ 2, 0 say "RShift: "+Num2Bit( iStatus ) 
       iStatus := GetLCtrlState()  
       @ 3, 0 say "LCtrl : "+Num2Bit( iStatus ) 
       iStatus := GetRCtrlState()  
       @ 4, 0 say "RCtrl : "+Num2Bit( iStatus ) 
       iStatus := GetLAltState()  
       @ 5, 0 say "LAlt  : "+Num2Bit( iStatus ) 
       iStatus := GetRAltState()  
       @ 6, 0 say "RAlt  : "+Num2Bit( iStatus ) 
    ENDDO  
    // 
    RETURN 
  
  
 FUNCTION Num2Bit( nNumber ) 
 LOCAL nInt := Int( nNumber ) 
 LOCAL nLen := IIf( Abs(nInt) > 2^15, 31, 15 ) 
 LOCAL cBin := Replicate( "0", nLen+1 ) 
 LOCAL nPos 
  
    FOR nPos := 0 TO nLen 
       IF HB_BitIsSet( nInt, nPos ) 
           cBin[ nLen-nPos+1 ] := "1" 
       ENDIF 
    NEXT 
    // 
    RETURN cBin 
  
 #pragma BEGINDUMP 
  
 #include <windows.h> 
 #include "hbapi.h" 
  
 HB_FUNC( GETLCTRLSTATE ) 
 { 
    hb_retni( GetKeyState(VK_LCONTROL) );   
 } 
  
 HB_FUNC( GETRCTRLSTATE ) 
 { 
    hb_retni( GetKeyState(VK_RCONTROL) );   
 } 
  
 HB_FUNC( GETLSHIFTSTATE ) 
 { 
    hb_retni( GetKeyState(VK_LSHIFT) );   
 } 
  
 HB_FUNC( GETRSHIFTSTATE ) 
 { 
    hb_retni( GetKeyState(VK_RSHIFT) );   
 } 
  
 HB_FUNC( GETLALTSTATE ) 
 { 
    hb_retni( GetKeyState(VK_LMENU) );   
 } 
  
 HB_FUNC( GETRALTSTATE ) 
 { 
    hb_retni( GetKeyState(VK_RMENU) );   
 } 
  
 #pragma ENDDUMP 
 

 Отправлено: 05.10.08 20:45. Заголовок: Конечно, GetKeyState..

Конечно, GetKeyState можно использовать более универсально

HB_FUNC( GETKEYSTATE )
{
hb_retni( GetKeyState(hb_parni(1)) );
}

Но это не принципиально - главное будет работать или нет
Возможно вместо GetKeyState нужно будет использовать GetAsyncKeyState()

цитата:

Функция GetAsyncKeyState устанавливает, в нажатом или отпущенном состоянии находится клавиша во время, когда вызывается функция и была ли клавиша нажата после предыдущего вызова GetAsyncKeyState().

 Отправлено: 06.10.08 08:48. Заголовок: Петр Огромное спаси..

Петр
Огромное спасибо дружище !!! :)
А вот и функция Iskey в первом приближении(все работает как надо)

 
 Func Iskey() 
 local iStatus:={GetLShiftState(),GetRShiftState(),GetLAltState(),GetRAltState(),GetLCtrlState(),GetRCtrlState()} 
 local aret:={1001,1000,1005,1004,1003,1002} 
 local ret:=0 
 local nret 
    for each nret in iStatus         
        if nret<0  
 ret:=aret[Hb_enumindex()] 
 exit 
        endif 
    next 
 return ret 
 

 Отправлено: 27.05.09 19:06. Заголовок: Re: Петр

Петр пишет:

цитата:

на форуме такими вещами интересовались Андрей и Лукашевский

Да я до сих пор мечтаю, чтобы в консольном режиме нажатие Alt с буквами в русском регистре хоть как-то определялось без дополнительных ухищрений!
Потому что пока пришлось делать функцию FT_Alt():
HB_FUNC( FT_ALT )
{
hb_retl( GetKeyState(VK_LMENU) + GetKeyState(VK_RMENU) < 0 ) ;
}
проставлять везде по программе проверку на FT_Alt() и соотв. русскую букву... очередное перелопачивание текста программы.

 Отправлено: 28.05.09 10:47. Заголовок: Ну а самое печальное..

Ну а самое печальное - что эти комбинации (Alt с буквами в русском регистре) на SET KEY повесить невозможно!

Правда, я и тут извернулся - что нужно повесил в обработчик TBrowse:
.....
case nKey == K_ALT_N .OR. FT_Alt() .AND. MYUPPER(CHR(nKey), .F.) == "Т"
do Nastr
.....
и то же в FT_Menuto, который у меня линкуется вместо стандартной системы меню.

Так что в общем и целом проблему решил.

 Отправлено: 17.05.13 14:24. Заголовок: Что то я не в непоня..

Что то я не в непонятках.
Есть прога , текст ниже. Запускаю ее , затем переключаюсь на любую другую задачу.
Там жму любой ALT (Ctrl или Shift) и это срабатывает почему то в моей задаче хотя даже
фокус ввода не на ней. Почему и как это исправить ?

 
 proc main 
 local nkey 
   do while ( nKey := inkey( 0.1 ) ) != 27 
    if iskey()#0 
 wait "Ops......" 
 cls 
    endif 
  
   enddo 
 return  
 ***************** 
 Func Iskey() 
 local iStatus:={GetLShiftState(),GetRShiftState(),GetLAltState(),GetRAltState(),GetLCtrlState(),GetRCtrlState()} 
 local aret:={1001,1000,1005,1004,1003,1002} 
 local ret:=0 
 local nret 
    for each nret in iStatus         
        if nret<0  
 ret:=aret[Hb_enumindex()] 
 exit 
        endif 
    next 
 return ret 
 ************** 
  #pragma BEGINDUMP  
    
  #include <windows.h>  
  #include "hbapi.h"  
    
  HB_FUNC( GETLCTRLSTATE )  
  {  
     hb_retni( GetKeyState(VK_LCONTROL) );    
  }  
    
  HB_FUNC( GETRCTRLSTATE )  
  {  
     hb_retni( GetKeyState(VK_RCONTROL) );    
  }  
    
  HB_FUNC( GETLSHIFTSTATE )  
  {  
     hb_retni( GetKeyState(VK_LSHIFT) );    
  }  
    
  HB_FUNC( GETRSHIFTSTATE )  
  {  
     hb_retni( GetKeyState(VK_RSHIFT) );    
  }  
    
  HB_FUNC( GETLALTSTATE )  
  {  
     hb_retni( GetKeyState(VK_LMENU) );    
  }  
    
  HB_FUNC( GETRALTSTATE )  
  {  
     hb_retni( GetKeyState(VK_RMENU) );    
  }  
    
  #pragma ENDDUMP  
  
 

 Отправлено: 17.05.13 14:31. Заголовок: А ты еще попробуй ок..

А ты еще попробуй окно ВОРДа наложить на свою задачу и потыкать в ВОРДЕ мышкой по меню...
Нажатие мышки тоже будет откликаться в твоей задаче...
Я с эти до сих пор у себя не разобрался...

 Отправлено: 17.05.13 14:55. Заголовок: Dima пишет: Там жму..

Dima пишет:

цитата:

Там жму любой ALT (Ctrl или Shift) и это срабатывает почему то в моей задаче

Значит тихо радуемся, можно забацать клавиатурный шпион

 Отправлено: 17.05.13 15:03. Заголовок: AlexMyr Не ну шутки..

AlexMyr
Не ну шутки шутками , но мне надо эту маленькую проблему пофиксить ;)
Чем еще можно поймать нажатия Alt,Shift и Ctrl что бы такого косяка не возникало ?

 Отправлено: 18.05.13 10:02. Заголовок: Если ловить нажатия ..

Если ловить нажатия Alt,Shift и Ctrl через hb_gtInfo(HB_GTI_KBDSHIFTS) то косяк так же имеет место.
В прочем как и через KbdStat()

 Отправлено: 19.12.13 15:05. Заголовок: Поскольку тема назыв..

Поскольку тема называется "ASM" спрашиваю здесь:
Как в Harbour включить в код ассемблерную функцию?

Скрытый текст

;============================================================================== INCLUDE EXTENDA.MAC PUBLIC CRCMAKER DGROUP GROUP DATA ; ------------------- сегмент данных ------------------------------------------ DATA SEGMENT 'DATA' PARM1 db ? PARM2 db ? DATA ENDS ;-------------------- сегмент кода -------------------------------------------- CODE SEGMENT 'CODE' ASSUME CS:CODE,DS:DGROUP ; ***************************************************************************** CRCMAKER PROC FAR ; ----- сохранение регистров push bp mov bp,sp push ds push es push si push di ; ----- проверка кол-ва параметров GET_PCOUNT cmp ax, 2 mov bx, -1 ;error 1 jz CONT0 jmp ERR_RET ; ----- проверка типа параметрa 1 CONT0: GET_PTYPE 1 cmp ax, NUMERIC mov bx, -2 ;error 2 jz CONT1 jmp ERR_RET ; ----- проверка типа параметра 2 CONT1: GET_PTYPE 2 cmp ax, NUMERIC mov bx, -3 ;error 3 jz CONT2 jmp ERR_RET ; ----- процедура расчета crc CONT2: GET_INT 1 ; байты последовательности mov PARM1,al ; берем только мл.часть GET_INT 2 ; CRC mov PARM2,al ; берем только мл.часть mov al,PARM1 ; в al байты последовательности mov ah,PARM2 ; в ah CRC-код mov cx,8 MOD1: rol al,1 rcl ah,1 jnc MOD2 xor ah,69h MOD2: dec cx jnz MOD1 mov bh,0 ; верхний байт р-та зануляется mov bl,ah ; результат ; ----- восстановление регистров ERR_RET: pop di pop si pop es pop ds pop bp ; ----- возвращение в CLIPPER кода возврата RET_INT bx ret CRCMAKER ENDP ; ***************************************************************************** CODE ENDS END

 Отправлено: 20.12.13 13:21. Заголовок: Если нигде не ошибся..

Если нигде не ошибся (все-таки лет 15 не писал на ассемблере), то так:

func aa(nPar1, nPar2)
Local nParm1, nParm2, nCF, nI

nParm1 := nPar1 % 256
nParm2 := nPar2 % 256
for nI := 1 to 8
nCF := iif(IsBit(nParm1, 8), 1, 0)
nParm1 := NumRol(nParm1, 1, .t.)
nParm2 := nParm2 * 2 + nCF
if nParm2 < 256
nParm2 := NumXor(nParm2, 0x69)
endif
nParm2 := nParm2 % 256
next
return nParm2

 Отправлено: 15.01.14 11:31. Заголовок: Вроде всё правильно,..

Pasha, долго я собирался, но наконец на основе Вашего модуля написал
правильный вариант, который по результатам совпал с ассемблерным вариантом.

цитата:

func aa(nPar1, nPar2) Local nParm1, nParm2, nCF, nCFo, nI nParm1 := nPar1 % 256 nParm2 := nPar2 % 256 for nI := 1 to 8 * ---------------------------------------------------------- nCF := iif(IsBit(nParm1, 8), 1, 0) // Знач. старшего бита nParm1 := NumRol(nParm1, 1, .t.) // Цикл. сдвиг nCFo := nCF * ----------------------------------------------------------- nCF := iif(IsBit(nParm2, 8), 1, 0) // Знач. старшего бита nParm2 := NumRol(nParm2, 1, .t.) // Цикл. сдвиг if nCFo=1 nParm2 := numor(nParm2,1) else nParm2 := numand(nParm2,254) endif if nCF=1 nParm2 := NumXor(nParm2, 0x69) endif next return nParm2

Спасибо за помощь.