Panelにフォーカスを持たせ、キー入力させるには？ (ID:42664)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

的外れかも知れませんが、
自作コントロールにカーソルを表示するサンプルを作ってみました。
KeyPreviewはFalseで確認しています。
抜き出しなので余計なものがついているかもしれません。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, imm;

type
  TFePanel = class(TPanel)
  private
    fCaret:TPoint;
    constructor Create(AOwner: TComponent); override;
    procedure MoveCaret(x,y:Integer);
    procedure SetIMECOMPOSITION;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  end;

TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    FePanel1 : TFePanel;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TFePanel }

procedure TFePanel.CMWantSpecialKey(var Message: TCMWantSpecialKey);
begin
  inherited;
  Message.Result := 1;
end;

constructor TFePanel.Create(AOwner: TComponent);
begin
  inherited;
  fCaret := Point(0,0);
end;

procedure TFePanel.MoveCaret(x, y: Integer);
begin
  fCaret := Point(x+fCaret.X,y+fCaret.Y);
  SetCaretPos(fCaret.x,fCaret.Y);
  SetIMECOMPOSITION;
end;

procedure TFePanel.SetIMECOMPOSITION;
var
  cf: TCompositionForm;
begin
  cf.dwStyle := CFS_POINT;
  cf.ptCurrentPos := fCaret;
  ImmSetCompositionWindow(ImmGetContext(Handle), @cf);
end;

procedure TFePanel.WMKeyDown(var Message: TWMKeyDown);
begin
  inherited;
  case Message.CharCode of
    VK_UP    : MoveCaret(0,-10);
    VK_DOWN  : MoveCaret(0, 10);
    VK_LEFT  : MoveCaret(-10,0);
    VK_RIGHT : MoveCaret( 10,0);
  end;
end;

procedure TFePanel.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  DestroyCaret;
end;

procedure TFePanel.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  fCaret := Point(Message.XPos,Message.YPos);
  SetFocus;
  MoveCaret(0,0);
end;

procedure TFePanel.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
   CreateCaret(Handle,0,10,10);
   ShowCaret(Handle);
   MoveCaret(0,0);
end;

{TForm1}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FePanel1 := TFePanel.Create(Self);
  FePanel1.Parent := Self;
  FePanel1.SetBounds(10,100,200,200);
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る