全角文字入力でフィルタリング（ＪＩＳ第１水準までとか）する必要があった
ので作りました。

以下の組み合わせの入力チェックを行います。（１バイト文字の入力は不可）

１．スペース
２．記号
３．数字
４．英字
５．ひらがな
６．カタカナ
７．ギリシャ文字
８．ロシア文字
９．罫線文字
１０．ＪＩＳ第１水準
１１．ＪＩＳ第２水準

文字のチェックはシフトＪＩＳで行っています。入力不可文字があった場合は
Beep で知らせます。

---- ここから ----
unit ZenEdit;

interface

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

type
  TEnableWChars = (chSpace, chSymbol, chNum, chAlpha, chHira, chKana,
                      chGreece, chRussia, chKeisen, chKnj1, chKnj2);
  TEnableWChar = set of TEnableWChars;
  TZenEdit = class(TCustomEdit)
  private
    FEnableWChar: TEnableWChar;
    inKanji: Boolean;
    Kanji: Char;
    function isKanji1(Key: Char): Boolean;
    function isKanji2(Key: Char): Boolean;
    function CodeChk(Key: Char): Boolean;
    procedure SetText(Value: string);
    function GetText: string;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AutoSelect;
  -- 途中省略 --
    property Text: string read GetText write SetText;
    property EnableWChar: TEnableWChar read FEnableWChar
                                        write FEnableWChar
        default [chSpace, chSymbol, chNum, chAlpha,
                                    chHira, chKana, chKnj1];
  end;

procedure Register;

implementation

{ 漢字コードの１バイト目のチェック}
function TZenEdit.isKanji1(Key: Char): Boolean;
begin
  Result := Key in [#$81..#$9f,#$e0..#$fc];
end;

{ 漢字コードの２バイト目のチェック}

function TZenEdit.isKanji2(Key: Char): Boolean;
begin
  Result := Key in [#$40..#$fc];
end;

{ コードのチェック }
function TZenEdit.CodeChk(Key: Char): Boolean;
var
  Code: WORD;
begin
  // 漢字コードチェック
  Result := False;
  // １バイト目のコードと合成する
  Code := Byte(Kanji) shl 8 + Byte(Key);
  // スペース
  if chSpace in EnableWChar then
    if Code = $8140 then
      Result := True;
  // 記号
  if not Result and (chSymbol in EnableWChar) then
    if ((Code >= $8141) and (Code <= $81ac)) or
        ((Code >= $81b8) and (Code <= $81bf)) or
        ((Code >= $81c8) and (Code <= $81ce)) or
        ((Code >= $81da) and (Code <= $81e8)) or
        ((Code >= $81f0) and (Code <= $81f7)) or
        (Code = $81fc) then
      Result := True;
  // 数字
  if not Result and (chNum in EnableWChar) then
    if (Code >= $824f) and (Code <= $8258) then
      Result := True;
  // 英字（大文字、小文字）
  if not Result and (chAlpha in EnableWChar) then
    if ((Code >= $8260) and (Code <= $8279)) or
        ((Code >= $8281) and (Code <= $829a)) then
      Result := True;
  // ひらがな
  if not Result and (chHira in EnableWChar) then
    if (Code >= $829f) and (Code <= $82f1) then
      Result := True;
  // カタカナ
  if not Result and (chKana in EnableWChar) then
    if (Code >= $8340) and (Code <= $8396) then
      Result := True;
  // ギリシャ文字
  if not Result and (chGreece in EnableWChar) then
    if ((Code >= $839f) and (Code <= $83b6)) or
        ((Code >= $83bf) and (Code <= $83d6)) then
      Result := True;
  // ロシア文字
  if not Result and (chRussia in EnableWChar) then
    if ((Code >= $8440) and (Code <= $8460)) or
        ((Code >= $8470) and (Code <= $8491)) then
      Result := True;
  // 罫線文字
  if not Result and (chKeisen in EnableWChar) then
    if (Code >= $849f) and (Code <= $84be) then
      Result := True;
  // 漢字第１水準
  if not Result and (chKnj1 in EnableWChar) then
    if ((Code >= $889f) and (Code <= $88fc)) or
        ((Code >= $8940) and (Code <= $89fc)) or
        ((Code >= $8a40) and (Code <= $8afc)) or
        ((Code >= $8b40) and (Code <= $8bfc)) or
        ((Code >= $8c40) and (Code <= $8cfc)) or
        ((Code >= $8d40) and (Code <= $8dfc)) or
        ((Code >= $8e40) and (Code <= $8efc)) or
        ((Code >= $8f40) and (Code <= $8ffc)) or
        ((Code >= $9040) and (Code <= $90fc)) or
        ((Code >= $9140) and (Code <= $91fc)) or
        ((Code >= $9240) and (Code <= $92fc)) or
        ((Code >= $9340) and (Code <= $93fc)) or
        ((Code >= $9440) and (Code <= $94fc)) or
        ((Code >= $9540) and (Code <= $95fc)) or
        ((Code >= $9640) and (Code <= $96fc)) or
        ((Code >= $9740) and (Code <= $97fc)) or
        ((Code >= $9840) and (Code <= $9873)) then
      Result := True;
  // 漢字第２水準
  if not Result and (chKnj2 in EnableWChar) then
    if ((Code >= $989f) and (Code <= $98fc)) or
        ((Code >= $9940) and (Code <= $99fc)) or
        ((Code >= $9a40) and (Code <= $9afc)) or
        ((Code >= $9b40) and (Code <= $9bfc)) or
        ((Code >= $9c40) and (Code <= $9cfc)) or
        ((Code >= $9d40) and (Code <= $9dfc)) or
        ((Code >= $9e40) and (Code <= $9efc)) or
        ((Code >= $9f40) and (Code <= $9ffc)) or
        ((Code >= $e040) and (Code <= $e0fc)) or
        ((Code >= $e140) and (Code <= $e1fc)) or
        ((Code >= $e240) and (Code <= $e2fc)) or
        ((Code >= $e340) and (Code <= $e3fc)) or
        ((Code >= $e440) and (Code <= $e4fc)) or
        ((Code >= $e540) and (Code <= $e5fc)) or
        ((Code >= $e640) and (Code <= $e6fc)) or
        ((Code >= $e740) and (Code <= $e7fc)) or
        ((Code >= $e840) and (Code <= $e8fc)) or
        ((Code >= $e940) and (Code <= $e9fc)) or
        ((Code >= $ea40) and (Code <= $eaa2)) then
      Result := True;
end;

{ テキストの設定 }
procedure TZenEdit.SetText(Value: string);
var
  i: Integer;
  s: string;
begin
  s := '';
  // 入力チェック
  for i := 1 to Length(Value) do begin
    // 漢字２バイト目のチェック？
    if inKanji then begin
      // 漢字２バイト目チェック
      if isKanji2(Value[i]) then begin
        if CodeChk(Value[i]) then
          s := s + Kanji + Value[i]
        else
          Beep;
        inKanji := False;
      end
      // 漢字１バイト目チェック
      else if isKanji1(Value[i]) then
        Kanji := Value[i]
      // その他
      else
        inKanji := False;
    end
    // 漢字１バイト目のチェック
    else begin
      // 漢字１バイト目チェック
      if isKanji1(Value[i]) then begin
        inKanji := True; Kanji := Value[i];
      end;
    end;
  end;
  inherited Text := s;
end;

{ テキストの取得 }
function TZenEdit.GetText: string;
begin
  Result := inherited Text;
end;

{ オブジェクトの作成 }
constructor TZenEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // プロパティの初期化
  FEnableWChar := [chSpace, chSymbol, chNum, chAlpha,
                                    chHira, chKana, chKnj1];
  inKanji := False;
  // 継承元プロパティの初期化
  Font.Charset := SHIFTJIS_CHARSET;
  Font.Name := 'ＭＳ ゴシック';
  Font.Size := 12;
  imeMode := imHira;
end;

{ キー入力処理 }
procedure TZenEdit.KeyPress(var Key: Char);
var
  i: Integer;
  s, w: string;
begin
  // 漢字２バイト目のチェック？
  if inKanji then begin
    // 漢字２バイト目チェック
    if isKanji2(Key) then begin
      if CodeChk(Key) then begin
        s := Text; w := string(Kanji) + string(Key);
        i := SelStart;
        // カーソル位置に挿入
        system.insert(w, s, i + 1);
        inherited Text := s;
        // カーソル位置を更新
        SelStart := Length(w) + i;
      end;
      inKanji := False;
    end
    // 漢字１バイト目チェック
    else if isKanji1(Key) then
      Kanji := Key
    // その他
    else
      inKanji := False;
    Key := #0;
  end
  // 漢字１バイト目のチェック
  else begin
    // 制御コード？
    if Key in [#$00..#$1f] then begin
      if Ord(Key) in [VK_RETURN,VK_ESCAPE] then
        Key := #0;
    end
    else begin
      // 漢字１バイト目チェック
      if isKanji1(Key) then begin
        inKanji := True; Kanji := Key;
      end;
      Key := #0;
    end
  end;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TZenEdit]);
end;

end.

--- ここまで ---

                                     98/10/27(火) 10:33 dcot(LDE04121)

Original document by DCOT            氏 ID:(LDE04121)

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