>From Gui.pm:
sub new {
shift;
my($k, $v);
my $flag = 0;
my $key = 0;
my %accels = @_;
while( ($k, $v) = each %accels) {
$flag = 0;
if($k =~ s/shift[-\+]//i) { $flag |= 0x0004; }
if($k =~ s/(ctrl|control)[-\+]//i) { $flag |= 0x0008; }
if($k =~ s/alt[-\+]//i) { $flag |= 0x0010; }
if($k =~ /^space$/i) { $flag |= 0x0001; $key =
0x20; } # VK_SPACE
elsif($k =~ /^left$/i) { $flag |= 0x0001; $key =
0x25; } # VK_LEFT
elsif($k =~ /^right$/i) { $flag |= 0x0001; $key =
0x27; } # VK_RIGHT
elsif($k =~ /^up$/i) { $flag |= 0x0001; $key =
0x26; } # VK_UP
elsif($k =~ /^down$/i) { $flag |= 0x0001; $key =
0x28; } # VK_DOWN
elsif($k =~ /^ins$/i) { $flag |= 0x0001; $key =
0x2D; } # VK_INSERT
elsif($k =~ /^del$/i) { $flag |= 0x0001; $key =
0x2E; } # VK_DELETE
elsif($k =~ /^f1$/i) { $flag |= 0x0001; $key =
0x70; } # VK_F1
elsif($k =~ /^f2$/i) { $flag |= 0x0001; $key =
0x71; } # VK_F2
elsif($k =~ /^f3$/i) { $flag |= 0x0001; $key =
0x72; } # VK_F3
elsif($k =~ /^f4$/i) { $flag |= 0x0001; $key =
0x73; } # VK_F4
elsif($k =~ /^f5$/i) { $flag |= 0x0001; $key =
0x74; } # VK_F5
elsif($k =~ /^f6$/i) { $flag |= 0x0001; $key =
0x75; } # VK_F6
elsif($k =~ /^f7$/i) { $flag |= 0x0001; $key =
0x76; } # VK_F7
elsif($k =~ /^f8$/i) { $flag |= 0x0001; $key =
0x77; } # VK_F8
elsif($k =~ /^f9$/i) { $flag |= 0x0001; $key =
0x78; } # VK_F9
elsif($k =~ /^f10$/i) { $flag |= 0x0001; $key =
0x79; } # VK_F10
elsif($k =~ /^f11$/i) { $flag |= 0x0001; $key =
0x7A; } # VK_F11
elsif($k =~ /^f12$/i) { $flag |= 0x0001; $key =
0x7B; } # VK_F12
elsif($k =~ /^esc$/i) { $flag |= 0x0001; $key =
0x1B; } # VK_ESCAPE
elsif($k =~ /^backspace$/i) { $flag |= 0x0001; $key =
0x08; } # VK_BACK
elsif($k =~ /^tab$/i) { $flag |= 0x0001; $key =
0x09; } # VK_TAB
elsif($k =~ /^return$/i) { $flag |= 0x0001; $key =
0x0D; } # VK_RETURN
elsif($k =~ /^end$/i) { $flag |= 0x0001; $key =
0x23; } # VK_END
elsif($k =~ /^home$/i) { $flag |= 0x0001; $key =
0x24; } # VK_HOME
elsif($k =~ /^(pgup|pageup)$/i) { $flag |= 0x0001; $key =
0x21; } # VK_PRIOR
elsif($k =~ /^(pgdn|pagedn|pagedown)$/i) { $flag |= 0x0001; $key =
0x22; } # VK_NEXT
elsif($k =~ /^[0-9a-zA-Z]$/) { $flag |= 0x0001; $key =
ord(uc($k)); } # ASCII
push(@acc, $id);
push(@acc, $key);
push(@acc, $flag);
$self->{$Win32::GUI::AcceleratorCounter++} = $v;
}
if($Win32::GUI::AcceleratorTable) {
Win32::GUI::DestroyAcceleratorTable($Win32::GUI::AcceleratorTable);
}
my $handle = Win32::GUI::CreateAcceleratorTable( @acc );
if($handle) {
$self->{-handle} = $handle;
return 1;
} else {
return 0;
}
}
Script: x.pl
use Win32::GUI;
$Window = new Win32::GUI::Window (
-name => "Window",
-topmost => 1,
-left => 300,
-dialogui => 1,
-top => 400,
-width => 205,
-height => 235,
-maxsize => [205,235],
-minsize => [205,235],
-text => "something",
-maximizebox => 0,
-minimizebox =>1,
-helpbutton => 0,
-resizable =>0,
-accel => $A,
);
$CBdropdown = $Window->AddCombobox(
-tabstop => 1,
-default =>1,
-sort => 1,
-name => Dropdown,
-left => 10,
-top => 15,
-width => 180,
-height => 300,
-scroll => 1,
-addstyle => WS_VISIBLE | 0x0003 | WS_VSCROLL,
);
my @a = qw[ One Two Three Four Five Six Seven Eight Nine Ten];
foreach my $a(){
$CBdropdown->InsertItem($a)
}
Running this script before modifiying gui.pm results in:
when pressing "t", the combo box will alternate between "Two", "Threee, and
"Ten"
If you Hold the ctrl while pressing "t", it will cycle the combo box, proving
that the accelerator table is not intercepting the events.
Now, if you just bless and return $self, (or $self,$class) you now get the
DESTROY event upon Window_Terminate AND the window seems to trap the ctrl-t
combonation, which I can assume since the combobox does not cycle.
I dont know how the message queue thing works, but perhaps this is a start.
Maybe someone with xs experience can take a look at it to see if any other
progress can be made on it. It appears that @acc is pushed in the form ($id,
$key, $flag) (key is the key pressed such as 'k', flag is the modifier key such
as 'alt', 'ctrl', but $id is defined nowhere, and is not even in the lexical
scope of the sub. I would expect this to be wrong, but not sure.
Or maybe we are close enough to a new Win32::GUI release that it does not make
a difference?
I changed :
if($handle) {
$self->{-handle} = $handle;
return 1;
}
to :
if($handle) {
$self->{-handle} = $handle;
bless($self);
return $self;
}
so that an object is return instead of a true/false. I can only assume that
the -accel needs an object and not a true/false value.
If anyone makes any headway, let the group know.
Joe
> -----Original Message-----
> From: Peter Eisengrein [mailto:[EMAIL PROTECTED]
> Sent: Monday, January 14, 2002 10:34 AM
> To: 'Nathan Meyers'; perl-win32-gui-users@lists.sourceforge.net
> Subject: RE: [perl-win32-gui-users] Keyboard accelerators possible?
>
>
> It does exist as method Win32::GUI::AcceleratorTable . I've
> never been able
> to make it work, but perhaps someone else can lend a hand.
>
> From the .pm...
> # Example:
> # $A = new Win32::GUI::AcceleratorTable(
> # "Ctrl-X" => "Close",
> # "Shift-N" => "New",
> # "Ctrl-Alt-Del" => "Reboot",
> # );
>
>
>
> > -----Original Message-----
> > From: Nathan Meyers [mailto:[EMAIL PROTECTED]
> > Sent: Monday, January 14, 2002 01:48
> > To: perl-win32-gui-users@lists.sourceforge.net
> > Subject: [perl-win32-gui-users] Keyboard accelerators possible?
> >
> >
> > Hello,
> >
> > I'm new to Win32::GUI and trying to solve a problem; I can't find a
> > thing about it in the mail archives.
> >
> > Is it possible to define keyboard accelerators for menu items
> > - not the
> > mnemonics used in conjunction with the Alt key, but the Ctrl
> > characters
> > that dispatch to menu callbacks (commonly done in GUI applications)?
> >
> > Nathan Meyers
> > [EMAIL PROTECTED]
> >
> > _______________________________________________
> > Perl-Win32-GUI-Users mailing list
> > Perl-Win32-GUI-Users@lists.sourceforge.net
> > https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
> >
>
> _______________________________________________
> Perl-Win32-GUI-Users mailing list
> Perl-Win32-GUI-Users@lists.sourceforge.net
> https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
>
