Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

2428 lines
72 KiB

  1. ###############################################################################
  2. #
  3. # Win32::GUI - Perl-Win32 Graphical User Interface Extension
  4. #
  5. # 29 Jan 1997 by Aldo Calpini <[email protected]>
  6. #
  7. # Version: 0.0.425 (08 Oct 1999)
  8. #
  9. # Copyright (c) 1997,8,9 Aldo Calpini. All rights reserved.
  10. # This program is free software; you can redistribute it and/or
  11. # modify it under the same terms as Perl itself.
  12. #
  13. ###############################################################################
  14. package Win32::GUI;
  15. require Exporter; # to export the constants to the main:: space
  16. require DynaLoader; # to dynuhlode the module.
  17. # Reserves GUI in the main namespace for us (uhmmm...)
  18. *GUI:: = \%Win32::GUI::;
  19. ###############################################################################
  20. # STATIC OBJECT PROPERTIES
  21. #
  22. $VERSION = "0.0.425";
  23. $MenuIdCounter = 1;
  24. $TimerIdCounter = 1;
  25. $NotifyIconIdCounter = 1;
  26. @ISA = qw( Exporter DynaLoader );
  27. @EXPORT = qw(
  28. BS_3STATE
  29. BS_AUTO3STATE
  30. BS_AUTOCHECKBOX
  31. BS_AUTORADIOBUTTON
  32. BS_CHECKBOX
  33. BS_DEFPUSHBUTTON
  34. BS_GROUPBOX
  35. BS_LEFTTEXT
  36. BS_NOTIFY
  37. BS_OWNERDRAW
  38. BS_PUSHBUTTON
  39. BS_RADIOBUTTON
  40. BS_USERBUTTON
  41. BS_BITMAP
  42. BS_BOTTOM
  43. BS_CENTER
  44. BS_ICON
  45. BS_LEFT
  46. BS_MULTILINE
  47. BS_RIGHT
  48. BS_RIGHTBUTTON
  49. BS_TEXT
  50. BS_TOP
  51. BS_VCENTER
  52. COLOR_3DFACE
  53. COLOR_ACTIVEBORDER
  54. COLOR_ACTIVECAPTION
  55. COLOR_APPWORKSPACE
  56. COLOR_BACKGROUND
  57. COLOR_BTNFACE
  58. COLOR_BTNSHADOW
  59. COLOR_BTNTEXT
  60. COLOR_CAPTIONTEXT
  61. COLOR_GRAYTEXT
  62. COLOR_HIGHLIGHT
  63. COLOR_HIGHLIGHTTEXT
  64. COLOR_INACTIVEBORDER
  65. COLOR_INACTIVECAPTION
  66. COLOR_MENU
  67. COLOR_MENUTEXT
  68. COLOR_SCROLLBAR
  69. COLOR_WINDOW
  70. COLOR_WINDOWFRAME
  71. COLOR_WINDOWTEXT
  72. DS_3DLOOK
  73. DS_ABSALIGN
  74. DS_CENTER
  75. DS_CENTERMOUSE
  76. DS_CONTEXTHELP
  77. DS_CONTROL
  78. DS_FIXEDSYS
  79. DS_LOCALEDIT
  80. DS_MODALFRAME
  81. DS_NOFAILCREATE
  82. DS_NOIDLEMSG
  83. DS_RECURSE
  84. DS_SETFONT
  85. DS_SETFOREGROUND
  86. DS_SYSMODAL
  87. ES_AUTOHSCROLL
  88. ES_AUTOVSCROLL
  89. ES_CENTER
  90. ES_LEFT
  91. ES_LOWERCASE
  92. ES_MULTILINE
  93. ES_NOHIDESEL
  94. ES_NUMBER
  95. ES_OEMCONVERT
  96. ES_PASSWORD
  97. ES_READONLY
  98. ES_RIGHT
  99. ES_UPPERCASE
  100. ES_WANTRETURN
  101. GW_CHILD
  102. GW_HWNDFIRST
  103. GW_HWNDLAST
  104. GW_HWNDNEXT
  105. GW_HWNDPREV
  106. GW_OWNER
  107. IMAGE_BITMAP
  108. IMAGE_CURSOR
  109. IMAGE_ICON
  110. LR_DEFAULTCOLOR
  111. LR_MONOCHROME
  112. LR_COLOR
  113. LR_COPYRETURNORG
  114. LR_COPYDELETEORG
  115. LR_LOADFROMFILE
  116. LR_LOADTRANSPARENT
  117. LR_DEFAULTSIZE
  118. LR_LOADMAP3DCOLORS
  119. LR_CREATEDIBSECTION
  120. LR_COPYFROMRESOURCE
  121. LR_SHARED
  122. MB_ABORTRETRYIGNORE
  123. MB_OK
  124. MB_OKCANCEL
  125. MB_RETRYCANCEL
  126. MB_YESNO
  127. MB_YESNOCANCEL
  128. MB_ICONEXCLAMATION
  129. MB_ICONWARNING
  130. MB_ICONINFORMATION
  131. MB_ICONASTERISK
  132. MB_ICONQUESTION
  133. MB_ICONSTOP
  134. MB_ICONERROR
  135. MB_ICONHAND
  136. MB_DEFBUTTON1
  137. MB_DEFBUTTON2
  138. MB_DEFBUTTON3
  139. MB_DEFBUTTON4
  140. MB_APPLMODAL
  141. MB_SYSTEMMODAL
  142. MB_TASKMODAL
  143. MB_DEFAULT_DESKTOP_ONLY
  144. MB_HELP
  145. MB_RIGHT
  146. MB_RTLREADING
  147. MB_SETFOREGROUND
  148. MB_TOPMOST
  149. MB_SERVICE_NOTIFICATION
  150. MB_SERVICE_NOTIFICATION_NT3X
  151. MF_STRING
  152. MF_POPUP
  153. SM_ARRANGE
  154. SM_CLEANBOOT
  155. SM_CMOUSEBUTTONS
  156. SM_CXBORDER
  157. SM_CYBORDER
  158. SM_CXCURSOR
  159. SM_CYCURSOR
  160. SM_CXDLGFRAME
  161. SM_CYDLGFRAME
  162. SM_CXDOUBLECLK
  163. SM_CYDOUBLECLK
  164. SM_CXDRAG
  165. SM_CYDRAG
  166. SM_CXEDGE
  167. SM_CYEDGE
  168. SM_CXFIXEDFRAME
  169. SM_CYFIXEDFRAME
  170. SM_CXFRAME
  171. SM_CYFRAME
  172. SM_CXFULLSCREEN
  173. SM_CYFULLSCREEN
  174. SM_CXHSCROLL
  175. SM_CYHSCROLL
  176. SM_CXHTHUMB
  177. SM_CXICON
  178. SM_CYICON
  179. SM_CXICONSPACING
  180. SM_CYICONSPACING
  181. SM_CXMAXIMIZED
  182. SM_CYMAXIMIZED
  183. SM_CXMAXTRACK
  184. SM_CYMAXTRACK
  185. SM_CXMENUCHECK
  186. SM_CYMENUCHECK
  187. SM_CXMENUSIZE
  188. SM_CYMENUSIZE
  189. SM_CXMIN
  190. SM_CYMIN
  191. SM_CXMINIMIZED
  192. SM_CYMINIMIZED
  193. SM_CXMINSPACING
  194. SM_CYMINSPACING
  195. SM_CXMINTRACK
  196. SM_CYMINTRACK
  197. SM_CXSCREEN
  198. SM_CYSCREEN
  199. SM_CXSIZE
  200. SM_CYSIZE
  201. SM_CXSIZEFRAME
  202. SM_CYSIZEFRAME
  203. SM_CXSMICON
  204. SM_CYSMICON
  205. SM_CXSMSIZE
  206. SM_CYSMSIZE
  207. SM_CXVSCROLL
  208. SM_CYVSCROLL
  209. SM_CYCAPTION
  210. SM_CYKANJIWINDOW
  211. SM_CYMENU
  212. SM_CYSMCAPTION
  213. SM_CYVTHUMB
  214. SM_DBCSENABLED
  215. SM_DEBUG
  216. SM_MENUDROPALIGNMENT
  217. SM_MIDEASTENABLED
  218. SM_MOUSEPRESENT
  219. SM_MOUSEWHEELPRESENT
  220. SM_NETWORK
  221. SM_PENWINDOWS
  222. SM_SECURE
  223. SM_SHOWSOUNDS
  224. SM_SLOWMACHINE
  225. SM_SWAPBUTTON
  226. WM_CREATE
  227. WM_DESTROY
  228. WM_MOVE
  229. WM_SIZE
  230. WM_ACTIVATE
  231. WM_SETFOCUS
  232. WM_KILLFOCUS
  233. WM_ENABLE
  234. WM_SETREDRAW
  235. WM_COMMAND
  236. WM_KEYDOWN
  237. WM_SETCURSOR
  238. WM_KEYUP
  239. WS_BORDER
  240. WS_CAPTION
  241. WS_CHILD
  242. WS_CHILDWINDOW
  243. WS_CLIPCHILDREN
  244. WS_CLIPSIBLINGS
  245. WS_DISABLED
  246. WS_DLGFRAME
  247. WS_GROUP
  248. WS_HSCROLL
  249. WS_ICONIC
  250. WS_MAXIMIZE
  251. WS_MAXIMIZEBOX
  252. WS_MINIMIZE
  253. WS_MINIMIZEBOX
  254. WS_OVERLAPPED
  255. WS_OVERLAPPEDWINDOW
  256. WS_POPUP
  257. WS_POPUPWINDOW
  258. WS_SIZEBOX
  259. WS_SYSMENU
  260. WS_TABSTOP
  261. WS_THICKFRAME
  262. WS_TILED
  263. WS_TILEDWINDOW
  264. WS_VISIBLE
  265. WS_VSCROLL
  266. WS_EX_ACCEPTFILES
  267. WS_EX_APPWINDOW
  268. WS_EX_CLIENTEDGE
  269. WS_EX_CONTEXTHELP
  270. WS_EX_CONTROLPARENT
  271. WS_EX_DLGMODALFRAME
  272. WS_EX_LEFT
  273. WS_EX_LEFTSCROLLBAR
  274. WS_EX_LTRREADING
  275. WS_EX_MDICHILD
  276. WS_EX_NOPARENTNOTIFY
  277. WS_EX_OVERLAPPEDWINDOW
  278. WS_EX_PALETTEWINDOW
  279. WS_EX_RIGHT
  280. WS_EX_RIGHTSCROLLBAR
  281. WS_EX_RTLREADING
  282. WS_EX_STATICEDGE
  283. WS_EX_TOOLWINDOW
  284. WS_EX_TOPMOST
  285. WS_EX_TRANSPARENT
  286. WS_EX_WINDOWEDGE
  287. );
  288. ###############################################################################
  289. # This AUTOLOAD is used to 'autoload' constants from the constant()
  290. # XS function. If a constant is not found then control is passed
  291. # to the AUTOLOAD in AutoLoader.
  292. #
  293. sub AUTOLOAD {
  294. my($constname);
  295. ($constname = $AUTOLOAD) =~ s/.*:://;
  296. #reset $! to zero to reset any current errors.
  297. $! = 0;
  298. my $val = constant($constname, @_ ? $_[0] : 0);
  299. if ($! != 0) {
  300. if ($! =~ /Invalid/) {
  301. $AutoLoader::AUTOLOAD = $AUTOLOAD;
  302. goto &AutoLoader::AUTOLOAD;
  303. } else {
  304. my($pack,$file,$line) = caller; # undef $pack;
  305. die "Can't find '$constname' in package '$pack' ".
  306. "used at $file line $line.";
  307. }
  308. }
  309. eval "sub $AUTOLOAD { $val }";
  310. goto &$AUTOLOAD;
  311. }
  312. ###############################################################################
  313. # PUBLIC METHODS
  314. # (@)PACKAGE:Win32::GUI
  315. ###########################################################################
  316. # (@)METHOD:Version()
  317. # Returns the module version number.
  318. sub Version {
  319. return $VERSION;
  320. }
  321. ###########################################################################
  322. # (@)METHOD:SetFont(FONT)
  323. # Sets the font of the window (FONT is a Win32::GUI::Font object).
  324. sub SetFont {
  325. my($self, $font) = @_;
  326. $font = $font->{-handle} if ref($font);
  327. # 48 == WM_SETFONT
  328. return Win32::GUI::SendMessage($self, 48, $font, 0);
  329. }
  330. ###########################################################################
  331. # (@)METHOD:GetFont(FONT)
  332. # Gets the font of the window (returns an handle; use
  333. # $Font = $W->GetFont();
  334. # %details = Win32::GUI::Font::Info( $Font );
  335. # to get font details).
  336. sub GetFont {
  337. my($self) = shift;
  338. # 49 == WM_GETFONT
  339. return Win32::GUI::SendMessage($self, 49, 0, 0);
  340. }
  341. ###########################################################################
  342. # (@)METHOD:SetIcon(ICON, [TYPE])
  343. # Sets the icon of the window; TYPE can be 0 for the small icon, 1 for
  344. # the big icon. Default is the same icon for small and big.
  345. sub SetIcon {
  346. my($self, $icon, $type) = @_;
  347. $icon = $icon->{-handle} if ref($icon);
  348. # 128 == WM_SETICON
  349. if(defined($type)) {
  350. return Win32::GUI::SendMessage($self, 128, $type, $icon);
  351. } else {
  352. Win32::GUI::SendMessage($self, 128, 0, $icon); # small icon
  353. Win32::GUI::SendMessage($self, 128, 1, $icon); # big icon
  354. }
  355. }
  356. ###########################################################################
  357. # (@)METHOD:SetRedraw(FLAG)
  358. # Determines if a window is automatically redrawn when its content changes.
  359. # FLAG can be a true value to allow redraw, false to prevent it.
  360. sub SetRedraw {
  361. my($self, $value) = @_;
  362. # 11 == WM_SETREDRAW
  363. my $r = Win32::GUI::SendMessage($self, 11, $value, 0);
  364. return $r;
  365. }
  366. ###########################################################################
  367. # (@)INTERNAL:MakeMenu(...)
  368. # better used as new Win32::GUI::Menu(...)
  369. sub MakeMenu {
  370. my(@menudata) = @_;
  371. my $i;
  372. my $M = new Win32::GUI::Menu();
  373. my $text;
  374. my %data;
  375. my $level;
  376. my %last;
  377. my $parent;
  378. for($i = 0; $i <= $#menudata; $i+=2) {
  379. $text = $menudata[$i];
  380. undef %data;
  381. if(ref($menudata[$i+1])) {
  382. %data = %{$menudata[$i+1]};
  383. } else {
  384. $data{-name} = $menudata[$i+1];
  385. }
  386. $level = 0;
  387. $level++ while($text =~ s/^\s*>\s*//);
  388. if($level == 0) {
  389. $M->{$data{-name}} = $M->AddMenuButton(
  390. -id => $MenuIdCounter++,
  391. -text => $text,
  392. %data,
  393. );
  394. $last{$level} = $data{-name};
  395. $last{$level+1} = "";
  396. } elsif($level == 1) {
  397. $parent = $last{$level-1};
  398. if($text eq "-") {
  399. $data{-name} = "dummy$MenuIdCounter";
  400. $M->{$data{-name}} = $M->{$parent}->AddMenuItem(
  401. -item => 0,
  402. -id => $MenuIdCounter++,
  403. -separator => 1,
  404. );
  405. } else {
  406. $M->{$data{-name}} = $M->{$parent}->AddMenuItem(
  407. -item => 0,
  408. -id => $MenuIdCounter++,
  409. -text => $text,
  410. %data,
  411. );
  412. }
  413. $last{$level} = $data{-name};
  414. $last{$level+1} = "";
  415. } else {
  416. $parent = $last{$level-1};
  417. if(!$M->{$parent."_Submenu"}) {
  418. $M->{$parent."_Submenu"} = new Win32::GUI::Menu();
  419. $M->{$parent."_SubmenuButton"} =
  420. $M->{$parent."_Submenu"}->AddMenuButton(
  421. -id => $MenuIdCounter++,
  422. -text => $parent,
  423. -name => $parent."_SubmenuButton",
  424. );
  425. $M->{$parent}->SetMenuItemInfo(
  426. -submenu => $M->{$parent."_SubmenuButton"}
  427. );
  428. }
  429. if($text eq "-") {
  430. $data{-name} = "dummy$MenuIdCounter";
  431. $M->{$data{-name}} =
  432. $M->{$parent."_SubmenuButton"}->AddMenuItem(
  433. -item => 0,
  434. -id => $MenuIdCounter++,
  435. -separator => 1,
  436. );
  437. } else {
  438. $M->{$data{-name}} =
  439. $M->{$parent."_SubmenuButton"}->AddMenuItem(
  440. -item => 0,
  441. -id => $MenuIdCounter++,
  442. -text => $text,
  443. %data,
  444. );
  445. }
  446. $last{$level} = $data{-name};
  447. $last{$level+1} = "";
  448. }
  449. }
  450. return $M;
  451. }
  452. ###########################################################################
  453. # (@)INTERNAL:_new(TYPE, %OPTIONS)
  454. # This is the generalized constructor;
  455. # it works pretty well for almost all controls.
  456. # However, other kind of objects may overload it.
  457. sub _new {
  458. # this is always Win32::GUI (class of _new);
  459. my $xclass = shift;
  460. # the window type passed by new():
  461. my $type = shift;
  462. # this is the real class:
  463. my $class = shift;
  464. my $oself = {};
  465. # bless($oself, $class);
  466. my %tier = ();
  467. tie %tier, $class, $oself;
  468. my $self = bless \%tier, $class;
  469. my (@input) = @_;
  470. my $handle = Win32::GUI::Create($self, $type, @input);
  471. # print "[_new] self='$self' oself='$oself'\n";
  472. # print "[_new] handle = $handle\n";
  473. # $self->{-handle} = $handle;
  474. # print "[_new] enumerating self.keys\n";
  475. # foreach my $k (keys %$self) {
  476. # print "[_new] '$k' = '$self->{$k}'\n";
  477. # }
  478. if($handle) {
  479. # $Win32::GUI::Windows{$handle} = $self;
  480. if(exists($self->{-background})) {
  481. # this is a little tricky; we must create a brush (and save
  482. # a reference to it in the window, so that it's not destroyed)
  483. # that will be used by the WM_CTLCOLOR message in GUI.xs to
  484. # paint the window background
  485. #
  486. # print "PM(_new): Window has a background!\n";
  487. $self->{-backgroundbrush} = new Win32::GUI::Brush($self->{-background});
  488. # print "PM(_new): -backgroundbrush = $self->{-backgroundbrush}->{-handle}\n";
  489. $self->{-background} = $self->{-backgroundbrush}->{-handle};
  490. }
  491. return $self;
  492. } else {
  493. return undef;
  494. }
  495. }
  496. ###############################################################################
  497. # SUB-PACKAGES
  498. #
  499. ###############################################################################
  500. # (@)PACKAGE:Win32::GUI::Font
  501. #
  502. package Win32::GUI::Font;
  503. @ISA = qw(Win32::GUI);
  504. ###########################################################################
  505. # (@)METHOD:new Win32::GUI::Font(%OPTIONS)
  506. # Creates a new Font object. %OPTIONS are:
  507. # -size
  508. # -height
  509. # -width
  510. # -escapement
  511. # -orientation
  512. # -weight
  513. # -bold => 0/1
  514. # -italic => 0/1
  515. # -underline => 0/1
  516. # -strikeout => 0/1
  517. # -charset
  518. # -outputprecision
  519. # -clipprecision
  520. # -family
  521. # -quality
  522. # -name
  523. # -face
  524. sub new {
  525. my $class = shift;
  526. my $self = {};
  527. my $handle = Create(@_);
  528. if($handle) {
  529. $self->{-handle} = $handle;
  530. bless($self, $class);
  531. return $self;
  532. } else {
  533. return undef;
  534. }
  535. }
  536. ###############################################################################
  537. # (@)PACKAGE:Win32::GUI::Bitmap
  538. #
  539. package Win32::GUI::Bitmap;
  540. @ISA = qw(Win32::GUI);
  541. ###########################################################################
  542. # (@)METHOD:new Win32::GUI::Bitmap(FILENAME, [TYPE, X, Y, FLAGS])
  543. # Creates a new Bitmap object reading from FILENAME; all other arguments
  544. # are optional. TYPE can be:
  545. # 0 bitmap (this is the default)
  546. # 1 icon
  547. # 2 cursor
  548. # You can eventually specify your desired size for the image with X and
  549. # Y and pass some FLAGS to the underlying LoadImage API (at your own risk)
  550. sub new {
  551. my $class = shift;
  552. my $self = {};
  553. my $handle = Win32::GUI::LoadImage(@_);
  554. if($handle) {
  555. $self->{-handle} = $handle;
  556. bless($self, $class);
  557. return $self;
  558. } else {
  559. return undef;
  560. }
  561. }
  562. ###############################################################################
  563. # (@)PACKAGE:Win32::GUI::Icon
  564. #
  565. package Win32::GUI::Icon;
  566. @ISA = qw(Win32::GUI);
  567. ###########################################################################
  568. # (@)METHOD:new Win32::GUI::Icon(FILENAME)
  569. # Creates a new Icon object reading from FILENAME.
  570. sub new {
  571. my $class = shift;
  572. my $file = shift;
  573. my $self = {};
  574. my $handle = Win32::GUI::LoadImage(
  575. $file,
  576. Win32::GUI::constant("IMAGE_ICON", 0),
  577. );
  578. if($handle) {
  579. $self->{-handle} = $handle;
  580. bless($self, $class);
  581. return $self;
  582. } else {
  583. return undef;
  584. }
  585. }
  586. ###########################################################################
  587. # (@)INTERNAL:DESTROY()
  588. sub DESTROY {
  589. my $self = shift;
  590. Win32::GUI::DestroyIcon($self);
  591. }
  592. ###############################################################################
  593. # (@)PACKAGE:Win32::GUI::Cursor
  594. #
  595. package Win32::GUI::Cursor;
  596. @ISA = qw(Win32::GUI);
  597. ###########################################################################
  598. # (@)METHOD:new Win32::GUI::Cursor(FILENAME)
  599. # Creates a new Cursor object reading from FILENAME.
  600. sub new {
  601. my $class = shift;
  602. my $file = shift;
  603. my $self = {};
  604. my $handle = Win32::GUI::LoadImage(
  605. $file,
  606. Win32::GUI::constant("IMAGE_CURSOR", 0),
  607. );
  608. if($handle) {
  609. $self->{-handle} = $handle;
  610. bless($self, $class);
  611. return $self;
  612. } else {
  613. return undef;
  614. }
  615. }
  616. ###########################################################################
  617. # (@)INTERNAL:DESTROY()
  618. sub DESTROY {
  619. my $self = shift;
  620. Win32::GUI::DestroyCursor($self);
  621. }
  622. ###############################################################################
  623. # (@)PACKAGE:Win32::GUI::Class
  624. #
  625. package Win32::GUI::Class;
  626. @ISA = qw(Win32::GUI);
  627. ###########################################################################
  628. # (@)METHOD: new Win32::GUI::Class(%OPTIONS)
  629. # Creates a new window class object.
  630. # Allowed %OPTIONS are:
  631. # -name => STRING
  632. # the name for the class (it must be unique!).
  633. # -icon => Win32::GUI::Icon object
  634. # -cursor => Win32::GUI::Cursor object
  635. # -color => COLOR or Win32::GUI::Brush object
  636. # the window background color.
  637. # -menu => STRING
  638. # a menu name (not yet implemented).
  639. # -extends => STRING
  640. # name of the class to extend (aka subclassing).
  641. # -widget => STRING
  642. # name of a widget class to subclass; currently available are:
  643. # Button, Listbox, TabStrip, RichEdit.
  644. # -style => FLAGS
  645. # use with caution!
  646. sub new {
  647. my $class = shift;
  648. my %args = @_;
  649. my $self = {};
  650. $args{-color} =
  651. Win32::GUI::constant("COLOR_WINDOW", 0)
  652. unless exists($args{-color});
  653. my $handle = Win32::GUI::RegisterClassEx(%args);
  654. if($handle) {
  655. $self->{-name} = $args{-name};
  656. $self->{-handle} = $handle;
  657. bless($self, $class);
  658. return $self;
  659. } else {
  660. return undef;
  661. }
  662. }
  663. ###############################################################################
  664. # (@)PACKAGE:Win32::GUI::Window
  665. #
  666. package Win32::GUI::Window;
  667. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  668. ###########################################################################
  669. # (@)METHOD:new Win32::GUI::Window(%OPTIONS)
  670. # Creates a new Window object.
  671. # Class specific %OPTIONS are:
  672. # -minsize => [X, Y]
  673. # specifies the minimum size (width and height) in pixels;
  674. # X and Y must be passed in an array reference
  675. # -maxsize => [X, Y]
  676. # specifies the maximum size (width and height) in pixels;
  677. # X and Y must be passed in an array reference
  678. # -minwidth => N
  679. # -minheight => N
  680. # -maxwidht => N
  681. # -maxheight => N
  682. # specify the minimum and maximum size width
  683. # and height, in pixels
  684. # -topmost => 0/1 (default 0)
  685. # the window "stays on top" even when deactivated
  686. sub new {
  687. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__WINDOW", 0), @_);
  688. }
  689. ###########################################################################
  690. # (@)METHOD:AddButton(%OPTIONS)
  691. # See new Win32::GUI::Button().
  692. sub AddButton { return Win32::GUI::Button->new(@_); }
  693. ###########################################################################
  694. # (@)METHOD:AddLabel(%OPTIONS)
  695. # See new Win32::GUI::Label().
  696. sub AddLabel { return Win32::GUI::Label->new(@_); }
  697. ###########################################################################
  698. # (@)METHOD:AddCheckbox(%OPTIONS)
  699. # See new Win32::GUI::Checkbox().
  700. sub AddCheckbox { return Win32::GUI::Checkbox->new(@_); }
  701. ###########################################################################
  702. # (@)METHOD:AddRadioButton(%OPTIONS)
  703. # See new Win32::GUI::RadioButton().
  704. sub AddRadioButton { return Win32::GUI::RadioButton->new(@_); }
  705. ###########################################################################
  706. # (@)METHOD:AddTextfield(%OPTIONS)
  707. # See new Win32::GUI::Textfield().
  708. sub AddTextfield { return Win32::GUI::Textfield->new(@_); }
  709. ###########################################################################
  710. # (@)METHOD:AddListbox(%OPTIONS)
  711. # See new Win32::GUI::Listbox().
  712. sub AddListbox { return Win32::GUI::Listbox->new(@_); }
  713. ###########################################################################
  714. # (@)METHOD:AddCombobox(%OPTIONS)
  715. # See new Win32::GUI::Combobox().
  716. sub AddCombobox { return Win32::GUI::Combobox->new(@_); }
  717. ###########################################################################
  718. # (@)METHOD:AddStatusBar(%OPTIONS)
  719. # See new Win32::GUI::StatusBar().
  720. sub AddStatusBar { return Win32::GUI::StatusBar->new(@_); }
  721. ###########################################################################
  722. # (@)METHOD:AddProgressBar(%OPTIONS)
  723. # See new Win32::GUI::ProgressBar().
  724. sub AddProgressBar { return Win32::GUI::ProgressBar->new(@_); }
  725. ###########################################################################
  726. # (@)METHOD:AddTabStrip(%OPTIONS)
  727. # See new Win32::GUI::TabStrip().
  728. sub AddTabStrip { return Win32::GUI::TabStrip->new(@_); }
  729. ###########################################################################
  730. # (@)METHOD:AddToolbar(%OPTIONS)
  731. # See new Win32::GUI::Toolbar().
  732. sub AddToolbar { return Win32::GUI::Toolbar->new(@_); }
  733. ###########################################################################
  734. # (@)METHOD:AddListView(%OPTIONS)
  735. # See new Win32::GUI::ListView().
  736. sub AddListView { return Win32::GUI::ListView->new(@_); }
  737. ###########################################################################
  738. # (@)METHOD:AddTreeView(%OPTIONS)
  739. # See new Win32::GUI::TreeView().
  740. sub AddTreeView { return Win32::GUI::TreeView->new(@_); }
  741. ###########################################################################
  742. # (@)METHOD:AddRichEdit(%OPTIONS)
  743. # See new Win32::GUI::RichEdit().
  744. sub AddRichEdit { return Win32::GUI::RichEdit->new(@_); }
  745. ###########################################################################
  746. # (@)INTERNAL:AddTrackbar(%OPTIONS)
  747. # Better used as AddSlider().
  748. sub AddTrackbar { return Win32::GUI::Trackbar->new(@_); }
  749. ###########################################################################
  750. # (@)METHOD:AddSlider(%OPTIONS)
  751. # See new Win32::GUI::Slider().
  752. sub AddSlider { return Win32::GUI::Slider->new(@_); }
  753. ###########################################################################
  754. # (@)METHOD:AddUpDown(%OPTIONS)
  755. # See new Win32::GUI::UpDown().
  756. sub AddUpDown { return Win32::GUI::UpDown->new(@_); }
  757. ###########################################################################
  758. # (@)METHOD:AddAnimation(%OPTIONS)
  759. # See new Win32::GUI::Animation().
  760. sub AddAnimation { return Win32::GUI::Animation->new(@_); }
  761. ###########################################################################
  762. # (@)METHOD:AddRebar(%OPTIONS)
  763. # See new Win32::GUI::Rebar().
  764. sub AddRebar { return Win32::GUI::Rebar->new(@_); }
  765. ###########################################################################
  766. # (@)METHOD:AddHeader(%OPTIONS)
  767. # See new Win32::GUI::Header().
  768. sub AddHeader { return Win32::GUI::Header->new(@_); }
  769. ###########################################################################
  770. # (@)METHOD:AddCombobox(%OPTIONS)
  771. # See new Win32::GUI::Combobox().
  772. sub AddComboboxEx { return Win32::GUI::ComboboxEx->new(@_); }
  773. ###########################################################################
  774. # (@)METHOD:AddTimer(NAME, ELAPSE)
  775. # See new Win32::GUI::Timer().
  776. sub AddTimer { return Win32::GUI::Timer->new(@_); }
  777. ###########################################################################
  778. # (@)METHOD:AddNotifyIcon(%OPTIONS)
  779. # See new Win32::GUI::NotifyIcon().
  780. sub AddNotifyIcon { return Win32::GUI::NotifyIcon->new(@_); }
  781. ###########################################################################
  782. # (@)METHOD:AddMenu()
  783. # See new Win32::GUI::Menu().
  784. sub AddMenu {
  785. my $self = shift;
  786. my $menu = Win32::GUI::Menu->new();
  787. my $r = Win32::GUI::SetMenu($self, $menu->{-handle});
  788. # print "SetMenu=$r\n";
  789. return $menu;
  790. }
  791. ###########################################################################
  792. # (@)METHOD:GetDC()
  793. # Returns the DC object associated with the window.
  794. sub GetDC {
  795. my $self = shift;
  796. return Win32::GUI::DC->new($self);
  797. }
  798. ###########################################################################
  799. # (@)INTERNAL:DESTROY(HANDLE)
  800. sub DESTROY {
  801. my $self = shift;
  802. my $timer;
  803. if( exists $self->{-timers} ) {
  804. foreach $timer ($self->{-timers}) {
  805. undef $self->{-timers}->{$timer};
  806. }
  807. }
  808. # Win32::GUI::DestroyWindow($self);
  809. }
  810. ###########################################################################
  811. # (@)INTERNAL:AUTOLOAD(HANDLE, METHOD)
  812. sub AUTOLOAD {
  813. my($self, $method) = @_;
  814. $AUTOLOAD =~ s/.*:://;
  815. # print "Win32::GUI::Window::AUTOLOAD called for object '$self', method '$method', AUTOLOAD=$AUTOLOAD\n";
  816. if( exists $self->{$AUTOLOAD}) {
  817. return $self->{$AUTOLOAD};
  818. }
  819. }
  820. ###############################################################################
  821. # (@)PACKAGE:Win32::GUI::DialogBox
  822. #
  823. package Win32::GUI::DialogBox;
  824. @ISA = qw(Win32::GUI::Window);
  825. ###########################################################################
  826. # (@)METHOD:new Win32::GUI::DialogBox(%OPTIONS)
  827. # Creates a new DialogBox object. See new Win32::GUI::Window().
  828. sub new {
  829. my $self = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__DIALOG", 0), @_);
  830. if($self) {
  831. $self->{-dialogui} = 1;
  832. return $self;
  833. } else {
  834. return undef;
  835. }
  836. }
  837. ###############################################################################
  838. # (@)PACKAGE:Win32::GUI::Button
  839. #
  840. package Win32::GUI::Button;
  841. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  842. ###########################################################################
  843. # (@)METHOD:new Win32::GUI::Button(PARENT, %OPTIONS)
  844. # Creates a new Button object;
  845. # can also be called as PARENT->AddButton(%OPTIONS).
  846. # Class specific %OPTIONS are:
  847. # -align => left/center/right (default left)
  848. # -valign => top/center/bottom
  849. #
  850. # -default => 0/1 (default 0)
  851. # -ok => 0/1 (default 0)
  852. # -cancel => 0/1 (default 0)
  853. sub new {
  854. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__BUTTON", 0), @_);
  855. }
  856. ###############################################################################
  857. # (@)PACKAGE:Win32::GUI::RadioButton
  858. #
  859. package Win32::GUI::RadioButton;
  860. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  861. ###########################################################################
  862. # (@)METHOD:new Win32::GUI::RadioButton(PARENT, %OPTIONS)
  863. # Creates a new RadioButton object;
  864. # can also be called as PARENT->AddRadioButton(%OPTIONS).
  865. # %OPTIONS are the same of Button (see new Win32::GUI::Button() ).
  866. sub new {
  867. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__RADIOBUTTON", 0), @_);
  868. }
  869. ###########################################################################
  870. # (@)METHOD:Checked([VALUE])
  871. # Gets or sets the checked state of the RadioButton; if called without
  872. # arguments, returns the current state:
  873. # 0 not checked
  874. # 1 checked
  875. # If a VALUE is specified, it can be one of these (eg. 0 to uncheck the
  876. # RadioButton, 1 to check it).
  877. sub Checked {
  878. my $self = shift;
  879. my $check = shift;
  880. if(defined($check)) {
  881. # 241 == BM_SETCHECK
  882. return Win32::GUI::SendMessage($self, 241, $check, 0);
  883. } else {
  884. # 240 == BM_GETCHECK
  885. return Win32::GUI::SendMessage($self, 240, 0, 0);
  886. }
  887. }
  888. ###############################################################################
  889. # (@)PACKAGE:Win32::GUI::Checkbox
  890. #
  891. package Win32::GUI::Checkbox;
  892. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  893. ###########################################################################
  894. # (@)METHOD:new Win32::GUI::Checkbox(PARENT, %OPTIONS)
  895. # Creates a new Checkbox object;
  896. # can also be called as PARENT->AddCheckbox(%OPTIONS).
  897. # %OPTIONS are the same of Button (see new Win32::GUI::Button() ).
  898. sub new {
  899. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__CHECKBOX", 0), @_);
  900. }
  901. ###########################################################################
  902. # (@)METHOD:GetCheck()
  903. # Returns the check state of the Checkbox:
  904. # 0 not checked
  905. # 1 checked
  906. # 2 indeterminate (grayed)
  907. sub GetCheck {
  908. my $self = shift;
  909. # 240 == BM_GETCHECK
  910. return Win32::GUI::SendMessage($self, 240, 0, 0);
  911. }
  912. ###########################################################################
  913. # (@)METHOD:SetCheck([VALUE])
  914. # Sets the check state of the Checkbox; for a list of possible values,
  915. # see GetCheck().
  916. # If called without arguments, it checks the Checkbox (eg. state = 1).
  917. sub SetCheck {
  918. my $self = shift;
  919. my $check = shift;
  920. $check = 1 unless defined($check);
  921. # 241 == BM_SETCHECK
  922. return Win32::GUI::SendMessage($self, 241, $check, 0);
  923. }
  924. ###########################################################################
  925. # (@)METHOD:Checked([VALUE])
  926. # Gets or sets the check state of the Checkbox; if called without
  927. # arguments, returns the current state:
  928. # 0 not checked
  929. # 1 checked
  930. # 2 indeterminate (grayed)
  931. # If a VALUE is specified, it can be one of these (eg. 0 to uncheck the
  932. # Checkbox, 1 to check it).
  933. sub Checked {
  934. my $self = shift;
  935. my $check = shift;
  936. if(defined($check)) {
  937. # 241 == BM_SETCHECK
  938. return Win32::GUI::SendMessage($self, 241, $check, 0);
  939. } else {
  940. # 240 == BM_GETCHECK
  941. return Win32::GUI::SendMessage($self, 240, 0, 0);
  942. }
  943. }
  944. ###############################################################################
  945. # (@)PACKAGE:Win32::GUI::Label
  946. #
  947. package Win32::GUI::Label;
  948. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  949. ###########################################################################
  950. # (@)METHOD:new Win32::GUI::Label(PARENT, %OPTIONS)
  951. # Creates a new Label object;
  952. # can also be called as PARENT->AddLabel(%OPTIONS).
  953. # Class specific %OPTIONS are:
  954. # -align => left/center/right (default left)
  955. # -bitmap => 0/1 (default 0)
  956. # the control displays a bitmap, not a text.
  957. # -fill => black/gray/white/none (default none)
  958. # fills the control rectangle ("black", "gray" and "white" are
  959. # the window frame color, the desktop color and the window
  960. # background color respectively).
  961. # -frame => black/gray/white/etched/none (default none)
  962. # draws a border around the control. colors are the same
  963. # of -fill, with the addition of "etched" (a raised border).
  964. # -noprefix => 0/1 (default 0)
  965. # disables the interpretation of "&" as accelerator prefix.
  966. # -notify => 0/1 (default 0)
  967. # enables the Click(), DblClick, etc. events.
  968. # -sunken => 0/1 (default 0)
  969. # draws a half-sunken border around the control.
  970. # -truncate => 0/1/word/path (default 0)
  971. # specifies how the text is to be truncated:
  972. # 0 the text is not truncated
  973. # 1 the text is truncated at the end
  974. # path the text is truncated before the last "\"
  975. # (used to shorten paths).
  976. # -wrap => 0/1 (default 1)
  977. # the text wraps automatically to a new line.
  978. sub new {
  979. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__STATIC", 0), @_);
  980. }
  981. ###########################################################################
  982. # (@)METHOD:SetImage(BITMAP)
  983. # Draws the specified BITMAP, a Win32::GUI::Bitmap object, in the Label
  984. # (must have been created with -bitmap => 1 option).
  985. sub SetImage {
  986. my $self = shift;
  987. my $image = shift;
  988. $image = $image->{-handle} if ref($image);
  989. my $type = Win32::GUI::constant("IMAGE_BITMAP", 0);
  990. # 370 == STM_SETIMAGE
  991. return Win32::GUI::SendMessage($self, 370, $type, $image);
  992. }
  993. ###############################################################################
  994. # (@)PACKAGE:Win32::GUI::Textfield
  995. #
  996. package Win32::GUI::Textfield;
  997. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  998. ###########################################################################
  999. # (@)METHOD:new Win32::GUI::Textfield(PARENT, %OPTIONS)
  1000. # Creates a new Textfield object;
  1001. # can also be called as PARENT->AddTextfield(%OPTIONS).
  1002. # Class specific %OPTIONS are:
  1003. # -align => left/center/right (default left)
  1004. # aligns the text in the control accordingly.
  1005. # -keepselection => 0/1 (default 0)
  1006. # the selection is not hidden when the control loses focus.
  1007. # -multiline => 0/1 (default 0)
  1008. # the control can have more than one line (note that newline
  1009. # is "\r\n", not "\n"!).
  1010. # -password => 0/1 (default 0)
  1011. # masks the user input (like password prompts).
  1012. # -passwordchar => char (default '*')
  1013. # the char that is shown instead of the text with -password => 1.
  1014. # -prompt => (see below)
  1015. # -readonly => 0/1 (default 0)
  1016. # text can't be changed.
  1017. #
  1018. # The -prompt option is very special; if a string is passed, a
  1019. # Win32::GUI::Label object (with text set to the string passed) is created
  1020. # to the left of the Textfield.
  1021. # Example:
  1022. # $Window->AddTextfield(
  1023. # -name => "Username",
  1024. # -left => 75,
  1025. # -top => 150,
  1026. # -prompt => "Your name:",
  1027. # );
  1028. # Furthermore, the value to -prompt can be a reference to a list containing
  1029. # the string and an additional parameter, which sets the width for
  1030. # the Label (eg. [ STRING, WIDTH ] ). If WIDTH is negative, it is calculated
  1031. # relative to the Textfield left coordinate. Example:
  1032. #
  1033. # -left => 75, (Label left) (Textfield left)
  1034. # -prompt => [ "Your name:", 30 ], 75 105 (75+30)
  1035. #
  1036. # -left => 75,
  1037. # -prompt => [ "Your name:", -30 ], 45 (75-30) 75
  1038. #
  1039. # Note that the Win32::GUI::Label object is named like the Textfield, with
  1040. # a "_Prompt" suffix (in the example above, the Label is named
  1041. # "Username_Prompt").
  1042. sub new {
  1043. my($class, $parent, %options) = @_;
  1044. if(exists $options{-prompt}) {
  1045. my $add = 0;
  1046. my ($text, $left, $width, $height, );
  1047. my $visible = 1;
  1048. if(ref($options{-prompt}) eq "ARRAY") {
  1049. $left = pop(@{$options{'-prompt'}});
  1050. $text = pop(@{$options{'-prompt'}});
  1051. if($left < 0) {
  1052. $left = $options{-left} + $left;
  1053. $width = -$left;
  1054. } else {
  1055. $width = $left;
  1056. $left = $options{-left};
  1057. $add = $width;
  1058. }
  1059. } else {
  1060. $text = $options{-prompt};
  1061. $add = -1;
  1062. }
  1063. if(exists $options{-height}) {
  1064. $height = $options{-height}-3;
  1065. } else {
  1066. $height = 0;
  1067. }
  1068. if(exists $options{-visible}) {
  1069. $visible = $options{-visible};
  1070. }
  1071. my $prompt = new Win32::GUI::Label(
  1072. $parent,
  1073. -name => $options{-name} . '_Prompt',
  1074. -width => $width,
  1075. -left => $left,
  1076. -top => $options{-top} + 3,
  1077. -text => $text,
  1078. -height => $height,
  1079. -visible => $visible,
  1080. );
  1081. $add = $prompt->Width if $add == -1;
  1082. $options{-left} += $add;
  1083. }
  1084. return Win32::GUI->_new(
  1085. Win32::GUI::constant("WIN32__GUI__EDIT", 0),
  1086. $class, $parent, %options,
  1087. );
  1088. }
  1089. ###########################################################################
  1090. # (@)METHOD:Select(START, END)
  1091. # Selects the specified range of characters in the Textfield.
  1092. sub Select {
  1093. my($self, $wparam, $lparam) = @_;
  1094. # 177 == EM_SETSEL
  1095. return Win32::GUI::SendMessage($self, 177, $wparam, $lparam);
  1096. }
  1097. ###########################################################################
  1098. # (@)METHOD:SelectAll()
  1099. # Selects all the text in the Textfield.
  1100. sub SelectAll {
  1101. my($self, $wparam, $lparam) = @_;
  1102. # 177 == EM_SETSEL
  1103. # 14 == WM_GETTEXTLENGTH
  1104. return Win32::GUI::SendMessage(
  1105. $self, 177,
  1106. 0, Win32::GUI::SendMessage($self, 14, 0, 0),
  1107. );
  1108. }
  1109. ###########################################################################
  1110. # (@)METHOD:MaxLength([CHARS])
  1111. # Limits the number of characters that the Textfield accept to CHARS,
  1112. # or returns the current limit if no argument is given.
  1113. # To remove the limit (eg. set it to the maximum allowed which is 32k
  1114. # for a single-line Textfield and 64k for a multiline one) set CHARS
  1115. # to 0.
  1116. sub MaxLength {
  1117. my($self, $chars) = @_;
  1118. if(defined $chars) {
  1119. # 197 == EM_SETLIMITTEXT
  1120. return Win32::GUI::SendMessage($self, 197, $chars, 0);
  1121. } else {
  1122. # 213 == EM_GETLIMITTEXT
  1123. return Win32::GUI::SendMessage($self, 213, 0, 0);
  1124. }
  1125. }
  1126. ###############################################################################
  1127. # (@)PACKAGE:Win32::GUI::Listbox
  1128. #
  1129. package Win32::GUI::Listbox;
  1130. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1131. ###########################################################################
  1132. # (@)METHOD:new Win32::GUI::Listbox(PARENT, %OPTIONS)
  1133. # Creates a new Listbox object;
  1134. # can also be called as PARENT->AddListbox(%OPTIONS).
  1135. # Class specific %OPTIONS are:
  1136. # -multisel => 0/1/2 (default 0)
  1137. # specifies the selection type:
  1138. # 0 single selection
  1139. # 1 multiple selection
  1140. # 2 multiple selection ehnanced (with Shift, Control, etc.)
  1141. # -sort => 0/1 (default 0)
  1142. # items are sorted alphabetically.
  1143. sub new {
  1144. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__LISTBOX", 0), @_);
  1145. }
  1146. ###########################################################################
  1147. # (@)METHOD:SelectedItem()
  1148. # Returns the zero-based index of the currently selected item, or -1 if
  1149. # no item is selected.
  1150. sub SelectedItem {
  1151. my $self = shift;
  1152. # 392 == LB_GETCURSEL
  1153. return Win32::GUI::SendMessage($self, 392, 0, 0);
  1154. }
  1155. ###########################################################################
  1156. # (@)METHOD:ListIndex()
  1157. # See SelectedItem().
  1158. sub ListIndex { SelectedItem(@_); }
  1159. ###########################################################################
  1160. # (@)METHOD:Select(INDEX)
  1161. # Selects the zero-based INDEX item in the Listbox.
  1162. sub Select {
  1163. my $self = shift;
  1164. my $item = shift;
  1165. # 390 == LB_SETCURSEL
  1166. my $r = Win32::GUI::SendMessage($self, 390, $item, 0);
  1167. return $r;
  1168. }
  1169. ###########################################################################
  1170. # (@)METHOD:Reset()
  1171. # Deletes the content of the Listbox.
  1172. sub Reset {
  1173. my $self = shift;
  1174. # 388 == LB_RESETCONTENT
  1175. my $r = Win32::GUI::SendMessage($self, 388, 0, 0);
  1176. return $r;
  1177. }
  1178. ###########################################################################
  1179. # (@)METHOD:Clear()
  1180. # See Reset().
  1181. sub Clear { Reset(@_); }
  1182. ###########################################################################
  1183. # (@)METHOD:RemoveItem(INDEX)
  1184. # Removes the zero-based INDEX item from the Listbox.
  1185. sub RemoveItem {
  1186. my $self = shift;
  1187. my $item = shift;
  1188. # 386 == LB_DELETESTRING
  1189. my $r = Win32::GUI::SendMessage($self, 386, $item, 0);
  1190. return $r;
  1191. }
  1192. ###########################################################################
  1193. # (@)METHOD:Count()
  1194. # Returns the number of items in the Listbox.
  1195. sub Count {
  1196. my $self = shift;
  1197. # 395 == LB_GETCOUNT
  1198. my $r = Win32::GUI::SendMessage($self, 395, 0, 0);
  1199. return $r;
  1200. }
  1201. sub List {
  1202. my $self = shift;
  1203. my $index = shift;
  1204. if(not defined $index) {
  1205. my @list = ();
  1206. for my $i (0..($self->Count-1)) {
  1207. push @list, Win32::GUI::Listbox::Item->new($self, $i);
  1208. }
  1209. return @list;
  1210. } else {
  1211. return Win32::GUI::Listbox::Item->new($self, $index);
  1212. }
  1213. }
  1214. ###############################################################################
  1215. # (@)PACKAGE:Win32::GUI::Listbox::Item
  1216. #
  1217. package Win32::GUI::Listbox::Item;
  1218. sub new {
  1219. my($class, $listbox, $index) = @_;
  1220. $self = {
  1221. -parent => $listbox,
  1222. -index => $index,
  1223. -string => $listbox->GetString($index),
  1224. };
  1225. return bless $self, $class;
  1226. }
  1227. sub Remove {
  1228. my($self) = @_;
  1229. $self->{-parent}->RemoveItem($self->{-index});
  1230. undef $_[0];
  1231. }
  1232. sub Select {
  1233. my($self) = @_;
  1234. $self->{-parent}->Select($self->{-index});
  1235. }
  1236. ###############################################################################
  1237. # (@)PACKAGE:Win32::GUI::Combobox
  1238. #
  1239. package Win32::GUI::Combobox;
  1240. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1241. ###########################################################################
  1242. # (@)METHOD:new Win32::GUI::Combobox(PARENT, %OPTIONS)
  1243. # Creates a new Combobox object;
  1244. # can also be called as PARENT->AddCombobox(%OPTIONS).
  1245. sub new {
  1246. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__COMBOBOX", 0), @_);
  1247. }
  1248. ###########################################################################
  1249. # (@)METHOD:SelectedItem()
  1250. # Returns the zero-based index of the currently selected item, or -1 if
  1251. # no item is selected.
  1252. sub SelectedItem {
  1253. my $self = shift;
  1254. # 327 == CB_GETCURSEL
  1255. return Win32::GUI::SendMessage($self, 327, 0, 0);
  1256. }
  1257. ###########################################################################
  1258. # (@)METHOD:ListIndex()
  1259. # See SelectedItem().
  1260. sub ListIndex { SelectedItem(@_); }
  1261. ###########################################################################
  1262. # (@)METHOD:Select(INDEX)
  1263. # Selects the zero-based INDEX item in the Combobox.
  1264. sub Select {
  1265. my $self = shift;
  1266. my $item = shift;
  1267. # 334 == CB_SETCURSEL
  1268. my $r = Win32::GUI::SendMessage($self, 334, $item, 0);
  1269. return $r;
  1270. }
  1271. ###########################################################################
  1272. # (@)METHOD:Reset()
  1273. # Deletes the content of the Combobox.
  1274. sub Reset {
  1275. my $self = shift;
  1276. # 331 == CB_RESETCONTENT
  1277. my $r = Win32::GUI::SendMessage($self, 331, 0, 0);
  1278. return $r;
  1279. }
  1280. ###########################################################################
  1281. # (@)METHOD:Clear()
  1282. # See Reset().
  1283. sub Clear { Reset(@_); }
  1284. ###########################################################################
  1285. # (@)METHOD:RemoveItem(INDEX)
  1286. # Removes the zero-based INDEX item from the Combobox.
  1287. sub RemoveItem {
  1288. my $self = shift;
  1289. my $item = shift;
  1290. # 324 == CB_DELETESTRING
  1291. my $r = Win32::GUI::SendMessage($self, 324, $item, 0);
  1292. return $r;
  1293. }
  1294. ###########################################################################
  1295. # (@)METHOD:Count()
  1296. # Returns the number of items in the Combobox.
  1297. sub Count {
  1298. my $self = shift;
  1299. # 326 == CB_GETCOUNT
  1300. my $r = Win32::GUI::SendMessage($self, 326, 0, 0);
  1301. return $r;
  1302. }
  1303. ###############################################################################
  1304. # (@)PACKAGE:Win32::GUI::ProgressBar
  1305. #
  1306. package Win32::GUI::ProgressBar;
  1307. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1308. ###########################################################################
  1309. # (@)METHOD:new Win32::GUI::ProgressBar(PARENT, %OPTIONS)
  1310. # Creates a new ProgressBar object;
  1311. # can also be called as PARENT->AddProgressBar(%OPTIONS).
  1312. # Class specific %OPTIONS are:
  1313. # -smooth => 0/1 (default 0)
  1314. # uses a smooth bar instead of the default segmented bar.
  1315. # -vertical => 0/1 (default 0)
  1316. # display progress status vertically (from bottom to top).
  1317. sub new {
  1318. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__PROGRESS", 0), @_);
  1319. }
  1320. ###########################################################################
  1321. # (@)METHOD:SetPos(VALUE)
  1322. # Sets the position of the ProgressBar to the specified VALUE.
  1323. sub SetPos {
  1324. my $self = shift;
  1325. my $pos = shift;
  1326. # 1026 == PBM_SETPOS
  1327. return Win32::GUI::SendMessage($self, 1026, $pos, 0);
  1328. }
  1329. ###########################################################################
  1330. # (@)METHOD:StepIt()
  1331. # Increments the position of the ProgressBar of the defined step value;
  1332. # see SetStep().
  1333. sub StepIt {
  1334. my $self = shift;
  1335. # 1029 == PBM_STEPIT
  1336. return Win32::GUI::SendMessage($self, 1029, 0, 0);
  1337. }
  1338. ###########################################################################
  1339. # (@)METHOD:SetRange([MIN], MAX)
  1340. # Sets the range of values (from MIN to MAX) for the ProgressBar; if MIN
  1341. # is not specified, it defaults to 0.
  1342. sub SetRange {
  1343. my $self = shift;
  1344. my ($min, $max) = @_;
  1345. $max = $min, $min = 0 unless defined($max);
  1346. # 1025 == PBM_SETRANGE
  1347. # return Win32::GUI::SendMessage($self, 1025, 0, ($max + $min >> 8));
  1348. return Win32::GUI::SendMessage($self, 1025, 0, ($min | $max << 16));
  1349. }
  1350. ###########################################################################
  1351. # (@)METHOD:SetStep([VALUE])
  1352. # Sets the increment value for the ProgressBar; see StepIt().
  1353. sub SetStep {
  1354. my $self = shift;
  1355. my $step = shift;
  1356. $step = 10 unless $step;
  1357. # 1028 == PBM_SETSTEP
  1358. return Win32::GUI::SendMessage($self, 1028, $step, 0);
  1359. }
  1360. # TODO 4.71: Color, BackColor
  1361. ###############################################################################
  1362. # (@)PACKAGE:Win32::GUI::StatusBar
  1363. #
  1364. package Win32::GUI::StatusBar;
  1365. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1366. ###########################################################################
  1367. # (@)METHOD:new Win32::GUI::StatusBar(PARENT, %OPTIONS)
  1368. # Creates a new StatusBar object;
  1369. # can also be called as PARENT->AddStatusBar(%OPTIONS).
  1370. sub new {
  1371. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__STATUS", 0), @_);
  1372. }
  1373. ###############################################################################
  1374. # (@)PACKAGE:Win32::GUI::TabStrip
  1375. #
  1376. package Win32::GUI::TabStrip;
  1377. @ISA = qw(Win32::GUI::Window Win32::GUI::WindowProps);
  1378. ###########################################################################
  1379. # (@)METHOD:new Win32::GUI::TabStrip(PARENT, %OPTIONS)
  1380. # Creates a new TabStrip object;
  1381. # can also be called as PARENT->AddTabStrip(%OPTIONS).
  1382. # Class specific %OPTIONS are:
  1383. # -bottom => 0/1 (default 0)
  1384. # -buttons => 0/1 (default 0)
  1385. # -hottrack => 0/1 (default 0)
  1386. # -imagelist => Win32::GUI::ImageList object
  1387. # -justify => 0/1 (default 0)
  1388. # -multiline => 0/1 (default 0)
  1389. # -right => 0/1 (default 0)
  1390. # -vertical => 0/1 (default 0)
  1391. sub new {
  1392. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TAB", 0), @_);
  1393. }
  1394. ###########################################################################
  1395. # (@)METHOD:SelectedItem()
  1396. # Returns the zero-based index of the currently selected item.
  1397. sub SelectedItem {
  1398. my $self = shift;
  1399. # 4875 == TCM_GETCURSEL
  1400. return Win32::GUI::SendMessage($self, 4875, 0, 0);
  1401. }
  1402. ###########################################################################
  1403. # (@)METHOD:Select(INDEX)
  1404. # Selects the zero-based INDEX item in the TabStrip.
  1405. sub Select {
  1406. my $self = shift;
  1407. # 4876 == TCM_SETCURSEL
  1408. return Win32::GUI::SendMessage($self, 4876, shift, 0);
  1409. }
  1410. ###############################################################################
  1411. # (@)PACKAGE:Win32::GUI::Toolbar
  1412. #
  1413. package Win32::GUI::Toolbar;
  1414. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1415. ###########################################################################
  1416. # (@)METHOD:new Win32::GUI::Toolbar(PARENT, %OPTIONS)
  1417. # Creates a new Toolbar object;
  1418. # can also be called as PARENT->AddToolbar(%OPTIONS).
  1419. # Class specific %OPTIONS are:
  1420. # -flat => 0/1
  1421. # -imagelist => IMAGELIST
  1422. # -multiline => 0/1
  1423. # -nodivider => 0/1
  1424. sub new {
  1425. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TOOLBAR", 0), @_);
  1426. }
  1427. ###########################################################################
  1428. # (@)METHOD:SetBitmapSize([X, Y])
  1429. sub SetBitmapSize {
  1430. my $self = shift;
  1431. my ($x, $y) = @_;
  1432. $x = 16 unless defined($x);
  1433. $y = 15 unless defined($y);
  1434. # 1056 == TB_SETBITMAPSIZE
  1435. return Win32::GUI::SendMessage($self, 1056, 0, ($x | $y << 16));
  1436. }
  1437. ###############################################################################
  1438. # (@)PACKAGE:Win32::GUI::RichEdit
  1439. #
  1440. package Win32::GUI::RichEdit;
  1441. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1442. ###########################################################################
  1443. # (@)METHOD:new Win32::GUI::RichEdit(PARENT, %OPTIONS)
  1444. # Creates a new RichEdit object;
  1445. # can also be called as PARENT->AddRichEdit(%OPTIONS).
  1446. sub new {
  1447. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__RICHEDIT", 0), @_);
  1448. }
  1449. ###############################################################################
  1450. # (@)PACKAGE:Win32::GUI::ListView
  1451. #
  1452. package Win32::GUI::ListView;
  1453. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1454. ###########################################################################
  1455. # (@)METHOD:new Win32::GUI::ListView(PARENT, %OPTIONS)
  1456. # Creates a new ListView object;
  1457. # can also be called as PARENT->AddListView(%OPTIONS).
  1458. sub new {
  1459. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__LISTVIEW", 0), @_);
  1460. }
  1461. ###############################################################################
  1462. # (@)PACKAGE:Win32::GUI::TreeView
  1463. #
  1464. package Win32::GUI::TreeView;
  1465. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1466. ###########################################################################
  1467. # (@)METHOD:new Win32::GUI::TreeView(PARENT, %OPTIONS)
  1468. # Creates a new TreeView object
  1469. # can also be called as PARENT->AddTreeView(%OPTIONS).
  1470. sub new {
  1471. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TREEVIEW", 0), @_);
  1472. }
  1473. ###############################################################################
  1474. # (@)PACKAGE:Win32::GUI::Slider
  1475. # also Trackbar
  1476. #
  1477. package Win32::GUI::Trackbar;
  1478. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1479. ###########################################################################
  1480. # (@)METHOD:new Win32::GUI::Slider(PARENT, %OPTIONS)
  1481. # Creates a new Slider object;
  1482. # can also be called as PARENT->AddSlider(%OPTIONS).
  1483. sub new {
  1484. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TRACKBAR", 0), @_);
  1485. }
  1486. sub SetRange {
  1487. }
  1488. sub Min {
  1489. my $self = shift;
  1490. my $value = shift;
  1491. if(defined($value)) {
  1492. my $flag = shift;
  1493. $flag = 1 unless defined($flag);
  1494. # 1031 == TBM_SETRANGEMIN
  1495. return Win32::GUI::SendMessage($self, 1031, $flag, $value);
  1496. } else {
  1497. # 1025 == TBM_GETRANGEMIN
  1498. return Win32::GUI::SendMessage($self, 1025, 0, 0);
  1499. }
  1500. }
  1501. sub Max {
  1502. my $self = shift;
  1503. my $value = shift;
  1504. if(defined($value)) {
  1505. my $flag = shift;
  1506. $flag = 1 unless defined($flag);
  1507. # 1032 == TBM_SETRANGEMAX
  1508. return Win32::GUI::SendMessage($self, 1032, $flag, $value);
  1509. } else {
  1510. # 1026 == TBM_GETRANGEMAX
  1511. return Win32::GUI::SendMessage($self, 1026, 0, 0);
  1512. }
  1513. }
  1514. sub Pos {
  1515. my $self = shift;
  1516. my $value = shift;
  1517. if(defined($value)) {
  1518. my $flag = shift;
  1519. $flag = 1 unless defined($flag);
  1520. # 1029 == TBM_SETPOS
  1521. return Win32::GUI::SendMessage($self, 1029, $flag, $value);
  1522. } else {
  1523. # 1024 == TBM_GETPOS
  1524. return Win32::GUI::SendMessage($self, 1024, 0, 0);
  1525. }
  1526. }
  1527. sub TicFrequency {
  1528. my $self = shift;
  1529. my $value = shift;
  1530. # 1044 == TBM_SETTICFREQ
  1531. return Win32::GUI::SendMessage($self, 1044, $value, 0);
  1532. }
  1533. ###############################################################################
  1534. # (@)PACKAGE:Win32::GUI::Slider
  1535. #
  1536. package Win32::GUI::Slider;
  1537. @ISA = qw(Win32::GUI::Trackbar);
  1538. ###############################################################################
  1539. # (@)PACKAGE:Win32::GUI::UpDown
  1540. #
  1541. package Win32::GUI::UpDown;
  1542. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1543. ###########################################################################
  1544. # (@)METHOD:new Win32::GUI::UpDown(PARENT, %OPTIONS)
  1545. # Creates a new UpDown object;
  1546. # can also be called as PARENT->AddUpDown(%OPTIONS).
  1547. sub new {
  1548. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__UPDOWN", 0), @_);
  1549. }
  1550. ###############################################################################
  1551. # (@)PACKAGE:Win32::GUI::Tooltip
  1552. #
  1553. package Win32::GUI::Tooltip;
  1554. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1555. ###########################################################################
  1556. # (@)METHOD:new Win32::GUI::Tooltip(PARENT, %OPTIONS)
  1557. # (preliminary) creates a new Tooltip object
  1558. sub new {
  1559. my $parent = $_[0];
  1560. my $new = Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__TOOLTIP", 0), @_);
  1561. if($new) {
  1562. if($parent->{-tooltips}) {
  1563. push(@{$parent->{-tooltips}}, $new->{-handle});
  1564. } else {
  1565. $parent->{-tooltips} = [ $new->{-handle} ];
  1566. }
  1567. }
  1568. return $new;
  1569. }
  1570. ###############################################################################
  1571. # (@)PACKAGE:Win32::GUI::Animation
  1572. #
  1573. package Win32::GUI::Animation;
  1574. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1575. ###########################################################################
  1576. # (@)METHOD:new Win32::GUI::Animation(PARENT, %OPTIONS)
  1577. # Creates a new Animation object;
  1578. # can also be called as PARENT->AddAnimation(%OPTIONS).
  1579. # Class specific %OPTIONS are:
  1580. # -autoplay => 0/1 (default 0)
  1581. # starts playing the animation as soon as an AVI clip is loaded
  1582. # -center => 0/1 (default 0)
  1583. # centers the animation in the control window
  1584. # -transparent => 0/1 (default 0)
  1585. # draws the animation using a transparent background
  1586. sub new {
  1587. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__ANIMATION", 0), @_);
  1588. }
  1589. ###############################################################################
  1590. # (@)PACKAGE:Win32::GUI::Rebar
  1591. #
  1592. package Win32::GUI::Rebar;
  1593. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1594. ###########################################################################
  1595. # (@)METHOD:new Win32::GUI::Rebar(PARENT, %OPTIONS)
  1596. # Creates a new Rebar object;
  1597. # can also be called as PARENT->AddRebar(%OPTIONS).
  1598. # Class specific %OPTIONS are:
  1599. # -bandborders => 0/1 (default 0)
  1600. # display a border to separate bands.
  1601. # -fixedorder => 0/1 (default 0)
  1602. # band position cannot be swapped.
  1603. # -imagelist => Win32::GUI::ImageList object
  1604. # -varheight => 0/1 (default 1)
  1605. # display bands using the minimum required height.
  1606. sub new {
  1607. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__REBAR", 0), @_);
  1608. }
  1609. ###############################################################################
  1610. # (@)PACKAGE:Win32::GUI::Header
  1611. #
  1612. package Win32::GUI::Header;
  1613. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1614. ###########################################################################
  1615. # (@)METHOD:new Win32::GUI::Header(PARENT, %OPTIONS)
  1616. # Creates a new Header object;
  1617. # can also be called as PARENT->AddHeader(%OPTIONS).
  1618. # Class specific %OPTIONS are:
  1619. # -buttons => 0/1 (default 0)
  1620. # header items look like push buttons and can be clicked.
  1621. # -hottrack => 0/1 (default 0)
  1622. # -imagelist => Win32::GUI::ImageList object
  1623. sub new {
  1624. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__HEADER", 0), @_);
  1625. }
  1626. ###############################################################################
  1627. # (@)PACKAGE:Win32::GUI::ComboboxEx
  1628. #
  1629. package Win32::GUI::ComboboxEx;
  1630. @ISA = qw(Win32::GUI::Combobox Win32::GUI::WindowProps);
  1631. ###########################################################################
  1632. # (@)METHOD:new Win32::GUI::ComboboxEx(PARENT, %OPTIONS)
  1633. # Creates a new ComboboxEx object;
  1634. # can also be called as PARENT->AddComboboxEx(%OPTIONS).
  1635. # Class specific %OPTIONS are:
  1636. # -imagelist => Win32::GUI::ImageList object
  1637. # Except for images, a ComboboxEx object acts like a Win32::GUI::Combobox
  1638. # object. See also new Win32::GUI::Combobox().
  1639. sub new {
  1640. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__COMBOBOXEX", 0), @_);
  1641. }
  1642. ###############################################################################
  1643. # (@)PACKAGE:Win32::GUI::DateTime
  1644. #
  1645. package Win32::GUI::DateTime;
  1646. @ISA = qw(Win32::GUI Win32::GUI::WindowProps);
  1647. ###########################################################################
  1648. # (@)METHOD:new Win32::GUI::DateTime(PARENT, %OPTIONS)
  1649. # Creates a new DateTime object;
  1650. # can also be called as PARENT->AddDateTime(%OPTIONS).
  1651. # Class specific %OPTIONS are:
  1652. # [TBD]
  1653. sub new {
  1654. return Win32::GUI->_new(Win32::GUI::constant("WIN32__GUI__DTPICK", 0), @_);
  1655. }
  1656. ###############################################################################
  1657. # (@)PACKAGE:Win32::GUI::Graphic
  1658. #
  1659. package Win32::GUI::Graphic;
  1660. @ISA = qw(Win32::GUI::DC);
  1661. ###########################################################################
  1662. # (@)METHOD:new Win32::GUI::Graphic(PARENT, %OPTIONS)
  1663. # Creates a new Graphic object;
  1664. # can also be called as PARENT->AddGraphic(%OPTIONS).
  1665. # Class specific %OPTIONS are:
  1666. sub new {
  1667. my $class = shift;
  1668. my $self = {};
  1669. bless($self, $class);
  1670. my(@input) = @_;
  1671. my $handle = Win32::GUI::Create($self, 101, @input);
  1672. if($handle) {
  1673. return $self;
  1674. } else {
  1675. return undef;
  1676. }
  1677. }
  1678. ###########################################################################
  1679. # (@)METHOD:GetDC()
  1680. # Returns the DC object associated with the window.
  1681. sub GetDC {
  1682. my $self = shift;
  1683. return Win32::GUI::DC->new($self);
  1684. }
  1685. ###############################################################################
  1686. # (@)PACKAGE:Win32::GUI::ImageList
  1687. #
  1688. package Win32::GUI::ImageList;
  1689. @ISA = qw(Win32::GUI);
  1690. ###########################################################################
  1691. # (@)METHOD:new Win32::GUI::ImageList(X, Y, FLAGS, INITAL, GROW)
  1692. # Creates an ImageList object; X and Y specify the size of the images,
  1693. # FLAGS [TBD]. INITIAL and GROW specify the number of images the ImageList
  1694. # actually contains (INITIAL) and the number of images for which memory
  1695. # is allocated (GROW).
  1696. sub new {
  1697. my $class = shift;
  1698. my $handle = Win32::GUI::ImageList::Create(@_);
  1699. if($handle) {
  1700. $self->{-handle} = $handle;
  1701. bless($self, $class);
  1702. return $self;
  1703. } else {
  1704. return undef;
  1705. }
  1706. }
  1707. ###########################################################################
  1708. # (@)METHOD:Add(BITMAP, [BITMAPMASK])
  1709. # Adds a bitmap to the ImageList; both BITMAP and BITMAPMASK can be either
  1710. # Win32::GUI::Bitmap objects or filenames.
  1711. sub Add {
  1712. my($self, $bitmap, $bitmapMask) = @_;
  1713. $bitmap = new Win32::GUI::Bitmap($bitmap) unless ref($bitmap);
  1714. if(defined($bitmapMask)) {
  1715. $bitmapMask = new Win32::GUI::Bitmap($bitmapMask) unless ref($bitmapMask);
  1716. $self->AddBitmap($bitmap, $bitmapMask);
  1717. } else {
  1718. $self->AddBitmap($bitmap);
  1719. }
  1720. }
  1721. ###############################################################################
  1722. # (@)PACKAGE:Win32::GUI::Menu
  1723. #
  1724. package Win32::GUI::Menu;
  1725. @ISA = qw(Win32::GUI);
  1726. ###########################################################################
  1727. # (@)METHOD:new Win32::GUI::Menu(...)
  1728. sub new {
  1729. my $class = shift;
  1730. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1731. my $self={};
  1732. if($#_ > 0) {
  1733. return Win32::GUI::MakeMenu(@_);
  1734. } else {
  1735. my $handle = Win32::GUI::CreateMenu();
  1736. if($handle) {
  1737. $self->{-handle} = $handle;
  1738. bless($self, $class);
  1739. return $self;
  1740. } else {
  1741. return undef;
  1742. }
  1743. }
  1744. }
  1745. ###########################################################################
  1746. # (@)METHOD:AddMenuButton()
  1747. # see new Win32::GUI::MenuButton()
  1748. sub AddMenuButton {
  1749. return Win32::GUI::MenuButton->new(@_);
  1750. }
  1751. ###############################################################################
  1752. # (@)PACKAGE:Win32::GUI::MenuButton
  1753. #
  1754. package Win32::GUI::MenuButton;
  1755. @ISA = qw(Win32::GUI);
  1756. ###########################################################################
  1757. # (@)METHOD:new Win32::GUI::MenuButton()
  1758. sub new {
  1759. my $class = shift;
  1760. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1761. my $menu = shift;
  1762. $menu = $menu->{-handle} if ref($menu);
  1763. # print "new MenuButton: menu=$menu\n";
  1764. my %args = @_;
  1765. my $self = {};
  1766. my $handle = Win32::GUI::CreatePopupMenu();
  1767. if($handle) {
  1768. $args{-submenu} = $handle;
  1769. Win32::GUI::MenuButton::InsertMenuItem($menu, %args);
  1770. $self->{-handle} = $handle;
  1771. bless($self, $class);
  1772. if($args{-name}) {
  1773. $Win32::GUI::Menus{$args{-id}} = $self;
  1774. $self->{-name} = $args{-name};
  1775. }
  1776. return $self;
  1777. } else {
  1778. return undef;
  1779. }
  1780. }
  1781. ###########################################################################
  1782. # (@)METHOD:AddMenuItem()
  1783. # see new Win32::GUI::MenuItem()
  1784. sub AddMenuItem {
  1785. return Win32::GUI::MenuItem->new(@_);
  1786. }
  1787. ###############################################################################
  1788. # (@)PACKAGE:Win32::GUI::MenuItem
  1789. #
  1790. package Win32::GUI::MenuItem;
  1791. @ISA = qw(Win32::GUI);
  1792. ###########################################################################
  1793. # (@)METHOD:new Win32::GUI::MenuItem()
  1794. sub new {
  1795. my $class = shift;
  1796. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1797. my $menu = shift;
  1798. return undef unless ref($menu) =~ /^Win32::GUI::Menu/;
  1799. my %args = @_;
  1800. my $self = {};
  1801. my $handle = Win32::GUI::MenuButton::InsertMenuItem($menu, %args);
  1802. if($handle) {
  1803. $self->{-handle} = $handle;
  1804. $Win32::GUI::menucallbacks{$args{-id}} = $args{-function} if $args{-function};
  1805. $self->{-id} = $args{-id};
  1806. $self->{-menu} = $menu->{-handle};
  1807. bless($self, $class);
  1808. if($args{-name}) {
  1809. $Win32::GUI::Menus{$args{-id}} = $self;
  1810. $self->{-name} = $args{-name};
  1811. }
  1812. return $self;
  1813. } else {
  1814. return undef;
  1815. }
  1816. }
  1817. ###############################################################################
  1818. # (@)PACKAGE: Win32::GUI::Timer
  1819. #
  1820. package Win32::GUI::Timer;
  1821. @ISA = qw(Win32::GUI);
  1822. ###########################################################################
  1823. # (@)METHOD:new Win32::GUI::Timer(PARENT, NAME, ELAPSE)
  1824. # Creates a new timer in the PARENT window named NAME that will
  1825. # trigger its Timer() event after ELAPSE milliseconds.
  1826. # Can also be called as PARENT->AddTimer(NAME, ELAPSE).
  1827. sub new {
  1828. my $class = shift;
  1829. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1830. my $window = shift;
  1831. my $name = shift;
  1832. my $elapse = shift;
  1833. my %args = @_;
  1834. my $id = $Win32::GUI::TimerIdCounter;
  1835. $Win32::GUI::TimerIdCounter++;
  1836. Win32::GUI::SetTimer($window, $id, $elapse);
  1837. my $self = {};
  1838. bless($self, $class);
  1839. # add $self->{name}
  1840. $self->{-id} = $id;
  1841. $self->{-name} = $name;
  1842. $self->{-parent} = $window;
  1843. $self->{-handle} = $window->{-handle};
  1844. $self->{-interval} = $elapse;
  1845. # add to $window->timers->{$id} = $self;
  1846. $window->{-timers}->{$id} = $self;
  1847. $window->{$name} = $self;
  1848. return $self;
  1849. }
  1850. ###########################################################################
  1851. # (@)METHOD:Interval(ELAPSE)
  1852. # Changes the timeout value of the Timer to ELAPSE milliseconds.
  1853. # If ELAPSE is 0, the Timer is disabled;
  1854. # can also be used to resume a Timer after a Kill().
  1855. sub Interval {
  1856. my $self = shift;
  1857. my $interval = shift;
  1858. if(defined $interval) {
  1859. Win32::GUI::SetTimer($self->{-parent}->{-handle}, $self->{-id}, $interval);
  1860. $self->{-interval} = $interval;
  1861. } else {
  1862. return $self->{-interval};
  1863. }
  1864. }
  1865. ###########################################################################
  1866. # (@)METHOD:Kill()
  1867. # Disables the Timer.
  1868. sub Kill {
  1869. my $self = shift;
  1870. Win32::GUI::KillTimer($self->{-parent}->{-handle}, $self->{-id});
  1871. }
  1872. ###########################################################################
  1873. # (@)INTERNAL:DESTROY(HANDLE)
  1874. sub DESTROY {
  1875. my $self = shift;
  1876. Win32::GUI::KillTimer($self->{-handle}, $self->{-id});
  1877. undef $self->{-parent}->{-timers}->{$self->{-id}};
  1878. }
  1879. ###############################################################################
  1880. # (@)PACKAGE:Win32::GUI::NotifyIcon
  1881. #
  1882. package Win32::GUI::NotifyIcon;
  1883. ###########################################################################
  1884. # (@)METHOD:new Win32::GUI::NotifyIcon(PARENT, %OPTIONS)
  1885. # Creates a new NotifyIcon (also known as system tray icon) object;
  1886. # can also be called as PARENT->AddNotifyIcon(%OPTIONS).
  1887. # %OPTIONS are:
  1888. # -icon => Win32::GUI::Icon object
  1889. # -id => NUMBER
  1890. # a unique identifier for the NotifyIcon object
  1891. # -name => STRING
  1892. # the name for the object
  1893. # -tip => STRING
  1894. # the text that will appear as tooltip when the mouse is
  1895. # on the NotifyIcon
  1896. sub new {
  1897. my $class = shift;
  1898. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1899. my $window = shift;
  1900. my %args = @_;
  1901. $Win32::GUI::NotifyIconIdCounter++;
  1902. if(!exists($args{-id})) {
  1903. $args{-id} = $Win32::GUI::NotifyIconIdCounter;
  1904. }
  1905. Win32::GUI::NotifyIcon::Add($window, %args);
  1906. my $self = {};
  1907. bless($self, $class);
  1908. $self->{-id} = $args{-id};
  1909. $self->{-name} = $args{-name};
  1910. $self->{-parent} = $window;
  1911. $self->{-handle} = $window->{-handle};
  1912. $window->{-notifyicons}->{$args{-id}} = $self;
  1913. $window->{$args{-name}} = $self;
  1914. return $self;
  1915. }
  1916. ###########################################################################
  1917. # (@)INTERNAL:DESTROY(OBJECT)
  1918. sub DESTROY {
  1919. my($self) = @_;
  1920. Win32::GUI::NotifyIcon::Delete(
  1921. $self->{-parent},
  1922. -id => $self->{-id},
  1923. );
  1924. undef $self->{-parent}->{$self->{-name}};
  1925. }
  1926. ###############################################################################
  1927. # (@)PACKAGE:Win32::GUI::DC
  1928. #
  1929. package Win32::GUI::DC;
  1930. ###########################################################################
  1931. # (@)METHOD:new Win32::GUI::DC(WINDOW | DRIVER, DEVICE)
  1932. # Creates a new DC object; the first form (WINDOW is a Win32::GUI object)
  1933. # gets the DC for the specified window (can also be called as
  1934. # WINDOW->GetDC). The second form creates a DC for the specified DEVICE;
  1935. # actually, the only supported DRIVER is the display driver (eg. the
  1936. # screen). To get the DC for the entire screen use:
  1937. # $Screen = new Win32::GUI::DC("DISPLAY");
  1938. #
  1939. sub new {
  1940. my $class = shift;
  1941. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1942. my $self = {};
  1943. bless($self, $class);
  1944. my $window = shift;
  1945. if(defined($window)) {
  1946. if(ref($window)) {
  1947. $self->{-handle} = GetDC($window->{-handle});
  1948. $self->{-window} = $window->{-handle};
  1949. } else {
  1950. my $device = shift;
  1951. $self->{-handle} = CreateDC($window, $device);
  1952. }
  1953. } else {
  1954. $self = CreateDC("DISPLAY", 0);
  1955. }
  1956. return $self;
  1957. }
  1958. sub DESTROY {
  1959. my $self = shift;
  1960. if($self->{-window}) {
  1961. ReleaseDC($self->{-window}, $self->{-handle});
  1962. } else {
  1963. DeleteDC($self->{-handle});
  1964. }
  1965. }
  1966. ###############################################################################
  1967. # (@)PACKAGE:Win32::GUI::Pen
  1968. #
  1969. package Win32::GUI::Pen;
  1970. ###########################################################################
  1971. # (@)METHOD:new Win32::GUI::Pen(COLOR | %OPTIONS)
  1972. # Creates a new Pen object.
  1973. # Allowed %OPTIONS are:
  1974. # -style =>
  1975. # 0 PS_SOLID
  1976. # 1 PS_DASH
  1977. # 2 PS_DOT
  1978. # 3 PS_DASHDOT
  1979. # 4 PS_DASHDOTDOT
  1980. # 5 PS_NULL
  1981. # 6 PS_INSIDEFRAME
  1982. # -width => number
  1983. # -color => COLOR
  1984. sub new {
  1985. my $class = shift;
  1986. $class = "Win32::" . $class if $class =~ /^GUI::/;
  1987. my $self = {};
  1988. bless($self, $class);
  1989. $self->{-handle} = Create(@_);
  1990. return $self;
  1991. }
  1992. ###############################################################################
  1993. # (@)PACKAGE:Win32::GUI::Brush
  1994. #
  1995. package Win32::GUI::Brush;
  1996. ###########################################################################
  1997. # (@)METHOD:new Win32::GUI::Brush(COLOR | %OPTIONS)
  1998. # Creates a new Brush object.
  1999. # Allowed %OPTIONS are:
  2000. # -style =>
  2001. # 0 BS_SOLID
  2002. # 1 BS_NULL
  2003. # 2 BS_HATCHED
  2004. # 3 BS_PATTERN
  2005. # -pattern => Win32::GUI::Bitmap object (valid for -style => BS_PATTERN)
  2006. # -hatch => (valid for -style => BS_HATCHED)
  2007. # 0 HS_ORIZONTAL (-----)
  2008. # 1 HS_VERTICAL (|||||)
  2009. # 2 HS_FDIAGONAL (\\\\\)
  2010. # 3 HS_BDIAGONAL (/////)
  2011. # 4 HS_CROSS (+++++)
  2012. # 5 HS_DIAGCROSS (xxxxx)
  2013. # -color => COLOR
  2014. sub new {
  2015. my $class = shift;
  2016. $class = "Win32::" . $class if $class =~ /^GUI::/;
  2017. my $self = {};
  2018. bless($self, $class);
  2019. $self->{-handle} = Create(@_);
  2020. return $self;
  2021. }
  2022. ###############################################################################
  2023. # (@)INTERNAL:Win32::GUI::WindowProps
  2024. # the package we'll tie to a window hash to set/get properties in a more
  2025. # fashionable way...
  2026. #
  2027. package Win32::GUI::WindowProps;
  2028. my %TwoWayMethodMap = (
  2029. -text => "Text",
  2030. -left => "Left",
  2031. -top => "Top",
  2032. -width => "Width",
  2033. -height => "Height",
  2034. );
  2035. my %OneWayMethodMap = (
  2036. -scalewidth => "ScaleHeight",
  2037. -scaleheight => "ScaleWidth",
  2038. );
  2039. ###########################################################################
  2040. # (@)INTERNAL:TIEHASH
  2041. sub TIEHASH {
  2042. my($class, $object) = @_;
  2043. my $tied = { UNDERLYING => $object };
  2044. # print "[TIEHASH] called for '$class' '$object'\n";
  2045. # return bless $tied, $class;
  2046. return bless $object, $class;
  2047. }
  2048. ###########################################################################
  2049. # (@)INTERNAL:STORE
  2050. sub STORE {
  2051. my($self, $key, $value) = @_;
  2052. # print "[STORE] called for '$self' {$key}='$value'\n";
  2053. if(exists $TwoWayMethodMap{$key}) {
  2054. if(my $method = $self->can($TwoWayMethodMap{$key})) {
  2055. # print "[STORE] calling method '$TwoWayMethodMap{$key}' on '$self'\n";
  2056. return &{$method}($self, $value);
  2057. } else {
  2058. print "[STORE] PROBLEM: method '$TwoWayMethodMap{$key}' not found on '$self'\n";
  2059. }
  2060. } elsif($key eq "-style") {
  2061. # print "[STORE] calling GetWindowLong\n";
  2062. return Win32::GUI::GetWindowLong($self, -16, $value);
  2063. } else {
  2064. # print "[STORE] storing key '$key' in '$self'\n";
  2065. # return $self->{UNDERLYING}->{$key} = $value;
  2066. return $self->{$key} = $value;
  2067. }
  2068. }
  2069. ###########################################################################
  2070. # (@)INTERNAL:FETCH
  2071. sub FETCH {
  2072. my($self, $key) = @_;
  2073. if($key eq "UNDERLYING") {
  2074. # print "[FETCH] returning UNDERLYING for '$self'\n";
  2075. return $self->{UNDERLYING};
  2076. } elsif(exists $TwoWayMethodMap{$key}) {
  2077. # if(my $method = $self->{UNDERLYING}->can($TwoWayMethodMap{$key})) {
  2078. if(my $method = $self->can($TwoWayMethodMap{$key})) {
  2079. # print "[FETCH] calling method $TwoWayMethodMap{$key} on $self->{UNDERLYING}\n";
  2080. # print "[FETCH] calling method '$TwoWayMethodMap{$key}' on '$self'\n";
  2081. # return &{$method}($self->{UNDERLYING});
  2082. return &{$method}($self);
  2083. } else {
  2084. # print "[FETCH] method not found '$TwoWayMethodMap{$key}'\n";
  2085. return undef;
  2086. }
  2087. } elsif($key eq "-style") {
  2088. return Win32::GUI::GetWindowLong($self->{UNDERLYING}, -16);
  2089. #} elsif(exists $self->{UNDERLYING}->{$key}) {
  2090. # print "[FETCH] fetching key $key from $self->{UNDERLYING}\n";
  2091. # return $self->{UNDERLYING}->{$key};
  2092. } elsif(exists $self->{$key}) {
  2093. #print "[FETCH] fetching key '$key' from '$self'\n";
  2094. return $self->{$key};
  2095. } else {
  2096. # print "Win32::GUI::WindowProps::FETCH returning nothing for '$key' on $self->{UNDERLYING}\n";
  2097. #print "[FETCH] returning nothing for '$key' on '$self'\n";
  2098. return undef;
  2099. # return 0;
  2100. }
  2101. }
  2102. sub FIRSTKEY {
  2103. my $self = shift;
  2104. my $a = keys %{ $self };
  2105. my ($k, $v) = each %{ $self };
  2106. # print "[FIRSTKEY] k='$k' v='$v'\n";
  2107. return $k;
  2108. }
  2109. sub NEXTKEY {
  2110. my $self = shift;
  2111. my ($k, $v) = each %{ $self };
  2112. # print "[NEXTKEY] k='$k' v='$v'\n";
  2113. return $k;
  2114. }
  2115. sub EXISTS {
  2116. my($self, $key) = @_;
  2117. # return exists $self->{UNDERLYING}->{$key};
  2118. return exists $self->{$key};
  2119. }
  2120. ###############################################################################
  2121. # dynamically load in the GUI.dll module.
  2122. #
  2123. package Win32::GUI;
  2124. bootstrap Win32::GUI;
  2125. # Preloaded methods go here.
  2126. $Win32::GUI::StandardWinClass = Win32::GUI::Class->new(
  2127. -name => "PerlWin32GUI_STD_OBSOLETED"
  2128. );
  2129. $Win32::GUI::StandardWinClassVisual = Win32::GUI::Class->new(
  2130. -name => "PerlWin32GUI_STD",
  2131. -visual => 1,
  2132. );
  2133. $Win32::GUI::GraphicWinClass = Win32::GUI::Class->new(
  2134. -name => "Win32::GUI::Graphic",
  2135. -widget => "Graphic",
  2136. );
  2137. $Win32::GUI::RICHED = Win32::GUI::LoadLibrary("RICHED32");
  2138. END {
  2139. # print "Freeing library RICHED32\n";
  2140. Win32::GUI::FreeLibrary($Win32::GUI::RICHED);
  2141. }
  2142. #Currently Autoloading is not implemented in Perl for win32
  2143. # Autoload methods go after __END__, and are processed by the autosplit program.
  2144. 1;
  2145. __END__