{
+----------------------------------------------------------------------------+
|                                      İ  İ                                  |
|                                    İİ İ İ İ                                |
|                                 İİİ İ   İ  İ                               |
|                                 İİ    İ İ   İ                              |
|                  İ             İİ     İ  İ                                 |
|                 İ İ            İİİ    İİ  İ                                |
|             İİ  İ  İ      İİİİİİİİİİ  İ                                    |
|            İ  İİ  İİ      İİİİİİİİİİİİİİİ                                  |
|            İ İİİ İİİİİİ İİİ İ   İİİİİİİİ                                   |
|           İ İİ İİİİİİİİİİİİ İ   İİİİİİİİİİ      Copyright İ 1996-1997 by:  |
|           İ İİİİİİ İİİİİİİİİİİ  İ İİİİİ İİ                                 |
|          İ İİİİİİİ   İİİİİ İİİİ    İİ İİ İ      WHITE ANTS SYSTEMHOUSE BV  |
|         İ  İİİİİİİ İİİ İİİ İİ İ       İİİİ      Geleen 12                  |
|         İ İİİİİİİ    İ   İİ   İİİ       İ       8032 GB Zwolle             |
|           İİİİİİ     İ            İ İ           Netherlands                |
|      İİİ  İİİİİ      İ     İİ     İ  İ                                     |
|            İİ       İ              İ  İİİ İ     Tel. +31 38 453 86 31      |
|      İ              İ              İ            Fax. +31 38 453 41 22      |
|      İ             İ               İİ                                      |
|    İ              İ                  İİ         www.whiteants.com          |
|  İİ              İ                     İ İ      support@whiteants.com      |
|                 İ                                                          |
+----------------------------------------------------------------------------+
  File      : WTaskBar
  Model     : WTASKBAR
  Version   : 1.1
  Date      : 10-03-97
  Time      : 19:57:36
  Author    : Jeroen Laarhoven

  Descripton:
  The WTaskBar unit contains the classes: TWinTaskBar and  TCustomWinTaskBar.

+----------------------------------------------------------------------------+
| DISCLAIMER:                                                                |
| THIS SOURCE IS FREEWARE. YOU ARE ALLOWED TO USE IT IN YOUR OWN PROJECTS    |
| WITHOUT ANY RESTRICTIONS. YOU ARE NOT ALLOWED TO SELL THE SOURCE CODE.     |
| THERE IS NO WARRANTY AT ALL - YOU USE IT ON YOUR OWN RISC. WHITE ANTS DOES |
| NOT ASSUME ANY RESPONSIBILITY FOR ANY DAMAGE OR ANY LOSS OF TIME OR MONEY  |
| DUE THE USE OF ANY PART OF THIS SOURCE CODE.                               |
+----------------------------------------------------------------------------+
}
 
unit WTaskBar;

interface

uses
  Menus, ShellApi,
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

const
  WM_CallBack = WM_USER + 123;
  
type
  TCustomWinTaskbar = class (TComponent)
  private
    FHint: string;
    FIcon: TIcon;
    FNotifyIconData: TNotifyIconData;
    FOnDblClick: TNotifyEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;
    FOwnerHandle: HWND;
    FPopUpMenu: TPopupMenu;
    FShowIcon: Boolean;
    FWindowHandle: HWND;
  protected
    procedure DblClick; virtual;
    procedure DoPopup(xPos, yPos: Integer);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
        Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        virtual;
    procedure Notification(Component: TComponent; Operation: TOperation);
        override;
    procedure SetHint(const aValue: string);
    procedure SetIcon(aValue: TIcon);
    procedure SetShowIcon(aValue: Boolean);
    procedure UpdateTaskbar;
    procedure WMCallBack(var Message: TMessage);
    property WindowHandle: HWND read FWindowHandle write FWindowHandle;
    property Hint: string read FHint write SetHint;
    property Icon: TIcon read FIcon write SetIcon;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property PopUpMenu: TPopupMenu read FPopUpMenu write FPopUpMenu;
    property ShowIcon: Boolean read FShowIcon write SetShowIcon;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TWinTaskbar = class (TCustomWinTaskbar)
  private
    FOnClick: TNotifyEvent;
    FSkipNextOnClick: Boolean;
  protected
    procedure Click;
    procedure DblClick; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: 
        Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
        override;
  published
    property WindowHandle;
    property Hint;
    property Icon;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick;
    property PopUpMenu;
    property ShowIcon;
  end;

procedure Register;

implementation

{
****************************** TCustomWinTaskbar *******************************
}
constructor TCustomWinTaskbar.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FIcon := TIcon.Create;
  FOwnerHandle := (Owner as TForm).Handle;
  if not (csDesigning in ComponentState) then
  begin
    FWindowHandle := AllocateHWnd( WMCallBack);
    With FNotifyIconData do
    begin
      cbSize := SizeOf( TNotifyIconData);
      Wnd := FWindowHandle;
      uID := 0;
      uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
      uCallbackMessage := WM_CallBack;
      hIcon := 0;
      StrPCopy( szTip, FHint);
    end;
  end;
end;

destructor TCustomWinTaskbar.Destroy;
begin
  ShowIcon := False; {remove ourself from taskbar}
  FIcon.Free;
  DeallocateHWnd( FWindowHandle);
  inherited Destroy;
end;

procedure TCustomWinTaskbar.DblClick;
begin
  if Assigned( FOnDblClick) then FOnDblClick( Self);
end;

procedure TCustomWinTaskbar.DoPopup(xPos, yPos: Integer);
begin
  if Assigned( PopupMenu) then
  begin
    // MS Workaround for incorrect handling of menu
    SetForegroundWindow( FOwnerHandle);
    PopupMenu.Popup( xPos, yPos);
    // MS Workaround for incorrect handling of menu
    PostMessage( FOwnerHandle, WM_USER, 0, 0);
  end;
end;

procedure TCustomWinTaskbar.MouseDown(Button: TMouseButton; Shift: TShiftState; 
    X, Y: Integer);
begin
  if Assigned( FOnMouseDown) then FOnMouseDown( Self, Button, Shift, X, Y);
end;

procedure TCustomWinTaskbar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned( FOnMouseMove) then FOnMouseMove( Self, Shift, X, Y);
end;

procedure TCustomWinTaskbar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
    Y: Integer);
begin
  if Assigned( FOnMouseUp) then FOnMouseUp( Self, Button, Shift, X, Y);
end;

procedure TCustomWinTaskbar.Notification(Component: TComponent; Operation: 
    TOperation);
begin
  inherited Notification(Component, Operation);
  if Operation = opRemove then
  begin
    if Component = PopUpMenu then PopUpMenu := nil;
  end;
end;

procedure TCustomWinTaskbar.SetHint(const aValue: string);
begin
  if not (csDesigning in ComponentState) then
    if FHint <> aValue then
    begin
      StrPCopy( FNotifyIconData.szTip, aValue);
      UpdateTaskbar;
    end;
  FHint := aValue;
end;

procedure TCustomWinTaskbar.SetIcon(aValue: TIcon);
begin
  FIcon.Assign( aValue);
  if not (csDesigning in ComponentState) then
  begin
    FNotifyIconData.hIcon := 0;
    if ShowIcon and (aValue <> nil) then
      FNotifyIconData.hIcon := FIcon.Handle;
    UpdateTaskbar;
  end;
end;

procedure TCustomWinTaskbar.SetShowIcon(aValue: Boolean);
begin
  FShowIcon := aValue;
  UpdateTaskbar;
end;

procedure TCustomWinTaskbar.UpdateTaskbar;
begin
  if ShowIcon and not FIcon.Empty then
  begin
    if FNotifyIconData.hIcon = 0 then
    begin
      FNotifyIconData.hIcon := FIcon.Handle;
      Shell_NotifyIcon( NIM_ADD, @FNotifyIconData); {add}
    end else begin
      FNotifyIconData.hIcon := FIcon.Handle;
      Shell_NotifyIcon( NIM_MODIFY, @FNotifyIconData) {update}
    end;
  end else begin
    FNotifyIconData.hIcon := 0;
    Shell_NotifyIcon( NIM_DELETE, @FNotifyIconData); {remove}
  end;
end;

procedure TCustomWinTaskbar.WMCallBack(var Message: TMessage);
var
  Shift: TShiftState;
  P: TPoint;
begin
  { LParam = mouse message, WParam = icon identifier }
  Shift := [];
  GetCursorPos( P);
  with Message do
  begin
    if Msg = WM_Callback then
      case LParam of
        WM_LBUTTONDOWN:   MouseDown( mbLeft, Shift, P.X, P.Y);
        WM_MBUTTONDOWN:   MouseDown( mbMiddle, Shift, P.X, P.Y);
        WM_RBUTTONDOWN:   MouseDown( mbRight, Shift, P.X, P.Y);
        WM_LBUTTONUP:     MouseUp( mbLeft, Shift, P.X, P.Y);
        WM_MBUTTONUP:     MouseUp( mbMiddle, Shift, P.X, P.Y);
        WM_RBUTTONUP:     MouseUp( mbRight, Shift, P.X, P.Y);
        WM_LBUTTONDBLCLK: DblClick;
        WM_MBUTTONDBLCLK: DblClick;
        WM_RBUTTONDBLCLK: DblClick;
        WM_MOUSEMOVE:     MouseMove( Shift, P.X, P.Y);
        end{case}
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  end;
end;

{
********************************* TWinTaskbar **********************************
}
procedure TWinTaskbar.Click;
begin
  if Assigned( FOnClick) then
  begin
    SetForegroundWindow( FOwnerHandle);
    FOnClick( Self);
  end;
end;

procedure TWinTaskbar.DblClick;
begin
  if Assigned( FOnDblClick) then
  begin
    FSkipNextOnClick := True;
    SetForegroundWindow( FOwnerHandle);
    FOnDblClick( Self);
  end;
end;

procedure TWinTaskbar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: 
    Integer);
begin
  if (Button = mbRight) then DoPopUp( X, Y);
end;

procedure TWinTaskbar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: 
    Integer);
begin
  if (Button = mbLeft) then
  begin
    if FSkipNextOnClick then
      FSkipNextOnClick := False
    else
      Click;
  end;
end;

procedure Register;
begin
  RegisterComponents('Additional', [TWinTaskbar]);
end;

initialization

end.