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フォントからベクタ情報を得る
最終更新： 7566 日前
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);
の２つのメソッドを見てみると、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で捕まえたいのに、１度目のクリックで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関数を処理するのですが、受け取るのはコントロールの場合が多いので、少し工夫が必要です。
この例は、フォームに２つの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)でドラッグ＆ドロップを行う
やり方は２つあって、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;
なお、落とし穴があります。
ＩＤＥの中では、ドラッグカーソルとドラッグイメージの合成処理の過程で(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
// ここをいろいろ変えれば縦横比を変えることができる
// (日本語の場合、幅：高さ＝１：２で横倍率が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 := '@ＭＳ ゴシック';
// フォントを作成
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フォントからベクタ情報を得る
中村＠ＮＥＣさんのサンプルコードが[Delphi-ML:6963]にあります。
参照： [Delphi-ML:06963] <Windows> <コンポーネント >
[新規作成] [最新の情報に更新]
How To
Lounge
KeyWords
Osamu Takeuchi osamu@big.or.jp
Tips
Delphi
Home
