PC World 2005 June

home *** CD-ROM | disk | FTP | other *** search

/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / GUI.pm < prev next >

Wrap

Text File | 2004-01-12 | 98KB | 3,048 lines

############################################################################### # # Win32::GUI - Perl-Win32 Graphical User Interface Extension # # 29 Jan 1997 by Aldo Calpini <dada@perl.it> # # Version: 0.0.665 (27 Feb 2002) # # Copyright (c) 1997..2002 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. # # $Id: GUI.pm,v 1.5 2003/12/28 07:17:42 caelum Exp $ # ############################################################################### package Win32::GUI; eval { require Win32 }; 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.670"; $MenuIdCounter = 1; $TimerIdCounter = 1; $NotifyIconIdCounter = 1; %Menus = (); %Accelerators = (); $AcceleratorCounter = 9001; @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 DTS_UPDOWN DTS_SHOWNONE DTS_SHORTDATEFORMAT DTS_LONGDATEFORMAT DTS_TIMEFORMAT DTS_APPCANPARSE DTS_RIGHTALIGN 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 TPM_LEFTBUTTON TPM_RIGHTBUTTON TPM_LEFTALIGN TPM_CENTERALIGN TPM_RIGHTALIGN TPM_TOPALIGN TPM_VCENTERALIGN TPM_BOTTOMALIGN TPM_HORIZONTAL TPM_VERTICAL TPM_NONOTIFY TPM_RETURNCMD TPM_RECURSE ); ############################################################################### # 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; } sub bootstrap_subpackage { my($package) = @_; $package = 'Win32::GUI::' . $package; my $symbol = $package; $symbol =~ s/\W/_/g; no strict 'refs'; DynaLoader::dl_install_xsub( "${package}::bootstrap", DynaLoader::dl_find_symbol_anywhere( "boot_$symbol" ) ); &{ "${package}::bootstrap" }; } ############################################################################### # 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*//); # print "PM(MakeMenu) processing '$data{-name}', level=$level\n"; 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, -name => $data{-name}, ); } 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, -name => $data{-name}, ); } 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) = @_; # print "PM(Win32::GUI::_new) self='$self' type='$type' input='@input'\n"; my $handle = Win32::GUI::Create($self, $type, @input); # $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 = {}; # figure out the correct background color # (to avoid the "white background" syndrome on XP) if(not exists $args{-color}) { my($undef, $major, $minor) = Win32::GetOSVersion(); if($major == 5 && $minor > 0) { $args{-color} = Win32::GUI::constant("COLOR_BTNFACE", 0)+1; } else { $args{-color} = Win32::GUI::constant("COLOR_WINDOW", 0); } } 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:AddComboboxEx(%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:AddDateTime(%OPTIONS) # See new Win32::GUI::DateTime(). sub AddDateTime { return Win32::GUI::DateTime->new(@_); } ########################################################################### # (@)METHOD:AddGraphic(%OPTIONS) # See new Win32::GUI::Graphic(). sub AddGraphic { return Win32::GUI::Graphic->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) = @_; my %options = @options; if(exists $options{-prompt}) { my $add = 0; my ($text, $left, $width, $height, ); my $visible = 1; # Convert -pos and -size options to -left, -top, -width and -height options if (exists $options{-pos}) { $options{-left} = $options{-pos}[0]; $options{-top} = $options{-pos}[1]; } if (exists $options{-size}) { $options{-width} = $options{-size}[0]; $options{-height} = $options{-size}[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; # Update array options for (my $i = 0; $i < @options; $i += 2) { if ($options[$i] eq '-left') { $options[$i+1] = $options{-left}; last; } if ($options[$i] eq '-pos') { $options[$i+1][0] = $options{-left}; last; } } } 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) = @_; ($min, $max) = (0, $min) unless defined($max); # 1030 == PBM_SETRANGE32 # return Win32::GUI::SendMessage($self, 1030, 0, ($max + $min >> 8)); return Win32::GUI::SendMessage($self, 1030, $min, $max); } ########################################################################### # (@)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); } ########################################################################### # (@)METHOD:DisplayArea() sub DisplayArea { my $self = shift; my ($left,$top,$right,$bottom) = $self->AdjustRect($self->GetClientRect()); return ($left, $top, $right - $left, $bottom - $top); } ############################################################################### # (@)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 = $_[1]; 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: # -align => 'right'/'left' (default 'left') # The drop-down month calendar alignement. # -format => 'shortdate', 'longdate', 'time' # Control format type (Use local format date/time). # -shownone => 0/1 (default 0) # Allow no datetime (add a prefix checkbox). # -updown => 0/1 (default 0 for date, 1 for time format) # Use updown control instead of the drop-down month calendar. 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 $self = {}; 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; # print "PM(MenuButton::new) calling InsertMenuItem with menu=$menu, args=", join(", ", %args), "\n"; Win32::GUI::MenuButton::InsertMenuItem($menu, %args); # print "PM(MenuButton::new) back from InsertMenuItem\n"; $self->{-handle} = $handle; bless($self, $class); $Win32::GUI::Menus{ $args{-id} } = $handle; #if($args{-name}) { # $Win32::GUI::Menus{$args{-id}} = $self; # $self->{-name} = $args{-name}; #} # print "PM(MenuButton::new) returning self=$self\n"; 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 = {}; # print "PM(MenuItem::new) calling InsertMenuItem with menu=$menu, args=", join(", ", %args), "\n"; my $handle = Win32::GUI::MenuButton::InsertMenuItem($menu, %args); # print "PM(MenuItem::new) back from InsertMenuItem\n"; 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); $Win32::GUI::Menus{ $args{-id} } = $menu->{-handle}; #if($args{-name}) { # $Win32::GUI::Menus{$args{-id}} = $self; # $self->{-name} = $args{-name}; #} # print "PM(MenuItem::new) returning self=$self\n"; 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) = @_; if ( defined $self && defined $self->{-parent} && defined $self->{-id} && defined $self->{-parent}->{$self->{-name}} ) { 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 { my $class = shift; $class = "Win32::" . $class if $class =~ /^GUI::/; my($k, $v); my $flag = 0; my $key = 0; my %accels = @_; while( ($k, $v) = each %accels) { $flag = 0x0001; if($k =~ s/shift[-\+]//i) { $flag |= 0x0004; } if($k =~ s/(ctrl|control)[-\+]//i) { $flag |= 0x0008; } if($k =~ s/alt[-\+]//i) { $flag |= 0x0010; } # { $key = 0x01; } # VK_LBUTTON # { $key = 0x02; } # VK_RBUTTON # { $key = 0x03; } # VK_CANCEL # { $key = 0x04; } # VK_MBUTTON if($k =~ /^backspace$/i) { $key = 0x08; } # VK_BACK elsif($k =~ /^tab$/i) { $key = 0x09; } # VK_TAB # elsif($k =~ /^clear$/i) { $key = 0x0c; } # VK_CLEAR elsif($k =~ /^return$/i) { $key = 0x0d; } # VK_RETURN # { $key = 0x10; } # VK_SHIFT # { $key = 0x11; } # VK_CONTROL # { $key = 0x12; } # VK_MENU /ALT elsif($k =~ /^pause$/i) { $key = 0x13; } # VK_PAUSE elsif($k =~ /^capslock$/i) { $key = 0x14; } # VK_CAPITAL elsif($k =~ /^(esc|escape)$/i) { $key = 0x1b; } # VK_ESCAPE elsif($k =~ /^space$/i) { $key = 0x20; } # VK_SPACE elsif($k =~ /^(pgup|pageup)$/i) { $key = 0x21; } # VK_PRIOR elsif($k =~ /^(pgdn|pagedn|pagedown)$/i) { $key = 0x22; } # VK_NEXT elsif($k =~ /^end$/i) { $key = 0x23; } # VK_END elsif($k =~ /^home$/i) { $key = 0x24; } # VK_HOME elsif($k =~ /^left$/i) { $key = 0x25; } # VK_LEFT elsif($k =~ /^up$/i) { $key = 0x26; } # VK_UP elsif($k =~ /^right$/i) { $key = 0x27; } # VK_RIGHT elsif($k =~ /^down$/i) { $key = 0x28; } # VK_DOWN # elsif($k =~ /^select$/i) { $key = 0x29; } # VK_SELECT # elsif($k =~ /^print$/i) { $key = 0x2a; } # VK_PRINT # elsif($k =~ /^execute$/i) { $key = 0x2b; } # VK_EXECUTE elsif($k =~ /^(prntscrn|printscreen)$/i) { $key = 0x2c; } # VK_SNAPSHOT elsif($k =~ /^ins$/i) { $key = 0x2d; } # VK_INSERT elsif($k =~ /^del$/i) { $key = 0x2e; } # VK_DELETE # elsif($k =~ /^help$/i) { $key = 0x2f; } # VK_HELP elsif($k =~ /^[0-9a-z]$/i) { $key = ord(uc($k)); } # 0x30-0x39: ASCII 0-9 # 0x41-0x5a: ASCII A-Z elsif($k =~ /^left(win|windows)$/i) { $key = 0x5b; } # VK_LWIN elsif($k =~ /^right(win|windows)$/i) { $key = 0x5c; } # VK_RWIN elsif($k =~ /^(app|application)$/i) { $key = 0x5d; } # VK_APPS # elsif($k =~ /^sleep$/i) { $key = 0x5e; } # VK_SLEEP elsif($k =~ /^(num|numeric|keypad)0$/i) { $key = 0x60; } # VK_NUMPAD0 elsif($k =~ /^(num|numeric|keypad)1$/i) { $key = 0x61; } # VK_NUMPAD1 elsif($k =~ /^(num|numeric|keypad)2$/i) { $key = 0x62; } # VK_NUMPAD2 elsif($k =~ /^(num|numeric|keypad)3$/i) { $key = 0x63; } # VK_NUMPAD3 elsif($k =~ /^(num|numeric|keypad)4$/i) { $key = 0x64; } # VK_NUMPAD4 elsif($k =~ /^(num|numeric|keypad)5$/i) { $key = 0x65; } # VK_NUMPAD5 elsif($k =~ /^(num|numeric|keypad)6$/i) { $key = 0x66; } # VK_NUMPAD6 elsif($k =~ /^(num|numeric|keypad)7$/i) { $key = 0x67; } # VK_NUMPAD7 elsif($k =~ /^(num|numeric|keypad)8$/i) { $key = 0x68; } # VK_NUMPAD8 elsif($k =~ /^(num|numeric|keypad)9$/i) { $key = 0x69; } # VK_NUMPAD9 elsif($k =~ /^multiply$/i) { $key = 0x6a; } # VK_MULTIPLY elsif($k =~ /^add$/i) { $key = 0x6b; } # VK_ADD # elsif($k =~ /^separator$/i) { $key = 0x6c; } # VK_SEPARATOR elsif($k =~ /^subtract$/i) { $key = 0x6d; } # VK_SUBTRACT elsif($k =~ /^decimal$/i) { $key = 0x6e; } # VK_DECIMAL elsif($k =~ /^divide$/i) { $key = 0x6f; } # VK_DIVIDE elsif($k =~ /^f1$/i) { $key = 0x70; } # VK_F1 elsif($k =~ /^f2$/i) { $key = 0x71; } # VK_F2 elsif($k =~ /^f3$/i) { $key = 0x72; } # VK_F3 elsif($k =~ /^f4$/i) { $key = 0x73; } # VK_F4 elsif($k =~ /^f5$/i) { $key = 0x74; } # VK_F5 elsif($k =~ /^f6$/i) { $key = 0x75; } # VK_F6 elsif($k =~ /^f7$/i) { $key = 0x76; } # VK_F7 elsif($k =~ /^f8$/i) { $key = 0x77; } # VK_F8 elsif($k =~ /^f9$/i) { $key = 0x78; } # VK_F9 elsif($k =~ /^f10$/i) { $key = 0x79; } # VK_F10 elsif($k =~ /^f11$/i) { $key = 0x7a; } # VK_F11 elsif($k =~ /^f12$/i) { $key = 0x7b; } # VK_F12 # elsif($k =~ /^f13$/i) { $key = 0x7c; } # VK_F13 # elsif($k =~ /^f14$/i) { $key = 0x7d; } # VK_F14 # elsif($k =~ /^f15$/i) { $key = 0x7e; } # VK_F15 # elsif($k =~ /^f16$/i) { $key = 0x7f; } # VK_F16 # elsif($k =~ /^f17$/i) { $key = 0x80; } # VK_F17 # elsif($k =~ /^f18$/i) { $key = 0x81; } # VK_F18 # elsif($k =~ /^f19$/i) { $key = 0x82; } # VK_F19 # elsif($k =~ /^f20$/i) { $key = 0x83; } # VK_F20 # elsif($k =~ /^f21$/i) { $key = 0x84; } # VK_F21 # elsif($k =~ /^f22$/i) { $key = 0x85; } # VK_F22 # elsif($k =~ /^f23$/i) { $key = 0x86; } # VK_F23 # elsif($k =~ /^f24$/i) { $key = 0x87; } # VK_F24 elsif($k =~ /^numlock$/i) { $key = 0x90; } # VK_NUMLOCK elsif($k =~ /^scrolllock$/i) { $key = 0x91; } # VK_SCROLL # { $key = 0xa0; } # VK_LSHIFT # { $key = 0xa1; } # VK_RSHIFT # { $key = 0xa2; } # VK_LCONTROL # { $key = 0xa3; } # VK_RCONTROL # { $key = 0xa4; } # VK_LMENU # { $key = 0xa5; } # VK_RMENU # elsif($k =~ /^browserback$/i) { $key = 0xa6; } # VK_BROWSER_BACK # elsif($k =~ /^browserforward$/i) { $key = 0xa7; } # VK_BROWSER_FORWARD # elsif($k =~ /^browserrefresh$/i) { $key = 0xa8; } # VK_BROWSER_REFRESH # elsif($k =~ /^browserstop$/i) { $key = 0xa9; } # VK_BROWSER_STOP # elsif($k =~ /^browsersearch$/i) { $key = 0xaa; } # VK_BROWSER_SEARCH # elsif($k =~ /^browserfavorites$/i) { $key = 0xab; } # VK_BROWSER_FAVORITES # elsif($k =~ /^browserhome$/i) { $key = 0xac; } # VK_BROWSER_HOME # elsif($k =~ /^volumemute$/i) { $key = 0xad; } # VK_VOLUME_MUTE # elsif($k =~ /^volumedown$/i) { $key = 0xae; } # VK_VOLUME_UP # elsif($k =~ /^volumenup$/i) { $key = 0xaf; } # VK_VOLUME_DOWN # elsif($k =~ /^medianexttrack$/i) { $key = 0xb0; } # VK_MEDIA_NEXT_TRACK # elsif($k =~ /^mediaprevtrack$/i) { $key = 0xb1; } # VK_MEDIA_PREV_TRACK # elsif($k =~ /^mediastop$/i) { $key = 0xb2; } # VK_MEDIA_STOP # elsif($k =~ /^mediaplaypause$/i) { $key = 0xb3; } # VK_MEDIA_PLAY_PAUSE # elsif($k =~ /^launchmail$/i) { $key = 0xb4; } # VK_LAUNCH_MAIL # elsif($k =~ /^launchmediaselect$/i) { $key = 0xb5; } # VK_LAUNCH_MEDIA_SELECT # elsif($k =~ /^launchapp1$/i) { $key = 0xb6; } # VK_LAUNCH_APP1 # elsif($k =~ /^launchapp2$/i) { $key = 0xb7; } # VK_LAUNCH_APP2 elsif($k =~ /^semicolon$/i) { $key = 0xba; } # VK_OEM_1 elsif($k =~ /^(plus|equal)$/i) { $key = 0xbb; } # VK_OEM_PLUS elsif($k =~ /^(comma|lessthan)$/i) { $key = 0xbc; } # VK_OEM_COMMA elsif($k =~ /^(minus|underscore)$/i) { $key = 0xbd; } # VK_OEM_MINUS elsif($k =~ /^(period|greaterthan)$/i) { $key = 0xbe; } # VK_OEM_PERIOD elsif($k =~ /^(slash|question)$/i) { $key = 0xbf; } # VK_OEM_2 elsif($k =~ /^(acute|tilde)$/i) { $key = 0xc0; } # VK_OEM_3 elsif($k =~ /^(left|open)brac(e|ket)$/i) { $key = 0xdb; } # VK_OEM_4 elsif($k =~ /^(backslash|verticalbar)$/i) { $key = 0xdc; } # VK_OEM_5 elsif($k =~ /^(right|close)brac(e|ket)$/i) { $key = 0xdd; } # VK_OEM_6 elsif($k =~ /^(single|double|)quote$/i) { $key = 0xde; } # VK_OEM_7 # elsif($k =~ /^unknown$/i) { $key = 0xdf; } # VK_OEM_8 # elsif($k =~ /^process$/i) { $key = 0xe5; } # VK_PROCESSKEY elsif($k =~ /^(attn|attention)$/i) { $key = 0xf6; } # VK_ATTN elsif($k =~ /^crsel$/i) { $key = 0xf7; } # VK_CRSEL elsif($k =~ /^exsel$/i) { $key = 0xf8; } # VK_EXSEL elsif($k =~ /^(ereof|eraseeof)$/i) { $key = 0xf9; } # VK_EREOF elsif($k =~ /^play$/i) { $key = 0xfa; } # VK_PLAY elsif($k =~ /^zoom$/i) { $key = 0xfb; } # VK_ZOOM elsif($k =~ /^noname$/i) { $key = 0xfc; } # VK_NONAME elsif($k =~ /^pa1$/i) { $key = 0xfd; } # VK_PA1 elsif($k =~ /^oem_clear$/i) { $key = 0xfe; } # VK_OEM_CLEAR else {$key = 0; print "Key name '$k' unknown\n"; } if ($key) { my $id = $Win32::GUI::AcceleratorCounter++; push @acc, $id, $key, $flag; $Win32::GUI::Accelerators{$id} = $v; } } my $handle = Win32::GUI::CreateAcceleratorTable( @acc ); if($handle) { my $self = {}; $self->{-handle} = $handle; bless $self, $class; return $self; } else { return undef; } } sub DESTROY { my($self) = @_; # print "DESTROYING AcceleratorTable $self->{-handle}\n"; if( $self->{-handle} ) { 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 $Textfield_TwoWayMethodMap = { -passwordchar => "PasswordChar", }; my %PackageSpecific_TwoWayMethodMap = ( Splitter => { -min => "Min", -max => "Max", -horizontal => "Horizontal", -vertical => "Vertical", }, MenuItem => { -checked => "Checked", -enabled => "Enabled", }, Textfield => $Textfield_TwoWayMethodMap, RichEdit => $Textfield_TwoWayMethodMap, ); my %OneWayMethodMap = ( -scalewidth => "ScaleHeight", -scaleheight => "ScaleWidth", -abstop => "AbsTop", -absleft => "AbsLeft", ); ########################################################################### # (@)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"; my $Package = ref($self); $Package =~ s/Win32::GUI:://; if(exists $PackageSpecific_TwoWayMethodMap{$Package}{$key}) { if(my $method = $self->can($PackageSpecific_TwoWayMethodMap{$Package}{$key})) { #print "[STORE] calling method '$PackageSpecific_TwoWayMethodMap{$Package}{$key}' on '$self'\n"; return &{$method}($self, $value); } else { #print "[STORE] PROBLEM: method '$PackageSpecific_TwoWayMethodMap{$Package}{$key}' not found on '$self'\n"; } } elsif(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) = @_; my $Package = ref($self); $Package =~ s/Win32::GUI:://; if($key eq "UNDERLYING") { # print "[FETCH] returning UNDERLYING for '$self'\n"; return $self->{UNDERLYING}; } elsif(exists $PackageSpecific_TwoWayMethodMap{$Package}{$key}) { if(my $method = $self->can($PackageSpecific_TwoWayMethodMap{$Package}{$key})) { #print "[FETCH] calling method '$PackageSpecific_TwoWayMethodMap{$package}{$key}' on '$self'\n"; return &{$method}($self); } else { #print "[FETCH] PROBLEM: method '$PackageSpecific_TwoWayMethodMap{$package}{$key}' not found on '$self'\n"; } } 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; bootstrap_subpackage 'Animation'; bootstrap_subpackage 'Bitmap'; bootstrap_subpackage 'DC'; bootstrap_subpackage 'Font'; bootstrap_subpackage 'ImageList'; bootstrap_subpackage 'Label'; bootstrap_subpackage 'Listbox'; bootstrap_subpackage 'ListView'; bootstrap_subpackage 'NotifyIcon'; bootstrap_subpackage 'Rebar'; bootstrap_subpackage 'RichEdit'; bootstrap_subpackage 'Splitter'; bootstrap_subpackage 'TabStrip'; bootstrap_subpackage 'Textfield'; bootstrap_subpackage 'Toolbar'; bootstrap_subpackage 'TreeView'; # 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__