{ 
    SemTel version 1.0.0 ... comfortable telnet client
    Copyright (C) 1995-2000 Jan Tomasek <jan@tomasek.cz>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit Keygrab;

interface

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

type
  TKeyGrabber = class(TWinControl)
  private
  fOnKeyDown : TKeyEvent;
  fOnKeyUp : TKeyEvent;
  protected
  constructor Create (AOwner : TComponent); override;
  procedure WMKeyDown (var Message : TWMKeyDown); message WM_KEYDOWN;
  procedure WMKeyUp (var Message : TWMKeyUp); message WM_KEYUP;
  procedure WMGetDlgCode (var Message : TMessage); message WM_GETDLGCODE;
  procedure CreateWnd; override;
  procedure WMPaint (var Message : TMessage); message WM_PAINT;
  public
  published
  property OnKeyDown : TKeyEvent read fOnKeyDown write fOnKeyDown;
  property OnKeyUp   : TKeyEvent read fOnKeyUp write fOnKeyUp;
  end;

procedure Register;

implementation

constructor TKeyGrabber.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);
  width := 28;
  height := 28;
end;

procedure TKeyGrabber.CreateWnd;
begin
  inherited CreateWnd;
  if not (csDesigning in ComponentState) then
  begin
    width := 0;
    height := 0
  end
end;

procedure TKeyGrabber.WMKeyDown (var Message : TWMKeyDown);
var ShiftState : TShiftState;
begin
  if Assigned (FOnKeyDown) then with Message do
  begin
    ShiftState := KeyDataToShiftState (keyData);
    FOnKeyDown (self, CharCode, ShiftState)
  end
end;

procedure TKeyGrabber.WMKeyUp (var Message : TWMKeyDown);
var ShiftState : TShiftState;
begin
  if Assigned (FOnKeyUp) then with Message do
  begin
    ShiftState := KeyDataToShiftState (keyData);
    FOnKeyUp (self, CharCode, ShiftState)
  end
end;

procedure TKeyGrabber.WMGetDlgCode (var Message : TMessage);
begin
  Message.result :=  DLGC_WANTARROWS;
end;

{$IFDEF Win32}
Procedure MoveTo(H : HDC; X,Y: Integer);
Begin
  MoveToEx(H,X,Y,nil);
End;

{Procedure LineTo(H : HDC; X,Y: Integer);
Begin
  LineToEx(H,X,Y,nil);
End;}
{$ENDIF}

procedure TKeyGrabber.WMPaint (var Message : TMessage);
var
  PS : TPaintStruct;
  oldBrush : HBrush;
  oldPen : HPen;
  bmpDC : HDC;
  oldBitmap : HBitmap;

begin
  BeginPaint (Handle, PS);
  if csDesigning in ComponentState then
  begin
    oldPen := SelectObject (PS.HDC, GetStockObject (BLACK_PEN));
    oldBrush := SelectObject (PS.HDC, CreateSolidBrush (GetSysColor (COLOR_BTNFACE)));

    with ClientRect do Rectangle (PS.HDC, Left, Top, Right, Bottom);

    SelectObject (PS.HDC, CreatePen (PS_SOLID, 1, GetSysColor (COLOR_BTNHIGHLIGHT)));
    MoveTo (PS.HDC, 1, ClientRect.Bottom - 2);
    LineTo (PS.HDC, 1, 1);
    LineTo (PS.HDC, ClientRect.Right - 1, 1);

    DeleteObject (SelectObject (PS.HDC, CreatePen (PS_SOLID, 1, GetSysColor (COLOR_BTNSHADOW))));
    MoveTo (PS.HDC, ClientRect.Right - 2, 1);
    LineTo (PS.HDC, ClientRect.Right - 2, ClientRect.Bottom - 2);
    LineTo (PS.HDC, 0, ClientRect.Bottom - 2);

    bmpDC := CreateCompatibleDC (PS.HDC);

    oldBitmap := SelectObject (bmpDC, LoadBitmap (HInstance, 'TKEYGRABBER'));
    BitBlt (PS.HDC, 2, 2, 24, 24, bmpDC, 0, 0, SRCCOPY);

    DeleteObject (SelectObject (bmpDC, oldBitmap));
    DeleteObject (bmpDC);

    DeleteObject (SelectObject (PS.HDC, oldBrush));
    DeleteObject (SelectObject (PS.HDC, oldPen));
  end;

  EndPaint (Handle, PS);
end;

procedure Register;
begin
  RegisterComponents('Custom', [TKeyGrabber]);
end;

end.
