view release on metacpan or  search on metacpan

scripts/win32-gui-demos.pl  view on Meta::CPAN

    "&Help"     =>            "HelpB",
    ">&Help\tF1"           => { -name => "Help",    -onClick => \&showHelp, },
    ">&About..."           => { -name => "About",   -onClick => \&showAboutBox, },
);

my @menu_help = (
    undef,  # File Button
    undef,  # Help Button
    "Change program options.",
    "View the source for this program.",
    undef,  # Seperator
    "Exit.",
    undef,  # ??
    "View help for using this program.",
    $copyright,
);

## Accelerators:
my $accel = Win32::GUI::AcceleratorTable->new(
	"Ctrl-O" => \&getOptions,
	"Ctrl-S" => \&showMySource,
	"F1"     => \&showHelp,
);

######################################################################
# A class that removes the Win32::GUI default CS_HDRAW and CS_VDRAW
# styles - helps with reducing flicker when we are not scaling the
# content of the windows
######################################################################
my $class = Win32::GUI::Class->new(
    -name  => "Win32_GUI_MyClass",
    -style => 0,
) or die "Class";

######################################################################
# Main window
######################################################################
my $mw = Win32::GUI::Window->new(
    -title     => $progname,
    -left      => CW_USEDEFAULT,
    -size      => [750,500],
    -menu      => $menu,
    -accel     => $accel,
    -class     => $class,
    -pushstyle => WS_CLIPCHILDREN,  # avoid flicker on resize
    -onResize  => \&mwResize,
    -dialogui  => 1,
) or die "MainWindow";

## Hook for displaying menu help in the status bar
$mw->Hook(WM_MENUSELECT, \&showMenuHelp);

######################################################################
# Status bar
######################################################################
$mw->AddStatusBar(
    -name => 'SB',
) or die "StatusBar";

######################################################################
# Treeview
######################################################################
$mw->AddTreeView(
    -name            => 'TV',
    -pos             => [0,0],
    -width           => 200,
    -height          => $mw->ScaleHeight() - $mw->SB->Height(),
    -rootlines       => 1,
    -lines           => 1,
    -buttons         => 1,
    -onNodeClick     => \&loadFile,
    #-onMouseDown     => \&tvClick,
    -onMouseDblClick => \&tvDoubleClick,
    -tabstop         => 1,
) or die "Treeview";
## Hook for getting notification when <RETURN> key is pressed
$mw->TV->Hook(NM_RETURN, \&tvReturnHook);

######################################################################
# Splitter
######################################################################
$mw->AddSplitter(
    -name      => 'SP',
    -top       => 0,
    -left      => $mw->TV->Width(),
    -height    => $mw->ScaleHeight() - $mw->SB->Height(),
    -width     => 3,
    -onRelease => \&splitterRelease,
) or die "Splitter";

######################################################################
# Launch Button
######################################################################
$mw->AddButton(
    -name     => 'BUT',
    -text     => "Run demo ...",
    -disabled => 1,
    -top      => 10,
    -onClick  => \&runCurrent,
    -tabstop  => 1,
) or die "Button";
$mw->BUT->Left($mw->ScaleWidth()-10-$mw->BUT->Width());

######################################################################
# Code display area
######################################################################
$mw->AddScintillaPerl(
    -name       => 'RE',
    -left       => $mw->SP->Left() + $mw->SP->Width(),
    -top        => $mw->BUT->Top() + $mw->BUT->Height() + 10,
    -width      => $mw->ScaleWidth() - $mw->TV->Width() - $mw->SP->Width(),
    -height     => $mw->ScaleHeight() -$mw->SB->Height()- $mw->BUT->Height() - 20,
    -readonly   => 1,
    -addexstyle => WS_EX_CLIENTEDGE,
    -tabstop    => 1,
) or die "Editor";
$mw->RE->Hook(WM_GETDLGCODE, \&fixScintillaDlgCode);

######################################################################
# load tree view and run application
######################################################################
load_treeview($mw->TV);

$mw->Show();
$mw->TV->SetFocus();
Win32::GUI::Dialog();
$mw->Hide();
undef $mw;
exit(0);

######################################################################
# Callbacks
######################################################################

######################################################################

scripts/win32-gui-demos.pl  view on Meta::CPAN

    $win->SP->Height($h - $win->SB->Height());

    # Re-position button
    my $butleft = $win->ScaleWidth() - 10 - $win->BUT->Width();
    my $butleft_min = $win->TV->Width() + $win->SP->Width();
    $butleft = $butleft_min if $butleft < $butleft_min;

    $win->BUT->Left($butleft);

    # Fill remaining space with code display area
    $win->RE->Width($w - $win->TV->Width() - $win->SP->Width());
    $win->RE->Height($win->TV->Height() - $win->BUT->Height() - 20);

    # Stop the splitter moving over our button
    $win->SP->Change(-max => $win->BUT->Left() - 10);

    return 1;
}

######################################################################
# Reposition splitter
# Horizontal splitter, so only need to resize the 2 panes
######################################################################
sub splitterRelease {
    my ($s, $coord) = @_;
    my $p = $s->GetParent();

    $p->TV->Width($coord);
    $p->RE->Left($coord + $s->Width());
    $p->RE->Width($p->ScaleWidth() - $coord - $s->Width());

    return 1;
}

######################################################################
# Display menu help in the status bar
######################################################################
sub showMenuHelp {
    my ($win, $wParam, $lParam, $type, $msgcode) = @_;
    return 1 unless $type == 0;
    return 1 unless $msgcode == WM_MENUSELECT;

    if($lParam == 0) { # leaving menu
        $win->SB->Text($options->{current} || '');
    }
    else {
        # This technique is distinctly flakey, and depends
        # on understanding how the internals of Win32::GUI
        # allocates ids to menu items.  This mechanism has
        # changed since Win32::GUI 1.03, the code below
        # should work with old and new builds
        my $item = $wParam & 0xFF;
        $item -= 100 if $item > 100;;
        $win->SB->Text($menu_help[$item] || '');
    }

    return 1;
}

######################################################################
# Treeview <RETURN> pressed
######################################################################
sub tvReturnHook {
    my ($win, $wParam, $lParam, $type, $msgcode) = @_;
    return 1 unless $type == WM_NOTIFY;
    return 1 unless $msgcode == NM_RETURN;

    my $node = $win->GetSelection();
    loadFile($win, $node);

    # Force a non-zero return value to stop the beep that results
    # from default processing
    $win->Result(1);
    return 0;
}

######################################################################
# Treview node click - if node has associate file, load it
######################################################################
sub loadFile {
    my ($tv, $node) = @_;

    return 0 unless exists $nodes{$node};

    my $file = $nodes{$node};

    if(!defined($options->{current}) or $file ne $options->{current}) {
        $options->{current} = $file;
        # Can't use $tv->GetParent(), as GetParent is redefined to get
        # the parent node ... oops
        my $p = Win32::GUI::GetWindowObject(Win32::GUI::GetParent($tv));

        # If Scintilla is readonly, then LoadFile doesn't work
        $p->RE->SetReadOnly(0);
        $p->RE->LoadFile($file);
        $p->RE->SetReadOnly(1);

        $p->SB->Text($options->{current});
        $p->BUT->Enable();
    }

    return 1;
}

######################################################################
# Treview double click - if double click is on a node, load and run
# the associated file
######################################################################
sub tvDoubleClick {
    my ($tv, $x, $y) = @_;
    my ($node, $flags) = $tv->HitTest($x,$y);

    if($node && ($flags & TVHT_ONITEM)) {
        my $loaded = loadFile($tv, $node);
        runCurrent($tv) if($loaded);
    }

    return 1;
}

######################################################################