uglobal
  hToolPalette dd ?
endg

iglobal
  cControlsMask text '*.vcl'
  cControlsPath text '%Fresh%\IDE\components\'

  SplitStart PaletteLayout
    Cell cellPalette
  SplitEnd

endg


;***************************************************************
; Reloads visual components from standard component directory.
;***************************************************************
proc OnReloadVCL, .wparam, .lparam
.tci TCITEM
begin
        push    ebx
        mov     ebx, [hMainForm]
        test    ebx, ebx
        jnz     @f
        mov     ebx, [.lparam]
@@:
        stdcall CreateToolPalette, ebx
        stdcall ConvertAliasString, cControlsPath
        push    eax

        stdcall ScanForComponents, eax
        stdcall StrDel

        mov     [.tci.mask], TCIF_PARAM

        lea     eax, [.tci]
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMW, 0, eax
        test    eax, eax
        jz      .finish

        invoke  ShowWindow, [.tci.lParam], SW_SHOW

        invoke  SendMessageW, [.tci.lParam], TB_AUTOSIZE, 0, 0

.finish:
        pop     ebx
        return
endp




;----------------------------------------------
; Creates tool palette and returns handle to
; the tab-control.
;----------------------------------------------
proc CreateToolPalette, .hParent
begin
        cmp     [hToolPalette], 0
        je      @f
        stdcall DestroyToolPalette
@@:
        xor     ebx,ebx
        invoke  CreateWindowExW, 0, cTabClassName, NULL,                                                                        \
                WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or TCS_FOCUSNEVER or TCS_SINGLELINE or TCS_TABS,   \
                ebx, 20, 200,  56,                                                                                              \
                [.hParent], NULL, [hInstance], NULL

        mov     [hToolPalette], eax
        stdcall SubclassWindow, [hToolPalette], ToolPaletteWinProc

        stdcall SetSplitGrid, [hToolPalette], PaletteLayout
        stdcall AttachToCell, [hToolPalette], [.hParent], MainLayout.cellPalette

        return
endp




proc ToolPaletteWinProc, .hwnd, .wmsg, .wparam, .lparam
.rect RECT
begin
        dispatch [.wmsg]

.ondefault:
        stc
        return


oncase SGM_REALIGN

        invoke  GetPropW, [.hwnd], [propSplitGrid]
        test    eax, eax
        jz      .ondefault

        lea     edi, [eax+TArray.array]
        lea     esi, [.rect]
        invoke  GetClientRect, [.hwnd], esi
        invoke  SendMessageW, [.hwnd], TCM_ADJUSTRECT, FALSE, esi

        stdcall RealignGrid, [.hwnd], edi, esi
;        invoke  InvalidateRect, [.hwnd], 0, TRUE

        clc
        return

        enddispatch
endp




;--------------------------------------------
; Clears all content of the tool palette.
; Frees all alocated memory.
;--------------------------------------------
proc ClearToolPalette
.tci TCITEM
.tbb TBBUTTON
begin
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMCOUNT, 0, 0
        mov     ebx, eax

.tabloop:
        dec     ebx
        js      .finish

        lea     eax, [.tci]
        mov     [.tci.mask], TCIF_PARAM
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMW, ebx, eax

        mov     esi, [.tci.lParam]      ; handle of the toolbar.
        invoke  SendMessageW, esi, TB_BUTTONCOUNT, 0, 0
        mov     edi, eax

.btnloop:
        dec     edi
        js      .destroytoolbar

        lea     eax, [.tbb]
        invoke  SendMessageW, esi, TB_GETBUTTON, edi, eax

        mov     ecx, [.tbb.dwData]
        jecxz   .btnloop

        test    ecx, $80000000
        jz      .btnloop

        and     ecx, $7fffffff  ; Reset the marker for the block that need to be free-ed.

        stdcall FreeMem, ecx
        jmp     .btnloop

.destroytoolbar:
        invoke  DestroyWindow, esi
        jmp     .tabloop

.finish:
        return
endp

;-----------------------------------------------
; Free all memory allocated for TDesignTimeInfo
; structures and all toolbars and tab control of
; the tool palette.
;-----------------------------------------------
proc DestroyToolPalette
begin
        cmp     [hToolPalette], 0
        je      .finish
        stdcall ClearToolPalette
        invoke  DestroyWindow, [hToolPalette]
        mov     [hToolPalette], 0
.finish:
        return
endp



;-----------------------------------------------
; Scans given directory for components and add
; it to the tool palette.
;-----------------------------------------------
proc ScanForComponents, .hPath
.nmh    NMHDR
.olddir dd 0
.find FINDDATAW
begin

        stdcall GetCurrentDir
        mov     [.olddir], eax

        mov     [.find.dwFileAttributes], FILE_ATTRIBUTE_NORMAL

        stdcall StrDup, [.hPath]
        mov     edi, eax

        stdcall StrDup, edi                     ; edi - path.
        stdcall StrCat, eax, cControlsMask      ; eax - search mask
        push    eax

        stdcall utf8ToWideChar, eax
        stdcall StrDel  ; from the stack
        push    eax

        lea     esi, [.find]
        invoke  FindFirstFileW, eax, esi
        stdcall FreeMem ; from the stack

        cmp     eax, INVALID_HANDLE_VALUE
        je      .finish
        mov     ebx, eax

.addloop:
        stdcall StrDup, edi
        mov     edx, eax

        lea     eax, [.find.cFileName]
        stdcall WideCharToUtf8, eax

        stdcall StrCat, edx, eax

        stdcall AddToPalette, edx
        stdcall StrDel, edx

        invoke  FindNextFileW, ebx, esi
        test    eax,eax
        jnz     .addloop

        stdcall StrDel, edi

        invoke  FindClose, ebx

; Select first tab.
        mov     [.nmh.code], TCN_SELCHANGING
        push    [hToolPalette]
        pop     [.nmh.hwndFrom]
        mov     [.nmh.idFrom], 0

        lea     edi, [.nmh]

        invoke  SendMessageW, [hToolPalette], WM_NOTIFY, 0, edi
        invoke  SendMessageW, [hToolPalette], TCM_SETCURSEL, 0, 0

        mov     [.nmh.code], TCN_SELCHANGE
        invoke  SendMessageW, [hToolPalette], WM_NOTIFY, 0, edi

.finish:

        stdcall SetCurrentDir, [.olddir]
        stdcall StrDel, [.olddir]

        return
endp







;--------------------------------------
;  if palette with this name exists,
;  returns the handle of the toolbar.
;  If such palette does not exists,
;  creates one and returns handle of
;  the new created toolbar.
;--------------------------------------
proc GetPaletteToolbar, .hPaletteName
.nmh   NMHDR
.tci   TCITEM
.tbb   TBBUTTON
.index dd ?
.name  rw 256

begin
        push    ebx esi edi

; Check for palette.
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMCOUNT, 0, 0
        dec     eax
        js      .createnew
        mov     [.index], eax

        mov     [.tci.mask], TCIF_TEXT or TCIF_PARAM
        lea     ebx, [.name]
        mov     [.tci.pszText], ebx
        mov     [.tci.cchTextMax], 256
        lea     esi, [.tci]

.find:
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMW, [.index], esi

        stdcall WideCharToUtf8, ebx
        push    eax
        stdcall StrCompNoCase, eax, [.hPaletteName]
        stdcall StrDel ; from the stack
        mov     eax, [.tci.lParam]

        jc      .finish

        dec     [.index]
        jns     .find

.createnew:
        xor     esi, esi
        invoke  CreateWindowExW, esi, cToolbarClassName, NULL,    \
                                WS_CHILD or WS_CLIPSIBLINGS or    \
                                TBSTYLE_TRANSPARENT or            \
                                TBSTYLE_FLAT or                   \
                                TBSTYLE_TOOLTIPS or               \
                                CCS_NODIVIDER or                  \
                                CCS_NORESIZE or CCS_NOPARENTALIGN, \
                                esi, 16, 10000, 24,               \
                                [hToolPalette], esi, [hInstance], \
                                esi
        mov     ebx, eax

        invoke  SendMessageW, ebx, TB_BUTTONSTRUCTSIZE, TToolbarButton.size, esi

        invoke  ImageList_Create, 24, 24, ILC_COLOR24 or ILC_MASK, 0, 1
        mov     esi, eax

        invoke  LoadImageW, [hInstance], resArrowIcon, IMAGE_ICON, 24, 24, LR_DEFAULTCOLOR
        push    eax

        invoke  ImageList_AddIcon, esi, eax

        invoke  DestroyIcon     ; eax is in the stack

        invoke  SendMessageW, ebx, TB_SETIMAGELIST, 0, esi
        invoke  SendMessageW, ebx, TB_SETBITMAPSIZE, 0, $00180018

; make tooltip to appear on not active main window.
        invoke  SendMessageW, ebx, TB_GETTOOLTIPS, 0, 0
        mov     esi, eax
        invoke  GetWindowLongW, esi, GWL_STYLE
        or      eax, TTS_ALWAYSTIP or TTS_NOPREFIX
        invoke  SetWindowLongW, esi, GWL_STYLE, eax

; Set tooltip delay time.
        invoke  SendMessageW, esi, TTM_SETDELAYTIME, TTDT_AUTOMATIC, 600

; Add arrow button to the palette toolbar.
        mov     [.tbb.iBitmap], 0
        mov     [.tbb.idCommand], 0
        mov     [.tbb.fsState], TBSTATE_CHECKED or TBSTATE_ENABLED
        mov     [.tbb.fsStyle], TBSTYLE_CHECKGROUP
        mov     [.tbb.dwData], 0
        mov     [.tbb.iString], -1
        lea     eax, [.tbb]
        invoke  SendMessageW, ebx, TB_ADDBUTTONS, 1, eax

        mov     [.tbb.fsState], 0
        mov     [.tbb.fsStyle], TBSTYLE_GROUP or TBSTYLE_SEP
;        mov     [.tbb.dwData], 0
        lea     eax, [.tbb]
        invoke  SendMessageW, ebx, TB_ADDBUTTONS, 1, eax


; Insert the new palette
;        mov     [.nmh.code], TCN_SELCHANGING
;        push    [hToolPalette]
;        pop     [.nmh.hwndFrom]
;        lea     edi, [.nmh]
;
;        invoke  SendMessageA, [hToolPalette], WM_NOTIFY, 0, edi

        mov     [.tci.mask], TCIF_TEXT or TCIF_PARAM

        stdcall utf8ToWideChar, [.hPaletteName]
        mov     [.tci.pszText], eax
        mov     [.tci.lParam], ebx

        lea     esi, [.tci]
        invoke  SendMessageW, [hToolPalette], TCM_INSERTITEMW, 10000, esi
        stdcall FreeMem, [.tci.pszText]

;        invoke  SendMessageA, [hToolPalette], TCM_SETCURSEL, eax, 0

;        mov     [.nmh.code], TCN_SELCHANGE
;        invoke  SendMessageA, [hToolPalette], WM_NOTIFY, 0, edi

        mov     eax, ebx
.finish:
        pop     edi esi ebx
        return
endp

;--------------------------------------------
; Adds the file with design-time description
; of controls in the tool palette.
; Returns:
;   0 - operation OK
;   1 - file open error
;   2 - file read error
;   3 - image read error
;--------------------------------------------
proc AddToPalette, .hFileName
.tbb    TBBUTTON
.ffirst dd ?
begin
        push    ecx edx ebx esi edi

        stdcall GetFullPathNameUtf8, [.hFileName]
        mov     ebx, eax                ; the path

        stdcall StrSplitFilename, ebx
        mov     esi, eax                ; the filename

        stdcall SetCurrentDir, ebx

        stdcall LoadBinaryFile, esi
        mov     edi, eax

        stdcall StrDel, ebx
        stdcall StrDel, esi

; So, here, edi points to buffer with read data. It is array of TDesignTimeInfo
; make relocation of the array pointers.
        push    edi
.reloc:
        cmp     dword [edi], 0
        je      .endloop

        add     [edi+TDesignTimeInfo.ClassName], edi
        add     [edi+TDesignTimeInfo.ControlHint], edi
        add     [edi+TDesignTimeInfo.Palette], edi
        add     [edi+TDesignTimeInfo.DefaultText], edi
        add     [edi+TDesignTimeInfo.StyleNames], edi
        add     [edi+TDesignTimeInfo.StyleExNames], edi
        add     [edi+TDesignTimeInfo.SubtypeRange], edi
        cmp     [edi+TDesignTimeInfo.LibFile], 0
        je      @f
        add     [edi+TDesignTimeInfo.LibFile], edi
@@:
        cmp     [edi+TDesignTimeInfo.ImageFile], 0
        je      @f
        add     [edi+TDesignTimeInfo.ImageFile], edi
@@:
        add     edi, sizeof.TDesignTimeInfo
        jmp     .reloc

.endloop:
        pop     edi

        mov     [.ffirst], $80000000
; Creates buttons from the structure.
.createbuttons:
        cmp     dword [edi], 0
        je      .endcreate

        stdcall GetPaletteToolbar, [edi+TDesignTimeInfo.Palette]
        mov     ebx, eax        ; handle for toolbar.

        stdcall utf8ToWideChar, [edi+TDesignTimeInfo.ImageFile]
        push    eax

        invoke  LoadImageW, [hInstance], eax, IMAGE_ICON, 24, 24, LR_LOADFROMFILE ;  or LR_LOADTRANSPARENT
        stdcall FreeMem ; from the stack

        test    eax, eax
        jz      .error_image

        mov     esi, eax

        invoke  SendMessageW, ebx, TB_GETIMAGELIST, 0, 0
        invoke  ImageList_ReplaceIcon, eax, -1, esi
        mov     [.tbb.iBitmap], eax
        mov     [.tbb.idCommand], eax
        invoke  DestroyIcon, esi

        mov     [.tbb.fsState], TBSTATE_ENABLED
        mov     [.tbb.fsStyle], TBSTYLE_CHECKGROUP

        mov     [.tbb.dwData], edi
        cmp     [.ffirst], 0
        je      @f
        or      [.tbb.dwData], $80000000
        and     [.ffirst], 0
@@:
        mov     [.tbb.iString], -1

        lea     eax, [.tbb]
        invoke  SendMessageW, ebx, TB_INSERTBUTTON, -1, eax

        add     edi, sizeof.TDesignTimeInfo
        jmp     .createbuttons

.endcreate:
        xor     eax,eax
        jmp     .finish

.error_open:
        mov     eax, 1
        jmp     .finish

.error_read:
        invoke  CloseHandle, esi
        mov     eax, 2
        jmp     .finish

.error_image:
        mov     eax, 3

.finish:
        pop     edi esi ebx edx ecx
        return
endp



;--------------------------------------
; Returns pointer to TDesignTimeInfo
; structure for current selected
; tool.
; Returns NULL if there is no tool
; selected.
; Returns toolbar handle in the edx
;--------------------------------------
proc GetCurrentTool

.tci TCITEM
.tbb TBBUTTON

begin
        push    esi edi ebx
        invoke  SendMessageW, [hToolPalette], TCM_GETCURSEL, 0, 0
        cmp     eax, -1
        je      .finish

        lea     ecx, [.tci]
        mov     [.tci.mask], TCIF_PARAM
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMW, eax, ecx
        test    eax,eax
        jz      .finish

        invoke  SendMessageW, [.tci.lParam], TB_BUTTONCOUNT, 0, 0
        test    eax, eax
        jz      .finish

        mov     ebx, eax
        xor     esi, esi
        lea     edi, [.tbb]

.find:
        invoke  SendMessageW, [.tci.lParam], TB_GETBUTTON, esi, edi
        test    [.tbb.fsState], TBSTATE_CHECKED
        jnz     .found

        inc     esi
        cmp     esi, ebx
        jne     .find

        xor     eax, eax
        jz      .finish

.found:
        mov     eax, [.tbb.dwData]
        and     eax, $7fffffff
        mov     edx, [.tci.lParam]

.finish:
        pop     ebx edi esi
        return
endp


;---------------------------------------------------------
; Returns pointer to TDesignTimeInfo structure, if
; there is match. Returns NULL if there is no component
; with this parameters.
;---------------------------------------------------------
proc SearchForDesignTimeInfo, .hClassName, .Style
.tci TCITEM
.tbb TToolbarButton
.tb  dd ?
begin
        push    esi edi ebx

        invoke  SendMessageW, [hToolPalette], TCM_GETITEMCOUNT, 0, 0
        mov     ebx, eax

.tabloop:
        dec     ebx
        js      .finish

        lea     eax, [.tci]
        mov     [.tci.mask], TCIF_PARAM
        invoke  SendMessageW, [hToolPalette], TCM_GETITEMW, ebx, eax

        mov     eax, [.tci.lParam]      ; handle of the toolbar.
        mov     [.tb], eax
        invoke  SendMessageW, [.tb], TB_BUTTONCOUNT, 0, 0
        mov     edi, eax

.btnloop:
        dec     edi
        js      .tabloop

        lea     eax, [.tbb]
        invoke  SendMessageW, [.tb], TB_GETBUTTON, edi, eax
        mov     esi, [.tbb.dwData]
        test    esi, esi
        jz      .btnloop

        and     esi, $7fffffff  ; address of TDesignTimeInfo
        stdcall StrCompNoCase, [.hClassName], [esi+TDesignTimeInfo.ClassName]
        jnc     .btnloop

        mov     eax, [esi+TDesignTimeInfo.SubtypeMask]
        and     eax, [.Style]

        mov     edx, [esi+TDesignTimeInfo.SubtypeRange]
        cmp     edx, esi
        je      .nosubstyle

        mov     ecx, [edx]      ; count of the items in the list
        add     edx, 4

.substyle:
        dec     ecx
        js      .btnloop

        cmp     eax, [edx]
        je      .found

        add     edx, 4
        push    ecx
        movzx   ecx, byte [edx]
        lea     edx, [edx+ecx+1]   ; skip the text
        movzx   ecx, byte [edx]
        lea     edx, [edx+ecx+1]   ; skip the comment
        pop     ecx
        jmp     .substyle

.nosubstyle:
        mov     eax, [esi+TDesignTimeInfo.StyleMaskAnd]
        not     eax
        and     eax, [.Style]
        jnz     .btnloop
        mov     eax, [esi+TDesignTimeInfo.StyleMaskOr]
        and     eax, [.Style]
        cmp     eax, [esi+TDesignTimeInfo.StyleMaskOr]
        jne     .btnloop

.found:
        mov     eax, esi
        pop     ebx edi esi
        return

.finish:
        xor     eax, eax
        pop     ebx edi esi
        return
endp