summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm60
1 files changed, 60 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm
new file mode 100755
index 00000000000..8c24160951d
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm
@@ -0,0 +1,60 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/IconFile.pm $ $Author: autrijus $
+# $Revision: #9 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::IconFile;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+ Magic => 'a2',
+ Type => 'v',
+ Count => 'v',
+ 'Resource::Icon' => [ 'a16', '{$Count}', 1 ],
+ Data => 'a*',
+);
+use constant DEFAULT_ARGS => (
+ Magic => "\0\0",
+ Type => 1,
+ Count => 0,
+ Data => '',
+);
+use constant DISPATCH_FIELD => 'Magic';
+use constant DISPATCH_TABLE => (
+ "\0\0" => '',
+ "MZ" => '__BASE__',
+ '*' => sub { die "Invalid icon file header: $_[1]" },
+);
+
+sub icons {
+ my $self = shift;
+ $self->members(@_);
+}
+
+sub set_icons {
+ my ($self, $icons) = @_;
+ $self->SetCount(scalar @$icons);
+ $self->set_members('Resource::Icon' => $icons);
+ $self->refresh;
+
+ foreach my $idx (0 .. $#{$icons}) {
+ $self->icons->[$idx]->SetImageOffset(length($self->dump));
+ $self->SetData( $self->Data . $icons->[$idx]->Data );
+ }
+
+ $self->refresh;
+}
+
+sub dump_iconfile {
+ my $self = shift;
+ my @icons = $self->icons;
+ my $obj = $self->require_class('IconFile')->new;
+ $obj->set_icons(\@icons);
+ return $obj->dump;
+}
+
+sub write_iconfile {
+ my ($self, $filename) = @_;
+ $self->write_file($filename, $self->dump_iconfile);
+}
+
+1;