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

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

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

Postby AlikasS » Mon, 12 Oct 2009, 02:09

для однозначности, давайте определимся с кодом который до/переделываем
Code: Select all
<%
CREATE CommPos  -1 , -1 ,
CREATE CommSize -1 , -1 ,
VARIABLE CommColorBg -1 CommColorBg !
VARIABLE CommColorFont -1 CommColorFont !
VARIABLE CommFontSize
CREATE CommFont 256 ALLOT CommFont 0!
TRUE VALUE BLINK
: BLINK-OFF FALSE TO BLINK ;
: BLINK-ON TRUE TO BLINK ;

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 ;

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 idtimer

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

Font POINTER CurFont

DESTR: free
\ idtimer @ handle @ KillTimer DROP   \ Убиваем таймер, раскоменнтированный глючит
vClass @ TO pSplashClass
 pSplashClass hbrBackground @ DeleteObject DROP
\ CurFont SELF DELETE
CurFont Delete
free
CR ." free" CR
;

:NONAME { time event msg hwnd -- }
TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !
; 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

MM: MI_CLOSE
TRUE vClose !
;

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

W: WM_NCRBUTTONDOWN
TRUE vClose !
;

W: WM_NCLBUTTONDBLCLK
vText @ ASCIIZ> MsgBox
;

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

M: BringBack   vCurWin @ PUSH-WINDOW DROP   ;
: 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
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 hbrBackground !
2DROP DROP
pSplashClass Register DROP
pSplashClass SELF vClass !
0 Create
CommColor? 0= IF 0 THEN handle @ GetDC DUP >R SetTextColor DROP
CommColorBg? 0= IF vBkColor @ THEN R@ SetBkColor DROP
Font NEW TO CurFont
CommFont? 0= IF S" MS Sans Serif" THEN DROP CurFont lpszFace !
CommFontSize? 0= IF 16 THEN CurFont height !
CurFont Create
CurFont handle @ R@ SelectObject DROP
RDROP
AutoCreate
vTimeOut @
IF ['] TimeOutProc vTimeOut @ 1000 * 123 handle @ SetTimer idtimer ! ( DROP ) THEN
CalcSize CommPos?
IF SetPos SET-SIZE
ELSE
2DUP ToPixels GetDesktopSize
ROT  - 30 - 0 MAX >R
SWAP - 30 - 0 MAX R> SetPos
SET-SIZE
\ Center
THEN
\    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 --) S>ZALLOC vText ! ;
VM: OnExit TRUE vClose ! ;
W: WM_CLOSE TRUE vClose ! ;
;CLASS

SplashDialog POINTER msg

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

:NONAME
adr->2num
ASCIIZ>
2>R
SplashDialog NEW TO msg
msg vTimeOut !
2R> msg Text
msg Create
msg Show
msg BringBack
msg Flip
msg MoveToHome
msg Run
msg Delete
; TASK: ~(TimeSplash)
EXPORT
: (TimeSplash)  ( time a u --)
S>ZALLOC save2num->adr ~(TimeSplash) START DROP ;
;MODULE
%>

с этим кодом следующая задача нормально отрабатывает при множественном вызове
Code: Select all
#( Test_hint
\ AsLoggedUser
LoadProfile
WatchHotKey: "^(@t)"
Action:
BLINK-OFF
S" начало" CRON-LOG
S" Хинт сам пропадёт" 15 ROT ROT (TimeSplash)
S" конец" CRON-LOG
)#

и эта задача
Code: Select all
#( hint-re3333
 AsLoggedUser
NoActive
Action:
GetTickCount DUP 2DUP START-SEQUENCE
11 1 DO
BLINK-OFF \ отключить мигание хинта BLINK-ON
600 RANDOM 400 RANDOM CommPos 2! \ позиция хинта
\  150 150 CommSize 2! \ размер хинта ( 2числа )
\ 0x000000 CommColorBg !  \ цвет фона у шрифта (число) \ глючит, красит тока фон у шрифта
 0xFF0000 CommColorFont !  \ цвет шрифта (число)
\ CommFont ZPLACE  \ шрифт (строка)
\ 10 CommFontSize !  \ размер шрифта (цисло)
15 I N>S S"  новый хинт%crlf%скора пропадет" S+ EVAL-SUBST (TimeSplash)
500 PAUSE \ без паузы некоторые глюки вылазят, видимо хинт не все цифры успевает взять для себя
LOOP
)#
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Dark_Jones » Mon, 12 Oct 2009, 21:35

Да, даже задача с рандомным выводом работает. Но при повторном запуске этого скрипта на 3-4 хинте крон валится и перезапускается. После перезапуска тоже валится при первом же запуске этой задачи после вывода 3-4 хинта.
А вот после перезапуска крона (BAT-файлам "стоп"/"старт") задача нормально отрабатывет, но один раз.
Dark_Jones
 
Posts: 414
Joined: Thu, 09 Nov 2006, 00:43
Location: Russia, S.Peterburg

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

Postby AlikasS » Tue, 13 Oct 2009, 16:14

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

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

Postby AlikasS » Tue, 13 Oct 2009, 17:11

AlikasS wrote:P.S. как по мне так проще автора попросить/убедить
сделать мигание хинта опциональным
и пересмотреть запуск хинта с текстом из временного файла с диска на другой вариант.
а то что для оригинальный хинт сидит в tm.exe так это наоборот удобно,
т.к. после перечитывания кронтабов или падения крона, хинты остаются висеть.

избавление в оригинальном хинте от временного файла,
добавить в кронтаб или в nncron.ini (без <% %>)
Code: Select all
<%
: new(HINT) { 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 #>
\       2DUP TYPE CR
    APP-Dir 0!
    wait? IF StartAppWait ELSE  StartApp  THEN   
    DROP
    fn FREE DROP
;
 ' new(HINT) ' (HINT) JMP
%>
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Dark_Jones » Tue, 13 Oct 2009, 19:48

AlikasS wrote:избавление в оригинальном хинте от временного файла


Эххх, интереснее закрытие не через меню и событие на двойной клик. :oops:
Dark_Jones
 
Posts: 414
Joined: Thu, 09 Nov 2006, 00:43
Location: Russia, S.Peterburg

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

Postby Ilya » Wed, 14 Oct 2009, 01:16

Путем неимоверных-совместных :Hangman: усилий удалось победить следующее:
1) Нормальную много-хинтовость
2) Нормальную работу деструктора

Code: Select all
    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 ;
    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
       vClass @ TO pSplashClass
        pSplashClass 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"   \ отладка
    ; 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
   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   ;
    : 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
        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 hbrBackground !
        2DROP DROP

        pSplashClass Register DROP

        pSplashClass SELF 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
        CalcSize CommPos?
        IF SetPos SET-SIZE
        ELSE
            2DUP ToPixels GetDesktopSize
                ROT  - 30 - 0 MAX >R
                SWAP - 30 - 0 MAX R> SetPos
            SET-SIZE
       THEN

    \    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 --)
       S>ZALLOC vText !
    ;

    W: WM_CLOSE
       TRUE vClose !
    ;
    ;CLASS

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


:NONAME
adr->2num
ASCIIZ>
2>R
        SplashDialog NEW TO msg
        msg vTimeOut !
        2R> msg Text
        msg Create
        msg Show
        msg BringBack
       msg Flip
        msg MoveToHome
        msg Run
      cur-hwnd HANDLE>OBJ DELETE

      CR ." End task!"   \ отладка
1 ExitThread
    ; TASK: ~(TimeSplash)

    EXPORT
: (TimeSplash)  ( time a u --)
S>ZALLOC save2num->adr ~(TimeSplash) START DROP ;
    ;MODULE

Попробуйте.
Ilya
 
Posts: 443
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

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

Postby AlikasS » Thu, 15 Oct 2009, 01:54

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

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

Postby Ilya » Thu, 15 Oct 2009, 10:51

AlikasS wrote:у меня "новые хинты" при выводе зависают, на клики не реагируют.
зависание доходит до перезапуска крона.
чуть позже попробую на кроне без лишних задач и плагинов.

И по таймеру (без кликов мышью)?
Про клики и меню я забыл - акцентировал внимание на таймере. :roll:
Бум поковырять дальше.

Поковырял - исправил!
В предыдущем посте поправил код!
Вроде работает.
Было:
Code: Select all
W: WM_NCRBUTTONDOWN
   TRUE  vClose !
    ;


стало

Code: Select all
W: WM_NCRBUTTONDOWN
        handle @ TO cur-hwnd
   TRUE  vClose !
    ;
Ilya
 
Posts: 443
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

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

Postby AlikasS » Thu, 15 Oct 2009, 15:57

задача по таймеру нормально отрабатывает и по кликам закрывает хинты,
но есть пару моментов
если во время отработки задачи hint-re3333
1.запустить ее (эту же задачу hint-re3333) еще раз и кликнуть на любые хинты для закрытия
2.или запустить другую задачу Test_hint паралельно(даже без кликов по хинтам в этом случае)
то несколько хинтов могут зависнут до отваливания крона.
задачи такие
Code: Select all
#( hint-re3333
 AsLoggedUser
NoActive
Action:
GetTickCount DUP 2DUP START-SEQUENCE
11 1 DO
BLINK-OFF \ отключить мигание хинта BLINK-ON
600 RANDOM 400 RANDOM CommPos 2! \ позиция хинта
 0xFF0000 CommColorFont !  \ цвет шрифта (число)
15 I N>S S"  новый хинт%crlf%скора пропадет" S+ EVAL-SUBST (TimeSplash)
500 PAUSE
LOOP
)#

#( Test_hint
\ AsLoggedUser
LoadProfile
WatchHotKey: "^(@t)"
Action:
BLINK-OFF
S" начало" CRON-LOG
S" Хинт сам пропадёт" 15 ROT ROT (TimeSplash)
S" конец" CRON-LOG
)#
User avatar
AlikasS
 
Posts: 1434
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Ilya » Fri, 16 Oct 2009, 09:34

AlikasS wrote:задача по таймеру нормально отрабатывает и по кликам закрывает хинты,
но есть пару моментов
если во время отработки задачи hint-re3333
1.запустить ее (эту же задачу hint-re3333) еще раз и кликнуть на любые хинты для закрытия
2.или запустить другую задачу Test_hint паралельно(даже без кликов по хинтам в этом случае)
то несколько хинтов могут зависнут до отваливания крона.

Есть промежуточный код который: вроде победил п.1, а п.2 частично (на стадии создания объектов в п.1 - падает, а дальше вроде нет).
На всякий случай даю код для ознакомления:
Code: Select all
VARIABLE hcs2

    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 ;
    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 vText @ ASCIIZ> TYPE
        CalcSize CommPos?

        IF SetPos SET-SIZE
        ELSE
            2DUP ToPixels GetDesktopSize
                ROT  - 30 - 0 MAX >R
                SWAP - 30 - 0 MAX R> SetPos
            SET-SIZE
       THEN

    \    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
: save2num->adr ( id pause  -- adr ) HERE ROT , SWAP , ( DUP DP ! ) ; \ откат HERE заккоментирован
: adr->2num ( adr -- id pause ) DUP @ SWAP CELL+ @ ;

\ CRITICAL-SECTION hcs1

:NONAME { \ msg adr -- }
\ hcs1 CRIT-ENTER
hcs2 GET
adr->2num
ASCIIZ>
DROP TO adr \ 2>R
        SplashDialog NEW TO msg
WITH SplashDialog

       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
   \   hcs1 CRIT-LEAVE
   hcs2 RELEASE
        msg => Run
      cur-hwnd HANDLE>OBJ DELETE

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

1 ExitThread
    ; TASK: ~(TimeSplash)

    EXPORT
: (TimeSplash)  ( time a u --)
S>ZALLOC save2num->adr ~(TimeSplash) START DROP ;
    ;MODULE

Ilya
 
Posts: 443
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

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

Postby ascerdfg1 » Sat, 17 Oct 2009, 11:23

AlikasS wrote:...P.S. кому интересно, частично можно изменить
оригинальный хинт, если при вызове
tm.exe Hint [some text]
применить oneliner'ы, модифицируя и добавляя слова в класс хинта

Мне интересно, объясни по-подробнее
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 VoidVolker » Sat, 17 Oct 2009, 13:32

ascerdfg1 wrote:Мне интересно, объясни по-подробнее

Code: Select all
tm.exe <..... код .....> Hint [some text]
95% вопросов уже обсуждались на форуме или ответы на них есть в мануале.        nnCron 1.93 b15.exe
Как правильно задавать вопросы.
User avatar
VoidVolker
Site Admin
 
Posts: 2898
Joined: Tue, 25 Apr 2006, 17:56

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

Postby ascerdfg1 » Sat, 17 Oct 2009, 14:04

Ilya wrote:
AlikasS wrote:задача по таймеру нормально отрабатывает и по кликам закрывает хинты,
но есть пару моментов
если во время отработки задачи hint-re3333
1.запустить ее (эту же задачу hint-re3333) еще раз и кликнуть на любые хинты для закрытия
2.или запустить другую задачу Test_hint паралельно(даже без кликов по хинтам в этом случае)
то несколько хинтов могут зависнут до отваливания крона.

Есть промежуточный код который: вроде победил п.1, а п.2 частично (на стадии создания объектов в п.1 - падает, а дальше вроде нет).
На всякий случай даю код для ознакомления:
Code: Select all
VARIABLE hcs2

    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 ;
    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 vText @ ASCIIZ> TYPE
        CalcSize CommPos?

        IF SetPos SET-SIZE
        ELSE
            2DUP ToPixels GetDesktopSize
                ROT  - 30 - 0 MAX >R
                SWAP - 30 - 0 MAX R> SetPos
            SET-SIZE
       THEN

    \    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
: save2num->adr ( id pause  -- adr ) HERE ROT , SWAP , ( DUP DP ! ) ; \ откат HERE заккоментирован
: adr->2num ( adr -- id pause ) DUP @ SWAP CELL+ @ ;

\ CRITICAL-SECTION hcs1

:NONAME { \ msg adr -- }
\ hcs1 CRIT-ENTER
hcs2 GET
adr->2num
ASCIIZ>
DROP TO adr \ 2>R
        SplashDialog NEW TO msg
WITH SplashDialog

       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
   \   hcs1 CRIT-LEAVE
   hcs2 RELEASE
        msg => Run
      cur-hwnd HANDLE>OBJ DELETE

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

1 ExitThread
    ; TASK: ~(TimeSplash)

    EXPORT
: (TimeSplash)  ( time a u --)
S>ZALLOC save2num->adr ~(TimeSplash) START DROP ;
    ;MODULE


в такой задаче:
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)
)#

не видно шрифта
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 ascerdfg1 » Sat, 17 Oct 2009, 14:07

VoidVolker wrote:
Code: Select all
tm.exe <..... код .....> Hint [some text]

а можно пример?
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 ascerdfg1 » Sat, 17 Oct 2009, 14:14

Ilya wrote:Путем неимоверных-совместных :Hangman: усилий удалось победить следующее:
1) Нормальную много-хинтовость
2) Нормальную работу деструктора

Code: Select all
    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 ;
    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
       vClass @ TO pSplashClass
        pSplashClass 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"   \ отладка
    ; 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
   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   ;
    : 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
        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 hbrBackground !
        2DROP DROP

        pSplashClass Register DROP

        pSplashClass SELF 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
        CalcSize CommPos?
        IF SetPos SET-SIZE
        ELSE
            2DUP ToPixels GetDesktopSize
                ROT  - 30 - 0 MAX >R
                SWAP - 30 - 0 MAX R> SetPos
            SET-SIZE
       THEN

    \    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 --)
       S>ZALLOC vText !
    ;

    W: WM_CLOSE
       TRUE vClose !
    ;
    ;CLASS

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


:NONAME
adr->2num
ASCIIZ>
2>R
        SplashDialog NEW TO msg
        msg vTimeOut !
        2R> msg Text
        msg Create
        msg Show
        msg BringBack
       msg Flip
        msg MoveToHome
        msg Run
      cur-hwnd HANDLE>OBJ DELETE

      CR ." End task!"   \ отладка
1 ExitThread
    ; TASK: ~(TimeSplash)

    EXPORT
: (TimeSplash)  ( time a u --)
S>ZALLOC save2num->adr ~(TimeSplash) START DROP ;
    ;MODULE

Попробуйте.

в этой задаче:
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)
)#
не видно шрифта,
а если раскоментить
Code: Select all
CommFont ZPLACE  \ шрифт (строка)
то ругается
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: г. Алексин

PreviousNext

Return to nnCron forum (Russian)

Who is online

Users browsing this forum: ask and 2 guests

cron