# --------------------------------------
#  register_wndclass, create_window, wndproc
# ---- Register Window Class ----
subcode: register_wndclass(name, proc)
    $local WNDCLASSEX wc
    wc.cbSize = sizeof(WNDCLASSEX);
    wc.hInstance = cur_instance
    wc.cbClsExtra = 0;

    $(if:wc_style!=1) = 0

        wc.hIcon = NULL
        wc.hIconSm = NULL

        wc.hCursor = LoadCursor(NULL, IDC_ARROW);

        wc.hbrBackground = NULL
        wc.lpszMenuName = NULL

    wc.lpszClassName = $(name)

        wc.lpfnWndProc = DefDlgProc
        wc.cbWndExtra = DLGWINDOWEXTRA
            $call wndproc, $(proc)
        wc.lpfnWndProc = $(proc)
        wc.cbWndExtra = 0


$call register_wndclass, test, WndProc_main will be simply expanded into populating a WNDCLASSEX structure and calling RegisterClassEx. We have a bunch of preprocessing switches here to define the default. Optionally, we can set the cursor, style, icon, menu, and background by calling following subcodes:

subcode: wc_cursor(p)
    $local WNDCLASSEX wc
        wc.hCursor = LoadCursor(NULL, $(p))

subcode: wc_style(p)
    $(else) |= $(p)

subcode: wc_icon(p)
        wc.hIcon = LoadImage(cur_instance, MAKEINTRESOURCE($(p)), IMAGE_ICON, GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON), LR_DEFAULTCOLOR|LR_SHARED);
        wc.hIconSm = LoadImage(cur_instance, MAKEINTRESOURCE($(p)), IMAGE_ICON, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON), LR_DEFAULTCOLOR|LR_SHARED);

subcode: wc_menu(p)

subcode: wc_background(p)

For example, the following code:

$call wc_background, COLOR_BACKGROUND
$call register_wndclass, "test", WndProc_main

will register the window class with COLOR_BACKGROUND background color.


The bulky CreateWindowEx routine is similarly dealt with:

# ---- Create Window ----
subcode: create_window(hwnd, name)

    $(hwnd)=CreateWindowEx($(cw_style_ex), $(name), $(name), $(cw_style), $(cw_x), $(cw_y), $(cw_w), $(cw_h), NULL, NULL, cur_instance, NULL)

subcode: cw_style_ex(p)

subcode: cw_style(p)

subcode: cw_size(x, y, w, h)

subcode: cw_dim(x, v)

Window Proc

The window proc is writen as an extension (in Perl and directly working with MyDef internals). I will have explain how MyDef internal works before explaining this part, but nevertheless, I'll list the code here (nobody is going to prevent you to venture):

# ---- WNDPROC -----------------------------------------
#  $(block:global_init)
#      $call wndproc, WndProc_main
perlcode: wndproc
    $if $param=~/(WndProc|DlgProc)_(\w+)/
        my ($type, $name)=($1, $2)
        my $funcname="$type\_$name"
        my $context=$(C)start_function_block($funcname, "HWND hwnd, UINT msg, WPARAM wparam, LPARAM lparam")
        $if $context
            $$(C)cur_function->{ret_type}="LRESULT CALLBACK";
            $call window_proc_core

subcode: window_proc_core
    my $out=$$(C)out
    my $codes=$MyDef::def->{codes}
    # ---- process window msg ---------------
    push @$out, "switch(msg){";
    &call push_indent_block
        my %msg_hash;
        $foreach $k in sort(keys(%$codes))
            $if $k=~/$name\_on\_(WM_\w+)/
                my $msg=$1
                $call window_proc_on_msg
        $if !$msg_hash{"WM_DESTROY"} and $name eq "main"
            # $call msg_destroy

    push @$out, "}";
    $if $type eq "WndProc"
        push @$out, "return DefWindowProc(hwnd, msg, wparam, lparam);"
    $elif $type eq "DlgProc"
        push @$out, "return FALSE;"

subcode: window_proc_on_msg
    $if $msg eq "WM_ALLKEY"
        push @$out, "case WM_KEYDOWN:"
        push @$out, "case WM_KEYUP:"
        push @$out, "case WM_SYSKEYDOWN:"
        push @$out, "case WM_SYSKEYUP:"
    $elif $msg eq "WM_ALLCOMMAND"
        push @$out, "case WM_COMMAND:"
        push @$out, "case WM_SYSCOMMAND:"
        push @$out, "case $msg:"
    &call push_indent_block
        # push @$out, "printf(\"$name\_on_$msg\\n\");"
        push @$out, "break;"

# -- messages --
subcode: msg_destroy
    case WM_DESTROY:
        return 1

results matching ""

    No results matching ""