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

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

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

Postby AlikasS » Thu, 01 Oct 2009, 03:31

все таки лучше что бы автор внес изменения в Хинт.....
есть портированная версия Хинта из tm.exe
нельзя нормально раскасить фон у хинта (точнее раскаршивается только фон шрифта)
и при перечитывании кронтабов выведенные хинты закрываются
можно (что сам пробовал):
задать координаты вывода, цвет шрифта, время отображения хинта, размеры хинта
мигание настраивается BLINK-OFF |BLINK-ON
со шрифтом и его размером не пробовал
слово такое (TimeSplash) ( time a u -- ), если время установлено 0 S" " (TimeSplash) - хинт висит до закрытия (или перечитывания кронтабов)
исходники такие
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 ;


\ : 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 handle

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

Font POINTER CurFont

DESTR: free
    vClass @ TO pSplashClass
    pSplashClass hbrBackground @ DeleteObject DROP
    CurFont Delete
    free
;

:NONAME { hwnd msg event time -- }
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ 2 ModalResult! ( BYE )
; WNDPROC: TimeOutProc

W: WM_NCHITTEST  HTCAPTION ;

W: WM_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
    0
;

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
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ 2 ModalResult! ( BYE )
;
 
VM: CreatePopup
   POPUPMENU
     S" Close" MI_CLOSE MENUITEM
   END-MENU
;

 W: WM_NCRBUTTONDOWN
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ WM_CONTEXTMENU SELF WM:
;

 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
    AutoCreate
    vTimeOut @
    IF ['] TimeOutProc vTimeOut @ 1000 * 123 handle @ SetTimer 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 ReleaseDC DROP
;

M: Text ( a u --)
   S>ZALLOC vText !
;
VM: OnExit
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ 2 ModalResult! ( BYE )
;

W: WM_CLOSE
   TRUE vClose !
;
;CLASS

SplashDialog POINTER msg

EXPORT
: (TimeSplash) ( time a u --)
    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
;
;MODULE
%>


пример
Code: Select all
#( hint-re3333
NoActive
Action:
BLINK-OFF \ отключить мигание хинта BLINK-ON
10 10 CommPos 2! \ позиция хинта
\  150 150 CommSize 2! \ размер хинта ( 2числа )
\ 0x000000 CommColorBg !  \ цвет фона у шрифта (число) \ глючит, красит тока фон у шрифта
 0xFF0000 CommColorFont !  \ цвет шрифта (число)
\ CommFont ZPLACE  \ шрифт (строка)
\ 10 CommFontSize !  \ размер шрифта (цисло)
10 S" новая хинта%crlf%скора пропадет" EVAL-SUBST (TimeSplash)
)#
P.S. оригинальные слова работают по прежнему
Last edited by AlikasS on Sat, 10 Oct 2009, 14:28, edited 2 times in total.
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby AlikasS » Thu, 01 Oct 2009, 06:47

Илья, как опцию думаю добавить отображение кнопке Close (правый верхний угол)
пока для тестов, если убрать
WS_BORDER WS_POPUP OR vStyle !

и изменить
: CalcSize ( -- w h)
vMaxLen 0!
vNL 0!
vHeight 0!
vText @ ASCIIZ>
<TIB
vNL 1+! \ <---- в этом месте добавление еще одной строки при расчете размеров из-за заголовка окна
BEGIN NextLine WHILE

кнопка Close отображается, но не работает?
что надо добавить?
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby VoidVolker » Thu, 01 Oct 2009, 09:45

У меня есть заготовка на фортеке - вот только из-за багов в масме не закончил, и еще я так и не разобрался как сделать красивое окошко без рамок и кнопок.
95% вопросов уже обсуждались на форуме или ответы на них есть в мануале.        nnCron 1.93 b15.exe
Как правильно задавать вопросы.
User avatar
VoidVolker
Site Admin
 
Posts: 2898
Joined: Tue, 25 Apr 2006, 17:56

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

Postby Ilya » Thu, 01 Oct 2009, 11:16

AlikasS wrote:Илья, как опцию думаю добавить отображение кнопке Close (правый верхний угол)
пока для тестов, если убрать
WS_BORDER WS_POPUP OR vStyle !

и изменить
: CalcSize ( -- w h)
vMaxLen 0!
vNL 0!
vHeight 0!
vText @ ASCIIZ>
<TIB
vNL 1+! \ <---- в этом месте добавление еще одной строки при расчете размеров из-за заголовка окна
BEGIN NextLine WHILE

кнопка Close отображается, но не работает?
что надо добавить?

Не тестировал! Попробуй добавить в класс SplashDialog следующее
Code: Select all
 W: WM_CLOSE TRUE vClose ! ;
Ilya
 
Posts: 445
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

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

Postby AlikasS » Thu, 01 Oct 2009, 16:49

с
W: WM_CLOSE TRUE vClose ! ;
что-то не получилось.
пока отказался от клавиши закрытия и добавил на двойной клик по хинту - закрытие
следующий код был добавлен в первый пост
W: WM_NCLBUTTONDBLCLK
GetCurrentThreadId ?DUP
IF
0 1 OpenThread ?DUP
IF STOP THEN
THEN
;

P.S. кому интересно, частично можно изменить
оригинальный хинт, если при вызове
tm.exe Hint [some text]
применить oneliner'ы, модифицируя и добавляя слова в класс хинта
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Dark_Jones » Thu, 01 Oct 2009, 17:18

А можно делать закрытие по одинарному клику правой кнопки? А по двойному клику левой кнопкой создавать событие OnHintClick и добавлять переменную с содержимым хинта?
Dark_Jones
 
Posts: 414
Joined: Thu, 09 Nov 2006, 00:43
Location: Russia, S.Peterburg

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

Postby AlikasS » Thu, 01 Oct 2009, 17:27

Dark_Jones wrote:А можно делать закрытие по одинарному клику правой кнопки?

мог бы и сам изменить
Code: Select all
W: WM_NCRBUTTONDOWN
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ WM_CONTEXTMENU SELF WM:
;
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby AlikasS » Thu, 01 Oct 2009, 17:34

Dark_Jones wrote:А можно делать ....А по двойному клику левой кнопкой создавать событие OnHintClick и добавлять переменную с содержимым хинта?

Code: Select all
 W: WM_NCLBUTTONDBLCLK
vText @ ASCIIZ> MsgBox
 ;

дальше до делай сам....
например завести переменную и копировать в нее вместо MsgBox
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Ilya » Fri, 02 Oct 2009, 10:18

AlikasS wrote:
Dark_Jones wrote:А можно делать закрытие по одинарному клику правой кнопки?

мог бы и сам изменить
Code: Select all
W: WM_NCRBUTTONDOWN
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ WM_CONTEXTMENU SELF WM:
;

IMHO
Один маленький нюанс (кста у Николая тоже самое но только по BYE ) - завершение Хинта таким образом малость "некорректно", поскольку мы обходим деструктор.
Можно вот так попробовать:
Code: Select all
:NONAME { time event msg hwnd -- }
TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !
; WNDPROC: TimeOutProc

и
Code: Select all
MM: MI_CLOSE TRUE vClose ! ;
Ilya
 
Posts: 445
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

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

Postby AlikasS » Fri, 02 Oct 2009, 13:11

Ilya wrote:IMHO
Один маленький нюанс (кста у Николая тоже самое но только по BYE ) - завершение Хинта таким образом малость "некорректно", поскольку мы обходим деструктор.
Можно вот так попробовать:
Code: Select all
:NONAME { time event msg hwnd -- }
TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !
; WNDPROC: TimeOutProc

и
Code: Select all
MM: MI_CLOSE TRUE vClose ! ;

т.е. вместо просто остановки потока
или
Code: Select all
TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !

или
Code: Select all
TRUE vClose !

?
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby AlikasS » Fri, 02 Oct 2009, 17:09

попробовал варианты,
лучше чем
Code: Select all
GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF

в этом случае нет.
или тихое падение или ошибка стека не понятная
P.S. али пятницца и руки не для форта...
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Ilya » Fri, 02 Oct 2009, 18:06

AlikasS wrote:
Ilya wrote:IMHO
Один маленький нюанс (кста у Николая тоже самое но только по BYE ) - завершение Хинта таким образом малость "некорректно", поскольку мы обходим деструктор.
Можно вот так попробовать:
Code: Select all
:NONAME { time event msg hwnd -- }
TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !
; WNDPROC: TimeOutProc

и
Code: Select all
MM: MI_CLOSE TRUE vClose ! ;

т.е. вместо просто остановки потока
или
Code: Select all
TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !

или
Code: Select all
TRUE vClose !

?

Оба кода в плагин - один для таймера другой для меню.
Традиционно пробовал под SPF-ом (правда на исходном плагине от Николая), всё работает!
Учти что у тебя написано
Code: Select all
 :NONAME { hwnd msg event time -- }
, а на самом деле надо
Code: Select all
:NONAME { time event msg hwnd -- }
иначе ессно будет падать!
Так завершается задача через деструктор, а там удаляются зарезервированные тобой объекты!
Ilya
 
Posts: 445
Joined: Mon, 07 Aug 2006, 09:51
Location: Санкт-Петербург

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

Postby AlikasS » Sat, 03 Oct 2009, 06:23

видимо под кроном что-то поменялось (или у меня где-то в подключенных плагинах или словах),
потому что закрыть можно только так
Code: Select all
:NONAME { time event msg hwnd -- }
\ TRUE hwnd HANDLE>OBJ ->CLASS  SplashDialog vClose !
\ TRUE vClose !
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ 2 ModalResult! ( BYE )
; WNDPROC: TimeOutProc

или так
Code: Select all
 MM: MI_CLOSE
\ TRUE vClose !
\ MSG: "close "
 GetCurrentThreadId  ?DUP
    IF
        0 1 OpenThread ?DUP
        IF STOP THEN
    THEN
\ 2 ModalResult! ( BYE )
 ;

а эти слова
вообще не учавствуют
Code: Select all
\ VM: OnExit
\ TRUE vClose !
\  GetCurrentThreadId  ?DUP
\    IF
\        0 1 OpenThread ?DUP
\        IF STOP THEN
\    THEN
\ 2 ModalResult! ( BYE )
\ ;

\ W: WM_CLOSE TRUE vClose ! ;

кстати весь код располагаю между <% %>
ну да ладно, главное работает ;-)
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

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

Postby Dark_Jones » Wed, 07 Oct 2009, 22:49

Работает... Только пришлось закоментировать строчки:
Code: Select all
\    CommColorBg? 0= IF vBkColor @ THEN R@ SetBkColor DROP

и
Code: Select all
\    0 ( 0xEE 0xE8 0xAA rgb) CommColorBg? 0= IF COLOR_INFOBK GetSysColor THEN DUP vBkColor !

Ругался на синтаксическую ошибку.
Хинт из примера получился с зелёной рамкой и синим шрифтом на белом фоне.
И закрывается правой кнопкой, и выводит мессагу на двойное нажатие левой кнопки (доработаю).
Смущает только зелёная рамка и эти закоментированные строчки.
Dark_Jones
 
Posts: 414
Joined: Thu, 09 Nov 2006, 00:43
Location: Russia, S.Peterburg

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

Postby AlikasS » Thu, 08 Oct 2009, 01:21

наверное у тебя не подключены
forguiplugins.zip
из темы
"Произвольный" GUI-интерфейс
User avatar
AlikasS
 
Posts: 1437
Joined: Wed, 28 Jun 2006, 05:39
Location: Khabarovsk

Next

Return to nnCron forum (Russian)

Who is online

Users browsing this forum: No registered users and 1 guest

cron