Fresh IDE . Artifact [3d4e85d5a8]
Not logged in

This repository is a mirror!

The original is located on: https://fresh.flatassembler.net/fossil/repo/fresh
If you want to follow the project, please update your remote-url

Artifact 3d4e85d5a89247b813a6045096fecd435814cb08:


TFormLib:

;************************************************************
;*   Form class library                                     *
;*                                                          *
;*   This file is part of Fresh base library                *
;*   This is base window class for "Fresh" created project  *
;*                                                          *
;*   (C)2003, 2004 John Found                               *
;************************************************************

;*********************************************************************************************
; Registers form window class
; Call only once
;*********************************************************************************************
initialize RegisterFormClass

.wc WNDCLASS

begin
        xor     eax, eax
        lea     edi, [.wc]
        mov     ecx, sizeof.WNDCLASS / 4
        rep stosd

        invoke  LoadCursorW, eax, IDC_ARROW
        mov     [.wc.hCursor],eax
        mov     [.wc.style], CS_OWNDC
        mov     [.wc.lpfnWndProc],FormWinProc
        mov     [.wc.cbWndExtra], 32
        mov     eax,[hInstance]
        mov     [.wc.hInstance],eax
        mov     [.wc.lpszClassName], cFormClassName

        lea     eax, [.wc]
        invoke  RegisterClassW, eax

        return
endp


iglobal
  cFormClassName du 'TForm', 0

  property propLastFocused, 'LastFocused'
  property propColor, 'Color'
  property propModalResult, 'ModalResult'
  property propFont, 'Font'
endg

uglobal
  hLastBeforeMenu dd ?

;  LastMessage dd ? ; debug only
endg


;initialize CreateFormProperties
;begin
;        stdcall CreateProperty, propLastFocused
;        stdcall CreateProperty, propColor
;        stdcall CreateProperty, propModalResult
;        stdcall CreateProperty, propFont
;        return
;endp


;finalize DeleteFormProperties
;begin
;        stdcall DestroyProperty, propLastFocused
;        stdcall DestroyProperty, propColor
;        stdcall DestroyProperty, propModalResult
;        stdcall DestroyProperty, propFont
;        return
;endp


;*********************************************************************************************
; Main window procedure for 'TForm' window class.
;*********************************************************************************************
proc FormWinProc, .hwnd, .wmsg, .wparam, .lparam
begin
        push    ebx edi esi

        dispatch [.wmsg]

.ondefault:
        invoke  DefWindowProcW, [.hwnd],[.wmsg],[.wparam],[.lparam]
        pop     esi edi ebx
        return


;------------------------------------------------------------------------
oncase FM_SETCOLOR
        mov      eax, [.wparam]
        cmp      eax, $ff000000
        jne      .setcolor

        invoke  RemovePropW, [.hwnd], [propColor]
        pop     esi edi ebx
        return

.setcolor:
        or       eax, $ff000000
        invoke   SetPropW, [.hwnd], [propColor], eax
        invoke   InvalidateRect, [.hwnd], NULL, TRUE
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_SYSCOMMAND
        mov     eax, [.wparam]
        and     eax, $fff0

        cmp     eax, SC_MINIMIZE
        je      .savestate

        cmp     eax, SC_KEYMENU
        jne     .ondefault

        invoke  GetParent, [.hwnd]
        mov     ebx, eax
        test    eax, eax
        jnz     .resendmessage

; Get the main application window.
if defined AppLib
        invoke  GetPropW, [hApplication], [propMainForm]
        test    eax, eax
        jz      .ondefault

        cmp     eax, [.hwnd]
        je      .ondefault

        mov     ebx, eax
else
  if defined hMainForm
        mov ebx, [hMainForm]
        cmp ebx, [.hwnd]
        je  .ondefault
  end if
        jmp     .ondefault
end if

        invoke  GetMenu, [.hwnd]
        test    eax, eax
        jnz     .ondefault

        invoke  GetFocus
        mov     [hLastBeforeMenu], eax

        invoke  SetFocus, ebx

.resendmessage:
        invoke  SendMessageW, ebx, [.wmsg], [.wparam], [.lparam]

        xor     eax, eax
        pop     esi edi ebx
        return

;-------------------------------------------------
oncase WM_ACTIVATE
        cmp     word [.wparam], WA_INACTIVE
        jne     .ondefault

; Save the last focused window
.savestate:
        stdcall GetFocusedControl, [.hwnd]
        test    eax, eax
        jz      .ondefault

        invoke  SetPropW, [.hwnd], [propLastFocused], eax
        jmp     .ondefault

;----------------------------------------------------------------
oncase WM_SETFOCUS

; Restore the last focused window
        invoke  GetPropW, [.hwnd], [propLastFocused]
        test    eax, eax
        jz      .focus_next

        push    eax
        invoke  IsWindow, eax
        test    eax, eax
        pop     eax
        jnz     .focusit

        jmp     .endsetfocus

.focus_next:
        invoke  GetNextDlgTabItem, [.hwnd], NULL, FALSE
        test    eax, eax
        jz      .endsetfocus

        push    eax
        invoke  SetPropW, [.hwnd], [propLastFocused], eax
        pop     eax

.focusit:
        invoke  SetFocus, eax

.endsetfocus:
        xor     eax, eax
        pop     esi edi ebx
        return

;-------------------------------------------------------------------------
;oncase WM_NEXTDLGCTL
;;          int3
;        cmp     [.lparam], FALSE
;        je      .nextprev
;
;        invoke  SetFocus, [.wparam]
;        xor     eax, eax
;        pop     esi edi ebx
;        return
;
;.nextprev:
;        stdcall GetFocusedControl, [.hwnd]
;        test    eax, eax
;        jz      .focusok
;
;        invoke  GetNextDlgTabItem, [.hwnd], eax, [.wparam]
;        invoke  SetFocus, eax
;
;.focusok:
;        pop     esi edi ebx
;        return

;------------------------------------------------------------------------
oncase WM_ERASEBKGND
locals
  .rect    RECT
endl
        lea     eax, [.rect]
        invoke  GetClientRect, [.hwnd], eax

        invoke  GetPropW, [.hwnd], [propColor]
        test    eax, eax
        jnz     .colorok

        invoke  GetSysColor, COLOR_BTNFACE

.colorok:
        and     eax, $ffffff
        invoke  CreateSolidBrush, eax
        push    eax
        lea     ecx, [.rect]
        invoke  FillRect, [.wparam], ecx, eax
        invoke  DeleteObject ; from the stack.
        xor     eax, eax
        inc     eax
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_COMMAND

        invoke  GetWindowLongW, [.hwnd], GWL_STYLE
        test    eax, WS_CHILD
        jz      .process

        invoke  GetParent, [.hwnd]
        test    eax, eax
        jz      .process

        invoke  SendMessageW, eax, [.wmsg], [.wparam], [.lparam]
        xor     eax, eax
        pop     esi edi ebx
        return

.process:
        movzx   eax, word [.wparam]
        cmp     eax, MODAL_MIN
        jb      .ondefault
        cmp     eax, MODAL_MAX
        ja      .ondefault

        invoke  SetPropW, [.hwnd], [propModalResult], eax

        xor     eax, eax
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_CLOSE
if defined AppLib

        invoke  GetPropW, [hApplication], [propMainForm]
        cmp     eax, [.hwnd]
        jne     .ondefault

        invoke  SendMessageW,  [hApplication], WM_CLOSE, 0, 0
        xor     eax, eax
        pop     esi edi ebx
        return
else
  if defined hMainForm
        mov     eax, [.hwnd]
        cmp     eax, [hMainForm]
        jne     .ondefault

        invoke  PostQuitMessage, 0
        jmp     .ondefault
  end if
end if


;------------------------------------------------------------------------
oncase WM_EXITMENULOOP
        cmp     [hLastBeforeMenu], 0
        je      @f

        invoke  SetFocus, [hLastBeforeMenu]
@@:
        xor     eax, eax
        mov     [hLastBeforeMenu], eax
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_WINDOWPOSCHANGED
        mov     eax, [.lparam]
        mov     ecx, [eax+WINDOWPOS.flags]
        test    ecx, SWP_SHOWWINDOW
        jnz     .realign

        test    ecx, SWP_HIDEWINDOW
        jnz     .savestate

        test    ecx, SWP_NOSIZE
        jnz     .ondefault

.realign:
        stdcall AlignChildren, [.hwnd]
        jmp     .ondefault

;------------------------------------------------------------------------


if defined GUILib
;------------------------------------------------------------------------
oncase WM_MEASUREITEM
        stdcall OnMeasureItem,[.hwnd],[.lparam]
        mov     eax, TRUE
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_DRAWITEM
        stdcall OnDrawItem, [.lparam]
        mov     eax, TRUE
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_MENUCHAR
        stdcall OnMenuChar, [.wparam], [.lparam]
        jc      .ondefault
        pop     esi edi ebx
        return

end if

;------------------------------------------------------------------------
oncase WM_GETFONT
        invoke  GetPropW, [.hwnd], [propFont]
        test    eax, eax
        jnz     @f

;        invoke  GetStockObject, DEFAULT_GUI_FONT

        stdcall GetDefaultFont, gdfMenu

@@:
        pop     esi edi ebx
        return

;------------------------------------------------------------------------
oncase WM_PARENTNOTIFY
        cmp     word [.wparam], WM_CREATE
        jne     @f

        invoke  GetPropW, [.lparam], [propOwnFont]
        test    eax, eax
        jnz     @f

        invoke  SendMessageW, [.hwnd], WM_GETFONT, 0, 0
        invoke  SendMessageW, [.lparam], WM_SETFONT, eax, 0     ;TRUE

@@:
        xor     eax, eax
        pop     esi edi ebx
        return

        enddispatch
endp



proc GetFocusedControl, .hwnd
begin
        push    esi ebx
        invoke  GetFocus
        mov     esi, eax

.parentloop:
        mov     ebx, eax
        invoke  GetParent, eax
        test    eax, eax
        jnz     .parentloop

;        xor     eax, eax     ; eax is zero here...
        cmp     ebx, [.hwnd]
        jne     .endfocused
        mov     eax, esi
.endfocused:
        pop     ebx esi
        return
endp


;*********************************************************************************************
; Shows given form in modal form.
; Returns modal result
; This is first version so behaviour is not very proper.
;*********************************************************************************************

proc ShowModal, .hwnd, .flags

.info MONITORINFO
.rect RECT

begin
        push    esi edi ebx

;        invoke  GetFocus
;        push    eax      ; the parameter for SetFocus at the end of the procedure.

;if defined AppLib
;        mov     eax, [hApplication]
;else
;  if defined hMainForm
;        mov eax, [hMainForm]
;  else
;        mov eax, [.hwnd]
;  end if
;end if

        invoke  GetWindowLongW, [.hwnd], GWL_HWNDPARENT
        invoke  MonitorFromWindow, eax, 2

        mov     [.info.cbSize], sizeof.MONITORINFO
        lea     ebx, [.info]
        invoke  GetMonitorInfoA, eax, ebx

        lea     eax, [.rect]
        invoke  GetWindowRect, [.hwnd], eax

        mov     esi, [.rect.left]
        mov     edi, [.rect.top]

        test    [.flags], MSF_HCENTER
        jz      @f

        mov     eax, [.info.rcWork.right]
        sub     eax, [.info.rcWork.left]
        sub     eax, [.rect.right]
        add     eax, [.rect.left]
        sar     eax, 1
        add     eax, [.info.rcWork.left]
        mov     esi, eax

@@:
        test    [.flags], MSF_VCENTER
        jz      @f

        mov     eax, [.info.rcWork.bottom]
        sub     eax, [.info.rcWork.top]
        sub     eax, [.rect.bottom]
        add     eax, [.rect.top]
        sar     eax, 1
        add     eax, [.info.rcWork.top]
        mov     edi, eax

@@:
        invoke  SendMessageW, [.hwnd], WM_INITDIALOG, 0, 0
        invoke  SetWindowPos, [.hwnd], HWND_TOP, esi, edi, 0, 0, SWP_NOSIZE
        invoke  ShowWindow, [.hwnd], SW_SHOW
;        invoke  SendMessageA, [.hwnd], AM_CHILDRESIZED, 0, 0

        invoke  GetWindow, [.hwnd], GW_OWNER
        mov     ebx, eax

; Disables window owner and all other windows owned by window owner.

        invoke  EnableWindow, ebx, FALSE
        stdcall EnableAllOwnedWindows, ebx, FALSE       ; This is useless if all top level windows
                                                        ; are TForm, but it is important if not...

        invoke  EnableWindow, [.hwnd], TRUE              ; IMPORTANT: re-enable modal window.

        invoke  GetNextDlgTabItem, [.hwnd], NULL, FALSE
        test    eax, eax
        jz      @f
        invoke  SetFocus, eax
@@:
        invoke  SetPropW, [.hwnd], [propModalResult], MR_NONE

; Special message loop for modal window. It not finish until window becomes invisible.
.modalloop:
        call    ProcessMessages

        invoke  IsWindowVisible, [.hwnd]
        test    eax,eax
        jz      .endloop

        invoke  GetPropW, [.hwnd], [propModalResult]
        test    eax,eax              ; mrNone = 0
        jnz     .endloop

        invoke  SendMessageW, [.hwnd], FM_ONIDLE, 0, 0

        invoke  WaitMessage
        jmp     .modalloop

.endloop:
        stdcall EnableAllOwnedWindows, ebx, TRUE
        invoke  EnableWindow, ebx, TRUE
        invoke  ShowWindow, [.hwnd], SW_HIDE

        stdcall ProcessMessages

        invoke  GetLastActivePopup, ebx
        invoke  SetActiveWindow, eax     ; return the focus to the owner.

        invoke  GetPropW, [.hwnd], [propModalResult]
        pop     ebx edi esi
        return
endp


;-------------------------------------------------------------
; Enables or disables all windows owned by specifyed window.
;
; fEnable - TRUE = enable
;           FALSE = disable
;-------------------------------------------------------------
proc EnableAllOwnedWindows, .hwnd, .fEnable
        begin

        mov     eax, _EnableOwnedProc
        cmp     [.fEnable], FALSE
        jne     @f
        mov     eax, _DisableOwnedProc
@@:
        invoke  EnumWindows, eax, [.hwnd]
        return
endp


; callback procedure used in EnableAllOwnedWindows
proc _EnableOwnedProc, .hwnd, .owner
begin

        invoke  GetWindow, [.hwnd], GW_OWNER
        cmp     eax, [.owner]
        jne     .ready
        invoke  EnableWindow, [.hwnd], TRUE

.ready:
        mov     eax, 1
        return
endp


; callback procedure used in EnableAllOwnedWindows
proc _DisableOwnedProc, .hwnd, .owner
begin
        invoke  GetWindow, [.hwnd], GW_OWNER

        cmp     eax, [.owner]
        jne     .ready
        invoke  EnableWindow, [.hwnd], FALSE
.ready:
        mov     eax, 1
        return
endp




DispSize 'TForm class library', $ - TFormLib