Delphi Tips 
-----------------------------

キーワード:その他コンポーネント関連

>> Index

03/04 マウスがコントロールから出たことを検知する
08/22 非ビジュアルコンポーネントの Left, Top 座標を取得
06/25 OnDblClick発生時にOnMouseDownはいらない!
10/07 OnExit ハンドラで次にフォーカスを受け取るコントロールを知る
09/27 入力された漢字のひらがなを取り出す
08/26 セルのテキストをドラッグイメ−ジにしてグリッド(TStringGrid)でドラッグ&ドロップを行う
02/11 API を使って縦書きなどのフォントを指定する
02/11 TSplitter をドラッグ中にヒント文字列が表示された時の不具合
02/08 StringGrid で マウスのある Cell 内容に応じた Hint を出したい
02/08 TrueTypeフォントからベクタ情報を得る

最終更新: 5193 日前

0101  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 2004/03/04 osamu 編集
マウスがコントロールから出たことを検知する

マウスカーソルがコントロールに入ったり、出たりする瞬間を捕らえる方法です。

CM_MOUSEENTER/CM_MOUSELEAVE メッセージを使う方法
    [Delphi-ML:9631]

マウスの出入りを検出できるコンポーネントを作ってしまう方法
    [Delphi-ML:9645]

アイドル処理で、検出する方法
    [Delphi-ML:9820]

等が有ります。
9631 はフォームに直接貼り付けられたコントロールにしか使えないので注意して下さい。

コントロールをサブクラス化するコンポーネントを使っても簡単にできるかもしれません。
    http://www.delphianworld.com/direct.html?id=SY0054
SubClassVCL というやつです。
参照: [Delphi-ML:14031] <コンポーネント >

0342  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 2003/06/27 osamu rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 2003/08/22 osamu 編集
非ビジュアルコンポーネントの Left, Top 座標を取得

> 設計時にフォーム上に貼り付けた
> 非ビジュアルコンポーネント(TTable,TQuery)の
> フォーム上の位置を取得したいんですけれどもできるんでしょうか?

procedure TComponent.WriteLeft(Writer: TWriter);
procedure TComponent.WriteTop(Writer: TWriter);

の2つのメソッドを見てみると、DesignInfo プロパティの上半分、
下半分がそれぞれ Top, Left に対応するみたいですね。

TheLeft:= LongRec(ACompo.DesignInfo).Lo;
TheTop := LongRec(ACompo.DesignInfo).Hi;

で取り出せるようです。
参照: [Delphi-ML:77269] <コンポーネント >

0019  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 2003/06/25 osamu 編集
OnDblClick発生時にOnMouseDownはいらない!

ダブルクリック発生をOnDblClickで捕まえたいのに、1度目のクリックでOnMouseDownが発生してしまう。
ダブルクリックとシングルクリックの両方を捕まえるにはどうするか?

procedure TForm1.FormMouseDown(Sender: TObject;
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var t:LongInt;
begin
    //
    // シングル/ダブルクリックの判定
    //
    if ssDouble in Shift then begin
        DoubleClickOccurred[Button]:=True;
    end else begin
        DoubleClickOccurred[Button]:=False;
        t:=GetTickCount+GetDoubleClickTime;
        while GetTickCount<t do begin
            Application.ProcessMessages;
            if DoubleClickOccurred[Button] then
                Exit;
        end;
    end;

    if ssDouble in Shift then begin
      case Button of
      mbLeft:   ;
      mbMiddle: ;
      mbRight:  ;
      end;
    end else begin
      case Button of
      mbLeft:   ;
      mbMiddle: ;
      mbRight:  ;
      end;
    end;
end;

ここで、
    DoubleClickOccurred:array [TMouseButton] of Boolean;
は、TForm1のメンバ変数です。
シングルクリックの際の動作でチョット遅れた感じがするのはしかたないですね。
参照: [Delphi-ML:7386] [Delphi-ML:7392] [Delphi-ML:7457] <コンポーネント >

0280  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/10/07 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/10/07 osamu 編集
OnExit ハンドラで次にフォーカスを受け取るコントロールを知る

> OnExit 内で、この後フォーカスが移動するコンポーネントを
> 知ることは出来るのでしょうか?

私はこうやってます。

procedure XXXXXExit(Sender:TObject);
begin
           :
   If ActiveControl = 該当のコンポーネント then
           :
end
参照: [Delphi-ML:34067] <コンポーネント >

0201  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/08/13 西坂良幸 rev 1.4
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/09/27 K.Takaoka 編集
入力された漢字のひらがなを取り出す

WM_IME_COMPOSITIONメッセージをとらえて、ImmGetCompositionString関数を処理するのですが、受け取るのはコントロールの場合が多いので、少し工夫が必要です。

この例は、フォームに2つのTEditがあり、
TEdit1で漢字入力すると、TEdit2で入力に利用した平仮名がとれます。
ふりがなを取得するには別の方法を利用します.
// interface
type
  TForm1 = class(TForm)
    Edit1: TEdit;        // 漢字変換を行う
    Edit2: TEdit;        // フリガナを受け取る
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FDefEditProc: TWndMethod;
    procedure EditWndProc(var Message: TMessage);
  public
  end;

// implementation
uses imm;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // 本来のWndProcを待避する
  FDefEditProc := Edit1.WindowProc;
  // 新しいWndProcを設定
  Edit1.WindowProc := EditWndProc;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // 恐いので元に戻す
  Edit1.WindowProc := FDefEditProc;
end;

// 新しいEdit1のWndProc--ここでメッセーージを捕らえる
procedure TForm1.EditWndProc(var Message: TMessage);
var
  IMC: HIMC;
  Len: integer;
  Str: string;
begin
  with Message do
  begin
    if (Msg = WM_IME_COMPOSITION)
      and ((LParam and GCS_RESULTREADSTR) <> 0) then
    begin
      IMC := ImmGetContext(Edit1.Handle);
      Len := ImmGetCompositionString(IMC, GCS_RESULTREADSTR, nil, 0);
      SetLength(Str, Len + 1);
      ImmGetCompositionString(IMC, GCS_RESULTREADSTR, PChar(Str), Len + 1);
      ImmReleaseContext(Edit1.Handle, IMC);
      SetLength(Str, Len);
      Edit2.Text := Str;
      // Edit2.Text := Edit2.Text + Str; // でもよい
      // イベントを作成してもよい
    end;
    FDefEditProc(Message);
  end;
end;


実際は、メッセージを捕まえるコンポーネントのイベントなどで、必要なコントロールに渡すのがいいでしょうか。

参照: [Delphi-ML:41353] [Delphi-ML:41355] <System> <コンポーネント >

0219  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/08/26 西坂良幸 rev 1.2
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/08/26 西坂良幸 編集
セルのテキストをドラッグイメ−ジにしてグリッド(TStringGrid)でドラッグ&ドロップを行う


やり方は2つあって、Drag Object をすりかえる方法と
コントロール側で DoStartDrag, DoEndDrag, GetDragImages 等を
override する方法があります。[d40216]中村

以下は、[d40948]で須賀さんが書いたコードを若干省略したものです。
Drag&Dropのやり方として大変参考になりますね。


type
  TForm1 = class(TForm)
    //<省略>
   ・・・・・
  public
     CursorSave:TCursor;
  end;

  type

  TCustomDragObject = class(TDragControlObject)
  public
    function GetDragImages: TDragImageList; override;
    procedure HideDragImage; override;
    procedure ShowDragImage; override;
    function GetDragCursor(Accepted: Boolean; X, Y: Integer)
      : TCursor; override;
    procedure Finished(Target: TObject; X, Y: Integer;
                      Accepted: Boolean); override;
  end;

    //<省略>
   ・・・・・

var  // ローカルに宣言
  w_x,w_y:integer; // もとのcellの位置を取っておく
  Images: TImageList; // Image作成用
  drag_sizex,drag_sizey:integer;  // 作成したimageのサイズ
  drag_enter_sw:smallint;   // drag start時かどうかのsw

function TCustomDragObject.GetDragImages: TDragImageList;
begin
  Result := Images;
end;

procedure TCustomDragObject.HideDragImage;
begin
  GetDragImages.HideDragImage;
end;

procedure TCustomDragObject.ShowDragImage;
begin
  GetDragImages.ShowDragImage;
end;

procedure TCustomDragObject.Finished;
begin
  inherited;
  Free;
end;

function TCustomDragObject.GetDragCursor;
begin
  Result := crDeFault;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  drag_enter_sw := 0;   // drag start時かどうかのSwをクリア
  Grid1.ControlStyle := ControlStyle + [csDisplayDragImage];

  // 適当にセルに文字列を・・・
  Grid1.cells[1,1]:='AAA';
end;

procedure TForm1.Grid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
   acol,arow:integer;
begin
  if source is TCustomDragObject then
  begin
    Accept := True;
    Grid1.mousetocell(x, y, acol, arow);
    if (acol<0) or (arow<0) then   //
    begin
      Grid1.DragCursor := crNoDrop;
      exit;
    end
    else begin
      Grid1.DragCursor := crDrag;
    end;
    if State=dsDragMove then
    begin
      if drag_enter_sw = 0 then  // start drag時以外のとき
      begin
        if (y-drag_sizey) <= Grid1.rowheights[1] then  // 上にscroll
        begin
          if Grid1.toprow > 1 then
          begin
            Grid1.toprow := Grid1.toprow - 1 ;
            Grid1.repaint;
          end;
        end;
        if (y >= (Grid1.height - 5)) then   // 下にscroll
        begin
          if (Grid1.rowcount - Grid1.visiblerowcount)>Grid1.toprow then
          begin
            Grid1.toprow := Grid1.toprow + 1;
            Grid1.repaint;
          end;
        end;
      end
      else
       drag_enter_sw := 0;
    end;
  end;
end;

procedure TForm1.Grid1StartDrag(Sender: TObject;
  var DragObject: TDragObject);
var Size: TSize;
  bm: TBitmap;
  acol,arow:integer;
begin
  drag_enter_sw := 1;  
  // drag start時にswをたてる
  Grid1.mousetocell(Grid1.screentoclient(mouse.CursorPos).x,Grid1.screentoclient(mouse.CursorPos).y, acol, arow);
  w_x := acol;   // drag開始時のcellの位置を取っておく
  w_y := arow;   // drag開始時のcellの位置を取っておく
  // textのimageを作成
  bm := TBitmap.Create;
  bm.Canvas.Font := Font;
  Size := bm.Canvas.TextExtent(Grid1.cells[acol, arow]);
  bm.Width := Size.cx;
  bm.Height := Size.cy;
  drag_sizex := Size.cx;
  drag_sizey := Size.cy;
  bm.Canvas.TextOut(0, 0, Grid1.cells[acol, arow]);
  Images := TImageList.Create(Self);
  Images.Width := Size.cx;
  Images.Height := Size.cy;
  Images.Add(bm, Nil);
  bm.Free;
  Images.SetDragImage(0, Size.cx, Size.cy);
  Images.EndDrag;
  // カーソル処理
  CursorSave := Screen.Cursor;
  Screen.Cursor := crDefault;
  // DragImageを作成
  DragObject := TCustomDragObject.Create(Grid1);  // dragobjectの差し替え
end;

procedure TForm1.Grid1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  Screen.Cursor := CursorSave;
  Grid1.repaint;
  images.free;   // drag終了時にTImageListの開放   これを忘れていました !!
end;

procedure TForm1.Grid1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
   acol,arow:integer;
begin
  Grid1.mousetocell(x, y, acol, arow);
  if (acol < 0) or (arow < 0) then  // scroll barや最後の行より下のところにdropしたときは何もしない
  begin
    Grid1.DragCursor := crNoDrop;
    exit;
  end;
  if (Sender = Grid1) then    //  drag開始時のcellの内容をdropしたcellにcopy
  begin
    Grid1.mousetocell(x, y, acol, arow);
    Grid1.cells[acol, arow] := Grid1.cells[w_x, w_y];
    Grid1.repaint;
  end;
end;


なお、落とし穴があります。
IDEの中では、ドラッグカーソルとドラッグイメージの合成処理の過程で(TCustomImageList.CombineDragCursor)
Win95/98 が落ちることが前は良く起きました。Video Driver の問題らしいのですが、いまだに原因が良く判らないそうです。
EXEレベルではこの障害はでません。
参照: [Delphi-ML:22670] [Delphi-ML:40662] [Delphi-ML:40977] <Windows> <コンポーネント >

0137  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/11 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/02/11 osamu 編集
API を使って縦書きなどのフォントを指定する

var
    lbl :TLogFont;
begin
    // ここをいろいろ変えれば縦横比を変えることができる
    // (日本語の場合、幅:高さ=1:2で横倍率が100%)
    lbl.lfWidth := 10;
    lbl.lfHeight := 20;
    // 文字の太さ(0〜1000)
    // 「標準」の太さは400、「太字」の太さは700
    lbl.lfWeight := 400;
    // 反時計回りの角度(単位は1/10度)
    lbl.lfEscapement := 2700;
    // 下線なし(デフォルトでは「あり」)
    lbl.lfUnderline := 0;
    // 打ち消し線なし(デフォルトでは「あり」)
    lbl.lfStrikeOut := 0;
    // 斜体無効(デフォルトでは有効)
    lbl.lfItalic := 0;
    // 縦書き用の「@」がつくフォントを使用する
    lbl.lfFaceName := '@MS ゴシック';

    // フォントを作成
    Canvas.Font.Handle := CreateFontIndirect(lbl);
    // キャンバスのブラシスタイルを変えることで
    // 背景を透明にして描画します
    Canvas.Brush.Style := bsClear;
    // 文字列を描画
    Canvas.TextOut(300, 300, '縦書き文字');
end;

参照: [Delphi-ML:24027] <描画> <コンポーネント >

0134  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/11 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/02/11 osamu 編集
TSplitter をドラッグ中にヒント文字列が表示された時の不具合

TSplitter をドラッグ中に他のコントロール上にてヒントボックスを出現させると、TSpliter の境界線がその場に残ってしまいます。

TSplitter のドラッグ中は Application.ShowHint を False にしてしまうという回避方が [Delphi-ML:24019] にて紹介されています。
参照: [Delphi-ML:24019] <Additional> <バグ> <コンポーネント >

0082  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/02/08 osamu 編集
StringGrid で マウスのある Cell 内容に応じた Hint を出したい

{Application.OnShowHint イベントハンドラの設定}

procedure TForm1.FormCreate(Sender: TObject);
begin
    Application.OnShowHint := DoShowHint;
end;


{ヒントの表示ルーチン}
{TForm1 の Private で宣言してあります。}

procedure TForm1.DoShowHint( var HintStr: string; var CanShow: Boolean;
                             var HintInfo: THintInfo);
var
  ACol,ARow: Integer;
  ARect: TRect;
begin
  {ストリンググリッドならば}
  if HintInfo.HintControl = StringGrid1 then begin
     with HintInfo do begin
       {ヒントの色の指定}
       HintColor := clAqua;
       {セルの位置を取得}
       StringGrid1.MouseToCell( CursorPos.x, CursorPos.Y, ACol, ARow );
       {セルの範囲の取得}
       ARect := StringGrid1.CellRect( ACol, ARow );
       {ヒントの表示位置}
       HintPos := StringGrid1.ClientToScreen( Point(ARect.Left,ARect.Bottom));
       {ヒントの内容}
       HintStr := 'このセルは('+IntToStr(ACol)+','+IntToStr(ARow)+')';
       {ヒントの有効範囲の設定}
       CursorRect := ARect;
     end;
  end;
end;
参照: [Delphi-ML:19686] <Additional> <コンポーネント >

0048  D1   D2   D3   D4   D5   D6   D7   3.1   95   98    作成: 1999/02/08 osamu rev 1.1
   B1   B3   B4   B5   B6   B7   NT3   NT4   2K   XP  更新: 1999/02/08 osamu 編集
TrueTypeフォントからベクタ情報を得る

中村@NECさんのサンプルコードが[Delphi-ML:6963]にあります。
参照: [Delphi-ML:06963] <Windows> <コンポーネント >

[新規作成] [最新の情報に更新]

How To
Lounge
KeyWords

Tips
Delphi
Home
Osamu Takeuchi osamu@big.or.jp