Memo上で透過して使えるソフトキーボード（とりあえずテンキーのみ）です。
見た目はチャッチーですが、編集時に邪魔にならないのがウリです。
サブクラス化はデルマガ４月号 「TMemoの背景にビットマップを貼る」を
参考にさせてもらいました、ありがとうございました。

皆さんの添削をお待ちしております(^^)

☆準備
　Form1の上に、Memo1、Label1、Button1を置きます。

☆補足
　Delphi4 でテスト。


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Label1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    FMemo1OldWndProc: TWndMethod;
    procedure Memo1NewWndProc(var Message: TMessage);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  iCOL = 9;
  iROW = 9;
var
  FDragXPos: Integer;
  FDragYPos: Integer;
  FDragging: Boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Memo1をサブクラス化
  FMemo1OldWndProc := Memo1.WindowProc;
  Memo1.WindowProc := Memo1NewWndProc;
  //Memo1上にラベルのソフトキーセット
  Label1.Parent := Memo1;
  Label1.Font.Color := clPurple;
  Label1.Font.Name := 'ＭＳ ゴシック'; //プロポーショナルフォントは不可
  Label1.Font.Size := 12; //9, 12, 15など３の倍数にする
  Label1.Caption := '┏━━━━━━━┓'#13#10
                  + '┃　　　　　　Ｘ┃'#13#10
                  + '┠─┬─┬─┬─┨'#13#10
                  + '┃０│１│２│３┃'#13#10
                  + '┠─┼─┼─┼─┨'#13#10
                  + '┃４│５│６│７┃'#13#10
                  + '┠─┼─┼─┼─┨'#13#10
                  + '┃８│９│BS│CR┃'#13#10
                  + '┗━┷━┷━┷━┛';
  Label1.Cursor := crArrow;
  Label1.Transparent := True;
  Label1.Left := Memo1.Width div 2 - Label1.Width div 2;
  Label1.Top := Memo1.Height div 2 - Label1.Height div 2;
  FDragging := False;
end;

procedure TForm1.Memo1NewWndProc(var Message: TMessage);
begin
  //元のウィンドウプロシージャを呼び出す
  FMemo1OldWndProc(Message);
  if Message.Msg = CN_COMMAND then begin
    //文字列が変更されたら Label1を再描画させる
    if Message.WParamHi = EN_UPDATE then begin
      Label1.Invalidate;
    end
    //内部でスクロールが発生したら Memo1全体を再描画させる
    else if (Message.WParamHi = EN_HSCROLL) or
            (Message.WParamHi = EN_VSCROLL) then begin
      Memo1.Invalidate;
    end;
  end
  //スクロールバーが操作されたら Memo1全体を再描画
  else if (Message.Msg = WM_HSCROLL) or
          (Message.Msg = WM_VSCROLL) then begin
    Memo1.Invalidate;
  end;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  iC, iR, iX, iY, iW, iH, iNum: Integer;
  iTCol: Integer;
begin
  with Sender as TLabel do begin
    iTCol := (iCOL - 1) div 2;//実際の列数
    iC := Width * 2 div iCOL; //列幅
    iR := Height * 2 div iROW;//行高さ
    iX := X - iC div 4;       //実際のキーボード上のＸ位置
    iY := Y - iR div 4;       //実際のキーボード上のＹ位置
    iW := Width - iC div 2;     //実際のキーボード幅
    iH := Height - iR div 2;    //実際のキーボード高さ
    if (iX < 0) or (iW < iX) or (iY < 0) or (iH < iY) then Exit;
    if iR < iY then begin               //２行目以降？
      iNum := iX div iC + (iY div iR - 1) * iTCol;
      case iNum of
       0..9: begin
        SendMessage(Memo1.handle, WM_CHAR, Ord('0') + iNum, 0);
       end;
       10: begin
        SendMessage(Memo1.handle, WM_CHAR, VK_BACK, 0);
       end;
       11: begin
        SendMessage(Memo1.handle, WM_CHAR, VK_RETURN, 0);
       end;
      end;
    end
    else begin
      if iW * (iTCol - 1) div iTCol < iX then begin //４列目？
        TLabel(Sender).Visible := False;
      end
      else begin
        FDragXPos := X;
        FDragYPos := Y;
        FDragging := True;
      end;
    end;
  end;
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  with Sender as TLabel do begin
    if FDragging then begin
      Left := Left + X - FDragXPos;
      Top := Top + Y - FDragYPos;
    end;
    if Left < 0 then Left := 0;
    if Memo1.Width < Left + Width then Left := Memo1.Width - Width;
    if Top < 0 then Top := 0;
    if Memo1.Height < Top + Height then Top := Memo1.Height - Height;
  end;
end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Visible := True;
end;

end.
                                     99/09/20(月) 07:43 sai(FZA01256)

Original document by sai             氏 ID:(FZA01256)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。