Update of /cvsroot/perl-win32-gui/Win32-GUI/scripts
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11953/scripts

Modified Files:
        win32-gui-demos.pl 
Log Message:
keyboard navigation for win32-gui-demos

Index: win32-gui-demos.pl
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/scripts/win32-gui-demos.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** win32-gui-demos.pl  30 Aug 2006 21:59:31 -0000      1.4
--- win32-gui-demos.pl  15 Oct 2006 12:09:27 -0000      1.5
***************
*** 14,18 ****
  #   (and progress bar?)
  
! our $VERSION = '0.02';
  $VERSION = eval $VERSION;
  
--- 14,18 ----
  #   (and progress bar?)
  
! our $VERSION = '0.03';
  $VERSION = eval $VERSION;
  
***************
*** 24,31 ****
  use File::Basename();
  
! use Win32::GUI 1.03_03, qw( WS_CLIPCHILDREN WS_EX_CLIENTEDGE
!                             WM_MENUSELECT WM_NOTIFY NM_RETURN
                              CW_USEDEFAULT SW_SHOWDEFAULT TVHT_ONITEM
!                             IDC_WAIT );
  #use Win32::GUI::Console();
  use Win32::GUI::Scintilla::Perl();
--- 24,32 ----
  use File::Basename();
  
! use Win32::GUI 1.03_04, qw( WS_CLIPCHILDREN WS_EX_CLIENTEDGE
!                             WM_MENUSELECT WM_NOTIFY WM_GETDLGCODE NM_RETURN
                              CW_USEDEFAULT SW_SHOWDEFAULT TVHT_ONITEM
!                             IDC_WAIT DLGC_HASSETSEL WM_KEYDOWN WM_CHAR 
VK_TAB);
! 
  #use Win32::GUI::Console();
  use Win32::GUI::Scintilla::Perl();
***************
*** 54,64 ****
  my $menu = Win32::GUI::Menu->new(
      "&File"     =>            "File",
!     ">&Options" => { -name => "Options", -onClick => \&getOptions },
!     ">&Source"  => { -name => "Source",  -onClick => \&showMySource },
      ">-"        => 0,
      ">E&xit"    => { -name => "Exit",    -onClick => sub {-1}, },
      "&Help"     =>            "HelpB",
!     ">&Help"    => { -name => "Help",    -onClick => \&showHelp, },
!     ">&About"   => { -name => "About",   -onClick => \&showAboutBox, },
  );
  
--- 55,65 ----
  my $menu = Win32::GUI::Menu->new(
      "&File"     =>            "File",
!     ">&Options...\tCtrl-O" => { -name => "Options", -onClick => \&getOptions 
},
!     ">&Source\tCtrl-S"     => { -name => "Source",  -onClick => 
\&showMySource },
      ">-"        => 0,
      ">E&xit"    => { -name => "Exit",    -onClick => sub {-1}, },
      "&Help"     =>            "HelpB",
!     ">&Help\tF1"           => { -name => "Help",    -onClick => \&showHelp, },
!     ">&About..."           => { -name => "About",   -onClick => 
\&showAboutBox, },
  );
  
***************
*** 75,78 ****
--- 76,86 ----
  );
  
+ ## 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
***************
*** 93,96 ****
--- 101,105 ----
      -size      => [750,500],
      -menu      => $menu,
+       -accel     => $accel,
      -class     => $class,
      -pushstyle => WS_CLIPCHILDREN,  # avoid flicker on resize
***************
*** 166,169 ****
--- 175,179 ----
      -tabstop    => 1,
  ) or die "Editor";
+ $mw->RE->Hook(WM_GETDLGCODE, \&fixScintillaDlgCode);
  
  ######################################################################
***************
*** 173,176 ****
--- 183,187 ----
  
  $mw->Show();
+ $mw->TV->SetFocus();
  Win32::GUI::Dialog();
  $mw->Hide();
***************
*** 332,335 ****
--- 343,376 ----
  
  ######################################################################
+ # Scintilla fixScintillaDlgCode
+ # - Scintilla returns DLGC_HASSETSEL|DLGC_WANTALLKEYS in response
+ # to a WM_GETDLGCODE message.  This prevents 'TAB' navigation working,
+ # so this hook fixes that
+ ######################################################################
+ sub fixScintillaDlgCode {
+     my ($win, $wParam, $lParam, $type, $msgcode) = @_;
+     return 1 unless $type == 0;
+     return 1 unless $msgcode == WM_GETDLGCODE;
+ 
+       # $lParam is a pointer to a MSG structure, or NULL:
+       if($lParam == 0) {
+               $win->Result(DLGC_HASSETSEL);
+               return 0;
+       }
+       else {
+               my($m_hwnd, $m_msgcode, $m_wParam, $m_lParam, $m_time, $m_x, 
$m_y)
+                       = unpack("LLLLLLL", unpack("P28", pack( "L", $lParam)));
+ 
+               if($m_msgcode == WM_KEYDOWN or $msgcode == WM_CHAR) {
+                       if($m_wParam == VK_TAB) {
+                               $win->Result(DLGC_HASSETSEL);
+                               return 0;
+                       }
+               }
+       }
+       return 1;  # Do default processing
+ }
+ 
+ ######################################################################
  # Button click (and node double-click) - run current file
  ######################################################################
***************
*** 413,417 ****
  
  ######################################################################
! # Help menu item.  Show help text in code area
  ######################################################################
  sub showHelp {
--- 454,458 ----
  
  ######################################################################
! # Help menu item.  Show help text in help window
  ######################################################################
  sub showHelp {
***************
*** 521,527 ****
          -left    => $ab->ScaleWidth()-70,
          -top     => $ab->ScaleHeight()-35,
!         -ok      => 1,
          -default => 1,
          -onClick => sub {-1},
      );
  
--- 562,569 ----
          -left    => $ab->ScaleWidth()-70,
          -top     => $ab->ScaleHeight()-35,
!         -cancel  => 1,
          -default => 1,
          -onClick => sub {-1},
+               -tabstop => 1,
      );
  


Reply via email to