ikeyboard.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiKeyBoard Component                            }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iKeyBoard;{$endif}
{$ifdef iCLX}unit QiKeyBoard;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes,  iGPFunctions,  iClasses,  iCustomComponent;{$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions, QiClasses, QiCustomComponent;{$ENDIF}

type
  TiKeyBoardButtonStyle = (ikbbsStandard, ikbbsShift, ikbbsLock, ikbbsAccent, ikbbsScroll, ikbbsCtrl, ikbbsAlt, ikbbsNumLock, ikbbsSpacer);
  TiKeyBoardStyle       = (ikbs104, ikbs87, ikbs74, ikbs61, ikbsNumericKeyPad);

  TKeyData = record
    Style           : TiKeyBoardButtonStyle;

    CaptionStandard : String;
    CaptionShift    : String;

    VirtualKeyCode  : Integer;

    Size            : Integer;
    AcceptLock      : Boolean;
  end;

  TiKeyBoardButton = class(TiButton)
  private
    FStyle           : TiKeyBoardButtonStyle;
    FVirtualKeyCode  : Integer;
    FAcceptLock      : Boolean;

    FRow             : Integer;
    FSize            : Integer;
    FDoubleHeight    : Boolean;

    FCaptionShift    : String;
    FCaptionStandard : String;

    FLockActive      : Boolean;
    FShiftActive     : Boolean;
    FCtrlActive      : Boolean;
    FAltActive       : Boolean;
    FShowShift       : Boolean;
    FNumLockActive   : Boolean;
    FDown            : Boolean;
    FFocusHandle     : Integer;

    procedure SetAcceptLock     (const Value: Boolean);
    procedure SetCaptionShift   (const Value: String);
    procedure SetCaptionStandard(const Value: String);
    procedure SetDoubleHeight   (const Value: Boolean);
    procedure SetRow            (const Value: Integer);
    procedure SetSize           (const Value: Integer);
    procedure SetStyle          (const Value: TiKeyBoardButtonStyle);
    procedure SetVirtualKeyCode (const Value: Integer);
  protected
    function GetDisplayString: String;
    function GetIsToggle: Boolean;

    procedure UpdateKeyState;
 public
    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y, ScreenX, ScreenY: Integer); override;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y, ScreenX, ScreenY: Integer); override;

    procedure Draw(const Canvas : TCanvas); override;

    constructor Create; override;

    property LockActive      : Boolean               read FLockActive      write FLockActive;
    property ShiftActive     : Boolean               read FShiftActive     write FShiftActive;
    property CtrlActive      : Boolean               read FCtrlActive      write FCtrlActive;
    property AltActive       : Boolean               read FAltActive       write FAltActive;
    property NumLockActive   : Boolean               read FNumLockActive   write FNumLockActive;

    property DisplayString   : String                read GetDisplayString;
    property IsToggle        : Boolean               read GetIsToggle;
    property Down            : Boolean               read FDown            write FDown;

    property FocusHandle     : Integer               read FFocusHandle     write FFocusHandle;
  published
    property Style           : TiKeyBoardButtonStyle read FStyle           write SetStyle;

    property CaptionStandard : String                read FCaptionStandard write SetCaptionStandard;
    property CaptionShift    : String                read FCaptionShift    write SetCaptionShift;

    property AcceptLock      : Boolean               read FAcceptLock      write SetAcceptLock;

    property VirtualKeyCode  : Integer               read FVirtualKeyCode  write SetVirtualKeyCode;

    property Row             : Integer               read FRow             write SetRow;
    property Size            : Integer               read FSize            write SetSize;
    property DoubleHeight    : Boolean               read FDoubleHeight    write SetDoubleHeight;
  end;
  //----------------------------------------------------------------------------------------------
  TiKeyBoard = class(TiCustomComponent)
  private
    FButtonList      : TStringList;
    FRowListManager  : TStringList;

    FFont            : TFont;
    FOuterMargin     : Integer;

    //{$ifdef iVCL}FPreviousFocus : HWND;{$endif}

    FMouseDownObject : TiKeyBoardButton;

    FSecondRowMargin : Integer;
    FStyle           : TiKeyBoardStyle;
    FFocusHandle     : Integer;
    FLockFocusHandle : Boolean;
  private
    procedure SetFocusHandle(const Value: Integer);
  protected
    procedure SetFont           (const Value: TFont);
    procedure SetOuterMargin    (const Value: Integer);
    procedure SetSecondRowMargin(const Value: Integer);

    procedure CalcRects;

    function  CreateDefaultButton: TiKeyBoardButton;
    procedure CreateSpacer(Row, Size: Integer);
    function  CreateButton(VirtualKeyCode, Row, Size: Integer; DoubleHeight: Boolean): TiKeyBoardButton;

    function GetKeyCount: Integer;
    function GetKeyButton(Index: Integer): TiKeyBoardButton;

    procedure UnSelectAllOthers(Button: TiKeyBoardButton);
    procedure UnSelectShiftCtrlAlt;

    procedure SetLockStatus   (Value: Boolean);
    procedure SetShiftStatus  (Value: Boolean);
    procedure SetCtrlStatus   (Value: Boolean);
    procedure SetAltStatus    (Value: Boolean);
    procedure SetNumLockStatus(Value: Boolean);
    procedure SetStyle        (const Value: TiKeyBoardStyle);

    procedure ButtonInvalidate(Sender : TObject);
    procedure FontChange      (Sender : TObject);

    procedure ButtonClick     (Sender : TObject);

    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseMove(                      Shift: TShiftState; X, Y: Integer); override;

    {$ifdef iVCL}procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;{$endif}

    function  GetRowSize(RowList: TStringList): Integer;
    procedure RemoveAllButtons;
    procedure RemoveAllRows;

    procedure Setup104;
    procedure Setup087;
    procedure Setup074;
    procedure Setup061;
    procedure SetupNumericKeyPad;

    procedure LoadKeyData(Index, VirtualKeyCode: Integer; Style: TiKeyBoardButtonStyle; CaptionStandard, CaptionShift: String; AcceptLock: Boolean);
    procedure LoadKeyDataArray;

    procedure iDoKillFocus;                      override;
    procedure iPaintTo(Canvas: TCanvas);         override;

    procedure DefineProperties(Filer: TFiler);   override;
    procedure WriteItems      (Writer: TWriter);
    procedure ReadItems       (Reader: TReader);
    function  DoWriteItems: Boolean;

    property KeyCount                  : Integer          read GetKeyCount;
    property KeyButton[Index: Integer] : TiKeyBoardButton read GetKeyButton;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;                    override;

    procedure SavePropertiesToFile  (FileName: String); override;
    procedure LoadPropertiesFromFile(FileName: String); override;

    procedure SetFocusHandleToActiveWindow;

  published
    property Font            : TFont           read FFont            write SetFont;
    property OuterMargin     : Integer         read FOuterMargin     write SetOuterMargin;
    property SecondRowMargin : Integer         read FSecondRowMargin write SetSecondRowMargin;
    property Style           : TiKeyBoardStyle read FStyle           write SetStyle;

    property BackGroundColor;
    property BorderStyle;
    property Width            default 115;
    property Height           default 140;

    property FocusHandle     : Integer         read FFocusHandle     write SetFocusHandle;
  end;

implementation

type
  TWriterAccess = class(TWriter)end;
  TReaderAccess = class(TReader)end;

var
  KeyDataArray : array[0..255] of TKeyData;
//****************************************************************************************************************************************************
constructor TiKeyBoard.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
                                     
  Width   := 750;
  Height  := 225;

  FOuterMargin     := 5;
  FSecondRowMargin := 10;

  FFont := TFont.Create; FFont.Style := [fsBold]; Font.OnChange := FontChange;

  FButtonList     := TStringList.Create;
  FRowListManager := TStringList.Create; FRowListManager.Sorted := True;

  LoadKeyDataArray;
  Setup104;
end;
//****************************************************************************************************************************************************
destructor TiKeyBoard.Destroy;
begin
  FFont.Free;

  RemoveAllRows;
  FRowListManager.Free;

  RemoveAllButtons;
  FButtonList.Free;

  inherited;
end;
//****************************************************************************************************************************************************
procedure TiKeyBoard.RemoveAllButtons;
begin
  while FButtonList.Count > 0 do
    begin
      FButtonList.Objects[0].Free;
      FButtonList.Delete(0);
    end;
end;
//****************************************************************************************************************************************************
procedure TiKeyBoard.RemoveAllRows;
begin
  while FRowListManager.Count > 0 do
    FRowListManager.Delete(0);
end;
//*************************************************************************************************************************************
function TiKeyBoard.GetKeyCount: Integer;
begin
  Result := FButtonList.Count;
end;
//*************************************************************************************************************************************
function TiKeyBoard.GetKeyButton(Index: Integer): TiKeyBoardButton;
begin
  Result := FButtonList.Objects[Index] as TiKeyBoardButton;
end;
//****************************************************************************************************************************************************
function TiKeyBoard.CreateDefaultButton: TiKeyBoardButton;
begin
  Result                 := TiKeyBoardButton.Create;
  Result.OnInvalidate    := ButtonInvalidate;
  Result.OnClick         := ButtonClick;
  FButtonList.AddObject('', Result);
end;
//*************************************************************************************************************************************
function TiKeyBoard.CreateButton(VirtualKeyCode, Row, Size: Integer; DoubleHeight: Boolean): TiKeyBoardButton;
begin
  Result                 := CreateDefaultButton;
  Result.Style           := KeyDataArray[VirtualKeyCode].Style;
  Result.VirtualKeyCode  := KeyDataArray[VirtualKeyCode].VirtualKeyCode;
  Result.CaptionStandard := KeyDataArray[VirtualKeyCode].CaptionStandard;
  Result.CaptionShift    := KeyDataArray[VirtualKeyCode].CaptionShift;
  Result.AcceptLock      := KeyDataArray[VirtualKeyCode].AcceptLock;
  Result.Row             := Row;
  Result.Size            := Size;
  Result.DoubleHeight    := DoubleHeight;
end;
//****************************************************************************************************************************************************
procedure TiKeyBoard.CreateSpacer(Row, Size: Integer);
var
  iButton : TiKeyBoardButton;
begin
  iButton              := TiKeyBoardButton.Create;
  iButton.Caption      := Caption;
  iButton.Row          := Row;
  iButton.Size         := Size;
  iButton.Style        := ikbbsSpacer;

  FButtonList.AddObject('', iButton);