эксперимент по портированию HINT

Обсуждение программ nnCron и nnCron LITE

Re: эксперимент по портированию HINT

Postby AlikasS » Sun, 18 Oct 2009, 05:25

ascerdfg1 wrote:..
в этой задаче:
Code: Select all
#( hint-re3333
NoActive
Action:
BLINK-OFF \ отключить мигание хинта BLINK-ON
50 50 CommPos 2! \ позиция хинта
450 450 CommSize 2! \ размер хинта ( 2числа )
 0x000000 CommColorBg !  \ цвет фона у шрифта (число) \ глючит, красит тока фон у шрифта
 0xFF0000 CommColorFont !  \ цвет шрифта (число)
\ CommFont ZPLACE  \ шрифт (строка)
 20 CommFontSize !  \ размер шрифта (цисло)
1 S" новая хинта%crlf%скора пропадет" EVAL-SUBST (TimeSplash)
)#
не видно шрифта,

все видно. черный фон, синий цвет у шрифта
ascerdfg1 wrote:а если раскоментить
Code: Select all
CommFont ZPLACE  \ шрифт (строка)
то ругается

а это слово хочет видеть что-то типа
S" Arial" CommFont ZPLACE
P.S. ascerdfg1 нельзя ли цитирование кода плагина убрать?
а то несколько раз один и тот же код только мусорит в теме
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Re: эксперимент по портированию HINT

Postby ascerdfg1 » Sun, 18 Oct 2009, 07:46

Нельзя, потому что тогда будет непонятно какой код имелся ввиду. Вот мне, например, непонятно, какой код пробовал ты. Их в этой теме уже четыре разных. На первом у меня тоже синий шрифт (хотя должен быть красный) и чёрный фон. На третьем и четвёртом всё чёрное.
nncron.exe v 1.93b10 Build 1141
tm.exe v 1.93b10 Build 569
Windows XP (5.1.2600) SP3
Комп без nnCron - груда металла!
User avatar
ascerdfg1
 
Posts: 541
Joined: Thu, 29 Nov 2007, 02:45
Location: г. Алексин

Re: эксперимент по портированию HINT

Postby Ilya » Sun, 18 Oct 2009, 10:27

ascerdfg1 wrote:Нельзя, потому что тогда будет непонятно какой код имелся ввиду. Вот мне, например, непонятно, какой код пробовал ты. Их в этой теме уже четыре разных. На первом у меня тоже синий шрифт (хотя должен быть красный) и чёрный фон. На третьем и четвёртом всё чёрное.

Код пока не устаканился! Вот победим многопоточность, а потом можно будет побеждать цвета.
Ilya
 
Posts: 443
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

Re: эксперимент по портированию HINT

Postby Ilya » Wed, 28 Oct 2009, 23:48

Если данная тема ещё актуальна, то удалось обеспечить "живучесть" на предыдущих примерах, но есть некоторые нюансы с координатами, возможно и со шрифтами.
Бум бороть дальше? ;)
Ilya
 
Posts: 443
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

Re: эксперимент по портированию HINT

Postby Dark_Jones » Thu, 29 Oct 2009, 00:03

Голосование? :wink:
Зачем цвет и шрифт? Достаточно координат - как в штатном хинте. Главное - безглючность и удобство! :D
Dark_Jones
 
Posts: 414
Joined: Thu, 09 Nov 2006, 00:43
Location: Russia, S.Peterburg

Re: эксперимент по портированию HINT

Postby AlikasS » Thu, 29 Oct 2009, 02:54

код я так понял изменился?
интересно взглянуть.
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Re: эксперимент по портированию HINT

Postby Ilya » Thu, 29 Oct 2009, 11:06

AlikasS wrote:код я так понял изменился?
интересно взглянуть.

Без проблем.
Код отладочный и непричёсанный, но "рабочий"!
ЗЫ.
На данный момент существует проблема с использованием общих ресурсов ( CommPos, CommSize , Comm*...).
Самое "простое" (но не самое удобное) - сделать вызов ~ вида:
Code: Select all
15 S" text" x y blink ColorBg ColorFont FontSize FontName (TimeSplash)

другие варианты думаю.


Code: Select all
INCLUDE "plugins/other/wincon.f"
INCLUDE "plugins/other/wfunc.f"
INCLUDE "plugins/other/windowc.f"
INCLUDE "plugins\other\framewindowc.f"
INCLUDE "plugins\other\controlc.f"
INCLUDE "plugins\other\control1.f"
GLOBAL
VARIABLE hcs2
CRITICAL-SECTION hcs1
CRITICAL-SECTION hcs1_1
CRITICAL-SECTION hcs1_2
LOCAL
    CREATE CommPos  -1 , -1 ,
    CREATE CommSize -1 , -1 ,
    VARIABLE CommColorBg -1 CommColorBg !
    VARIABLE CommColorFont -1 CommColorFont !
    VARIABLE CommFontSize
    CREATE CommFont 256 ALLOT CommFont 0!
   0 VALUE cur-hwnd


    TRUE VALUE BLINK
    : BLINK-OFF FALSE TO BLINK ;
    : BLINK-ON TRUE TO BLINK ;
    : hint-pos hcs1_2 CRIT-ENTER CommPos 2! hcs1_2 CRIT-LEAVE ;

    MODULE: ~hint
    WINAPI: SelectObject          GDI32.DLL
    WINAPI: GetTextExtentPoint32A GDI32.DLL
    WINAPI: GetDC                 USER32.DLL
    WINAPI: ReleaseDC             USER32.DLL
    WINAPI: CreateBrushIndirect  GDI32.DLL
    WINAPI: CreateRectRgn        GDI32.DLL
    WINAPI: SetTextAlign  GDI32.DLL
    WINAPI: InvertRgn GDI32.DLL

    \ : -pos get-number get-number CommPos 2! ;
    \ : -size get-number get-number CommSize 2! ;
    \ : -bgcolor get-number CommColorBg ! ;
    \ : -color get-number CommColorFont ! ;
    \ : -font get-string CommFont ZPLACE ;
    \ : -fontsize get-number CommFontSize ! ;

    : CommPos? ( -- x y true | -- false)
        CommPos @ -1 =
        IF FALSE ELSE CommPos 2@ TRUE THEN ;

    : CommSize? ( -- w h true | -- false)
        CommSize @ -1 =
        IF FALSE ELSE CommSize 2@ TRUE THEN ;
    : CommColor? ( -- n true | -- false ) CommColorFont @ 0< 0= IF CommColorFont @ TRUE ELSE FALSE THEN ;
    : CommColorBg? ( -- n true | -- false ) CommColorBg @ 0< 0= IF CommColorBg @ TRUE ELSE FALSE THEN ;
    : CommFont? ( -- a u true | -- false ) CommFont C@ IF CommFont ASCIIZ> TRUE ELSE FALSE THEN ;
    : CommFontSize? ( -- n true | -- false ) CommFontSize @ ?DUP IF TRUE ELSE FALSE THEN ;


    \ : PUSH-WINDOW ( hwnd -- prev-hwnd)
    \    DUP SetActiveWindow >R
    \    DUP SetFocus DROP
    \    DUP SetForegroundWindow DROP
    \        BringWindowToTop DROP
    \    R>
    \ ;

    CLASS: SplashClass <SUPER WinClass

    CONSTR: init
         init
         S" nnCron Splash Class" DROP lpszClassName !
         style @ CS_SAVEBITS OR style !
    ;

    ;CLASS

\    SplashClass POINTER pSplashClass

    CLASS: SplashDialog <SUPER FrameWindow

    110 VALUE width
    50  VALUE height
    13 CONSTANT but_h
    37 CONSTANT but_w
        var vLines
        var vLen
        var vSplash
        var vTimeOut
        var vCurWin
        var vBkColor
\        var vText
        var vMaxLen
        var vHeight
        var vWidth
        var vNL
      var vTimerId
      var vHintFont
    \    var handle

    CONSTR: init
        init
        WS_BORDER  WS_POPUP OR  vStyle ! \ кнопка закрыть
        WS_EX_TOPMOST  WS_EX_TOOLWINDOW  OR vExStyle !
    ;



    DESTR: free
      vTimerId @ handle @ DUP CR ." h1=" h. KillTimer SPACE ." timer kill=" . \ DROP
       vClass @ \ TO pSplashClass
        ( pSplashClass) ->CLASS SplashClass hbrBackground @ DeleteObject DROP
      vHintFont @ DELETE
        free
      CR ." free end!" \ отладка
    ;



    :NONAME { time event msg hwnd -- }


    \ hwnd HANDLE>OBJ ->CLASS SplashDialog vTimerId @ hwnd KillTimer DROP
   TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !
   TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog Update
   hwnd TO cur-hwnd

 \ hwnd HANDLE>OBJ ->CLASS  SplashDialog mydel
 CR ." end time proc=" hwnd h.   \ отладка
    ; WNDPROC: TimeOutProc



    W: WM_NCHITTEST  HTCAPTION ;


    VM: Type S" nnCron Splash Class" ;

    : NextLine ( -- a u ? )
        10 SKIP 13 PARSE DUP ?DUP 0=
        IF EndOfChunk 0= THEN ;

    : Center?  CommSize? IF 2DROP TRUE ELSE FALSE THEN ;
    VARIABLE y
    VM: OnPaint
    \   GetRect SP@ pSplashClass hbrBackground @ SWAP dc FillRect . GetLastError . CR
    \  2DROP 2DROP
       Center? IF TA_CENTER dc SetTextAlign DROP THEN
       vText @ ASCIIZ>
       <TIB
            0 y !
            BEGIN NextLine WHILE
                SWAP  2 y @     CommFontSize? 0= IF 8 ELSE 2/ THEN * +
                Center? IF vWidth @ 2/ ELSE 4 THEN
                SWAP ToPixels SWAP dc TextOutA DROP
                y 1+!
            REPEAT
            2DROP
       TIB>
    ;

    102 CONSTANT MI_CLOSE

W: WM_TIMER
vTimerId @ handle @ KillTimer DROP
hwnd TO cur-hwnd
TRUE vClose !
;
    MM: MI_CLOSE
   handle @ TO cur-hwnd
    TRUE vClose !
    ;

    VM: CreatePopup
       POPUPMENU
         S" Close" MI_CLOSE MENUITEM
       END-MENU
    ;

    W: WM_NCRBUTTONDOWN
   handle @ TO cur-hwnd
   CR ." rbc=" handle @ h.   \ отладка
   TRUE  vClose !
    ;

    W: WM_NCLBUTTONDBLCLK
    \    0 S" Hello!!!" DROP DUP 0 MessageBoxA DROP
    \    0
    vText @ ASCIIZ> MsgBox
    \ GetCurrentThreadId  ?DUP
    \    IF
    \        0 1 OpenThread ?DUP
    \        IF STOP THEN
    \    THEN
    ;

    \ W: WM_NCLBUTTONDOWN
    \    0 S" Hello!!!" DROP DUP 0 MessageBoxA DROP
    \    0
    \ ;

    M: BringBack   vCurWin @ PUSH-WINDOW DROP   ;
    M: CalcSize ( -- w h)
       vMaxLen 0!
       vNL 0!
       vHeight 0!
       vText @ ASCIIZ>
       <TIB
    \ vNL 1+! \ дополнительная строка для заголовка
            BEGIN NextLine WHILE
               2>R 0 0 SP@ 2R> SWAP handle @ GetDC GetTextExtentPoint32A
               IF
                  DUP vMaxLen @ >
                  IF vMaxLen ! ELSE DROP THEN
                  DUP vHeight @ >
                  IF vHeight ! ELSE DROP THEN
               ELSE 2DROP THEN
               vNL 1+!
            REPEAT
            2DROP
       TIB>
       vHeight @ vNL @ * vHeight !
       vMaxLen @ vHeight @  FromPixels
       5 + vHeight !
       10 + vWidth !
       vWidth @ vHeight @
    ;
    M: SET-SIZE ( w h -- )
        CommSize?
        IF 2SWAP 2DROP FromPixels 2DUP vHeight ! vWidth ! THEN
        SetSize ;

    M: Create { \ pSplashClass -- }
        GetForegroundWindow vCurWin !
        SplashClass NEW TO pSplashClass
        0 ( 0xEE 0xE8 0xAA rgb) CommColorBg? 0= IF COLOR_INFOBK GetSysColor THEN DUP vBkColor !
            BS_SOLID SP@ CreateBrushIndirect  pSplashClass ->CLASS SplashClass hbrBackground !
        2DROP DROP

        pSplashClass ->CLASS SplashClass Register DROP

        pSplashClass ( SELF) ->CLASS SplashClass vClass !
        0 Create

      CommColor? 0= IF 0 THEN handle @ GetDC DUP >R SetTextColor DROP
        CommColorBg? 0= IF vBkColor @ THEN R@ SetBkColor DROP
        Font NEW vHintFont !
        CommFont? 0= IF S" MS Sans Serif" THEN DROP vHintFont @ ->CLASS Font lpszFace !
        CommFontSize? 0= IF 16 THEN vHintFont @ ->CLASS Font height !
        vHintFont @ ->CLASS Font Create
        vHintFont @ ->CLASS Font handle @ R@ SelectObject DROP
        RDROP
        AutoCreate

        vTimeOut @
        IF
      ['] TimeOutProc  vTimeOut @ 1000 * 123 handle @ SetTimer vTimerId ! THEN
      CR ." Create="  handle @ h.
      CR ." Create="  vText @ ASCIIZ> TYPE
hcs1_2 CRIT-ENTER
        CalcSize CommPos?

        IF SetPos SET-SIZE
        ELSE
            2DUP ToPixels GetDesktopSize
                ROT  - 30 - 0 MAX >R
                SWAP - 30 - 0 MAX R> SetPos
            SET-SIZE
       THEN
hcs1_2 CRIT-LEAVE
CR ." end create!"
    \    S" nnCron ~HINT window" SetText
    ;

    M: MoveToHome { \ xt yt x0 y0 hy hx nstep yrest xrest -- }
        CommPos? 0=
        IF
            GetPos TO y0 TO x0
            vWidth @ vHeight @ ToPixels DROP GetDesktopSize DROP SWAP - 30 - 0 MAX 30
            TO yt TO xt
            20 TO nstep
            xt x0 - nstep / TO hx
            yt y0 - nstep / TO hy
            nstep 1+ 1 DO x0 I hx * + y0 I hy * + SetPos 10 PAUSE LOOP
        xt yt
        THEN
        SetPos
    ;

    M: Flip { \ dc rgn -- }
        handle @ UpdateWindow DROP
        handle @ GetDC TO dc
        GetWindowSize SWAP 0 0 CreateRectRgn TO rgn
        rgn dc SelectObject DROP
        4 0 DO BLINK IF rgn dc InvertRgn DROP THEN 100 PAUSE LOOP \ заккомент инвертирование
        rgn DeleteObject DROP
        dc handle @ ReleaseDC DROP
    ;

    M: Text ( a u --)
   CR ." ent txt" vTimeOut @ .
       S>ZALLOC vText !
    ;

    W: WM_CLOSE
       TRUE vClose !
    ;
    ;CLASS

\    SplashDialog POINTER msg
CREATE mybuf 16 ALLOT
: save2num->adr ( id pause  -- adr ) HERE ROT , SWAP , ( DUP DP ! ) ; \ откат HERE заккоментирован
: adr->2num ( adr -- id pause ) DUP @ SWAP CELL+ @ ;

: save2num->adr1 mybuf 2! mybuf ;
\ CRITICAL-SECTION hcs1

:NONAME { \ msg adr -- }
\ hcs1 CRIT-ENTER
CR ." in=" GetTickCount .
\ hcs2 GET
 hcs1 CRIT-ENTER
\ hcs1 CRIT-TRY CR DUP . 0= IF RECURSE THEN
\ adr->2num
2@
ASCIIZ>
DROP TO adr \ 2>R

        SplashDialog NEW TO msg
        CR ." msg=" msg . SPACE AT msg .
WITH SplashDialog

       15 msg => vTimeOut !
        adr msg => vText !
      \ 2R> 2DROP  msg => vText CR ." vt=" h.
        \ 2R> 2DROP ( S>ZALLOC) S" text" DROP msg => vText ! \ Text
      msg => Create
         msg => Show
        msg => BringBack
       msg => Flip
        msg => MoveToHome
        CR ." ------------------------"
       hcs1 CRIT-LEAVE
         hcs1_1 CRIT-LEAVE

   \ hcs2 RELEASE
        msg => Run
      cur-hwnd HANDLE>OBJ DELETE

      CR ." End task!"   \ отладка
ENDWITH

1 ExitThread
    ; TASK: ~(TimeSplash)

    EXPORT
: (TimeSplash)  ( time a u --)
hcs1_1 CRIT-ENTER GLOBAL S>ZALLOC LOCAL ( save2num->adr)  mybuf 2!  mybuf ~(TimeSplash) START DROP ;
    ;MODULE
Ilya
 
Posts: 443
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

Re: эксперимент по портированию HINT

Postby AlikasS » Thu, 29 Oct 2009, 15:35

P.S. чуть разгружусь на работе , буду смотреть.....,
надеюсь как и закрытие портов и подсчет трафика :-D
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Re: эксперимент по портированию HINT

Postby ascerdfg1 » Tue, 16 Feb 2010, 10:45

Ну как там с работой? Займетесь кодом?
nncron.exe v 1.93b10 Build 1141
tm.exe v 1.93b10 Build 569
Windows XP (5.1.2600) SP3
Комп без nnCron - груда металла!
User avatar
ascerdfg1
 
Posts: 541
Joined: Thu, 29 Nov 2007, 02:45
Location: г. Алексин

Re: эксперимент по портированию HINT

Postby AlikasS » Tue, 16 Feb 2010, 14:43

проще и логичнее Николая попросить добавить опцию про мигание стандартного Хинта,
(и быть может настраиваемые реакции на клики хинта)
т.к. "местные экспериментальные" хинты, при перечитывании задач nncron, закрываются,
а стандартные завязаны на tm.exe и даже при падении крона остаются висеть (что на мой взгляд удобно).
P.S. Но еще попробую чего покопать в порядке дальнейшего эксперимента :-)
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Re: эксперимент по портированию HINT

Postby AlikasS » Tue, 16 Feb 2010, 17:07

вот чего получилось (через возможность tm.exe исполнять oneliner'ы)
Code: Select all
<%
: (HINT)2 { a u time-out wait? \ fn -- }
   u ALLOCATE THROW TO fn
    a u fn ZPLACE
    0
    <# 0 HOLD fn ASCIIZ> HOLDS S"  " HOLDS time-out S>D #S
       S"  TimeHint " HOLDS   
       <HINT-POS>  @ ?DUP IF #xy S"  -pos " HOLDS THEN
       <HINT-SIZE> @ ?DUP IF #xy S"  -size " HOLDS THEN       
       <HINT-FONT> @ ?DUP IF ASCIIZ> [CHAR] " HOLD HOLDS [CHAR] " HOLD S"  -font " HOLDS THEN
       <HINT-FONT-SIZE> @ ?DUP IF S>D #S 2DROP S"  -fontsize " HOLDS THEN
       <HINT-FONT-COLOR> @ 0< 0=  IF <HINT-FONT-COLOR> @ S>D #S 2DROP S"  -color " HOLDS THEN
       <HINT-COLOR> @ 0< 0= IF <HINT-COLOR> @ S>D #S 2DROP S"  -bgcolor " HOLDS THEN 
\ ниже до tm.exe HOLDS #> две! длинные строки (могут на форуме перенестись)
\ 1 строка
S"  : (TimeSplash)2 2>R SplashDialog NEW TO msg msg vTimeOut ! 2R> msg Text msg Create msg Show msg BringBack msg Run msg Delete ; "
\ 2 строка
S" : Hint 0 GetText (TimeSplash)2  BYE ; : TimeHint get-number GetText (TimeSplash)2 BYE ; " S+ HOLDS
       tm.exe HOLDS #>
    APP-Dir 0!
    wait? IF StartAppWait ELSE  StartApp  THEN   
    DROP
    fn FREE DROP
;

: HINT2  0 FALSE (HINT)2 ;
: HINTW2 0 TRUE  (HINT)2 ;

: THINT2  FALSE  (HINT)2 ;
: THINTW2 TRUE   (HINT)2 ;


: HINT2:  eval-string, POSTPONE HINT2  ; IMMEDIATE
: HINTW2: eval-string, POSTPONE HINTW2 ; IMMEDIATE

: THINT2:  eval-string, get-number POSTPONE LITERAL POSTPONE THINT2  ; IMMEDIATE
: THINTW2: eval-string, get-number POSTPONE LITERAL POSTPONE THINTW2 ; IMMEDIATE
%>

пример
Code: Select all
#( hint-тестовый-вывод
NoActive
Action:
0x000000 0xFF0000 HINT-COLOR
5 1 DO
 100 I * 100 I * HINT-POS
THINT2: "опа!%crlf%а вот и хинт" 10
LOOP
)#
аналоги стандартных слов соотвественно
HINT2
HINTW2
THINT2
THINTW2
HINT2:
HINTW2:
THINT2:
THINTW2:

и т.к. все делается через tm.exe - эти хинты сродни стандартным (не закрываются при падении крона)
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Re: эксперимент по портированию HINT

Postby AlikasS » Wed, 17 Feb 2010, 07:15

для экспериментов, выделил часть кода в файл (hint-ext.spf)
Code: Select all
SplashDialog REOPEN
\ W: WM_NCLBUTTONDBLCLK vText @ ASCIIZ> MsgBox ;
\ W: WM_NCRBUTTONDOWN BYE   ;
;CLASS

: (TimeSplash)2 ( time a u --)
    2>R
    SplashDialog NEW TO msg
    msg vTimeOut !
    2R> msg Text
    msg Create
    msg Show
    msg BringBack   
    msg MoveToHome
    msg Run
    msg Delete
;

: Hint 0 GetText (TimeSplash)2  BYE ;
: TimeHint get-number GetText (TimeSplash)2 BYE ;

а в кроне написал
Code: Select all
<%
: (HINT)2 { a u time-out wait? \ fn -- }
   u ALLOCATE THROW TO fn
    a u fn ZPLACE
    0
    <# 0 HOLD fn ASCIIZ> HOLDS S"  " HOLDS time-out S>D #S
       S"  TimeHint " HOLDS   
       <HINT-POS>  @ ?DUP IF #xy S"  -pos " HOLDS THEN
       <HINT-SIZE> @ ?DUP IF #xy S"  -size " HOLDS THEN       
       <HINT-FONT> @ ?DUP IF ASCIIZ> [CHAR] " HOLD HOLDS [CHAR] " HOLD S"  -font " HOLDS THEN
       <HINT-FONT-SIZE> @ ?DUP IF S>D #S 2DROP S"  -fontsize " HOLDS THEN
       <HINT-FONT-COLOR> @ 0< 0=  IF <HINT-FONT-COLOR> @ S>D #S 2DROP S"  -color " HOLDS THEN
       <HINT-COLOR> @ 0< 0= IF <HINT-COLOR> @ S>D #S 2DROP S"  -bgcolor " HOLDS THEN 
S"   S%QUOTE% hint-ext.spf%QUOTE% INCLUDED " EVAL-SUBST HOLDS \ вот оно! подключение файла
       tm.exe HOLDS #>
    APP-Dir 0!
    wait? IF StartAppWait ELSE  StartApp  THEN   
    DROP
    fn FREE DROP
;

: HINT2  0 FALSE (HINT)2 ;
: HINTW2 0 TRUE  (HINT)2 ;

: THINT2  FALSE  (HINT)2 ;
: THINTW2 TRUE   (HINT)2 ;


: HINT2:  eval-string, POSTPONE HINT2  ; IMMEDIATE
: HINTW2: eval-string, POSTPONE HINTW2 ; IMMEDIATE

: THINT2:  eval-string, get-number POSTPONE LITERAL POSTPONE THINT2  ; IMMEDIATE
: THINTW2: eval-string, get-number POSTPONE LITERAL POSTPONE THINTW2 ; IMMEDIATE
%>

Илья, интересно, почему нельзя открыть класс SplashDialog и определить
или переопределить слова (которые закомментированы в коде выделенном в файл)
для теста все та же задача
#( hint-тестовый-вывод
NoActive
Action:
0x000000 0xFF0000 HINT-COLOR
5 1 DO
100 I * 100 I * HINT-POS
THINT2: "опа!%crlf%а вот и хинт" 10
LOOP
)#
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Re: эксперимент по портированию HINT

Postby MAN » Thu, 18 Feb 2010, 10:24

AlikasS wrote:вот чего получилось (через возможность tm.exe исполнять oneliner'ы)

ХОРОШО получилось !
вот что получилось у меня на базе Вашего кода
Регулятор громкости с отображением хинта
управление Win+"кл.+"; Win+"кл.-" ; Win+"кл.*"
Code: Select all
################################################################################
# Определение немигающего хинта
###############
<%
: (HINT)2 { a u time-out wait? \ fn -- }
   u ALLOCATE THROW TO fn
    a u fn ZPLACE
    0
    <# 0 HOLD fn ASCIIZ> HOLDS S"  " HOLDS time-out S>D #S
       S"  TimeHint " HOLDS   
       <HINT-POS>  @ ?DUP IF #xy S"  -pos " HOLDS THEN
       <HINT-SIZE> @ ?DUP IF #xy S"  -size " HOLDS THEN       
       <HINT-FONT> @ ?DUP IF ASCIIZ> [CHAR] " HOLD HOLDS [CHAR] " HOLD S"  -font " HOLDS THEN
       <HINT-FONT-SIZE> @ ?DUP IF S>D #S 2DROP S"  -fontsize " HOLDS THEN
       <HINT-FONT-COLOR> @ 0< 0=  IF <HINT-FONT-COLOR> @ S>D #S 2DROP S"  -color " HOLDS THEN
       <HINT-COLOR> @ 0< 0= IF <HINT-COLOR> @ S>D #S 2DROP S"  -bgcolor " HOLDS THEN 
\ ниже до tm.exe HOLDS #> две! длинные строки (могут на форуме перенестись)
\ 1 строка
S"  : (TimeSplash)2 2>R SplashDialog NEW TO msg msg vTimeOut ! 2R> msg Text msg Create msg Show msg BringBack msg Run msg Delete ; "
\ 2 строка
S" : Hint 0 GetText (TimeSplash)2  BYE ; : TimeHint get-number GetText (TimeSplash)2 BYE ; " S+ HOLDS
       tm.exe HOLDS #>
    APP-Dir 0!
    wait? IF StartAppWait ELSE  StartApp  THEN   
    DROP
    fn FREE DROP
;

: HINT2  0 FALSE (HINT)2 ;
: HINTW2 0 TRUE  (HINT)2 ;

: THINT2  FALSE  (HINT)2 ;
: THINTW2 TRUE   (HINT)2 ;


: HINT2:  eval-string, POSTPONE HINT2  ; IMMEDIATE
: HINTW2: eval-string, POSTPONE HINTW2 ; IMMEDIATE

: THINT2:  eval-string, get-number POSTPONE LITERAL POSTPONE THINT2  ; IMMEDIATE
: THINTW2: eval-string, get-number POSTPONE LITERAL POSTPONE THINTW2 ; IMMEDIATE
%>
################################################################################
# Регулировка громкости и отображение на экране
###############
#( VOL_PLUS
WatchHotKey: "${ADD}"
\ SingleInstance
Action:
SWHide   NormalPriority
5 MIXER+ \ прибавить громкость на 5%
\ HINT-OFF
HINT-POS: 50 50 HINT-SIZE: 800 120
0x00000000 0x0000FF00 HINT-COLOR
S" Impact" 120 HINT-FONT
THINT2: "ГРОМКОСТЬ     %MIXER-VOLUME@%%PERCENT%" 1
)#
###############
#( VOL_MINUS
WatchHotKey: "${SUBTRACT}"
\ SingleInstance
Action:
SWHide   NormalPriority
-5 MIXER+ \ убавить громкость на 5%
\ HINT-OFF
HINT-POS: 50 50 HINT-SIZE: 800 120
0x00000000 0x0000FF00 HINT-COLOR
S" Impact" 120 HINT-FONT
THINT2: "ГРОМКОСТЬ     %MIXER-VOLUME@%%PERCENT%" 1
)#
###############
#( VOL_MUTE
VARIABLE VOL1
WatchHotKey: "${MULTIPLY}"
\ SingleInstance
Action:
SWHide   NormalPriority
MIXER-VOLUME@ 5 = \ сравниваем текущее знач. громкости с числом 5
   IF
VOL1 @ MIXER-VOLUME! \ если да то устанавливаем ранее запомненное
   ELSE
MIXER-VOLUME@ VOL1 ! \ если нет то запоминаем значение
5 MIXER-VOLUME!
   THEN
\ HINT-OFF
HINT-POS: 50 50 HINT-SIZE: 800 120
0x00000000 0x0000FF00 HINT-COLOR
S" Impact" 120 HINT-FONT
THINT2: "ГРОМКОСТЬ     %MIXER-VOLUME@%%PERCENT%" 1
)#
User avatar
MAN
 
Posts: 145
Joined: Wed, 17 Jun 2009, 21:34

Re: эксперимент по портированию HINT

Postby ascerdfg1 » Sat, 27 Feb 2010, 10:40

Спасибо! Пример от 16 фев 2010 18:15 работает!
А пример от 17 фев 2010 08:15 нет, почему?
nncron.exe v 1.93b10 Build 1141
tm.exe v 1.93b10 Build 569
Windows XP (5.1.2600) SP3
Комп без nnCron - груда металла!
User avatar
ascerdfg1
 
Posts: 541
Joined: Thu, 29 Nov 2007, 02:45
Location: г. Алексин

Re: эксперимент по портированию HINT

Postby AlikasS » Wed, 03 Mar 2010, 07:46

ascerdfg1 wrote:Спасибо! Пример от 16 фев 2010 18:15 работает!
А пример от 17 фев 2010 08:15 нет, почему?

у тебя скорее всего файлик hint-ext.spf,
с выделенной частью кода,
не может подхватиться.
я его располагал рядом с nncron.exe (крон сервисом на win xp)
ну да ладно, главное что один из вариантов работает :-)
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

PreviousNext

Return to nnCron forum (Russian)

Who is online

Users browsing this forum: No registered users and 2 guests