view release on metacpan or  search on metacpan

Win32RotLabel.pm  view on Meta::CPAN

package Tk::Win32RotLabel;

our $VERSION = 0.4;

use Tk;
use Tk::widgets qw/Label/;
use base qw/Tk::Derived Tk::Label/;
use Win32::API;

use strict;
use Carp;

our (
     $CreateFont,
     $SelectObject,
     $DeleteObject,
     $GetDC,
     $ReleaseDC,
     $ExtTextOut,
     $GetTextExtent,
     $SetBkColor,
     $SetTextColor,

     %configured,
    );

Construct Tk::Widget 'Win32RotLabel';

# load the proper Win32::API suroutines at init.
sub ClassInit {
  my ($class, $mw) = @_;

  $class->SUPER::ClassInit($mw);

  $CreateFont    = new Win32::API('gdi32' , 'CreateFont',   [('N') x 13,
							     'P'], 'N');
  $SelectObject  = new Win32::API('gdi32' , 'SelectObject', [qw/N N/], 'N');
  $DeleteObject  = new Win32::API('gdi32' , 'DeleteObject', ['P'], 'I');
  $GetDC         = new Win32::API('user32', 'GetDC',        ['N'], 'N');
  $ReleaseDC     = new Win32::API('user32', 'ReleaseDC',    [qw/N N/], 'I');
  $ExtTextOut    = new Win32::API('gdi32' , 'ExtTextOut',   [qw/N I I N P P
							     I P/], 'I');
  $GetTextExtent = new Win32::API('user32', 'GetTabbedTextExtent', [qw/N P N
								    N P/], 'I');
  $SetBkColor    = new Win32::API('gdi32', 'SetBkColor', [qw/N N/], 'N');
  $SetTextColor  = new Win32::API('gdi32', 'SetTextColor', [qw/N N/], 'N');
}

sub Populate {
  my ($w, $args) = @_;

  # clean up any images the user adds .. that's not the point.
  delete $args->{-image};
  $args->{-bitmap} = 'transparent';

  $w->SUPER::Populate($args);

  $w->ConfigSpecs(
    -angle        => [qw/METHOD angle Angle/, 0],
    -text         => [qw/METHOD text Text/, ''],
    -textvariable => [qw/METHOD textvariabel Textvariable/, undef],
    -font         => [qw/PASSIVE font Font/, ['Times New Roman']],
   );

  my $top = $w->toplevel;
  unless ($configured{$top}) {
    $top->bind('<Configure>'  => [\&_updateDescendants, $top]);