Perl 在WX帧上平铺位图
我想使用wxPerl在具有平铺位图的帧上设置背景。 在一个例子的帮助下,我想出了下面的代码。 不幸的是,它没有做任何事情,框架仍然是空白的。 这是正确的方法,还是有其他方法Perl 在WX帧上平铺位图,perl,wxwidgets,wxperl,Perl,Wxwidgets,Wxperl,我想使用wxPerl在具有平铺位图的帧上设置背景。 在一个例子的帮助下,我想出了下面的代码。 不幸的是,它没有做任何事情,框架仍然是空白的。 这是正确的方法,还是有其他方法 use warnings; use strict; package MyFrame; use Wx qw(:everything); use base qw( Wx::Frame ); sub new { my ( $class, $path ) = @_; my $self = $cla
use warnings;
use strict;
package MyFrame;
use Wx qw(:everything);
use base qw( Wx::Frame );
sub new {
my ( $class, $path ) = @_;
my $self
= $class->SUPER::new( undef, -1, 'Test', [ -1, -1 ], [ 600, 400 ], );
$self->set_tiling_background($path);
return $self;
}
sub set_tiling_background {
my ( $self, $path ) = @_;
## Create a wxBitmap from the file
my $file = IO::File->new($path);
binmode $file;
my $handler = Wx::BMPHandler->new();
my $image = Wx::Image->new();
$handler->LoadFile( $image, $file );
my $bitmap = Wx::Bitmap->new($image);
## Just to check that the bitmap is good.
$bitmap->SaveFile('saved.bmp', wxBITMAP_TYPE_BMP);
## Draw the bitmap tiling over the frame
## https://github.com/wxWidgets/wxWidgets/blob/master/src/html/htmlwin.cpp
my $dc = Wx::WindowDC->new($self);
my $size_x = $bitmap->GetWidth;
my $size_y = $bitmap->GetHeight;
for ( my $x = 0; $x < 600; $x += $size_x ) {
for ( my $y = 0; $y < 400; $y += $size_y ) {
$dc->DrawBitmap( $bitmap, $x, $y, 0 );
}
}
}
package MyApp;
use base 'Wx::App';
my $path = '/path/to/bitmap.bmp';
sub OnInit {
my ($self) = @_;
my $frame = MyFrame->new($path);
$frame->Show(1);
}
package main;
MyApp->new->MainLoop;
下面是使用ERASE_后台事件处理程序的示例:
package MyFrame;
use Wx qw(:everything wxBITMAP_TYPE_JPEG);
use base qw( Wx::Frame );
use feature qw(say);
use strict;
use warnings;
use Wx::Event;
sub new {
my ( $class, $path ) = @_;
my $self
= $class->SUPER::new( undef, -1, 'Test', [ -1, -1 ], [ 600, 400 ], );
my $bitmap = Wx::Bitmap->new( $path , wxBITMAP_TYPE_JPEG );
Wx::Event::EVT_ERASE_BACKGROUND( $self, sub { $self->setBgImage( $bitmap, @_) });
return $self;
}
sub setBgImage {
my ( $self, $bitmap, $frame, $evt ) = @_;
return if !defined $evt;
my $dc = $evt->GetDC();
my $size_x = $bitmap->GetWidth;
my $size_y = $bitmap->GetHeight;
for ( my $x = 0; $x < 600; $x += $size_x ) {
for ( my $y = 0; $y < 400; $y += $size_y ) {
$dc->DrawBitmap( $bitmap, $x, $y, 0 );
}
}
}
package MyApp;
use base 'Wx::App';
my $path = 'logo.jpg';
sub OnInit {
my ($self) = @_;
my $frame = MyFrame->new($path);
$frame->Show(1);
}
package main;
MyApp->new->MainLoop;
这为我提供了Ubuntu 20.04的以下输出:
另请参见:以下是使用ERASE_后台事件处理程序的示例:
package MyFrame;
use Wx qw(:everything wxBITMAP_TYPE_JPEG);
use base qw( Wx::Frame );
use feature qw(say);
use strict;
use warnings;
use Wx::Event;
sub new {
my ( $class, $path ) = @_;
my $self
= $class->SUPER::new( undef, -1, 'Test', [ -1, -1 ], [ 600, 400 ], );
my $bitmap = Wx::Bitmap->new( $path , wxBITMAP_TYPE_JPEG );
Wx::Event::EVT_ERASE_BACKGROUND( $self, sub { $self->setBgImage( $bitmap, @_) });
return $self;
}
sub setBgImage {
my ( $self, $bitmap, $frame, $evt ) = @_;
return if !defined $evt;
my $dc = $evt->GetDC();
my $size_x = $bitmap->GetWidth;
my $size_y = $bitmap->GetHeight;
for ( my $x = 0; $x < 600; $x += $size_x ) {
for ( my $y = 0; $y < 400; $y += $size_y ) {
$dc->DrawBitmap( $bitmap, $x, $y, 0 );
}
}
}
package MyApp;
use base 'Wx::App';
my $path = 'logo.jpg';
sub OnInit {
my ($self) = @_;
my $frame = MyFrame->new($path);
$frame->Show(1);
}
package main;
MyApp->new->MainLoop;
这为我提供了Ubuntu 20.04的以下输出:
另请参见:公认的答案已经解释了如何正确执行此操作,但我还想解释一下您最初做错了什么:您不能只在WindowDC上绘制一次,而希望完成任何事情。任何持久绘制都必须在EVT_PAINT handler中的PaintDC上完成,或者作为一种特殊的例外情况,在提供给EVT_BACKGROUND_ERASE handler的DC上完成。如果设置EVT_PAINT handler调用原始的set_tiling_背景并使用其中的PaintDC,它也会起作用
事实上,在现代平台GTK3、macOS上,你根本不能使用WindowDC或ClientDC,在它们上面画画根本不起作用。公认的答案已经解释了如何正确地做到这一点,但我也想解释一下你最初做错了什么:你不能在WindowDC上画画一次,希望完成任何事情。任何持久绘制都必须在EVT_PAINT handler中的PaintDC上完成,或者作为一种特殊的例外情况,在提供给EVT_BACKGROUND_ERASE handler的DC上完成。如果设置EVT_PAINT handler调用原始的set_tiling_背景并使用其中的PaintDC,它也会起作用 事实上,在现代平台GTK3、macOS上,您根本不能使用WindowDC或ClientDC,在它们上绘图根本不起作用