###############################################################################
#
# Win32::GUI - Perl-Win32 Graphical User Interface Extension
#
# 29 Jan 1997 by Aldo Calpini <dada@perl.it>
#
# Version: 0.0.558 (15 Jan 2001)
#
# Copyright (c) 1997..2001 Aldo Calpini. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
###############################################################################
package Win32::GUI;
require Exporter; # to export the constants to the main:: space
require DynaLoader; # to dynuhlode the module.
# Reserves GUI in the main namespace for us (uhmmm...)
*GUI:: = \%Win32::GUI::;
###############################################################################
# STATIC OBJECT PROPERTIES
#
$VERSION = "0.0.558";
$MenuIdCounter = 1;
$TimerIdCounter = 1;
$NotifyIconIdCounter = 1;
%Menus = ();
%Accelerators = ();
$AcceleratorCounter = 9001;
%AcceleratorTable = ();
@ISA = qw( Exporter DynaLoader );
@EXPORT = qw(
BS_3STATE
BS_AUTO3STATE
BS_AUTOCHECKBOX
BS_AUTORADIOBUTTON
BS_CHECKBOX
BS_DEFPUSHBUTTON
BS_GROUPBOX
BS_LEFTTEXT
BS_NOTIFY
BS_OWNERDRAW
BS_PUSHBUTTON
BS_RADIOBUTTON
BS_USERBUTTON
BS_BITMAP
BS_BOTTOM
BS_CENTER
BS_ICON
BS_LEFT
BS_MULTILINE
BS_RIGHT
BS_RIGHTBUTTON
BS_TEXT
BS_TOP
BS_VCENTER
COLOR_3DFACE
COLOR_ACTIVEBORDER
COLOR_ACTIVECAPTION
COLOR_APPWORKSPACE
COLOR_BACKGROUND
COLOR_BTNFACE
COLOR_BTNSHADOW
COLOR_BTNTEXT
COLOR_CAPTIONTEXT
COLOR_GRAYTEXT
COLOR_HIGHLIGHT
COLOR_HIGHLIGHTTEXT
COLOR_INACTIVEBORDER
COLOR_INACTIVECAPTION
COLOR_MENU
COLOR_MENUTEXT
COLOR_SCROLLBAR
COLOR_WINDOW
COLOR_WINDOWFRAME
COLOR_WINDOWTEXT
DS_3DLOOK
DS_ABSALIGN
DS_CENTER
DS_CENTERMOUSE
DS_CONTEXTHELP
DS_CONTROL
DS_FIXEDSYS
DS_LOCALEDIT
DS_MODALFRAME
DS_NOFAILCREATE
DS_NOIDLEMSG
DS_RECURSE
DS_SETFONT
DS_SETFOREGROUND
DS_SYSMODAL
ES_AUTOHSCROLL
ES_AUTOVSCROLL
ES_CENTER
ES_LEFT
ES_LOWERCASE
ES_MULTILINE
ES_NOHIDESEL
ES_NUMBER
ES_OEMCONVERT
ES_PASSWORD
ES_READONLY
ES_RIGHT
ES_UPPERCASE
ES_WANTRETURN
GW_CHILD
GW_HWNDFIRST
GW_HWNDLAST
GW_HWNDNEXT
GW_HWNDPREV
GW_OWNER
IMAGE_BITMAP
IMAGE_CURSOR
IMAGE_ICON
LR_DEFAULTCOLOR
LR_MONOCHROME
LR_COLOR
LR_COPYRETURNORG
LR_COPYDELETEORG
LR_LOADFROMFILE
LR_LOADTRANSPARENT
LR_DEFAULTSIZE
LR_LOADMAP3DCOLORS
LR_CREATEDIBSECTION
LR_COPYFROMRESOURCE
LR_SHARED
MB_ABORTRETRYIGNORE
MB_OK
MB_OKCANCEL
MB_RETRYCANCEL
MB_YESNO
MB_YESNOCANCEL
MB_ICONEXCLAMATION
MB_ICONWARNING
MB_ICONINFORMATION
MB_ICONASTERISK
MB_ICONQUESTION
MB_ICONSTOP
MB_ICONERROR
MB_ICONHAND
MB_DEFBUTTON1
MB_DEFBUTTON2
MB_DEFBUTTON3
MB_DEFBUTTON4
MB_APPLMODAL
MB_SYSTEMMODAL
MB_TASKMODAL
MB_DEFAULT_DESKTOP_ONLY
MB_HELP
MB_RIGHT
MB_RTLREADING
MB_SETFOREGROUND
MB_TOPMOST
MB_SERVICE_NOTIFICATION
MB_SERVICE_NOTIFICATION_NT3X
MF_STRING
MF_POPUP
SM_ARRANGE
SM_CLEANBOOT
SM_CMOUSEBUTTONS
SM_CXBORDER
SM_CYBORDER
SM_CXCURSOR
SM_CYCURSOR
SM_CXDLGFRAME
SM_CYDLGFRAME
SM_CXDOUBLECLK
SM_CYDOUBLECLK
SM_CXDRAG
SM_CYDRAG
SM_CXEDGE
SM_CYEDGE
SM_CXFIXEDFRAME
SM_CYFIXEDFRAME
SM_CXFRAME
SM_CYFRAME
SM_CXFULLSCREEN
SM_CYFULLSCREEN
SM_CXHSCROLL
SM_CYHSCROLL
SM_CXHTHUMB
SM_CXICON
SM_CYICON
SM_CXICONSPACING
SM_CYICONSPACING
SM_CXMAXIMIZED
SM_CYMAXIMIZED
SM_CXMAXTRACK
SM_CYMAXTRACK
SM_CXMENUCHECK
SM_CYMENUCHECK
SM_CXMENUSIZE
SM_CYMENUSIZE
SM_CXMIN
SM_CYMIN
SM_CXMINIMIZED
SM_CYMINIMIZED
SM_CXMINSPACING
SM_CYMINSPACING
SM_CXMINTRACK
SM_CYMINTRACK
SM_CXSCREEN
SM_CYSCREEN
SM_CXSIZE
SM_CYSIZE
SM_CXSIZEFRAME
SM_CYSIZEFRAME
SM_CXSMICON
SM_CYSMICON
SM_CXSMSIZE
SM_CYSMSIZE
SM_CXVSCROLL
SM_CYVSCROLL
SM_CYCAPTION
SM_CYKANJIWINDOW
SM_CYMENU
SM_CYSMCAPTION
SM_CYVTHUMB
SM_DBCSENABLED
SM_DEBUG
SM_MENUDROPALIGNMENT
SM_MIDEASTENABLED
SM_MOUSEPRESENT
SM_MOUSEWHEELPRESENT
SM_NETWORK
SM_PENWINDOWS
SM_SECURE
SM_SHOWSOUNDS
SM_SLOWMACHINE
SM_SWAPBUTTON
WM_CREATE
WM_DESTROY
WM_MOVE
WM_SIZE
WM_ACTIVATE
WM_SETFOCUS
WM_KILLFOCUS
WM_ENABLE
WM_SETREDRAW
WM_COMMAND
WM_KEYDOWN
WM_SETCURSOR
WM_KEYUP
WS_BORDER
WS_CAPTION
WS_CHILD
WS_CHILDWINDOW
WS_CLIPCHILDREN
WS_CLIPSIBLINGS
WS_DISABLED
WS_DLGFRAME
WS_GROUP
WS_HSCROLL
WS_ICONIC
WS_MAXIMIZE
WS_MAXIMIZEBOX
WS_MINIMIZE
WS_MINIMIZEBOX
WS_OVERLAPPED
WS_OVERLAPPEDWINDOW
WS_POPUP
WS_POPUPWINDOW
WS_SIZEBOX
WS_SYSMENU
WS_TABSTOP
WS_THICKFRAME
WS_TILED
WS_TILEDWINDOW
WS_VISIBLE
WS_VSCROLL
WS_EX_ACCEPTFILES
WS_EX_APPWINDOW
WS_EX_CLIENTEDGE
WS_EX_CONTEXTHELP
WS_EX_CONTROLPARENT
WS_EX_DLGMODALFRAME
WS_EX_LEFT
WS_EX_LEFTSCROLLBAR
WS_EX_LTRREADING
WS_EX_MDICHILD
WS_EX_NOPARENTNOTIFY
WS_EX_OVERLAPPEDWINDOW
WS_EX_PALETTEWINDOW
WS_EX_RIGHT
WS_EX_RIGHTSCROLLBAR
WS_EX_RTLREADING
WS_EX_STATICEDGE
WS_EX_TOOLWINDOW
WS_EX_TOPMOST
WS_EX_TRANSPARENT
WS_EX_WINDOWEDGE
);
###############################################################################
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
#
sub AUTOLOAD {
my($constname);
($constname = $AUTOLOAD) =~ s/.*:://;
#reset $! to zero to reset any current errors.
$! = 0;
my $val = constant($constname, @_ ? $_[0] : 0);
if ($! != 0) {
if ($! =~ /Invalid/) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
} else {
my($pack,$file,$line) = caller; # undef $pack;
die "Can't find '$constname' in package '$pack' ".
"used at $file line $line.";
}
}
eval "sub $AUTOLOAD { $val }";
goto &$AUTOLOAD;
}
###############################################################################
# PUBLIC METHODS
# (@)PACKAGE:Win32::GUI
###########################################################################
# (@)METHOD:Version()
# Returns the module version number.
sub Version {
return $VERSION;
}
###########################################################################
# (@)METHOD:SetFont(FONT)
# Sets the font of the window (FONT is a Win32::GUI::Font object).
sub SetFont {
my($self, $font) = @_;
$font = $font->{-handle} if ref($font);
# 48 == WM_SETFONT
return Win32::GUI::SendMessage($self, 48, $font, 0);
}
###########################################################################
# (@)METHOD:GetFont(FONT)
# Gets the font of the window (returns an handle; use
# $Font = $W->GetFont();
# %details = Win32::GUI::Font::Info( $Font );
# to get font details).
sub GetFont {
my($self) = shift;
# 49 == WM_GETFONT
return Win32::GUI::SendMessage($self, 49, 0, 0);
}
###########################################################################
# (@)METHOD:SetIcon(ICON, [TYPE])
# Sets the icon of the window; TYPE can be 0 for the small icon, 1 for
# the big icon. Default is the same icon for small and big.
sub SetIcon {
my($self, $icon, $type) = @_;
$icon = $icon->{-handle} if ref($icon);
# 128 == WM_SETICON
if(defined($type)) {
return Win32::GUI::SendMessage($self, 128, $type, $icon);
} else {
Win32::GUI::SendMessage($self, 128, 0, $icon); # small icon
Win32::GUI::SendMessage($self, 128, 1, $icon); # big icon
}
}
###########################################################################
# (@)METHOD:SetRedraw(FLAG)
# Determines if a window is automatically redrawn when its content changes.
# FLAG can be a true value to allow redraw, false to prevent it.
sub SetRedraw {
my($self, $value) = @_;
# 11 == WM_SETREDRAW
my $r = Win32::GUI::SendMessage($self, 11, $value, 0);
return $r;
}
###########################################################################
# (@)INTERNAL:MakeMenu(...)
# better used as new Win32::GUI::Menu(...)
sub MakeMenu {
my(@menudata) = @_;
my $i;
my $M = new Win32::GUI::Menu();
my $text;
my %data;
my $level;
my %last;
my $parent;
for($i = 0; $i <= $#menudata; $i+=2) {
$text = $menudata[$i];
undef %data;
if(ref($menudata[$i+1])) {
%data = %{$menudata[$i+1]};
} else {
$data{-name} = $menudata[$i+1];
}
$level = 0;
$level++ while($text =~ s/^\s*>\s*//);
if($level == 0) {
$M->{$data{-name}} = $M->AddMenuButton(
-id => $MenuIdCounter++,
-text => $text,
%data,
);
$last{$level} = $data{-name};
$last{$level+1} = "";
} elsif($level == 1) {
$parent = $last{$level-1};
if($text eq "-") {
$data{-name} = "dummy$MenuIdCounter";
$M->{$data{-name}} = $M->{$parent}->AddMenuItem(
-item => 0,
-id => $MenuIdCounter++,
-separator => 1,
);
} else {
$M->{$data{-name}} = $M->{$parent}->AddMenuItem(
-item => 0,
-id => $MenuIdCounter++,
-text => $text,
%data,
);
}
$last{$level} = $data{-name};
$last{$level+1} = "";
} else {
$parent = $last{$level-1};
if(!$M->{$parent."_Submenu"}) {
$M->{$parent."_Submenu"} = new Win32::GUI::Menu();
$M->{$parent."_SubmenuButton"} =
$M->{$parent."_Submenu"}->AddMenuButton(
-id => $MenuIdCounter++,
-text => $parent,
-name => $parent."_SubmenuButton",
);
$M->{$parent}->Change(
-submenu => $M->{$parent."_SubmenuButton"}
);
}
if($text eq "-") {
$data{-name} = "dummy$MenuIdCounter";
$M->{$data{-name}} =
$M->{$parent."_SubmenuButton"}->AddMenuItem(
-item => 0,
-id => $MenuIdCounter++,
-separator => 1,
);
} else {
$M->{$data{-name}} =
$M->{$parent."_SubmenuButton"}->AddMenuItem(
-item => 0,
-id => $MenuIdCounter++,
-text => $text,
%data,
);
}
$last{$level} = $data{-name};
$last{$level+1} = "";
}
}
return $M;
}
###########################################################################
# (@)INTERNAL:_new(TYPE, %OPTIONS)
# This is the generalized constructor;
# it works pretty well for almost all controls.
# However, other kind of objects may overload it.
sub _new {
# this is always Win32::GUI (class of _new);
my $xclass = shift;
# the window type passed by new():
my $type = shift;
# this is the real class:
my $class = shift;
my $oself = {};
# bless($oself, $class);
my %tier = ();
tie %tier, $class, $oself;
my $self = bless \%tier, $class;
my (@input) = @_;
my $handle = Win32::GUI::Create($self, $type, @input);
# print "[_new] self='$self' oself='$oself'\n";
# print "[_new] handle = $handle\n";
# $self->{-handle} = $handle;
# print "[_new] enumerating self.keys\n";
# foreach my $k (keys %$self) {
# print "[_new] '$k' = '$self->{$k}'\n";
# }
if($handle) {
return $self;
} else {
return undef;
}
}
###############################################################################
# SUB-PACKAGES
#
###############################################################################
# (@)PACKAGE:Win32::GUI::Font
#
package Win32::GUI::Font;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::Font(%OPTIONS)
# Creates a new Font object. %OPTIONS are:
# -size
# -height
# -width
# -escapement
# -orientation
# -weight
# -bold => 0/1
# -italic => 0/1
# -underline => 0/1
# -strikeout => 0/1
# -charset
# -outputprecision
# -clipprecision
# -family
# -quality
# -name
# -face
sub new {
my $class = shift;
my $self = {};
my $handle = Create(@_);
if($handle) {
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Bitmap
#
package Win32::GUI::Bitmap;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::Bitmap(FILENAME, [TYPE, X, Y, FLAGS])
# Creates a new Bitmap object reading from FILENAME; all other arguments
# are optional. TYPE can be:
# 0 bitmap (this is the default)
# 1 icon
# 2 cursor
# You can eventually specify your desired size for the image with X and
# Y and pass some FLAGS to the underlying LoadImage API (at your own risk)
sub new {
my $class = shift;
my $self = {};
my $handle = Win32::GUI::LoadImage(@_);
if($handle) {
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Icon
#
package Win32::GUI::Icon;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::Icon(FILENAME)
# Creates a new Icon object reading from FILENAME.
sub new {
my $class = shift;
my $file = shift;
my $self = {};
my $handle = Win32::GUI::LoadImage(
$file,
Win32::GUI::constant("IMAGE_ICON", 0),
);
if($handle) {
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
###########################################################################
# (@)INTERNAL:DESTROY()
sub DESTROY {
my $self = shift;
Win32::GUI::DestroyIcon($self);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Cursor
#
package Win32::GUI::Cursor;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::Cursor(FILENAME)
# Creates a new Cursor object reading from FILENAME.
sub new {
my $class = shift;
my $file = shift;
my $self = {};
my $handle = Win32::GUI::LoadImage(
$file,
Win32::GUI::constant("IMAGE_CURSOR", 0),
);
if($handle) {
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
###########################################################################
# (@)INTERNAL:DESTROY()
sub DESTROY {
my $self = shift;
Win32::GUI::DestroyCursor($self);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Class
#
package Win32::GUI::Class;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD: new Win32::GUI::Class(%OPTIONS)
# Creates a new window class object.
# Allowed %OPTIONS are:
# -name => STRING
# the name for the class (it must be unique!).
# -icon => Win32::GUI::Icon object
# -cursor => Win32::GUI::Cursor object
# -color => COLOR or Win32::GUI::Brush object
# the window background color.
# -menu => STRING
# a menu name (not yet implemented).
# -extends => STRING
# name of the class to extend (aka subclassing).
# -widget => STRING
# name of a widget class to subclass; currently available are:
# Button, Listbox, TabStrip, RichEdit.
# -style => FLAGS
# use with caution!
sub new {
my $class = shift;
my %args = @_;
my $self = {};
$args{-color} =
Win32::GUI::constant("COLOR_WINDOW", 0)
unless exists($args{-color});
my $handle = Win32::GUI::RegisterClassEx(%args);
if($handle) {
$self->{-name} = $args{-name};
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Window
#
package Win32::GUI::Window;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Window(%OPTIONS)
# Creates a new Window object.
# Class specific %OPTIONS are:
# -minsize => [X, Y]
# specifies the minimum size (width and height) in pixels;
# X and Y must be passed in an array reference
# -maxsize => [X, Y]
# specifies the maximum size (width and height) in pixels;
# X and Y must be passed in an array reference
# -minwidth => N
# -minheight => N
# -maxwidht => N
# -maxheight => N
# specify the minimum and maximum size width
# and height, in pixels
# -topmost => 0/1 (default 0)
# the window "stays on top" even when deactivated
sub new {
my $self = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__WINDOW", 0), @_);
if($self) {
return $self;
} else {
return undef;
}
}
###########################################################################
# (@)METHOD:AddButton(%OPTIONS)
# See new Win32::GUI::Button().
sub AddButton { return Win32::GUI::Button->new(@_); }
###########################################################################
# (@)METHOD:AddLabel(%OPTIONS)
# See new Win32::GUI::Label().
sub AddLabel { return Win32::GUI::Label->new(@_); }
###########################################################################
# (@)METHOD:AddCheckbox(%OPTIONS)
# See new Win32::GUI::Checkbox().
sub AddCheckbox { return Win32::GUI::Checkbox->new(@_); }
###########################################################################
# (@)METHOD:AddRadioButton(%OPTIONS)
# See new Win32::GUI::RadioButton().
sub AddRadioButton { return Win32::GUI::RadioButton->new(@_); }
###########################################################################
# (@)METHOD:AddGroupbox(%OPTIONS)
# See new Win32::GUI::Groupbox().
sub AddGroupbox { return Win32::GUI::Groupbox->new(@_); }
###########################################################################
# (@)METHOD:AddTextfield(%OPTIONS)
# See new Win32::GUI::Textfield().
sub AddTextfield { return Win32::GUI::Textfield->new(@_); }
###########################################################################
# (@)METHOD:AddListbox(%OPTIONS)
# See new Win32::GUI::Listbox().
sub AddListbox { return Win32::GUI::Listbox->new(@_); }
###########################################################################
# (@)METHOD:AddCombobox(%OPTIONS)
# See new Win32::GUI::Combobox().
sub AddCombobox { return Win32::GUI::Combobox->new(@_); }
###########################################################################
# (@)METHOD:AddStatusBar(%OPTIONS)
# See new Win32::GUI::StatusBar().
sub AddStatusBar { return Win32::GUI::StatusBar->new(@_); }
###########################################################################
# (@)METHOD:AddProgressBar(%OPTIONS)
# See new Win32::GUI::ProgressBar().
sub AddProgressBar { return Win32::GUI::ProgressBar->new(@_); }
###########################################################################
# (@)METHOD:AddTabStrip(%OPTIONS)
# See new Win32::GUI::TabStrip().
sub AddTabStrip { return Win32::GUI::TabStrip->new(@_); }
###########################################################################
# (@)METHOD:AddToolbar(%OPTIONS)
# See new Win32::GUI::Toolbar().
sub AddToolbar { return Win32::GUI::Toolbar->new(@_); }
###########################################################################
# (@)METHOD:AddListView(%OPTIONS)
# See new Win32::GUI::ListView().
sub AddListView { return Win32::GUI::ListView->new(@_); }
###########################################################################
# (@)METHOD:AddTreeView(%OPTIONS)
# See new Win32::GUI::TreeView().
sub AddTreeView { return Win32::GUI::TreeView->new(@_); }
###########################################################################
# (@)METHOD:AddRichEdit(%OPTIONS)
# See new Win32::GUI::RichEdit().
sub AddRichEdit { return Win32::GUI::RichEdit->new(@_); }
###########################################################################
# (@)INTERNAL:AddTrackbar(%OPTIONS)
# Better used as AddSlider().
sub AddTrackbar { return Win32::GUI::Trackbar->new(@_); }
###########################################################################
# (@)METHOD:AddSlider(%OPTIONS)
# See new Win32::GUI::Slider().
sub AddSlider { return Win32::GUI::Slider->new(@_); }
###########################################################################
# (@)METHOD:AddUpDown(%OPTIONS)
# See new Win32::GUI::UpDown().
sub AddUpDown { return Win32::GUI::UpDown->new(@_); }
###########################################################################
# (@)METHOD:AddAnimation(%OPTIONS)
# See new Win32::GUI::Animation().
sub AddAnimation { return Win32::GUI::Animation->new(@_); }
###########################################################################
# (@)METHOD:AddRebar(%OPTIONS)
# See new Win32::GUI::Rebar().
sub AddRebar { return Win32::GUI::Rebar->new(@_); }
###########################################################################
# (@)METHOD:AddHeader(%OPTIONS)
# See new Win32::GUI::Header().
sub AddHeader { return Win32::GUI::Header->new(@_); }
###########################################################################
# (@)METHOD:AddCombobox(%OPTIONS)
# See new Win32::GUI::Combobox().
sub AddComboboxEx { return Win32::GUI::ComboboxEx->new(@_); }
###########################################################################
# (@)METHOD:AddSplitter(%OPTIONS)
# See new Win32::GUI::Splitter().
sub AddSplitter { return Win32::GUI::Splitter->new(@_); }
###########################################################################
# (@)METHOD:AddTimer(NAME, ELAPSE)
# See new Win32::GUI::Timer().
sub AddTimer { return Win32::GUI::Timer->new(@_); }
###########################################################################
# (@)METHOD:AddNotifyIcon(%OPTIONS)
# See new Win32::GUI::NotifyIcon().
sub AddNotifyIcon { return Win32::GUI::NotifyIcon->new(@_); }
###########################################################################
# (@)METHOD:AddMenu()
# See new Win32::GUI::Menu().
sub AddMenu {
my $self = shift;
my $menu = Win32::GUI::Menu->new();
my $r = Win32::GUI::SetMenu($self, $menu->{-handle});
# print "SetMenu=$r\n";
return $menu;
}
###########################################################################
# (@)METHOD:GetDC()
# Returns the DC object associated with the window.
sub GetDC {
my $self = shift;
return Win32::GUI::DC->new($self);
}
###########################################################################
# (@)INTERNAL:DESTROY(HANDLE)
sub DESTROY {
my $self = shift;
if(tied($self)) {
my $timer;
if( exists $self->{-timers} ) {
foreach $timer ($self->{-timers}) {
undef $self->{-timers}->{$timer};
}
}
}
# Win32::GUI::DestroyWindow($self);
}
###########################################################################
# (@)INTERNAL:AUTOLOAD(HANDLE, METHOD)
sub AUTOLOAD {
my($self, $method) = @_;
$AUTOLOAD =~ s/.*:://;
# print "Win32::GUI::Window::AUTOLOAD called for object '$self', method '$method', AUTOLOAD=$AUTOLOAD\n";
if( exists $self->{$AUTOLOAD}) {
return $self->{$AUTOLOAD};
} else {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::DialogBox
#
package Win32::GUI::DialogBox;
@ISA = qw(Win32::GUI::Window);
###########################################################################
# (@)METHOD:new Win32::GUI::DialogBox(%OPTIONS)
# Creates a new DialogBox object. See new Win32::GUI::Window().
sub new {
my $self = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__DIALOG", 0), @_);
if($self) {
$self->DialogUI(1);
return $self;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::MDI
#
package Win32::GUI::MDI;
@ISA = qw(
Win32::GUI::Window
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::MDI(%OPTIONS)
# Creates a new MDI (Multiple Document Interface) object.
# Class specific %OPTIONS are:
# -minsize => [X, Y]
# specifies the minimum size (width and height) in pixels;
# X and Y must be passed in an array reference
# -maxsize => [X, Y]
# specifies the maximum size (width and height) in pixels;
# X and Y must be passed in an array reference
# -minwidth => N
# -minheight => N
# -maxwidht => N
# -maxheight => N
# specify the minimum and maximum size width
# and height, in pixels
# -topmost => 0/1 (default 0)
# the window "stays on top" even when deactivated
sub new {
my $self = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__MDICLIENT", 0), @_);
if($self) {
return $self;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Button
#
package Win32::GUI::Button;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Button(PARENT, %OPTIONS)
# Creates a new Button object;
# can also be called as PARENT->AddButton(%OPTIONS).
# Class specific %OPTIONS are:
# -align => left/center/right (default left)
# -valign => top/center/bottom
#
# -default => 0/1 (default 0)
# -ok => 0/1 (default 0)
# -cancel => 0/1 (default 0)
# -bitmap => Win32::GUI::Bitmap object
# -picture => see -bitmap
# -icon => Win32::GUI::Icon object
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__BUTTON", 0), @_);
}
###########################################################################
# (@)METHOD:SetImage(BITMAP)
# Draws the specified BITMAP, a Win32::GUI::Bitmap or Win32::GUI::Icon
# object, in the Button.
sub SetImage {
my $self = shift;
my $image = shift;
my $type = Win32::GUI::constant("IMAGE_BITMAP", 0);
$type = Win32::GUI::constant("IMAGE_ICON", 0) if ref($image) =~ /Icon/;
$image = $image->{-handle} if ref($image);
# 247 == BM_SETIMAGE
return Win32::GUI::SendMessage($self, 247, $type, $image);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::RadioButton
#
package Win32::GUI::RadioButton;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::RadioButton(PARENT, %OPTIONS)
# Creates a new RadioButton object;
# can also be called as PARENT->AddRadioButton(%OPTIONS).
# %OPTIONS are the same of Button (see new Win32::GUI::Button() ).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__RADIOBUTTON", 0), @_);
}
###########################################################################
# (@)METHOD:Checked([VALUE])
# Gets or sets the checked state of the RadioButton; if called without
# arguments, returns the current state:
# 0 not checked
# 1 checked
# If a VALUE is specified, it can be one of these (eg. 0 to uncheck the
# RadioButton, 1 to check it).
sub Checked {
my $self = shift;
my $check = shift;
if(defined($check)) {
# 241 == BM_SETCHECK
return Win32::GUI::SendMessage($self, 241, $check, 0);
} else {
# 240 == BM_GETCHECK
return Win32::GUI::SendMessage($self, 240, 0, 0);
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Checkbox
#
package Win32::GUI::Checkbox;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Checkbox(PARENT, %OPTIONS)
# Creates a new Checkbox object;
# can also be called as PARENT->AddCheckbox(%OPTIONS).
# %OPTIONS are the same of Button (see new Win32::GUI::Button() ).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__CHECKBOX", 0), @_);
}
###########################################################################
# (@)METHOD:GetCheck()
# Returns the check state of the Checkbox:
# 0 not checked
# 1 checked
# 2 indeterminate (grayed)
sub GetCheck {
my $self = shift;
# 240 == BM_GETCHECK
return Win32::GUI::SendMessage($self, 240, 0, 0);
}
###########################################################################
# (@)METHOD:SetCheck([VALUE])
# Sets the check state of the Checkbox; for a list of possible values,
# see GetCheck().
# If called without arguments, it checks the Checkbox (eg. state = 1).
sub SetCheck {
my $self = shift;
my $check = shift;
$check = 1 unless defined($check);
# 241 == BM_SETCHECK
return Win32::GUI::SendMessage($self, 241, $check, 0);
}
###########################################################################
# (@)METHOD:Checked([VALUE])
# Gets or sets the check state of the Checkbox; if called without
# arguments, returns the current state:
# 0 not checked
# 1 checked
# 2 indeterminate (grayed)
# If a VALUE is specified, it can be one of these (eg. 0 to uncheck the
# Checkbox, 1 to check it).
sub Checked {
my $self = shift;
my $check = shift;
if(defined($check)) {
# 241 == BM_SETCHECK
return Win32::GUI::SendMessage($self, 241, $check, 0);
} else {
# 240 == BM_GETCHECK
return Win32::GUI::SendMessage($self, 240, 0, 0);
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Groupbox
#
package Win32::GUI::Groupbox;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Groupbox(PARENT, %OPTIONS)
# Creates a new Groupbox object;
# can also be called as PARENT->AddGroupbox(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__GROUPBOX", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Label
#
package Win32::GUI::Label;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Label(PARENT, %OPTIONS)
# Creates a new Label object;
# can also be called as PARENT->AddLabel(%OPTIONS).
# Class specific %OPTIONS are:
# -align => left/center/right (default left)
# -bitmap => Win32::GUI::Bitmap object
# -fill => black/gray/white/none (default none)
# fills the control rectangle ("black", "gray" and "white" are
# the window frame color, the desktop color and the window
# background color respectively).
# -frame => black/gray/white/etched/none (default none)
# draws a border around the control. colors are the same
# of -fill, with the addition of "etched" (a raised border).
# -icon => Win32::GUI::Icon object
# -noprefix => 0/1 (default 0)
# disables the interpretation of "&" as accelerator prefix.
# -notify => 0/1 (default 0)
# enables the Click(), DblClick, etc. events.
# -picture => see -bitmap
# -sunken => 0/1 (default 0)
# draws a half-sunken border around the control.
# -truncate => 0/1/word/path (default 0)
# specifies how the text is to be truncated:
# 0 the text is not truncated
# 1 the text is truncated at the end
# path the text is truncated before the last "\"
# (used to shorten paths).
# -wrap => 0/1 (default 1)
# the text wraps automatically to a new line.
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__STATIC", 0), @_);
}
###########################################################################
# (@)METHOD:SetImage(BITMAP)
# Draws the specified BITMAP, a Win32::GUI::Bitmap object, in the Label.
sub SetImage {
my $self = shift;
my $image = shift;
$image = $image->{-handle} if ref($image);
my $type = Win32::GUI::constant("IMAGE_BITMAP", 0);
# 370 == STM_SETIMAGE
return Win32::GUI::SendMessage($self, 370, $type, $image);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Textfield
#
package Win32::GUI::Textfield;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Textfield(PARENT, %OPTIONS)
# Creates a new Textfield object;
# can also be called as PARENT->AddTextfield(%OPTIONS).
# Class specific %OPTIONS are:
# -align => left/center/right (default left)
# aligns the text in the control accordingly.
# -keepselection => 0/1 (default 0)
# the selection is not hidden when the control loses focus.
# -multiline => 0/1 (default 0)
# the control can have more than one line (note that newline
# is "\r\n", not "\n"!).
# -password => 0/1 (default 0)
# masks the user input (like password prompts).
# -passwordchar => char (default '*')
# the char that is shown instead of the text with -password => 1.
# -prompt => (see below)
# -readonly => 0/1 (default 0)
# text can't be changed.
#
# The -prompt option is very special; if a string is passed, a
# Win32::GUI::Label object (with text set to the string passed) is created
# to the left of the Textfield.
# Example:
# $Window->AddTextfield(
# -name => "Username",
# -left => 75,
# -top => 150,
# -prompt => "Your name:",
# );
# Furthermore, the value to -prompt can be a reference to a list containing
# the string and an additional parameter, which sets the width for
# the Label (eg. [ STRING, WIDTH ] ). If WIDTH is negative, it is calculated
# relative to the Textfield left coordinate. Example:
#
# -left => 75, (Label left) (Textfield left)
# -prompt => [ "Your name:", 30 ], 75 105 (75+30)
#
# -left => 75,
# -prompt => [ "Your name:", -30 ], 45 (75-30) 75
#
# Note that the Win32::GUI::Label object is named like the Textfield, with
# a "_Prompt" suffix (in the example above, the Label is named
# "Username_Prompt").
sub new {
my($class, $parent, %options) = @_;
if(exists $options{-prompt}) {
my $add = 0;
my ($text, $left, $width, $height, );
my $visible = 1;
if(ref($options{-prompt}) eq "ARRAY") {
$left = pop(@{$options{'-prompt'}});
$text = pop(@{$options{'-prompt'}});
if($left < 0) {
$left = $options{-left} + $left;
$width = -$left;
} else {
$width = $left;
$left = $options{-left};
$add = $width;
}
} else {
$text = $options{-prompt};
$add = -1;
}
if(exists $options{-height}) {
$height = $options{-height}-3;
} else {
$height = 0;
}
if(exists $options{-visible}) {
$visible = $options{-visible};
}
my $prompt = new Win32::GUI::Label(
$parent,
-name => $options{-name} . '_Prompt',
-width => $width,
-left => $left,
-top => $options{-top} + 3,
-text => $text,
-height => $height,
-visible => $visible,
);
$add = $prompt->Width if $add == -1;
$options{-left} += $add;
}
return Win32::GUI->_new(
Win32::GUI::constant("WIN32__GUI__EDIT", 0),
$class, $parent, %options,
);
}
###########################################################################
# (@)METHOD:Select(START, END)
# Selects the specified range of characters.
sub Select {
my($self, $wparam, $lparam) = @_;
# 177 == EM_SETSEL
return Win32::GUI::SendMessage($self, 177, $wparam, $lparam);
}
###########################################################################
# (@)METHOD:SelectAll()
sub SelectAll {
my($self, $wparam, $lparam) = @_;
# 177 == EM_SETSEL
# 14 == WM_GETTEXTLENGTH
return Win32::GUI::SendMessage(
$self, 177,
0, Win32::GUI::SendMessage($self, 14, 0, 0),
);
}
###########################################################################
# (@)METHOD:MaxLength([CHARS])
sub MaxLength {
my($self, $chars) = @_;
if(defined $chars) {
# 197 == EM_SETLIMITTEXT
return Win32::GUI::SendMessage($self, 197, $chars, 0);
} else {
# 213 == EM_GETLIMITTEXT
return Win32::GUI::SendMessage($self, 213, 0, 0);
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Listbox
#
package Win32::GUI::Listbox;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Listbox(PARENT, %OPTIONS)
# Creates a new Listbox object;
# can also be called as PARENT->AddListbox(%OPTIONS).
# Class specific %OPTIONS are:
# -multisel => 0/1/2 (default 0)
# specifies the selection type:
# 0 single selection
# 1 multiple selection
# 2 multiple selection ehnanced (with Shift, Control, etc.)
# -sort => 0/1 (default 0)
# items are sorted alphabetically.
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__LISTBOX", 0), @_);
}
###########################################################################
# (@)METHOD:SelectedItem()
sub SelectedItem {
my $self = shift;
# 392 == LB_GETCURSEL
return Win32::GUI::SendMessage($self, 392, 0, 0);
}
###########################################################################
# (@)METHOD:ListIndex()
sub ListIndex { SelectedItem(@_); }
###########################################################################
# (@)METHOD:Select(INDEX)
# Selects the zero-based INDEX item in the Listbox.
sub Select {
my $self = shift;
my $item = shift;
# 390 == LB_SETCURSEL
my $r = Win32::GUI::SendMessage($self, 390, $item, 0);
return $r;
}
###########################################################################
# (@)METHOD:Reset()
sub Reset {
my $self = shift;
# 388 == LB_RESETCONTENT
my $r = Win32::GUI::SendMessage($self, 388, 0, 0);
return $r;
}
###########################################################################
# (@)METHOD:Clear()
sub Clear { Reset(@_); }
###########################################################################
# (@)METHOD:RemoveItem(INDEX)
# Removes the zero-based INDEX item from the Listbox.
sub RemoveItem {
my $self = shift;
my $item = shift;
# 386 == LB_DELETESTRING
my $r = Win32::GUI::SendMessage($self, 386, $item, 0);
return $r;
}
###########################################################################
# (@)METHOD:Count()
# Returns the number of items in the Listbox.
sub Count {
my $self = shift;
# 395 == LB_GETCOUNT
my $r = Win32::GUI::SendMessage($self, 395, 0, 0);
return $r;
}
sub List {
my $self = shift;
my $index = shift;
if(not defined $index) {
my @list = ();
for my $i (0..($self->Count-1)) {
push @list, Win32::GUI::Listbox::Item->new($self, $i);
}
return @list;
} else {
return Win32::GUI::Listbox::Item->new($self, $index);
}
}
sub Item { &List; }
###############################################################################
# (@)PACKAGE:Win32::GUI::Listbox::Item
#
package Win32::GUI::Listbox::Item;
sub new {
my($class, $listbox, $index) = @_;
$self = {
-parent => $listbox,
-index => $index,
-string => $listbox->GetString($index),
};
return bless $self, $class;
}
sub Remove {
my($self) = @_;
$self->{-parent}->RemoveItem($self->{-index});
undef $_[0];
}
sub Select {
my($self) = @_;
$self->{-parent}->Select($self->{-index});
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Combobox
#
package Win32::GUI::Combobox;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Combobox(PARENT, %OPTIONS)
# Creates a new Combobox object;
# can also be called as PARENT->AddCombobox(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__COMBOBOX", 0), @_);
}
###########################################################################
# (@)METHOD:SelectedItem()
# Returns the zero-based index of the currently selected item, or -1 if
# no item is selected.
sub SelectedItem {
my $self = shift;
# 327 == CB_GETCURSEL
return Win32::GUI::SendMessage($self, 327, 0, 0);
}
###########################################################################
# (@)METHOD:ListIndex()
# See SelectedItem().
sub ListIndex { SelectedItem(@_); }
###########################################################################
# (@)METHOD:Select(INDEX)
# Selects the zero-based INDEX item in the Combobox.
sub Select {
my $self = shift;
my $item = shift;
# 334 == CB_SETCURSEL
my $r = Win32::GUI::SendMessage($self, 334, $item, 0);
return $r;
}
###########################################################################
# (@)METHOD:Reset()
sub Reset {
my $self = shift;
# 331 == CB_RESETCONTENT
my $r = Win32::GUI::SendMessage($self, 331, 0, 0);
return $r;
}
###########################################################################
# (@)METHOD:Clear()
sub Clear { Reset(@_); }
###########################################################################
# (@)METHOD:RemoveItem(INDEX)
# Removes the zero-based INDEX item from the Combobox.
sub RemoveItem {
my $self = shift;
my $item = shift;
# 324 == CB_DELETESTRING
my $r = Win32::GUI::SendMessage($self, 324, $item, 0);
return $r;
}
###########################################################################
# (@)METHOD:Count()
sub Count {
my $self = shift;
# 326 == CB_GETCOUNT
my $r = Win32::GUI::SendMessage($self, 326, 0, 0);
return $r;
}
###############################################################################
# (@)PACKAGE:Win32::GUI::ProgressBar
#
package Win32::GUI::ProgressBar;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::ProgressBar(PARENT, %OPTIONS)
# Creates a new ProgressBar object;
# can also be called as PARENT->AddProgressBar(%OPTIONS).
# Class specific %OPTIONS are:
# -smooth => 0/1 (default 0)
# uses a smooth bar instead of the default segmented bar.
# -vertical => 0/1 (default 0)
# display progress status vertically (from bottom to top).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__PROGRESS", 0), @_);
}
###########################################################################
# (@)METHOD:SetPos(VALUE)
# Sets the position of the ProgressBar to the specified VALUE.
sub SetPos {
my $self = shift;
my $pos = shift;
# 1026 == PBM_SETPOS
return Win32::GUI::SendMessage($self, 1026, $pos, 0);
}
###########################################################################
# (@)METHOD:StepIt()
# Increments the position of the ProgressBar of the defined step value;
# see SetStep().
sub StepIt {
my $self = shift;
# 1029 == PBM_STEPIT
return Win32::GUI::SendMessage($self, 1029, 0, 0);
}
###########################################################################
# (@)METHOD:SetRange([MIN], MAX)
sub SetRange {
my $self = shift;
my ($min, $max) = @_;
$max = $min, $min = 0 unless defined($max);
# 1025 == PBM_SETRANGE
# return Win32::GUI::SendMessage($self, 1025, 0, ($max + $min >> 8));
return Win32::GUI::SendMessage($self, 1025, 0, ($min | $max << 16));
}
###########################################################################
# (@)METHOD:SetStep([VALUE])
# Sets the increment value for the ProgressBar; see StepIt().
sub SetStep {
my $self = shift;
my $step = shift;
$step = 10 unless $step;
# 1028 == PBM_SETSTEP
return Win32::GUI::SendMessage($self, 1028, $step, 0);
}
# TODO 4.71: Color, BackColor
###############################################################################
# (@)PACKAGE:Win32::GUI::StatusBar
#
package Win32::GUI::StatusBar;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::StatusBar(PARENT, %OPTIONS)
# Creates a new StatusBar object;
# can also be called as PARENT->AddStatusBar(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__STATUS", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::TabStrip
#
package Win32::GUI::TabStrip;
@ISA = qw(
Win32::GUI::Window
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::TabStrip(PARENT, %OPTIONS)
# Creates a new TabStrip object;
# can also be called as PARENT->AddTabStrip(%OPTIONS).
# Class specific %OPTIONS are:
# -bottom => 0/1 (default 0)
# -buttons => 0/1 (default 0)
# -hottrack => 0/1 (default 0)
# -imagelist => Win32::GUI::ImageList object
# -justify => 0/1 (default 0)
# -multiline => 0/1 (default 0)
# -right => 0/1 (default 0)
# -vertical => 0/1 (default 0)
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TAB", 0), @_);
}
###########################################################################
# (@)METHOD:SelectedItem()
# Returns the zero-based index of the currently selected item.
sub SelectedItem {
my $self = shift;
# 4875 == TCM_GETCURSEL
return Win32::GUI::SendMessage($self, 4875, 0, 0);
}
###########################################################################
# (@)METHOD:Select(INDEX)
# Selects the zero-based INDEX item in the TabStrip.
sub Select {
my $self = shift;
# 4876 == TCM_SETCURSEL
return Win32::GUI::SendMessage($self, 4876, shift, 0);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Toolbar
#
package Win32::GUI::Toolbar;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Toolbar(PARENT, %OPTIONS)
# Creates a new Toolbar object;
# can also be called as PARENT->AddToolbar(%OPTIONS).
# Class specific %OPTIONS are:
# -flat => 0/1
# -imagelist => IMAGELIST
# -multiline => 0/1
# -nodivider => 0/1
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TOOLBAR", 0), @_);
}
###########################################################################
# (@)METHOD:SetBitmapSize([X, Y])
sub SetBitmapSize {
my $self = shift;
my ($x, $y) = @_;
$x = 16 unless defined($x);
$y = 15 unless defined($y);
# 1056 == TB_SETBITMAPSIZE
return Win32::GUI::SendMessage($self, 1056, 0, ($x | $y << 16));
}
###############################################################################
# (@)PACKAGE:Win32::GUI::RichEdit
#
package Win32::GUI::RichEdit;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::RichEdit(PARENT, %OPTIONS)
# Creates a new RichEdit object;
# can also be called as PARENT->AddRichEdit(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__RICHEDIT", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::ListView
#
package Win32::GUI::ListView;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::ListView(PARENT, %OPTIONS)
# Creates a new ListView object;
# can also be called as PARENT->AddListView(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__LISTVIEW", 0), @_);
}
sub Item {
my($self, $index) = @_;
return Win32::GUI::ListView::Item->new($self, $index);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::ListView::Item
#
package Win32::GUI::ListView::Item;
sub new {
my($class, $listview, $index) = @_;
my $self = {
-parent => $listview,
-index => $index,
};
return bless $self, $class;
}
sub SubItem {
my($self, $index) = @_;
return Win32::GUI::ListView::SubItem->new($self, $index);
}
sub Remove {
my($self) = @_;
$self->{-parent}->DeleteItem($self->{-index});
undef $_[0];
}
sub Select {
my($self) = @_;
$self->{-parent}->Select($self->{-index});
}
sub Text {
my($self, $text) = @_;
if(not defined $text) {
my %data = $self->{-parent}->ItemInfo($self->{-index});
return $data{-text};
} else {
return $self->{-parent}->ChangeItem(
-item => $self->{-index},
-text => $text,
);
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::ListView::SubItem
#
package Win32::GUI::ListView::SubItem;
sub new {
my($class, $parent, $index) = @_;
my $self = {
-parent => $parent->{-parent},
-index => $parent->{-index},
-subindex => $index,
};
return bless $self, $class;
}
sub Text {
my($self, $text) = @_;
if(not defined $text) {
my %data = $self->{-parent}->ItemInfo(
$self->{-index},
$self->{-subindex},
);
return $data{-text};
} else {
return $self->{-parent}->ChangeItem(
-item => $self->{-index},
-subitem => $self->{-subindex},
-text => $text,
);
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::TreeView
#
package Win32::GUI::TreeView;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::TreeView(PARENT, %OPTIONS)
# Creates a new TreeView object
# can also be called as PARENT->AddTreeView(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TREEVIEW", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Slider
# also Trackbar
#
package Win32::GUI::Trackbar;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Slider(PARENT, %OPTIONS)
# Creates a new Slider object;
# can also be called as PARENT->AddSlider(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TRACKBAR", 0), @_);
}
sub SetRange {
}
sub Min {
my $self = shift;
my $value = shift;
if(defined($value)) {
my $flag = shift;
$flag = 1 unless defined($flag);
# 1031 == TBM_SETRANGEMIN
return Win32::GUI::SendMessage($self, 1031, $flag, $value);
} else {
# 1025 == TBM_GETRANGEMIN
return Win32::GUI::SendMessage($self, 1025, 0, 0);
}
}
sub Max {
my $self = shift;
my $value = shift;
if(defined($value)) {
my $flag = shift;
$flag = 1 unless defined($flag);
# 1032 == TBM_SETRANGEMAX
return Win32::GUI::SendMessage($self, 1032, $flag, $value);
} else {
# 1026 == TBM_GETRANGEMAX
return Win32::GUI::SendMessage($self, 1026, 0, 0);
}
}
sub Pos {
my $self = shift;
my $value = shift;
if(defined($value)) {
my $flag = shift;
$flag = 1 unless defined($flag);
# 1029 == TBM_SETPOS
return Win32::GUI::SendMessage($self, 1029, $flag, $value);
} else {
# 1024 == TBM_GETPOS
return Win32::GUI::SendMessage($self, 1024, 0, 0);
}
}
sub TicFrequency {
my $self = shift;
my $value = shift;
# 1044 == TBM_SETTICFREQ
return Win32::GUI::SendMessage($self, 1044, $value, 0);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Slider
#
package Win32::GUI::Slider;
@ISA = qw(Win32::GUI::Trackbar);
###############################################################################
# (@)PACKAGE:Win32::GUI::UpDown
#
package Win32::GUI::UpDown;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::UpDown(PARENT, %OPTIONS)
# Creates a new UpDown object;
# can also be called as PARENT->AddUpDown(%OPTIONS).
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__UPDOWN", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Tooltip
#
package Win32::GUI::Tooltip;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Tooltip(PARENT, %OPTIONS)
# (preliminary) creates a new Tooltip object
sub new {
my $parent = $_[0];
my $new = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TOOLTIP", 0), @_);
if($new) {
if($parent->{-tooltips}) {
push(@{$parent->{-tooltips}}, $new->{-handle});
} else {
$parent->{-tooltips} = [ $new->{-handle} ];
}
}
return $new;
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Animation
#
package Win32::GUI::Animation;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Animation(PARENT, %OPTIONS)
# Creates a new Animation object;
# can also be called as PARENT->AddAnimation(%OPTIONS).
# Class specific %OPTIONS are:
# -autoplay => 0/1 (default 0)
# starts playing the animation as soon as an AVI clip is loaded
# -center => 0/1 (default 0)
# centers the animation in the control window
# -transparent => 0/1 (default 0)
# draws the animation using a transparent background
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__ANIMATION", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Rebar
#
package Win32::GUI::Rebar;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Rebar(PARENT, %OPTIONS)
# Creates a new Rebar object;
# can also be called as PARENT->AddRebar(%OPTIONS).
# Class specific %OPTIONS are:
# -bandborders => 0/1 (default 0)
# display a border to separate bands.
# -fixedorder => 0/1 (default 0)
# band position cannot be swapped.
# -imagelist => Win32::GUI::ImageList object
# -varheight => 0/1 (default 1)
# display bands using the minimum required height.
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__REBAR", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Header
#
package Win32::GUI::Header;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Header(PARENT, %OPTIONS)
# Creates a new Header object;
# can also be called as PARENT->AddHeader(%OPTIONS).
# Class specific %OPTIONS are:
# -buttons => 0/1 (default 0)
# header items look like push buttons and can be clicked.
# -hottrack => 0/1 (default 0)
# -imagelist => Win32::GUI::ImageList object
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__HEADER", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Splitter
#
package Win32::GUI::Splitter;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Splitter(PARENT, %OPTIONS)
# Creates a new Splitter object;
# can also be called as PARENT->AddHeader(%OPTIONS).
# Class specific %OPTIONS are:
# -buttons => 0/1 (default 0)
# header items look like push buttons and can be clicked.
# -hottrack => 0/1 (default 0)
# -imagelist => Win32::GUI::ImageList object
sub new {
my $new = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__SPLITTER", 0), @_);
if($new) {
$new->{-tracking} = 0;
return $new;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::ComboboxEx
#
package Win32::GUI::ComboboxEx;
@ISA = qw(
Win32::GUI::Combobox
);
###########################################################################
# (@)METHOD:new Win32::GUI::ComboboxEx(PARENT, %OPTIONS)
# Creates a new ComboboxEx object;
# can also be called as PARENT->AddComboboxEx(%OPTIONS).
# Class specific %OPTIONS are:
# -imagelist => Win32::GUI::ImageList object
# Except for images, a ComboboxEx object acts like a Win32::GUI::Combobox
# object. See also new Win32::GUI::Combobox().
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__COMBOBOXEX", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::DateTime
#
package Win32::GUI::DateTime;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::DateTime(PARENT, %OPTIONS)
# Creates a new DateTime object;
# can also be called as PARENT->AddDateTime(%OPTIONS).
# Class specific %OPTIONS are:
# [TBD]
sub new {
return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__DTPICK", 0), @_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Graphic
#
package Win32::GUI::Graphic;
@ISA = qw(
Win32::GUI
Win32::GUI::WindowProps
);
###########################################################################
# (@)METHOD:new Win32::GUI::Graphic(PARENT, %OPTIONS)
# Creates a new Graphic object;
# can also be called as PARENT->AddGraphic(%OPTIONS).
# Class specific %OPTIONS are:
sub new {
my $class = shift;
my $self = {};
bless($self, $class);
my(@input) = @_;
my $handle = Win32::GUI::Create($self, 101, @input);
if($handle) {
return $self;
} else {
return undef;
}
}
###########################################################################
# (@)METHOD:GetDC()
# Returns the DC object associated with the window.
sub GetDC {
my $self = shift;
return Win32::GUI::DC->new($self);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::ImageList
#
package Win32::GUI::ImageList;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::ImageList(X, Y, FLAGS, INITAL, GROW)
# Creates an ImageList object; X and Y specify the size of the images,
# FLAGS [TBD]. INITIAL and GROW specify the number of images the ImageList
# actually contains (INITIAL) and the number of images for which memory
# is allocated (GROW).
sub new {
my $class = shift;
my $handle = Win32::GUI::ImageList::Create(@_);
if($handle) {
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
###########################################################################
# (@)METHOD:Add(BITMAP, [BITMAPMASK])
# Adds a bitmap to the ImageList; both BITMAP and BITMAPMASK can be either
# Win32::GUI::Bitmap objects or filenames.
sub Add {
my($self, $bitmap, $bitmapMask) = @_;
$bitmap = new Win32::GUI::Bitmap($bitmap) unless ref($bitmap);
if(defined($bitmapMask)) {
$bitmapMask = new Win32::GUI::Bitmap($bitmapMask) unless ref($bitmapMask);
$self->AddBitmap($bitmap, $bitmapMask);
} else {
$self->AddBitmap($bitmap);
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Menu
#
package Win32::GUI::Menu;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::Menu(...)
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $self={};
if($#_ > 0) {
return Win32::GUI::MakeMenu(@_);
} else {
my $handle = Win32::GUI::CreateMenu();
if($handle) {
$self->{-handle} = $handle;
bless($self, $class);
return $self;
} else {
return undef;
}
}
}
###########################################################################
# (@)METHOD:AddMenuButton()
# see new Win32::GUI::MenuButton()
sub AddMenuButton {
return Win32::GUI::MenuButton->new(@_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::MenuButton
#
package Win32::GUI::MenuButton;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::MenuButton()
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $menu = shift;
$menu = $menu->{-handle} if ref($menu);
# print "new MenuButton: menu=$menu\n";
my %args = @_;
my $self = {};
my $handle = Win32::GUI::CreatePopupMenu();
if($handle) {
$args{-submenu} = $handle;
Win32::GUI::MenuButton::InsertMenuItem($menu, %args);
$self->{-handle} = $handle;
bless($self, $class);
if($args{-name}) {
$Win32::GUI::Menus{$args{-id}} = $self;
$self->{-name} = $args{-name};
}
return $self;
} else {
return undef;
}
}
###########################################################################
# (@)METHOD:AddMenuItem()
# see new Win32::GUI::MenuItem()
sub AddMenuItem {
return Win32::GUI::MenuItem->new(@_);
}
###############################################################################
# (@)PACKAGE:Win32::GUI::MenuItem
#
package Win32::GUI::MenuItem;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::MenuItem()
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $menu = shift;
return undef unless ref($menu) =~ /^Win32::GUI::Menu/;
my %args = @_;
my $self = {};
my $handle = Win32::GUI::MenuButton::InsertMenuItem($menu, %args);
if($handle) {
$self->{-handle} = $handle;
$Win32::GUI::menucallbacks{$args{-id}} = $args{-function} if $args{-function};
$self->{-id} = $args{-id};
$self->{-menu} = $menu->{-handle};
bless($self, $class);
if($args{-name}) {
$Win32::GUI::Menus{$args{-id}} = $self;
$self->{-name} = $args{-name};
}
return $self;
} else {
return undef;
}
}
###############################################################################
# (@)PACKAGE: Win32::GUI::Timer
#
package Win32::GUI::Timer;
@ISA = qw(Win32::GUI);
###########################################################################
# (@)METHOD:new Win32::GUI::Timer(PARENT, NAME, ELAPSE)
# Creates a new timer in the PARENT window named NAME that will
# trigger its Timer() event after ELAPSE milliseconds.
# Can also be called as PARENT->AddTimer(NAME, ELAPSE).
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $window = shift;
my $name = shift;
my $elapse = shift;
my %args = @_;
my $id = $Win32::GUI::TimerIdCounter;
$Win32::GUI::TimerIdCounter++;
Win32::GUI::SetTimer($window, $id, $elapse);
my $self = {};
bless($self, $class);
# add $self->{name}
$self->{-id} = $id;
$self->{-name} = $name;
$self->{-parent} = $window;
$self->{-handle} = $window->{-handle};
$self->{-interval} = $elapse;
# add to $window->timers->{$id} = $self;
$window->{-timers}->{$id} = $self;
$window->{$name} = $self;
return $self;
}
###########################################################################
# (@)METHOD:Interval(ELAPSE)
sub Interval {
my $self = shift;
my $interval = shift;
if(defined $interval) {
Win32::GUI::SetTimer($self->{-parent}->{-handle}, $self->{-id}, $interval);
$self->{-interval} = $interval;
} else {
return $self->{-interval};
}
}
###########################################################################
# (@)METHOD:Kill()
sub Kill {
my $self = shift;
Win32::GUI::KillTimer($self->{-parent}->{-handle}, $self->{-id});
}
###########################################################################
# (@)INTERNAL:DESTROY(HANDLE)
sub DESTROY {
my $self = shift;
Win32::GUI::KillTimer($self->{-handle}, $self->{-id});
undef $self->{-parent}->{-timers}->{$self->{-id}};
}
###############################################################################
# (@)PACKAGE:Win32::GUI::NotifyIcon
#
package Win32::GUI::NotifyIcon;
###########################################################################
# (@)METHOD:new Win32::GUI::NotifyIcon(PARENT, %OPTIONS)
# Creates a new NotifyIcon (also known as system tray icon) object;
# can also be called as PARENT->AddNotifyIcon(%OPTIONS).
# %OPTIONS are:
# -icon => Win32::GUI::Icon object
# -id => NUMBER
# a unique identifier for the NotifyIcon object
# -name => STRING
# the name for the object
# -tip => STRING
# the text that will appear as tooltip when the mouse is
# on the NotifyIcon
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $window = shift;
my %args = @_;
$Win32::GUI::NotifyIconIdCounter++;
if(!exists($args{-id})) {
$args{-id} = $Win32::GUI::NotifyIconIdCounter;
}
Win32::GUI::NotifyIcon::Add($window, %args);
my $self = {};
bless($self, $class);
$self->{-id} = $args{-id};
$self->{-name} = $args{-name};
$self->{-parent} = $window;
$self->{-handle} = $window->{-handle};
$window->{-notifyicons}->{$args{-id}} = $self;
$window->{$args{-name}} = $self;
return $self;
}
###########################################################################
# (@)INTERNAL:DESTROY(OBJECT)
sub DESTROY {
my($self) = @_;
Win32::GUI::NotifyIcon::Delete(
$self->{-parent},
-id => $self->{-id},
);
undef $self->{-parent}->{$self->{-name}};
}
###############################################################################
# (@)PACKAGE:Win32::GUI::DC
#
package Win32::GUI::DC;
###########################################################################
# (@)METHOD:new Win32::GUI::DC(WINDOW | DRIVER, DEVICE)
# Creates a new DC object; the first form (WINDOW is a Win32::GUI object)
# gets the DC for the specified window (can also be called as
# WINDOW->GetDC). The second form creates a DC for the specified DEVICE;
# actually, the only supported DRIVER is the display driver (eg. the
# screen). To get the DC for the entire screen use:
# $Screen = new Win32::GUI::DC("DISPLAY");
#
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $self = {};
bless($self, $class);
my $window = shift;
if(defined($window)) {
if(ref($window)) {
$self->{-handle} = GetDC($window->{-handle});
$self->{-window} = $window->{-handle};
} else {
my $device = shift;
$self->{-handle} = CreateDC($window, $device);
}
} else {
$self = CreateDC("DISPLAY", 0);
}
return $self;
}
sub DESTROY {
my $self = shift;
if($self->{-window}) {
ReleaseDC($self->{-window}, $self->{-handle});
} else {
DeleteDC($self->{-handle});
}
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Pen
#
package Win32::GUI::Pen;
###########################################################################
# (@)METHOD:new Win32::GUI::Pen(COLOR | %OPTIONS)
# Creates a new Pen object.
# Allowed %OPTIONS are:
# -style =>
# 0 PS_SOLID
# 1 PS_DASH
# 2 PS_DOT
# 3 PS_DASHDOT
# 4 PS_DASHDOTDOT
# 5 PS_NULL
# 6 PS_INSIDEFRAME
# -width => number
# -color => COLOR
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $self = {};
bless($self, $class);
$self->{-handle} = Create(@_);
return $self;
}
###############################################################################
# (@)PACKAGE:Win32::GUI::Brush
#
package Win32::GUI::Brush;
###########################################################################
# (@)METHOD:new Win32::GUI::Brush(COLOR | %OPTIONS)
# Creates a new Brush object.
# Allowed %OPTIONS are:
# -style =>
# 0 BS_SOLID
# 1 BS_NULL
# 2 BS_HATCHED
# 3 BS_PATTERN
# -pattern => Win32::GUI::Bitmap object (valid for -style => BS_PATTERN)
# -hatch => (valid for -style => BS_HATCHED)
# 0 HS_ORIZONTAL (-----)
# 1 HS_VERTICAL (|||||)
# 2 HS_FDIAGONAL (\\\\\)
# 3 HS_BDIAGONAL (/////)
# 4 HS_CROSS (+++++)
# 5 HS_DIAGCROSS (xxxxx)
# -color => COLOR
sub new {
my $class = shift;
$class = "Win32::" . $class if $class =~ /^GUI::/;
my $self = {};
bless($self, $class);
$self->{-handle} = Create(@_);
return $self;
}
###############################################################################
# (@)PACKAGE:Win32::GUI::AcceleratorTable
# an accelerator table
#
package Win32::GUI::AcceleratorTable;
###########################################################################
# (@)METHOD:new Win32::GUI::AcceleratorTable(%ACCELERATORS)
# Creates an AcceleratorTable object.
# %ACCELERATORS is an associative array of key combinations and
# accelerator names, in pair:
# Example:
# $A = new Win32::GUI::AcceleratorTable(
# "Ctrl-X" => "Close",
# "Shift-N" => "New",
# "Ctrl-Alt-Del" => "Reboot",
# );
# The AcceleratorTable object can be associated to a window
# with the -accel option; then, when an accelerator is used, a
# corresponding <name>_Click event is fired.
# Keyboard combinations currently support the following modifier :
# Shift
# Ctrl (or Control)
# Alt
# and the following keys:
# A..Z, 0..9
# Left, Right, Up, Down
# Home, End, PageUp, PageDown (or PgUp/PgDn)
# Space, Ins, Del, Esc, Backspace, Tab, Return
# F1..F12
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;
}
}
sub DESTROY {
print "DESTROYING AcceleratorTable $self->{-handle}\n";
Win32::GUI::DestroyAcceleratorTable($self->{-handle});
}
###############################################################################
# (@)INTERNAL:Win32::GUI::WindowProps
# the package to tie to a window hash to set/get properties in a more
# fashionable way...
#
package Win32::GUI::WindowProps;
my %TwoWayMethodMap = (
-text => "Text",
-left => "Left",
-top => "Top",
-width => "Width",
-height => "Height",
-dialogui => "DialogUI",
);
my %OneWayMethodMap = (
-scalewidth => "ScaleHeight",
-scaleheight => "ScaleWidth",
);
###########################################################################
# (@)INTERNAL:TIEHASH
sub TIEHASH {
my($class, $object) = @_;
# my $tied = { UNDERLYING => $object };
# print "[TIEHASH] called for '$class' '$object'\n";
# return bless $tied, $class;
return bless $object, $class;
}
###########################################################################
# (@)INTERNAL:STORE
sub STORE {
my($self, $key, $value) = @_;
# print "[STORE] called for '$self' {$key}='$value'\n";
if(exists $TwoWayMethodMap{$key}) {
if(my $method = $self->can($TwoWayMethodMap{$key})) {
# print "[STORE] calling method '$TwoWayMethodMap{$key}' on '$self'\n";
return &{$method}($self, $value);
} else {
# print "[STORE] PROBLEM: method '$TwoWayMethodMap{$key}' not found on '$self'\n";
}
} elsif($key eq "-style") {
# print "[STORE] calling GetWindowLong\n";
return Win32::GUI::GetWindowLong($self, -16, $value);
} else {
# print "[STORE] storing key '$key' in '$self'\n";
# return $self->{UNDERLYING}->{$key} = $value;
return $self->{$key} = $value;
}
}
###########################################################################
# (@)INTERNAL:FETCH
sub FETCH {
my($self, $key) = @_;
if($key eq "UNDERLYING") {
# print "[FETCH] returning UNDERLYING for '$self'\n";
return $self->{UNDERLYING};
} elsif(exists $TwoWayMethodMap{$key}) {
# if(my $method = $self->{UNDERLYING}->can($TwoWayMethodMap{$key})) {
if(my $method = $self->can($TwoWayMethodMap{$key})) {
# print "[FETCH] calling method $TwoWayMethodMap{$key} on $self->{UNDERLYING}\n";
# print "[FETCH] calling method '$TwoWayMethodMap{$key}' on '$self'\n";
# return &{$method}($self->{UNDERLYING});
return &{$method}($self);
} else {
# print "[FETCH] method not found '$TwoWayMethodMap{$key}'\n";
return undef;
}
} elsif($key eq "-style") {
return Win32::GUI::GetWindowLong($self->{UNDERLYING}, -16);
#} elsif(exists $self->{UNDERLYING}->{$key}) {
# print "[FETCH] fetching key $key from $self->{UNDERLYING}\n";
# return $self->{UNDERLYING}->{$key};
} elsif(exists $self->{$key}) {
# print "[FETCH] fetching key '$key' from '$self'\n";
return $self->{$key};
} else {
# print "Win32::GUI::WindowProps::FETCH returning nothing for '$key' on $self->{UNDERLYING}\n";
# print "[FETCH] returning nothing for '$key' on '$self'\n";
return undef;
# return 0;
}
}
sub FIRSTKEY {
my $self = shift;
my $a = keys %{ $self };
my ($k, $v) = each %{ $self };
# print "[FIRSTKEY] k='$k' v='$v'\n";
return $k;
}
sub NEXTKEY {
my $self = shift;
my ($k, $v) = each %{ $self };
# print "[NEXTKEY] k='$k' v='$v'\n";
return $k;
}
sub EXISTS {
my($self, $key) = @_;
# return exists $self->{UNDERLYING}->{$key};
return exists $self->{$key};
}
###############################################################################
# dynamically load in the GUI.dll module.
#
package Win32::GUI;
bootstrap Win32::GUI;
# Preloaded methods go here.
$Win32::GUI::StandardWinClass = Win32::GUI::Class->new(
-name => "PerlWin32GUI_STD_OBSOLETED"
);
$Win32::GUI::StandardWinClassVisual = Win32::GUI::Class->new(
-name => "PerlWin32GUI_STD",
-visual => 1,
);
$Win32::GUI::GraphicWinClass = Win32::GUI::Class->new(
-name => "Win32::GUI::Graphic",
-widget => "Graphic",
);
$Win32::GUI::InteractiveGraphicWinClass = Win32::GUI::Class->new(
-name => "Win32::GUI::InteractiveGraphic",
-widget => "InteractiveGraphic",
);
$Win32::GUI::SplitterHorizontal = Win32::GUI::Class->new(
-name => "Win32::GUI::Splitter(horizontal)",
-widget => "SplitterH",
);
$Win32::GUI::SplitterVertical = Win32::GUI::Class->new(
-name => "Win32::GUI::Splitter(vertical)",
-widget => "Splitter",
);
$Win32::GUI::RICHED = Win32::GUI::LoadLibrary("RICHED32");
END {
# print "Freeing library RICHED32\n";
Win32::GUI::FreeLibrary($Win32::GUI::RICHED);
}
#Currently Autoloading is not implemented in Perl for win32
# Autoload methods go after __END__, and are processed by the autosplit program.
1;
__END__