Tuesday 17 of June 2008 08:57:45 James McDonald napisał(a):
> I would like to close my application by pressing the escape key.
>
> I know I have to define the escape key press event and specify a sub
> routine that will trigger when I press escape. However I haven't been
> able to google an example.
>
> Could anyone point me in the right direction?
>
This is my simple text file viewer with ESCAPE key to exit;
ARGV[0] = file to view. Inifile at the end
wb
#----------------------------------------------------------------
#!/usr/bin/perl -w
use strict;
use warnings;
use Win32::GUI qw(
WS_CAPTION
WS_THICKFRAME
WS_BORDER
WS_EX_CLIENTEDGE
);
use Win32::GUI::BitmapInline ();
Win32::SetChildShowWindow(0);
my $plik = '';
my $tekst = '';
my $tytul = '';
if ( $ARGV[0] ) { $plik = $ARGV[0] if -e $ARGV[0] }
if ( $plik ) {
open F, "<",$plik;
while ( <F> ) {
chomp;
$tekst .= $_."\r\n";
}
close F;
$tytul = "[ $plik ]";
} else {
$tytul = "[ $plik ] No file!";
}
my $printer = 'LPT1';
my $font = "Lucida Console";
my $size = 8;
my $width = 800;
my $height = 600;
my $left = 0;
my $top = 0;
my ($width_obj,$height_obj);
if ( open FH, '<STFViewer.ini' ) {
my $file = '';
while ( my $row = <FH> ) { $row =~ s/^\s*//; $file .= '$'.$row.';' }
eval( $file )
}
my $sao_ico ='
AAABAAEAICAQAAEABADoAgAAFgAAACgAAAAgAAAAQAAAAAEABAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAyH3AAI10dADF/FwBMLbEAOJ0xAGk+7wBFvjgAhmnbAIti+ABS4DwAZ+RYAIXQdwCoif8A
hOxsAK73pAAAAAAAsRERERERERERERER/////+tEREREREREREREIf/////tqZmpmZmZmZmZqUH/
////7ZmamamamampqZlB/////+2ard3d3d3d3dqpQf/////tmUvu7u7u7u7tmUH/////7alB////
////7ZlB/////+2ZQf///////+2pQf/////tqUH/cAAAAAAAAAAAAAAA7ZlB/8czMzMzMzMzMzMz
AO2pQf/IVVVVVVVVVVVVVTDtmUH/yFVVVVVVVVVVVVUw7alB/8hViIiIiIiIiIhVMO2ZQf/IVTfM
zMzMzMzIVTDtqUH/yFUw///tqUH/yFUw7ZlB/8hVMP//7ZlB/8hVMO2aQf/IVTD//+2pQf/IVTDt
mUH/yFUw///tmUH/yFUw7alBERERERERvZlB/8hVMO2ZZEREREREREqpQf/IVTDtmpmZmZmZmZmZ
mUH/yFUw7ZmampqampmpmplB/8hVMO7d3d3d3d3d3d3dsf/IVTDu7u7u7u7u7u7u7uv/yFUw////
/8hVMP///////8hVMP/////IVTD////////IVTD/////yIUwAAAAAAAAeFUw/////8hVUzMzMzMz
MzhVMP/////IVVVVVVVVVVVVVTD/////yFVVVVVVVVVVVVUw/////8yIiIiIiIiIiIiIcP/////M
zMzMzMzMzMzMzMcAAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8D/8D/A//A/wMAAAADAAAAAwAAAAMA
AAADAAAAAwAAAAMDwMADA8DAAwPAwAMDwMAAAADAAAAAwAAAAMAAAADAAAAAwAAAAMD/A//A/wP/
wP8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAA==
';
my $print ='
Qk3mBAAAAAAAADYAAAAoAAAAFAAAABQAAAABABgAAAAAALAEAADECAAAxAgAAAAAAAAAAAAAuLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4ubm5uLi4uLi4uLi4qKioqKiorq6uuLi4uLi4uLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4ubm5ubm54dvbs7OzdHR0hYWFubOz1tbW4eHhqKiouLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4ubm5ubm5+Pj4/v7+4eHhubm5enp6Y11jY11jbm5ukZGRqKio
rq6uuLi4uLi4uLi4uLi4uLi4s66uubm58vLy/v7+8u3t1tbWubm5rq6us7OzqKiokZGRdHR0XWNj
Y11jnJycuLi4uLi4uLi4uLi4uLi4ubm57e3t7e3t0NDQv7+/ysTE1tDQv7+/s7Ozs66us7OzubOz
rq6ul5eXqKiouLi4uLi4uLi4uLi4uLi4s7OzxMTEv7+/xMTE1tbW4eHh8vLy8vLy5+fn1tbWxMTE
ubm5s66us7Ozrq6uuLi4uLi4uLi4uLi4uLi4s66uxMTE1tbW29vb1tbW5+fn29vbv8S/0NDQ29vb
4eHh4eHh1tbWysrKs7OzuLi4uLi4uLi4uLi4uLi4uLi4ubm529vb29vb5+fn1tbWysrKv+G/0NbQ
1r+/xL+/v7+/ysrK1tDQv7+/uLi4uLi4uLi4uLi4uLi4uLi4uLi4ubm50NDQxMTExMTE7e3t+PLy
6e/w6ezp////2uDhysrKs7OzuLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4ubm54eHh29vbubm5
0NDQ////////////1tbWxMTEuLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi41M3N/ufb
7dbQ7dbQ7dvW4uTh2uDhs7OzuLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi427m5
/ufb/tvQ/tbE/tC//sS5uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
27m5/ufb/tvQ/tbE/tC/+MSzuLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi427m5/ufb/tvQ/tbE/tC/+MS5uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi427m5/u3h/ufb/tvQ/tbE/tC/+MS5uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi4uLi427m527m527m527m5+MS5+MS5uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4uLi4
';
my $window = new Win32::GUI::Window (
-name => "Window",
-title => $tytul,
-pos => [ $left, $top ],
-size => [ $width, $height ],
-onResize => sub {
my ($self) = @_;
($width_obj,$height_obj) = ($self->GetClientRect())[2..3];
$self->Pole->Resize($width_obj, $height_obj-40) if exists
$self->{Pole};
},
-onKeyDown => \&keydown,
-onTerminate => sub { return -1 },
);
$window->ChangeIcon( newIcon Win32::GUI::BitmapInline( $sao_ico ));
my $prawa_font = new Win32::GUI::Font( -name=>'Comic Sans MS', -size=>7, );
my $prawa = $window->AddLabel(
-name => 'prawa',
-pos => [ 130, 4 ],
-popstyle => WS_CAPTION | WS_THICKFRAME | WS_BORDER,
-remexstyle => WS_EX_CLIENTEDGE,
-visible => 1,
-text => "This is STFViewer ver. 0.04. Waldemar Biernacki,
2007-2008. All rights reserved",
-foreground => 0x777777,
-font => $prawa_font,
);
my $Font_obj;
my $Text_obj;
pokaz_text();
sub pokaz_text {
$Font_obj = new Win32::GUI::Font( -name=>$font, -size=>$size, );
$Text_obj = $window->AddTextfield(
-name => "Pole",
-pos => [0,30],
-size => [$width-10,$height-80],
-readonly => 1,
-multiline => 1,
-hscroll => 1,
-vscroll => 1,
-autovscroll => 1,
-autohscroll => 1,
# -keepselection => 1,
-font => $Font_obj,
-background => 0xddffff,
-onKeyDown => \&keydown,
-flat => 0,
);
$window->Pole->Text($tekst);
}
my $windowprint = new Win32::GUI::BitmapInline( $print );
$window->AddButton(
-name => 'print',
-onClick => eval ( 'sub { druk(); }' ),
-tabstop => 1,
-bitmap => $windowprint,
-pos => [ 2, 2],
-size => [24,24],
-flat => 1,
);
$window->AddButton(
-name => 'plus',
-onClick => eval ( 'sub { plus(); }' ),
-tabstop => 1,
-text => '+',
-pos => [27, 2],
-size => [24,24],
-flat => 1,
);
$window->AddButton(
-name => 'minus',
-onClick => eval ( 'sub { minus(); }' ),
-tabstop => 1,
-text => '-',
-pos => [52, 2],
-size => [24,24],
-flat => 1,
);
$window->Pole->Select(0,0);
$window->Pole->ScrollCaret();
$window->Pole->SetFocus();
$window->Show();
Win32::GUI::Dialog();
$window->DESTROY;
exit 1;
##########################################################################
sub druk {
system( 'copy', $plik, $printer );
return 1;
}
#---------------------------------------------
sub plus {
$Font_obj->DESTROY;
$Text_obj->DESTROY;
my $new_size = int( 1.2 * $size );
if ( $new_size > $size ) { $size = $new_size } else { $size += 1 }
pokaz_text();
return 1;
}
#---------------------------------------------
sub minus {
if ( $size > 2 ) {
$Font_obj->DESTROY;
$Text_obj->DESTROY;
$size = int ($size/1.2);
pokaz_text();
}
return 1;
}
#---------------------------------------------
sub keydown {
my ( $self, undef, $key ) = @_;
exit (1) if $key == 27 or $key == 81;
druk() if $key == 120 or $key == 80;
return 0 unless $plik;
return 1;
}
#---------------------------------------------
__END__
inifile=
printer = 'LPT1'
font = 'Courier New'
size = 10
width = 800
height = 600
left = 0
top = 0
