テンキー表示できる Combobox を探しています (ID:43239)

名前

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

本文

裕子：「明けましておめでとうございま〜す、あれ？ 二人でどっかに出かけるの？」
勝爺：「おぅ、新年おめでとう、それがな、毎年 夏に泊まりに来てくれる常連のお客様がギックリ腰でな、しばらく動けねぇらしいんだ」
真琴：「それで、お見舞いとお手伝いに１週間くらいアタシ達がアチラに出かけるの、車で」
裕子：「毎年夏休みにココで見かけるアノおばさん？ 確か、小さい子と二人暮らしとか言ってたよね？」
真琴：「そうなのよ、だから手を貸してあげないと…」
裕子：「家の場所ドコか分かってるの？」
真琴：「チョット遠くで、住所しか分からないけど、ナントカなるでしょ」
裕子：「そう？ …ねえ、マサルさん、初めて行く遠くの場所なのにチャンと行けるの？」
勝爺：「車のナビはマコトに任せてあるから問題なし」
裕子：「えっ、マコトは あんまり遠くに出かけたことないよね、大丈夫？」
真琴：「GoogleMapさんがあるから大丈夫、 ホラこれ見てみて」

http://makoto.pa.land.to/img/_ScreenShot02.png
http://makoto.pa.land.to/img/_ScreenShot03.png
http://makoto.pa.land.to/img/_ScreenShot04.png
http://makoto.pa.land.to/img/_ScreenShot05.png
http://makoto.pa.land.to/img/_ScreenShot06.png
http://makoto.pa.land.to/img/_ScreenShot07.png

裕子：「ん？ このGoogleMapアプリは地図が表示されるまで チョット時間がかかるね」
真琴：「land.toのサイトに置いてある画像の読み込みが遅いためなの、２回目からは速くなるよ」
裕子：「ふ〜ん、この地図の青い線が、これから行く場所へのルートなの？」
真琴：「GoogleMapがV3になって Keyの取得が不要で利用し易くなったし、地図を拡大すれば、ルートも細かく分かってバッチリよ」
裕子：「目的の場所はお寺？」
真琴：「そぅ、…だからタダで泊まれるし、部屋もタップリ」
裕子：「GoogleMapは確かに素晴らしいわよ、だけど、カーナビを使えば もっと便利じゃない？」
真琴：「アタシもそう言ったのよ、でも、めったに使わないから買うのはモッタイナイんだって」
裕子：「相変わらずケチよね、マサルさん、 でもココにマコトの"ただナビ"が付いてるもんね」
勝爺：「ぁん？ ナンカ言ったか？ そうだ、ちょうどイイ、お前も一緒に…、行ってくれるよな？」
裕子：「えぇ〜？、行ったらアッチでコキ使われるんでしょ？ イヤよ、アタシは初詣に行くの」
真琴：「途中で明治神宮に寄るから初詣もできるよ」
勝爺：「一緒に行ってくれたら、ご褒美に帰りの日にディズニーランドにも寄ってやるから」
裕子：「ホント！？ じゃあ一緒に行く」
勝爺：「よし、そうと決まったら、お前の分の寝袋などの準備も…」

裕子：「ねぇ、このGoogleMapアプリはアタシが持ってるWin2000のパソコンでも使える？」
真琴：「Win2000でも一応OK、でもIE6だと遅いし 謎のエラーに悩まされるし、XPかWin7の方が快適よ」
裕子：「じゃあ、兄貴がパソコンを新調したら 古いXPパソコンをアタシが貰うことにする」
真琴：「あと、アタシが試したDelphiは D4とD6で、Unicode版のDelphiではどうなのか分からないのよね、もし試した人がいたら教えて欲しいな」
裕子：「アタシだって D6 Personalしかないよ」
真琴：「あっ、そうそう、忘れてたけど、これが TComboBoxにテンキーを表示する方法」

type
  TNumPad = class(TCustomPanel)
  private
   FCtrl: TWinControl;
   procedure SetCtrl(Value: TWinControl);
   procedure BtnClick(Sender: TObject);
  public
   constructor Create(AOwner: TComponent); override;
  published
   property Cntrl: TWinControl read FCtrl write SetCtrl;
  end;

type
  TComboBox = class(StdCtrls.TComboBox)
  private
   FNumPad: TNumPad;
   FNumPadEnable: Boolean;
   procedure WmLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
  public
   constructor Create(Owner: TComponent); override;
   procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
  published
   property NumPad: TNumPad Read FNumPad;
   property NumPadEnable: Boolean Read FNumPadEnable Write FNumPadEnable;
  end;

............................

const
  NUMPAD_HEIGHT = 135;
  NUMPAD_WIDTH = 88+24;

constructor TNumpad.Create(AOwner: TComponent);
begin
  inherited;

with TBevel.Create(Self) do begin
   Parent := Self;
   Shape := bsFrame;
   SetBounds(4, 4, NUMPAD_WIDTH-8, NUMPAD_HEIGHT-8);
  end;
//Parent := Form1;

with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '0';
   SetBounds(8, 80+24, 23+24, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '1';
   SetBounds(8,    80,    23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '2';
   SetBounds(8+24,    80, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '3';
   SetBounds(8+48,    80, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '4';
   SetBounds(8   , 80-24, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '5';
   SetBounds(8+24, 80-24, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '6';
   SetBounds(8+48, 80-24, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '7';
   SetBounds(8   , 80-48, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '8';
   SetBounds(8+24, 80-48, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '9';
   SetBounds(8+48, 80-48, 23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Tag := VK_RETURN;
   Glyph.LoadFromFile('Enter.bmp');
   SetBounds(8+72,    80, 23, 46);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '-';
   SetBounds(8+72, 80-48, 23, 22+24);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Caption := '.';
   SetBounds(8+48, 80+24,  23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Tag := VK_BACK;
   Glyph.LoadFromFile('Back.bmp');
   SetBounds(8   , 80-72,  23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Tag := VK_LEFT;
   Caption := '←';
   SetBounds(8+24, 80-72,  23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Tag := VK_RIGHT;
   Caption := '→';
   SetBounds(8+48, 80-72,  23, 22);
   OnClick := BtnClick;
  end;
  with TSpeedButton.Create(Self) do begin
   Parent := Self;
   Tag := VK_DELETE;
   Caption := 'Del';
   SetBounds(8+72, 80-72,  23, 22);
   OnClick := BtnClick;
  end;
end;

procedure TNumpad.SetCtrl(Value: TWinControl);
var
  P: TPoint;
  O: TControl;
begin
  if FCtrl <> Value then begin
   FCtrl := Value;
   if FCtrl = nil then exit;

GetCursorPos(P);
   O := FindVCLWindow(P);
   if not Assigned(O) then exit;
   O := O.Parent;
   P.x := FCtrl.Left;
   P.y := FCtrl.Top + FCtrl.Height;
   P := Form1.ScreenToClient(O.ClientToScreen(P));
   Self.SetBounds(P.x, P.y, NUMPAD_WIDTH, NUMPAD_HEIGHT);
   Parent := Form1;
  end;
end;

procedure TNumpad.BtnClick(Sender: TObject);
begin
  if TButton(Sender).Tag = VK_RETURN then begin
   Self.Hide;
   Cntrl := nil;
   exit;
  end else
  if TButton(Sender).Tag = VK_BACK then begin
   SendMessage(FCtrl.Handle, WM_CHAR, VK_BACK, 0);
   exit;
  end else
  if TButton(Sender).Tag = VK_DELETE then begin
   SendMessage(FCtrl.Handle, WM_KEYDOWN, VK_DELETE, 0);
   SendMessage(FCtrl.Handle, WM_KEYUP, VK_DELETE, 0);
   exit;
  end else
  if TButton(Sender).Tag = VK_LEFT then begin
   SendMessage(FCtrl.Handle, WM_KEYDOWN, VK_LEFT, 0);
   SendMessage(FCtrl.Handle, WM_KEYUP, VK_LEFT, 0);
   exit;
  end else
  if TButton(Sender).Tag = VK_RIGHT then begin
   SendMessage(FCtrl.Handle, WM_KEYDOWN, VK_RIGHT, 0);
   SendMessage(FCtrl.Handle, WM_KEYUP, VK_RIGHT, 0);
   exit;
  end;
  if FCtrl.ClassType = TComboBox then
   TComboBox(FCtrl).SelText := TButton(Sender).Caption;
  if FCtrl.ClassType = TEdit then
   TEdit(FCtrl).SelText := TButton(Sender).Caption;
end;

constructor TComboBox.Create(Owner: TComponent);
begin
  inherited;
  FNumpad := TNumPad.Create(Self);
//  FNumPad.Hide;
end;

procedure TComboBox.WmLButtonDown(var Msg: TMessage);
begin
  if Assigned(FNumPad) then FNumPad.Hide;
  inherited;
end;

procedure TComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
begin
  case Message.Msg of
   WM_KILLFOCUS:  FNumpad.Hide;
   WM_LBUTTONDOWN:
   if FNumPadEnable then begin
    FNumPad.Cntrl := TWinControl(Self);
    FNumPad.Visible := True;
   end;
  end;
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // NumPad(テンキー)を表示したいComboBoxのNumPadEnableをTrueに
  ComboBox1.NumPadEnable := True;
  ComboBox3.NumPadEnable := True;

end;

http://makoto.pa.land.to/img/_ScreenShot01.png

真琴：「コンポーネントじゃないけど、このGoogleMAPのアプリでも試してるから、ソースを見れば分かるよ」

※GoogleMapsTest プロジェクトソースと、Win7(64bit)上で D4でコンパイルしたサンプルDemoEXE
http://makoto.pa.land.to/diamondhead/lime.cgi?GoogleMapsTest

勝爺：「お〜い、マコト、何やってんだ、もう出かけるぞ、ユウコのための着替えも忘れるなよ」
真琴：「は〜い、今いく」

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

戻る

テンキー表示 できる Combobox を探しています (ID:43239)

テンキー表示できる Combobox を探しています (ID:43239)