#!/usr/bin/winperl
use warnings;
use strict;

use Win32::GUI::Carp 'fatalsToDialog';

use Win32::API;
use Win32::GuiTest 'FindWindowLike';

use constant SW_SHOW                => 0x5;
use constant SW_HIDE                => 0x0;
use constant GWL_STYLE              => -16;
use constant GWL_EXSTYLE            => -20;
use constant WS_BORDER              => 0x800000;
use constant WS_CAPTION             => 0xC00000;
use constant WS_OVERLAPPEDWINDOW    => 0xCF0000;
use constant WS_EX_TOOLWINDOW       => 0x80;
use constant WS_EX_APPWINDOW        => 0x40000;
use constant SWP_NOSIZE             => 0x1;
use constant SWP_NOMOVE             => 0x2;
use constant SWP_NOZORDER           => 0x4;
use constant SWP_FRAMECHANGED       => 0x20;
use constant WS_EX_STATICEDGE       => 0x20000;
use constant WS_EX_NOACTIVATE       => 0x8000000;
use constant WS_EX_WINDOWEDGE       => 0x100;
use constant WS_EX_OVERLAPPEDWINDOW => 0x300;

Win32::API->Import('user32', 'LONG GetWindowLong (HWND h, int f)')    
+     and
Win32::API->Import('user32', 'LONG SetWindowLong (HWND h, int f, LONG 
+n)') and
Win32::API->Import('user32', 'BOOL ShowWindow    (HWND h, int f)')
  or die "Couldn't import necessary functions.\n";

#notitlebar('Buddy List');
unfocusable('Buddy List');

# Make one or more windows with title(s) unfocusable
# (this also removes their taskbar entry; at least in XP).
sub unfocusable {
  foreach my $win (@_) {
    my ($hwnd) = FindWindow($win);
    applyexstyle($hwnd, WS_EX_NOACTIVATE);
  }
}

# Undo what unfocusable() does.
sub focusable {
  foreach my $win (@_) {
    my ($hwnd) = FindWindow($win);
    removeexstyle($hwnd, WS_EX_NOACTIVATE);
  }
}

# Remove window(s) frame (incl. min, max, & close buttons).
sub notitlebar {
  foreach my $win (@_) {
    my ($hwnd) = FindWindow($win);
    removestyle($hwnd, WS_CAPTION);
  }
}

# Give window(s) a toolbox style frame (ie, small close button).
sub toolborder {
  foreach my $win (@_) {
    my ($hwnd) = FindWindow($win);
    applyexstyle($hwnd, WS_EX_TOOLWINDOW);
  }
}

# Give window(s) a normal frame.
sub normalborder {
  foreach my $win (@_) {
    my ($hwnd) = FindWindow($win);
    setstyle($hwnd, WS_BORDER | WS_OVERLAPPEDWINDOW);
    setexstyle($hwnd, WS_EX_APPWINDOW);
  }
}

# Set window with $hwnd to have exact $style (replace everything else)
+.
sub setstyle {
  my ($hwnd, $style) = @_;

  ShowWindow($hwnd, SW_HIDE);
  SetWindowLong($hwnd, GWL_STYLE, $style);
  ShowWindow($hwnd, SW_SHOW);
}

# Set the style bits set in $style for $hwnd
# (NewStyle = OldStyle | $style).
sub applystyle {
  my ($hwnd, $style) = @_;

  my $old = GetWindowLong($hwnd, GWL_STYLE);
  $old |= $style;

  ShowWindow($hwnd, SW_HIDE);
  SetWindowLong($hwnd, GWL_STYLE, $old);
  ShowWindow($hwnd, SW_SHOW);
}

# Clear the style bits set in $style for $hwnd
# (NewStyle = OldStyle & ~$style).
sub removestyle {
  my ($hwnd, $style) = @_;

  my $old = GetWindowLong($hwnd, GWL_STYLE);
  $old &= ~$style;

  ShowWindow($hwnd, SW_HIDE);
  SetWindowLong($hwnd, GWL_STYLE, $old);
  ShowWindow($hwnd, SW_SHOW);
}

# Same as setstyle() for extended style data.
sub setexstyle {
  my ($hwnd, $style) = @_;

  ShowWindow($hwnd, SW_HIDE);
  SetWindowLong($hwnd, GWL_EXSTYLE, $style);
  ShowWindow($hwnd, SW_SHOW);
}

# Same as applystyle() for extended style data.
sub applyexstyle {
  my ($hwnd, $style) = @_;

  my $old = GetWindowLong($hwnd, GWL_EXSTYLE);
  $old |= $style;

  ShowWindow($hwnd, SW_HIDE);
  SetWindowLong($hwnd, GWL_EXSTYLE, $old);
  ShowWindow($hwnd, SW_SHOW);
}

# Same as removestyle() for extended style data.
sub removeexstyle {
  my ($hwnd, $style) = @_;

  my $old = GetWindowLong($hwnd, GWL_EXSTYLE);
  $old &= ~$style;

  ShowWindow($hwnd, SW_HIDE);
  SetWindowLong($hwnd, GWL_EXSTYLE, $old);
  ShowWindow($hwnd, SW_SHOW);
}

# Find a window with $title and return its HWND.
sub FindWindow {
  my $title = shift;

  my $timeout = 30;
  my $hwnd;
  {
    ($hwnd) = FindWindowLike(undef, $title);
    return $hwnd if $hwnd;
    last unless --$timeout;
    sleep 1;
    redo;
  }

  die "Couldn't find window '$title'\n";
}
[download]