Delphi Tips
>> Index
● 01/12 ファイルを作らずメモリ上で動作する TTable コンポーネント
● 12/08 SubDetailが印刷できない
● 03/04 マウスがコントロールから出たことを検知する
● 03/04 エディットコントロールで右寄せ表示
● 09/24 Delphi7 のコンボボックスの空文字列でエラー
● 08/22 非ビジュアルコンポーネントの Left, Top 座標を取得
● 06/27 コンボボックスにブラウザのURL入力のような自動補完機能を付けたい
● 06/27 TMemoで、先頭行/最終行/指定行へ移動する。
● 06/25 OnDblClick発生時にOnMouseDownはいらない!
● 06/25 ComboBoxのDropDownListの幅を変更する
● 06/25 自己実行形式の動画
● 06/25 フォルダもファイルも選べるダイアログ
● 06/25 ボタン間を矢印キーで移動させるロジック
● 06/25 RichEdit を印刷したい
● 05/17 2つの TMemo のスクロールを同期させる
● 05/17 2つの TRichEdit のスクロールを同期させる
● 05/17 TreeView で D&D 中の描画処理
● 02/09 TListView の ... 表示をなくす
● 06/11 ListView をスクロールする
● 01/02 TField.EditMask の y2k 回避
● 01/02 StringGrid の内容更新を高速に行う
● 10/07 OnExit ハンドラで次にフォーカスを受け取るコントロールを知る
● 09/27 入力された漢字のひらがなを取り出す
● 09/27 アプリケーションを常駐させてタスクトレイに登録したい
● 09/24 TOpenDialogで、Executeメソッド実行時に表示位置を変えたい。
● 09/16 StringGrid でセル編集終了のイベントを得たい
● 09/16 TStringGrid の列の ReSize イベントの取得
● 09/15 TRichEdit.Add でリソース不足
● 09/15 TPageControl に OnDblClick を追加する
● 09/15 TTreeView で5つ以上のオーバレイ・イメージを使う
● 09/13 TFontDialog で標準以外のサイズを選択肢に表示したい
● 09/11 Editコントロールで入力を数値専用にする
● 09/11 TMemo のキャレットを非表示にする
● 09/11 エディットコントロールにポップアップウィンドウをつけたい
● 09/09 DLL 内で TDBCtrlGrid を使うときの注意事項
● 09/09 TPageControl でタブをドラッグして順序入れ替え
● 09/08 IME に未確定文字列を入力
● 09/08 ショートカットキーに'+'を使う。
● 09/07 右寄せ・数値入力可能なEditコンポーネントを作りたい。
● 09/06 ButtonのCaptionで改行を使って文字を複数段で表示したい
● 09/06 キーボードでボタンを押したとき、ボタンをちゃんと沈ませたい
● 09/06 カーソルキーでボタン(TButton)のフォーカス移動をやめさせたい
● 09/06 エディットコントロールにコンボボックスのようなボタンをつけたい
● 09/05 ドッカブルメニュー(ツールバー形式のメニュー)を実現したい。
● 09/01 RichEditでHTMLタグを色・書式付き表示をする
● 08/31 LinesプロパティエディタでTabを入力する
● 08/31 RichEdit の全パラグラフのタブ幅を設定する
● 08/31 TRichEdit.Paragraph.Tab[] の設定(Tab位置の設定)
● 08/28 データコントロールのDataLinkオブジェクトを取得する方法(ReadOnlyプロパティのバグの解決法)
● 08/26 セルのテキストをドラッグイメ−ジにしてグリッド(TStringGrid)でドラッグ&ドロップを行う
● 08/26 ツリービューのノードをドラッグ&ドロップで移動させる
● 08/26 書式付きメモ型項目へアクセスしたい
● 08/14 ショートカットキーのキー名を独自に設定する
● 05/28 TFileListBox にファイル名が重複して表示されてしまう
● 05/19 コンボボックスのリスト部分の幅を指定する
● 05/19 TRichEdit の内容を高速に変更する
● 05/01 右の項目の幅が固定されるTStatusBar
● 04/29 TCoolBarを用いたツールバーの位置保存
● 02/11 IME 入力で読み仮名を取得する
● 02/11 DBGrid のスクロールバーを非表示に
● 02/11 半角カナを確定無しで直接入力させる
● 02/11 長すぎる TreeView アイテムを補完するチップヘルプを出さなくする
● 02/11 下の図柄がすける透明パネル
● 02/11 API を使って縦書きなどのフォントを指定する
● 02/11 表示中のポップアップメニューを消す
● 02/11 TSplitter をドラッグ中にヒント文字列が表示された時の不具合
● 02/08 超高速 ListView
● 02/08 ステータスバーにプログレスバーを置きたい
● 02/08 PopupMenu に MainMenu のサブ項目をそのまま表示する
● 02/08 StringGrid で マウスのある Cell 内容に応じた Hint を出したい
● 02/08 自作コントロールで IME 入力時の変換候補をキャレット位置に表示したい
● 02/08 TDDEClientConvで最初の行しか実行されない?
● 02/08 TUpDown の不具合
● 02/08 TPageControl を TabPosition=tpBottom にすると不具合
● 02/08 超高速タイマーコンポーネント(サブミリ秒)
● 02/08 StringGridで選択セルのハイライト表示を無くしたい
● 02/08 フォームの印刷時にComboBoxの内容が印刷されない
● 02/08 TrueTypeフォントからベクタ情報を得る
● 02/08 TDriveComboBoxの内容の更新
● 02/08 TMemoで入力*行数*を制限したい
● 02/08 TListViewで列を指定してソート
● 02/08 TStringGridのソート
● 02/08 StringGrid/DBGrid でのセル編集の動作を細かく指定する
最終更新: 6475 日前
0129 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.4 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2007/01/12 RAN 編集
ファイルを作らずメモリ上で動作する TTable コンポーネント
>前どこかで TTable 互換でメモリ上で動作するコンポーネントを見かけたのです
>が、ご存知な方いらっしゃいませんか? (その時にダウンロードしておけばよかっ
>た...)
[1]
Delphi Super Pageに昔からあるコンポーネントです。
BDEのインメモリテーブルと一時テーブルの機能を使ったものです。
http://sunsite.icm.edu.pl/delphi/
(2007年現在はhttp://delphi.icm.edu.pl/authors/a0000561.htm に移動)
ファイル名:inmemory.zip および inmem32.zip
※サンプル付きです。
Delphi1.0用のほうを、Delphi3で使用するときの修正点は以下のとおりです。32ビット版が出ているのでもう必要無いのかな?
#Inmemユニット:
# TypeMapで配列の最後に「, fldCURSOR」を追加。
# SubTypeMapで配列の最後に「, 0」を追加。
#TempTblユニット:
# TypeMapで配列の最後に「, fldCURSOR」を追加。
# SubTypeMapで配列の最後に「, 0」を追加。
※Register手続きがありませんので、追加してください。
>これがあればテンポラリのテーブルをいちいちディスクに作成しなくても済んで
>しまうため(結果的に作られるとしても)、便利なのですが...
そうなんですが、デバッグのとき、値を確認しにくいと思いますよ。
[2]
> ひょっとして http://delphideli.com/dlnbde.htm にある TMemTable のことでしょうか。
僕が前見たのは確かシェアウエアだったのですが、これはフリーでしかもソース付き。嬉しい限りです。
[3]
最近のDelphi では標準でMyBase が利用できます。
http://hp.vector.co.jp/authors/VA028375/delphi/db.html が分かりやすいです。
参照: [Delphi-ML:22981] [Delphi-ML:22983] <データベース> <DataAccess>
0357 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2005/12/08 三輪一雄 rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2005/12/08 <> 編集
SubDetailが印刷できない
QRBandでBandTypeをrbSubDetailに設定しても、テーブルのフィールドが印刷されません。この方法で作成するとDataSetを指定するプロパティーがありません。
必ずQRSubDetailでバンドを作成します。
参照: <QReport> [d DelphiML]
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] <その他コンポーネント関連>
0204 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/16 osamu rev 1.4 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2004/03/04 osamu 編集
エディットコントロールで右寄せ表示
>TEditで表示したい内容が数字なため右寄せにしたいと
>思っています。しかし、調べた限りでは右に寄ってく
>れません。
Delphian World などで既存のコンポーネントを入手するのが一番楽チンですね。( http://www.delphianworld.com/ )
自分で作る場合:
Win98とそれ以前のWinとでは作り方が異なります。
これはWindows98が右寄せEditをサポートしたからです。
『Win98で右寄せ・数値入力可能なEditコンポーネントを作る』
というTipsを参照ください。
こちらでは簡単に完璧に右寄せEditが作れませす。
Win98以前のWinでは
Editの代わりにTMemoを使い、1LineのTMemoをEditに見せかけます。
TMemoを配置して
1、Alignment Property を taRightJustify にする。
2、WordWrap Property を False にする。
WantReturns Property を False にして改行を入力させないようにしても
Ctrl+JやCtrl+Returnを押すと改行コードが入力されてしまいます。
そこで改行された時に改行を解除する動作をコーディングします。
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
SelStartBuf: Integer;
S: string;
begin
if Memo1.SelLength>0 then exit;
SelStartBuf := Memo1.SelStart;
S := Memo1.Text;
if pos(#13,S)<>0 then//改行コードのCRを削除
begin
Delete(S,pos(#13,S),1);
Dec( SelStartBuf );
end;
if pos(#10,S)<>0 then
begin
Delete(S,pos(#10,S),1);//改行コードLFを削除
Dec( SelStartBuf );
end;
Memo1.Text := S;
Memo1.SelStart := SelStartBuf;
(*
また、TMemoを右寄せにしているとWordWrap:=falseが効果ありません。
文字が増えるとどうしても改行されてしまいます。
それに対応して改行されたらその時の文字数を保持して左寄せに変えます。
LengthShowはFormのメンバーとして変数宣言してください。
*)
if Memo1.Lines[1]<>'' then//改行されたなら
begin
SelStartBuf := Memo1.SelStart ;
Memo1.Alignment := taLeftJustify;
Memo1.SelStart := SelStartBuf;
LengthShow := Length(Memo1.Lines[0]);//LengthShow変数に
end;//表示可能文字数を保持
(*
文字数が減ったら元に戻さなければいけません。
*)
if LengthShow<>0 then//LengthShowに保持数があるなら
if Length(Memo1.Lines[0])<LengthShow then//文字が減ったら
begin
SelStartBuf := Memo1.SelStart;
Memo1.Alignment := taRightJustify;
Memo1.SelStart := SelStartBuf;
end;
end;//KeyUpイベント終わり
単純に、改行された時の文字数=表示の限界、とみなして
その文字数以下になれば右寄せに変えるという動作ですので
プロポーショナルフォントの場合では文字幅が異なりますのでちょっと変な動作になりそう。
また、左寄せの状況で文字を削除していくと左寄せという事がばれる動作をします。
更に、キー入力以外でテキストを代入するような動作は考慮していません。
その辺は、自分で作ってね。出来たら、このTipsを更新してくだされ。
参照: [Delphi-ML:9195] [Delphi-ML:41622] <Standard>
0344 D1D2D3D4D5D6D7 3.195 98 作成: 2003/07/03 osamu rev 1.4 B1B3B4B5B6 B7 NT3 NT4 2K XP 更新: 2003/09/24 osamu 編集
Delphi7 のコンボボックスの空文字列でエラー
Delphi7 では、コンボボックスに空文字列を入れておくと、
ComboBox1.Items.Add('');
この Item を Items[0] などとして参照した時にアクセスバイオレーションエラーが発生してしまいます。
これは、以前の Delphi が Item 保持領域として 4096 などの固定値を使っていたのに対して、Delphi7 からは CB_GETLBTEXTLEN を使ってバッファを動的に確保するようになったためで、それ自体は正しいことなのですが、Item の長さが 0 の時に正しくバッファが確保されないためにエラーが発生してしまいます。
エラーの詳しい内容は、[Delphi-ML:77352][Delphi-ML:77360][Delphi-ML:77366]を見てみてください。回避方法としては、Amaito さんの [Delphi-ML:77357] のように、
StdCtrls.pasをプロジェクトと同じフォルダにコピーして、2325行を
//if Len <> CB_ERR then
if Len > 0 then
とするのが良いようです。(CB_ERR は負の値なので、Len > 0 で Len=0 と Len=CB_ERR との両方の場合に対応しています)
#[Delphi-ML:72969] でもすでに同じ問題が報告されていました。
## 実は編集後のコードにもちょっとした仕様バグが含まれています。
## TListBox.Items などと動作を合わせるのであれば、CB_ERR
## の場合には空文字列を返すのではなく例外を投げるべきだと
## 思います。
参照: [Delphi-ML:72969] [Delphi-ML:77352] [Delphi-ML:77357] [Delphi-ML:77360] [Delphi-ML:77366] <バグ> <Standard>
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] <その他コンポーネント関連>
0171 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/03/08 osamu rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2003/06/27 osamu 編集
コンボボックスにブラウザのURL入力のような自動補完機能を付けたい
ひきさんのページにサンプルコードを見つけることができます。ひきさんに感謝しつつ、ご利用下さい。
[Delphi壁の穴]-[その一:Delphiを覗く]
http://hp.vector.co.jp/authors/VA009712/take/delphi/kabedel.htm#autocomplete
参照: <Standard>
0172 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/03/08 osamu rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2003/06/27 osamu 編集
TMemoで、先頭行/最終行/指定行へ移動する。
ひきさんのページにサンプルソースを見つけることができます。ひきさんに感謝しつつ活用しましょう。
[Delphi壁の穴]-[その1:Delphiを覗く]
http://hp.vector.co.jp/authors/VA009712/take/delphi/kabedel.htm#memomove
参照: <Standard>
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] <その他コンポーネント関連>
0043 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 編集
ComboBoxのDropDownListの幅を変更する
エディット部分はそのままで、ドロップダウンする部分の幅だけを変更したければ、
ComboBox1.Perform(CB_SETDROPPEDWIDTH, 幅, 0);
とします。
「幅」はピクセル単位となります。
参照: [Delphi-ML:19165] <Standard>
0340 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2003/06/25 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2003/06/25 osamu 編集
自己実行形式の動画
Exe 内部に動画データをバイナリデータのリソースにしてコンパイルします。D5でのリソースファイルの作り方について:
http://halbow.cool.ne.jp/Notes/N008.html
例えば、'clock.avi' をリソースにする場合、リソーススクリプトファイル(MyRes.rc) は以下のようになります。
MyAVI AVI "c:\WINNT\clock.avi"
このリソースを使って以下のようにして、うまくいきました。
procedure TForm1.Button1Click(Sender: TObject);
var
RS:TResourceStream;
begin
RS := TResourceStream.Create(hInstance,'MyAVI','AVI');
try
RS.SaveToFile(ExtractFilePath(ParamStr(0))+'MyAVI.avi');
finally
RS.Free;
end;
if FileExists(ExtractFilePath(ParamStr(0))+'MyAVI.avi') then
with MediaPlayer1 do begin
Filename := ExtractFilePath(ParamStr(0))+'MyAVI.avi';
DeviceType := dtAVIVideo;
Notify := false;
Open;
Notify := true;
Play;
end;
end;
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
MediaPlayer1.Close;
if FileExists(ExtractFilePath(ParamStr(0))+'MyAVI.avi') then
begin
DeleteFile(ExtractFilePath(ParamStr(0))+'MyAVI.avi');
ShowMessage('AviFile has Deleted!');
end;
end;
参照: [Delphi-ML:76119] <その他Windows関連> <System> <Windows>
0339 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2003/06/25 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2003/06/25 osamu 編集
フォルダもファイルも選べるダイアログ
Q.デスクトップ 〜 右クリック 〜 新規作成 〜 ショートカットの時に「参照」ボタンを押しますと、Caption は「フォルダの参照」とかになっていながらフォルダもファイルも選べるダイアログが出てきます。こいつを使用したいのです。
A.ShBrowseForFolder で BIF_BROWSEINCLUDEFILES を指定すると良いようです。
with BrowseInfo do begin
hwndOwner := FhParent;
pidlRoot := nil;
pszDisplayName := BDisplayName;
lpszTitle := 'フォルダを選択してください';
ulFlags := BIF_STATUSTEXT or BIF_RETURNONLYFSDIRS or
BIF_BROWSEINCLUDEFILES; // ここを追加
lpfn := @BrowseFolderProc;
lParam := integer(@BFFR);
end;
参照: [Delphi-ML:76043] <Dialogs>
0337 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2003/06/25 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2003/06/25 osamu 編集
ボタン間を矢印キーで移動させるロジック
Q.フォーム上にボタンがたくさんあり、上下左右の矢印キーによって、実際のボタンの配置から期待される順序でフォーカスを動かしたいのですが。
A.設計時の手間はかかるのですが、各ボタンを個別にパネルの上に乗せてしまえば、矢印キーによる通常のフォーカス移動を無効にできるので、ボタンの OnKeyUp イベント内で移動先を設定できると思うのですがいかがでしょうか。
参照: [Delphi-ML:75689] <Standard>
0336 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2003/06/25 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2003/06/25 osamu 編集
RichEdit を印刷したい
Delphi の Demo にサンプルコードが含まれています。Delphi5 であれば、
Program Files\Borland\Delphi5\Demos\Richedit\richedit.dpr
に RichEdit の印刷ルーチンがあります。
参照: [Delphi-ML:54315] <印刷> <Win95>
0321 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2002/05/17 osamu rev 1.4 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2002/05/17 osamu 編集
2つの TMemo のスクロールを同期させる
Q:
memo1 のスクロールバーを動かすと、memo2 も同じようにスクロールさせたいです。
A:[Delphi-ML:67004] Halbow さん
垂直スクロールバーについてだけ、回答します。Memo1 と Memo2 は Width や Height 、Font.Size など同一のプロパティーであると仮定しています。
TRichEdit で同様のことをする方法が[Tips:322]にあります。
type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
Memo1Proc:TWndMethod;
MKEY:WORD;
procedure Memo1SuclassProc(var Msg:TMessage);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1Proc := Memo1.WindowProc;
Memo1.WindowProc := Memo1SuclassProc;
end;
procedure TForm1.Memo1SuclassProc(var Msg: TMessage);
begin
Memo1Proc(Msg);
case Msg.Msg of
WM_VSCROLL:Memo2.Dispatch(Msg);
CN_COMMAND:
if (Msg.WParamHi = EN_VSCROLL) then begin
case MKEY of
VK_DOWN:Memo2.Perform(EM_LINESCROLL,0,1);
VK_UP :Memo2.Perform(EM_LINESCROLL,0,-1);
VK_HOME:if (GetAsyncKeyState(VK_CONTROL) and $8000) <> 0 then begin
Memo2.SelStart := 0;
Memo2.Perform(EM_SCROLLCARET,0,0);
end;
VK_END:if (GetAsyncKeyState(VK_CONTROL) and $8000) <> 0 then begin
Memo2.SelStart := Length(Memo2.Text);
Memo2.Perform(EM_SCROLLCARET,0,0);
end;
end;
MKEY := 0;
end;
CN_KEYDOWN:MKEY := Msg.WParam;
end;
end;
参照: [Delphi-ML:67004] <Standard> [Tips:322]
0322 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2002/05/17 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2002/05/17 osamu 編集
2つの TRichEdit のスクロールを同期させる
2つのTMemo のスクロールを同期させるやり方が[Tips:321]にありますが、実は TRichEdit だと同じようにしてもうまく行きません。
解決方法は、やはり Halbow さんの[Delphi-ML:67313]にあります。
うまく行かないのは、TRichEdit では CN_COMMAND を通じたスクロール通知メッセージ EN_VSCROLL が発行されないためです。EM_SETEVENTMASK というメッセージを送って、LParam に ENM_SCROLL を設定すると、親に EN_VSCROLL を通知するようになります。
親にイベントを通知するかどうかをプログラムで設定するためのこのようなマスクについて、[Delphi-ML:67328]にさらに詳しい説明があります。
public
RichEdit1Proc:TWndMethod;
MKEY:WORD;
procedure RichEdit1SuclassProc(var Msg:TMessage);
procedure SyncVScroll;
procedure PageDown;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
richedit;
procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1Proc := RichEdit1.WindowProc;
RichEdit1.WindowProc := RichEdit1SuclassProc;
end;
procedure TForm1.FormShow(Sender: TObject);
var
MASK:LPARAM;
begin
MASK := RichEdit1.Perform(EM_GETEVENTMASK,0,0);
RichEdit1.Perform(EM_SETEVENTMASK,0,MASK or ENM_SCROLL);
end;
procedure TForm1.RichEdit1SuclassProc(var Msg: TMessage);
begin
RichEdit1Proc(Msg);
case Msg.Msg of
WM_VSCROLL:RichEdit2.Dispatch(Msg);
CN_COMMAND:begin
if (Msg.WParamHi = EN_VSCROLL) then
case MKEY of
VK_DOWN,VK_UP,VK_PRIOR:SyncVScroll;
VK_NEXT:PageDown;
VK_HOME,VK_END:
if (GetAsyncKeyState(VK_CONTROL) and $8000) <> 0 then
SyncVScroll;
end;
end;
CN_KEYDOWN:MKEY := Msg.WParam;
end;
end;
procedure TForm1.SyncVScroll;
var
Msg:TWMScroll;
begin
Msg.Msg := WM_VSCROLL;
Msg.Pos := GetScrollPos(RichEdit1.Handle,SB_VERT);
Msg.ScrollBar := 0;
Msg.ScrollCode := SB_THUMBTRACK;
RichEdit2.Dispatch(Msg);
Msg.ScrollCode := SB_THUMBPOSITION;
RichEdit2.Dispatch(Msg);
Msg.ScrollCode := SB_ENDSCROLL;
RichEdit2.Dispatch(Msg);
end;
procedure TForm1.PageDown;
var
Msg:TWMScroll;
begin
Msg.Msg := WM_VSCROLL;
Msg.Pos := 0;
Msg.ScrollBar := 0;
Msg.ScrollCode := SB_PAGEDOWN;
RichEdit2.Dispatch(Msg);
end;
参照: [Delphi-ML:67313] [Delphi-ML:67328] <Win95> <Standard> [Tips:321]
0316 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 2002/05/17 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2002/05/17 osamu 編集
TreeView で D&D 中の描画処理
TreeView のアイテムをドラッグ・ドロップする際に、挿入位置をグラフィカルに表示するためのサンプルコードです。[Delphi-ML:67348] Halbow さん作。
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
AnItem: TTreeNode;
r:TRect;
begin
AnItem := TreeView1.GetNodeAt(X, Y);
if not Assigned(AnItem) then exit;
r := AnItem.DisplayRect(true);
with TreeView1.Canvas do begin
Brush.Color := TreeView1.Color;
Pen.Color := clRed;
Font := TreeView1.Font;
TextRect(r,r.Left+2,r.Top+1,AnItem.Text);
if (GetAsyncKeyState(VK_CONTROL) and $8000) = 0 then begin
Brush.Style := bsClear;
Rectangle(r.Left,r.Top,r.Right,r.Bottom)
end else begin
MoveTo(r.Left+1,r.Bottom-1);
LineTo(r.Right-1,r.Bottom-1);
end;
end;
end;
参照: [Delphi-ML:67348] <Win95>
0314 D1 D2 D3 D4 D5 D6 D7 3.195 98 作成: 2002/02/09 鈴木充 rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2002/02/09 鈴木充 編集
TListView の ... 表示をなくす
> 自作ソフトにTListViewを使っているのですが、ViewStyleをvsListにした場
> 合、実行時にListItemのCaptionを編集して元のCaptionより長くなった場合、
> 入りきらない部分が"..."表示になるのですが、これをすべて表示するように
> するにはどうすればよいのでしょうか?
ListView1.Perform(CM_RECREATEWND, 0, 0);
で表示されるはずですが、選択状態・スクロール状態等は解除されるので必要に
応じて状態を復元する処理を行ってください。
参照: [Delphi-ML:64465] <Win95>
0312 D1D2 D3 D4 D5 D6 D7 3.195 98 作成: 2001/06/11 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2001/06/11 osamu 編集
ListView をスクロールする
> データセット後に任意の行を表示させたいのですが、
> TopItem プロパティだと read のみで変更できません。
> TStringGrid では TopRow プロパティにて行う事ができますが、
> TListView では何か良い方法はあるのでしょうか?
ListView1->Selected->MakeVisible(false or true);
でスクロールすることができます。
参照: [builder:31260] <Win95>
0296 D1D2D3D4 D5 D6 D7 3.195 98 作成: 2000/01/02 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2000/01/02 osamu 編集
TField.EditMask の y2k 回避
> DBEditで日付入力させるのですが、関連付けているTTable側の
> 日付フィールドのTFieldのEditMaskプロパティで
>
> !99/99/00;1;_
>
> ・・とマスクをかけています。
> すると、西暦を下2桁で打つマスクが有効になるのですが
> 2000/05/05 の意で 00/05/05 とか打つと、期待した
> 2000/05/05にならずに、1900/05/05と表示されてしまいます。
OnCreate イベントハンドラ内で
TwoDigitYearCenturyWindow := 50;
ShortDateFormat := 'yyyy/mm/dd';
の設定を行うと,現在の年が1999年のとき,1999年の前後50年である
1949/1/1 から 2048/12/31 の100年を変換の対象として扱います.
ただし D4 からの機能のようです。
詳しくはヘルプか以下のサイトをご覧になられるとよいと思います.
http://www.inprise.com/devsupport/y2000/
【追記】
Delphi 5 になってから TwoDigitYearCenturyWindow グローバル変数の初期値が「0」から「50」に変更されました。UI 簡略化等で西暦2桁年を使っているような場合、TwoDigitYearCenturyWindow 変数を設定しないまま日付型に変換しているような処理では、処理結果がD4以前と変わる場合があります。
ヘルプの記述(初期値は0)は誤っていますので、ご注意ください。
参照: [Delphi-ML:37908] [Delphi-ML:43093] <データベース> <DataControls>
0190 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/05/19 osamu rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 2000/01/02 osamu 編集
StringGrid の内容更新を高速に行う
| 少々データ量が大きいので時間を稼ぐため、画面表示の Update を
| 停止したいのですが TStringGrid に BeginUpdate/EndUpdate は
| 無いようです。
【解法1】
描画更新の一次停止
SendMessage(StringGrid1.Handle, WM_SETREDRAW, 0, 0);
描画更新の再開
SendMessage(StringGrid1.Handle, WM_SETREDRAW, 1, 0);
StringGrid1.Refresh;
この方法は、すべての TWinControl に対して有効です。
【解法2】
描画更新の一次停止
StringGrid1.Rows[0].BeginUpdate;
描画更新の再開
StringGrid1.Rows[0].EndUpdate;
Rows[0] は Rows[1] でも何でも構いませんが、停止と開始で同じ添字を使わなければなりません。Cols[x] も使えます。一つの Rows[x] または Cols[x] に対して BeginUpdate すると StringGrid のすべての表示更新が停止になります。
BeginUpdate は TStrings の仮想メンバ関数なので、TMemo.Lines とか TListBox.Items などで BeginUpdate を使って TMemo/TListBox などの変更を高速に行うこともできます。
【メモ】
描画更新の再開を必ず行うために、BeginUpdate/EndUpdate は try/finally で保護した方が良いです。
StringGrid1.Rows[0].BeginUpdate;
try
// 更新処理
finally
StringGrid1.Rows[0].EndUpdate;
end;
また、BeginUpdate を繰り返し呼んだ場合には EndUpdate を同じ回数呼ばなければ描画は再開されません。さらに、BeginUpdate よりも多く EndUpdate を呼んでしまうとおかしなことになってしまうので注意が必要です。
参照: [Delphi-ML:38146] [builder:19539] <Additional>
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> <その他コンポーネント関連>
0207 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/19 西坂良幸 rev 1.10 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/27 西坂良幸 編集
アプリケーションを常駐させてタスクトレイに登録したい
コンポーネントをつかう人が多いんでしょうね。MLでは少ない話題です。このようなAPLを何十本も作るんでなければ、直接コーディングしてみませんか。
要領は、APIのShell_NotifyIcon関数を使うことです。TaskTrayへの登録と削除は簡単にできます。
頭を悩ますのは、どんなアイコンを使うのかと、TaskTrayに送られてくるメッセージを自分で決めなければならないことです。
const
WM_MY_TRAYICON = WM_APP + $300; // 適当です
// ProcessMesageに配慮−−無くても良い
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// WM_QUIT メッセージを受け取る時
if Application.Terminated then
begin
ShowWindow(Application.Handle, SW_HIDE);
Visible := False;
Action := caNone;
end;
end;
// アイコンをトレイに登録−−ここではメインアイコンを使用
procedure TForm1.CreateTaskBarIcon;
var
NotifyData: TNotifyIconData;
begin
with NotifyData do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := hWndTrayIcon;
uID := 0;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
szTip := 'Traybar Tip';
hIcon := Application.Icon.Handle;
uCallbackMessage := WM_MY_TRAYICON;// 独自に定義
end;
Shell_NotifyIcon( NIM_ADD, @NotifyData );
end;
// アイコンを削除
procedure TForm1.DeleteTaskBarIcon;
var
NotifyData: TNotifyIconData;
begin
with NotifyData do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := hWndTrayIcon;
uID := 0;
end;
Shell_NotifyIcon( NIM_DELETE, @NotifyData );
end;
// 起動直後はトレイにアイコン表示のみ
procedure TForm1.FormCreate(Sender: TObject);
begin
// uTaskBarRecrate は TForm1 の private に UINT 型で宣言
// 新しい UtilWindow を作成し、ブロードキャストメッセージのみを受け取らせる
uTaskBarRecreate := RegisterWindowMessage('TaskbarCreated');
// hWndTrayIcon は TForm1 の private に HWND 型で宣言
// メッセージ送信先を指定
hWndTrayIcon := AllocateHWnd(TaskTrayWndProc);
CreateTaskBarIcon;
ShowWindow(Application.Handle,SW_HIDE);
Application.ShowMainForm := False;
end;
// 終了した時にトレイのアイコンを削除
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteTaskBarIcon;
DeallocateHWnd(hWndTrayIcon);
end;
// タスクトレイに来るWM_MY_TRAYICONメッセージを受信
procedure TForm1.TaskTrayWndProc(var Msg: TMessage);
var
ps: TPoint;
begin
Case Msg.LParam of
WM_LBUTTONDBLCLK:
begin
Visible := true;
ShowWindow(Application.Handle,SW_SHOW);
//ShowWindow(Application.Handle,SW_RESTORE);
end;
WM_RBUTTONUP:
begin
GetCursorPos(ps);
SetForegroundWindow(Handle);
// フォームにポップアップメニューがあるとする
PopupMenu1.Popup(ps.x,ps.y);
PostMessage(Handle, WM_NULL, 0,0);
end;
else
// タスクバーが移動・再構築された場合に消えたアイコンを再生成
if (Msg.LParam = LongInt(uTaskBarRecreate)) then
CreateTaskBarIcon;
end;
end;
AllocateHWnd 関数の戻り値のウィンドウハンドルを利用すれば他のメッセージ受信先/送信先として利用できるので、TrayIcon のメッセージ送信先に利用しました。
参照: [Delphi-ML:2536] [Delphi-ML:11821] [Delphi-ML:35250] <System> <Windows> <フォーム>
0141 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/11 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/24 西坂良幸 編集
TOpenDialogで、Executeメソッド実行時に表示位置を変えたい。
TOpenDialogは、OnShowイベントの段階では、位置がすでに決まっているようです。調べてみると、何回かWM_NOTIFYが送られますが、NMHDR構造体のCodeメンバーがCDN_INITDONEになるダイアログの初期化時を捕まえるとうまくいくようです。(ただし、これでも最初のExecute時しか効果ありません。D4のみ?)
以下のような拡張ダイアログコンポが紹介されています。
// 定義部
type
TQueryDlgPosEvent = procedure(Sender: TObject; var pt: TPoint) of object;
ThtOpenDialogEx = class(TOpenDialog)
private
FQueryDlgPos: TQueryDlgPosEvent;
protected
procedure DefaultHandler(var Message); override;
procedure DoQueryDlgPos; virtual;
published
property OnQueryDlgPos: TQueryDlgPosEvent read FQueryDlgPos write FQueryDlgPos;
end;
// 実装部n
procedure ThtOpenDialogEx.DefaultHandler(var Message);
begin
inherited;
with TWMNotify(Message) do
if (Msg = WM_NOTIFY) then
if (NMHdr^.Code = CDN_INITDONE) then
DoQueryDlgPos;
end;
procedure ThtOpenDialogEx.DoQueryDlgPos;
var
DlgHandle: THandle;
Rect: TRect;
pt: TPoint;
begin
if Assigned(FQueryDlgPos) then
begin
DlgHandle := GetParent(Handle);
GetWindowRect(DlgHandle, Rect);
pt.x := (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2;
pt.y := (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3;
FQueryDlgPos(Self, pt);
SetWindowPos(DlgHandle, HWND_TOP, pt.X, pt.Y, 0, 0,
SWP_NOSIZE or SWP_NOZORDER);
end;
end;
// テスト
procedure TForm1.Button1Click(Sender: TObject);
var
OpenDialogEx:ThtOpenDialogEx;
begin
OpenDialogEx:=ThtOpenDialogEx.Create(self);
try
with OpenDialogEx do
begin
OnQueryDlgPos := QueryDlgPos;
Execute;
end;
finally
OpenDialogEx.Free;
end;
end;
procedure TForm1.QueryDlgPos(Sender: TObject; var pt: TPoint);
begin
Pt.x := 800;
pt.y := 600;
end;
追記:
DefaultHandlerメソッドのかわりに、WndProcメソッドをオーバーライドしてもほぼ同じ結果が得られます。
以下は、イベントの代わりに、InitialLeft, InitialTop、というプロパティを設定しています。
procedure ThtOpenDialogEx.WndProc(var Message: TMessage);
var
DlgHandle: THandle;
begin
inherited WndProc(Message);
if (Message.Msg = WM_NOTIFY) then
if (TWMNOTIFY(Message).NMHdr^.Code = CDN_INITDONE)
and not ((FInitialLeft < 0) or (FInitialTop < 0)) then
begin // 負数のときは処理しない
DlgHandle := GetParent(Handle);
SetWindowPos(DlgHandle, 0, FInitialLeft, FInitialTop, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;
end;
参照: [Delphi-ML:12600] [Delphi-ML:24640] <ダイアログ> <Dialogs>
0263 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/16 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/16 osamu 編集
StringGrid でセル編集終了のイベントを得たい
StringGrid で表計算のような動作をさせようとすると、セル編集終了のイベントで、関係し合うセルの再計算を行いたくなります。OnSetEditText というイベントが利用できそうなのですが、このイベントはユーザのキー入力の一文字ごとに発生するため使えません。
で、少なくとも Delphi3 では、以下のようにすると、セル編集終了時を検出することができます。
これは、セル編集終了時に、OnSetEditText が2度続けて同じ Value 値で呼び出されるという現象を利用しています。Delphi の今後のバージョンで動作が保証されるわけではありませんので、注意が必要です。また、Options に goAlwaysShowEditor が含まれている場合には、Enter キーで値を確定することができないという不具合(?)が生じます。
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
const
MagicValue = 'd0308|ybh<_lfds$t083q()'#1#5; // 入力値としてありえない値
PreviousEditorValue: string = MagicValue; // C でいう static 変数の代り
begin
if Value<>PreviousEditorValue then begin // まだ編集中
PreviousEditorValue:= Value;
Exit;
end;
// 編集終了時には、同じ値が二度続けて送られてくる
case ACol of
0: ;
1: ; // ここで入力後の処理
2: ;
end;
// 次回のために絶対にありえない文字列を代入
PreviousEditorValue:= MagicValue;
end;
参照: [Delphi-ML:42663] <Additional>
0262 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/16 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/16 osamu 編集
TStringGrid の列の ReSize イベントの取得
ColWidthsChanged を overrideすることで、実現できます。
■interface
TStringGrid_Ex = class(TStringGrid)
private
FOnColWidthsChange:TNotifyEvent;
ptotected
procedure ColWidthsChanged; override;
published
property OnColWidthsChange:TNotifyEvent
read FOnColWidthsChange
write FOnColWidthsChange;
end;
■implementation
procedure TStringGrid_Ex.ColWidthsChange;
begin
inherited;
if Assigned(FOnColWIdthsChange) then
FOnColWidthsChange(Self);
end;
■利用方法
procedure TForm1.Grid1OnColWidthsChange(Sender:TObject);
var
idx :Longint;
begin
//条件
// Grid1.ColCount = Grid2.ColCountであること
if Sender = Grid1 then begin
for idx:=0 to Grid1.ColCount-1 do begin
Grid2.ColWidths[idx] := Grid1.ColWidths[idx];
end;
end else begin
for idx:=0 to Grid2.ColCount-1 do begin
Grid1.ColWidths[idx] := Grid2.ColWidths[idx];
end;
end;
end;
end;
同様に、RowHeighsChangedもoverrideできます。
参照: [Delphi-ML:31921] <Additional>
0258 D1D2 D3 D4 D5 D6 D7 3.195 98 作成: 1999/09/15 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3NT4 2K XP 更新: 1999/09/15 osamu 編集
TRichEdit.Add でリソース不足
> 現在、通信関係のソフトを開発しているのですが、RichEdit の Add メソッドで
> EOutOfResources(リソース不足)の例外が発生するようになってしまい
> ました。
>
> RichEdit の MaxLength には、20000000 の値を入れており、まだそんなに
> Add していない状態で発生します。
Lines.Add メソッドで読み込んでいるということですね。
私も同じトラブルを経験しましたが、Lines.Add の代わりに、一旦 TMemoryStream に書き出してから、LoadFromStream メソッドを使うという方法で回避しました。
参照: [Delphi-ML:34075] <Win95>
0257 D1 D2 D3 D4 D5 D6 D7 3.195 98 作成: 1999/09/15 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3NT4 2K XP 更新: 1999/09/15 osamu 編集
TPageControl に OnDblClick を追加する
> PageControl や TabControl にクリックイベントやダブルクリックイベントを
> 付けたいのですがどのようにしたらよろしいのでしょうか?
以下の派生クラスでお望みのイベントが生成されます。
# ただ、PageControl の仕様をよく調査しないで作ったので、
# もしかしたら Click関係で弊害があるかもしれません。
uses
Classes, Controls, ComCtrls;
type
TxxPageControl = class(TPageControl)
public
constructor Create(AOwner: TComponent); override;
published
property OnDblClick;
end;
implementation
constructor TxxPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csClickEvents];
end;
参照: [Delphi-ML:34074] <Win95>
0256 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/15 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/15 osamu 編集
TTreeView で5つ以上のオーバレイ・イメージを使う
>TreeView で同時に指定可能なオーバーレイ・イメージの最大数は
>使用する ImageList のメソッド Overlay で設定可能な最大数
>(4つ、TOverlay の範囲内で指定) になると解釈しています。
>現在、この制限を越えた数のオーバーレイ・イメージを使いたいの
>ですが、何か良い方法は無いでしょうか?
Overlay は ComCtl32.dll が 4.70 以前は4個まで、4.71 以降で 15個までに拡張されたようです。4.70 以前の場合は、同時に4つまでしか使用できませんが、4.71 以降では、
ImageList_SetOverlayImage(ImageList1.Handle, 8, 5);
のように直接設定すれば OK です。(^^)/
参照: [Delphi-ML:32333] <Win95>
0253 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/13 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/13 osamu 編集
TFontDialog で標準以外のサイズを選択肢に表示したい
> ルビをうつフォントを指定しようと思い、TFontDialogで
> 片付けようと思いましたが、TFontDialogで、MSゴシック
> など8Pt以下のポイントが出てきません。指定できるように
> する方法をどなたかご存知でしょうか。
思いっきり強引ですけど
unit FontDialogEx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs;
type
TFontDialogEx = class(TFontDialog)
protected
function TaskModalDialog(DialogFunc: Pointer;
var DialogData): Bool; override;
end;
procedure Register;
implementation
uses Dlgs, CommDlg;
const
WM_FONTDIALOGEX = WM_USER + 256;
str1: string = '4';
str2: string = '5';
str3: string = '6';
str4: string = '7';
var
OldHook: function(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): UINT; stdcall;
function FontDialogHookEx(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
LParam: LPARAM): UINT; stdcall;
begin
if (Msg = WM_COMMAND) and (LOWORD(WParam) = cmb1) then begin
PostMessage(Wnd, WM_FONTDIALOGEX, 0, 0);
end;
if Msg = WM_FONTDIALOGEX then begin
SendDlgItemMessage(Wnd, cmb3, CB_RESETCONTENT, 0, 0);
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str1)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str2)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str3)));
SendDlgItemMessage(Wnd, cmb3, CB_ADDSTRING, 0, LongInt(PCHAR(str4)));
Result := 1;
exit;
end;
Result := OldHook(Wnd, Msg, WParam, LParam);
end;
function TFOntDialogEx.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
OldHook := TChooseFont(DialogData).lpfnHook;
TChooseFont(DialogData).lpfnHook := FontDialogHookEx;
inherited TaskModalDialog(DialogFunc, DialogData);
end;
procedure Register;
begin
RegisterComponents('NkCtrls', [TFontDialogEx]);
end;
end.
一応動いてます(^^ フォント名毎に表示するサイズリストを変えたい場合は、cmb1 に選択されているフォント名を確認するコードが必要になるでしょう。
一瞬元のポイントサイズがコンボボックスに表示されてしまいますが今のところ他に良い手を思いつきません(^^;
参照: [Delphi-ML:42562] <ダイアログ> <Dialogs> <描画>
0223 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/28 おばQ rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/11 K.Takaoka 編集
Editコントロールで入力を数値専用にする
入力を数値のみにする場合は、Handleの生成を確認した後
SetWindowLong(Edit1.Handle, GWL_STYLE,
GetWindowLong(Edit1.Handle,GWL_STYLE) or ES_NUMBER);
でできます。
SetWindowLong による指定はウィンドウの再生成が行われた時に無効になりますので、Delphi4 のドッキングウィンドウや、Toolbar97 などのコンポーネントを同時に利用される場合には CreateParams をオーバーライドしたコンポーネントを作成するかフローティング状態の変更通知を受け取るたびに SetWindowLong を行う必要があります。
参照: [Delphi-ML:9195] [Delphi-ML:41622] <Standard>
0243 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/09 osamu rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/11 K.Takaoka 編集
TMemo のキャレットを非表示にする
> メモコンポーネントでキャレットを消したいのです。
以下のコードでうまくいっています
// TExMemo=class(TMemo)
// TExMemo.WMSetFocusはWM_SETFOCUSのメッセージハンドラ
Procedure TExMemo.WMSetFocus(var Msg:TWMKeyDown);
Begin
Inherited;
HideCaret(Handle);
End;
参照: [Delphi-ML:33802] <Standard>
0235 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/06 西坂良幸 rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/11 K.Takaoka 編集
エディットコントロールにポップアップウィンドウをつけたい
エディットコントロールにボタンをつけた、コンボボックスもどきは、カスタムコントロールでよく見かけます。ボタンを押すと小ウィンドウが開くヤツです。これはどのように作るのでしょうか。
このような小ウィンドウをインプレースコントロールと呼びます。
ポイントは、小ウィンドウの親をコントロールにすることと、独自のフォーカスを与えないことです。これさえ理解できれば後は、小ウィンドウのVisbleの切り替えで開いたり閉じたりします。
ここでは、プロパティを受け渡すことを無視し、ただ開閉だけをやってみます。(マウス右ボタンで開く)
// 定義部
TxEdit = class;
// インプレースコントロール ここではリストボックス
TinPlaceList = class(TListbox)
private
FEdit: TxEdit;
protected
procedure CreateWnd; override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor CreateList(AOwner: TComponent; Edit: TxEdit);
end;
// ここでは、TEditから継承する
TxEdit = class(TEdit)
private
FInplaceList:TListbox;
protected
procedure Mousedown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
procedure DropDown;
end;
// 実装部
//コンストラクタでコントロールに接続させる
constructor TInplaceList.CreateList(AOwner: TComponent; Edit: TxEdit);
begin
inherited Create(AOwner);
// 小ウィンドウに親のポインタを持たせて接続する
FEdit := TxEdit(Edit);
Visible := false;
end;
// インプレースコントロールの生成とフォーカス制御
procedure TInplaceList.CreateWnd;
begin
inherited CreateWnd;
//親の変更を行う
if not (csDesigning in ComponentState) then
Windows.SetParent(Handle, 0);
//独自のフォカスメッセージを避ける
CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
end;
//とりあえずマウス(左右)で閉じることにする
procedure TInplaceList.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if Button = mbLeft then
begin
// プロパティの受け渡しをここらで行う
Hide;
end;
if Button = mbRight then
Hide;
end;
// コンストラクタで、インプレースコントロールを生成
constructor TxEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FInplaceList := TInplaceList.CreateList(Self, Self);
with FInplaceList do
begin
Parent := Self;
TabStop := false;
Visible := false;
Top := FInplaceList.Top + Self.Height;
end;
end;
// デストラクタで念のため明示的に解放する
destructor TxEdit.Destroy;
begin
FInplaceList.free;
inherited Destroy;
end;
// ドロップダウンリストの開閉のメソッドを作成する
procedure TxEdit.DropDown;
var
xyPos: TPoint;
begin
if (FInplaceList <> nil) and not FInplaceList.Visible then
with FInplaceList do
begin
xyPos := Self.ClientToScreen(Point(0 + Self.Width - Width, Self.Height));
SetWindowPos(Handle, 0, xyPos.X, xyPos.Y, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE);
Windows.SetFocus(Handle);
Visible := not Visible;
// プロパティの受け渡しをここらで行う
end;
Invalidate;
end;
// マウス右ボタンで開く
procedure TxEdit.Mousedown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Button = mbRight then
DropDown;
inherited Mousedown(Button, Shift, X, Y);
end;
TListBoxのかわりに、何でも使えます。TPanelなら、電卓、カレンダなどになりますね。TGridでもいいですね。
実際にカスタムコントロールを作るときは
・やはりボタンをつける
・キーボード入力にも対応させる
・必要なプロパティの受け渡しを行う
・ドロップダウンなどイベントを記述する
・ロストフォーカスで開きっぱなしにしない
などが必要でしょうか。
参照: [Delphi-ML:40241] <コンポーネント開発> <Standard>
0246 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/09 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/09 osamu 編集
DLL 内で TDBCtrlGrid を使うときの注意事項
>DLL化したアプリのフォームにDBCtrlGrid,DBCheckBoxを置いてローカルDB
>の内容を表示させているのですが、DLL化した途端にカレントレコードしか
>表示されなくなってしまいました。
この現象は以下の理由で発生します。
1.DLLの中では、何もしなければApplication.Handle=0です。
2.DBCtrlGridに配置されるコンポーネントの一部(DBCheckBoxを含む)はカレントレコード以外へ複製表示を行うために、Application.Handleを利用しています。
具体的にはDBCtrls.pasのTPaintControl.GetHandleで、次のようなコードで表示用の別ウインドウを生成しています。
with Params do
FHandle := CreateWindowEx(ExStyle, PChar(FClassName),
PChar(TWinControlAccess(FOwner).Text), Style or WS_VISIBLE,
X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
Application.Handle=0 だと CreateWindowEXは失敗し、FHandle=0となるので複製表示が正常に行われないのです。
対処方法としては、Delphiヘルプの TApplication.Handle に書いてありますが、EXE ホストのメインウィンドウのウィンドウハンドルを DLL の Application.Handleに割り当てます。
別の方法としては、上記の TPaintControl.GetHandle の Application.Handle を FOwner.Handle に書き換えてもいいでしょう。
このスレッドではさらに、TApplication.MainForm.Handle を渡すべきか、TApplication.Handle を渡すべきか。また、TApplication.Handle を渡す際には、DLL 側の uses から Forms を削除しなければ、など、使い方に関する細かい注意点が議論されています。
参照: [Delphi-ML:33636] [Delphi-ML:33791] <データベース> <DataControls>
0241 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/09 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/09 osamu 編集
TPageControl でタブをドラッグして順序入れ替え
>マウスでTabSheet上のTabをドラッグして
>Tabの順序を交換するにはどうしたらよいのでしょうか?
面白そうなので、D3 でやってみました。
--- 以下 例文 ---
procedure TForm1.PageControl1MouseDown(Sender: TObject;...);
begin
PageControl1.BeginDrag(false);
end;
procedure TForm1.PageControl1DragOver(Sender, ...);
begin
if Sender is TPageControl then
Accept := true;
end;
procedure TForm1.PageControl1DragDrop(Sender, ...);
var
i: Integer;
r: TRect;
begin
if not (Sender is TPageControl) then
Exit;
with PageControl1 do
begin
for i := 0 to PageCount - 1 do
begin
Perform(TCM_GETITEMRECT, i, LPARAM(@r));
if PtInRect(r, Point(X, Y)) then
begin
if i <> ActivePage.PageIndex then
ActivePage.PageIndex := i;
Exit;
end;
end;
end;
end;
参照: [Delphi-ML:33411] <Win95>
0239 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/08 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/08 osamu 編集
IME に未確定文字列を入力
> プログラム中からIMEに未変換・未確定文字列として送りたいのですが。。。
>
> 例
> プログラムで渡す文字列 へいせい10ねん
> ↓
> IME 「へいせい10ねん」(未変換・未確定)
方法1
「へいせい10ねん」を「heisei10nenn」もしくは、
「ヘイセイ10ネン」(ほんとは半角)に変換し、キーボードイベントとして
sendkeysや、keybd_event APIでIMEに送る。
ローマ字変換か、カナ変換かは、ImmGetConversionStatus APIで
判断出来ます。
例
Edit1.SetFocus;
SendKeys('heisei10nenn',true);
方法2
ImmSetCompositionString APIでIMEに直接セットする。
例
var
IMC:HIMC;
BufLen:longint;
Buf:string;
begin
Edit1.SetFocus;
IMC:=ImmGetContext(Edit1.Handle);
Buf:='へいせい10ねん';
BufLen:=length(Buf);
//MS-IME98
ImmSetCompositionStringA(IMC,SCS_SETSTR,PChar(Buf),BufLen,nil,0);
//ATOK12
ImmSetCompositionStringW(IMC,SCS_SETSTR,PChar(Buf),BufLen,nil,0);
ImmReleaseContext(Edit1.Handle,IMC);
end;
MS-IME98とATOK12でテストしましたが、ATOK12の場合、UniCodeの方のAPIで実行しないとちゃんと動作しませんでした。
なぜなのかは、よくわかりません(^^;
#詳しくは、英語のヘルプやAPIの解説書等で調べてください。
参照: [Delphi-ML:32185] <その他Windows関連> <Windows> <Standard>
0003 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/08 osamu 編集
ショートカットキーに'+'を使う。
Delphi2.0 以上では、『!"#$%&'()=~|^{}`*+_?><』など、101のフルキー側(テンキーを除いた部分)で、Shiftと同時にキーを押さなければ入力できない文字はショートカットに使えない。
テンキーがついてたり、JISキーボードならばワンキーで押せるものもあるのに。
こういったキーを使うには、ShortCut プロパティにキーコードを直接セットすればいい。
たとえば、
Test2.ShortCut:=$6B; // <- + キーのキーコード
でも、これだとメニューの右端にキー名が表示されない。 (;_;)
対処方法は [Tips:4]。
参照: [Delphi-ML:17954] [Tips:4] <Standard> <メニュー>
0224 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/28 おばQ rev 1.1.1.5 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/07 西坂良幸 編集
右寄せ・数値入力可能なEditコンポーネントを作りたい。
Win98 以降では、次のようにすれば完璧な右寄せエディタが作成できます。
WindowsNT4 では SP3 (User32.Dll が 03/11/97 07:04p Intel, 03/11/97 06:14p Alpha) から利用できます。
type
TRgEdit = class(TEdit)
protected
procedure CreateParams(var params: TCreateParams); override;
end;
procedure TRgEdit.CreateParams(var params: TCreateParams);
begin
inherited CreateParams(params);
with Params do
Style := Style or ES_RIGHT;
end;
追記のバージョン以前、またDelhi3以前は、
Style := Style or WS_MULTILINE or ES_RIGHT and not WS_VSCROLL and not WS_AUTOVSCROLL ;
とします。
また、入力を数字専用される場合は、上記にES_NUMBERを論理和
させます。
以下は、Alignment、NumOnly の各プロパティを作成する例です
(FAlignment、FNumOnlyやプロパティ定義部分は省略しています)
procedure TRgEdit.CreateParams(var params: TCreateParams);
const
Alignments: array[TAlignment]of Word = (ES_LEFT, ES_RIGHT, ES_CENTER);
NumlOnlies: array[Boolean]of Word = (0, ES_NUMBER);
begin
inherited CreateParams(Params);
Params.Style := Params.Style
or Alignments[FAlignment]
or NumlOnlies[FNumlonly];
end;
procedure TRgEdit.SetAlignment(NewValue: TAlignment);
begin
if FAlignment <> NewValue then
begin
FAlignment := NewValue;
RecreateWnd;// CreateParamsを呼び出すのではないことに注意
end;
end;
procedure TRgEdit.SetNumlOnly(NewValue: Boolean);
begin
if FNumlOnly <> NewValue then
begin
FNumlOnly := NewValue;
RecreateWnd;
end;
end;
参照: [Delphi-ML:9195] [Delphi-ML:41622] <Standard>
0123 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/02/08 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/06 西坂良幸 編集
ButtonのCaptionで改行を使って文字を複数段で表示したい
Windows95では #13#10 挿入することにより思った通り表示できるのですが
WindowsNTの場合は改行されません。
procedure TForm1.Button1Click(Sender: TObject);
begin
SetWindowLong(Button1.Handle, GWL_STYLE, GetWindowLong(Button1.Handle, GWL_STYLE) or BS_MULTILINE);
Button1.Caption := 'ABC' + #13#10 + 'DEF';
end;
なお、コンポ−ネント化する場合はCreateParamsをオーバーライドして下さい。
この方法は、TButtonControl系(TRadioButton,TCheckBox)でほとんど使えますが、オーナードロー系(TBitBtn,TSpeedButtonなど)のボタンではできません。
また、以下のプロパティエディッタをインストールすれば、オブジェクトインスペクタで,改行コードを入力を'\n'ですることが出来るようになります。
// 定義部
type
// 複数行の入力を\nで受け入れるプロパティエディッタ
TMultCapProperty = Class(TCaptionProperty)
Public
Function GetValue: string; Override;
Procedure SetValue(const Value: string); Override;
End;
procedure Register;
// 実装部
// 置き換える関数
procedure ReplaceStr(var Source : string; Search, Replace : string);
function XPos(Source, Search : string):integer;
begin
if StrPos(PChar(Source), PCHar(Search)) = nil then
result := 0
else
result := StrPos(PChar(Source), PCHar(Search)) - PChar(Source) + 1;
end;
var
p, L1, L2 : Integer;
begin
L2 := Length(Search);
p := XPos(Source, Search);
while p <> 0 do
begin
L1 := Length(Source);
if p = 1 then
Source := Replace + Copy(Source, L2 + 1, L1)
else
Source := Copy(Source, 1, p - 1) + Replace +
Copy(Source, p + L2, L1);
p := XPos(Source, Search);
end;
end;
function TMultCapProperty.GetValue: string;
begin
Result := GetStrValue;
// 以下3つのパターンがある
ReplaceStr(Result, #13 + #10, '\n');
ReplaceStr(Result, #10, '\n');
ReplaceStr(Result, #13, '\n');
end;
procedure TMultCapProperty.SetValue(const Value: string);
var
Caption : string;
begin
Caption := Value;
ReplaceStr(Caption, '\n', #13);
SetStrValue(Caption);
end;
// プロパティエディタとして登録する
procedure Register;
begin
// TLabelのCaptionプロパティエディタの登録--'\n'で改行入力
RegisterPropertyEditor(TypeInfo(TCaption), TLabel; , 'Caption', TMultCapProperty);
// TButtonのCaptionプロパティエディタの登録--'\n'で改行入力
// ただし上記BS_MULTILINEが設定されていないとダメ
RegisterPropertyEditor(TypeInfo(TCaption), TButton; , 'Caption', TMultCapProperty);
end;
参照: [Delphi-ML:17735] [Delphi-ML:39679] [builder:6270] <コンポーネント開発> <Standard>
0063 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 更新: 1999/09/06 西坂良幸 編集
キーボードでボタンを押したとき、ボタンをちゃんと沈ませたい
BM_SETSTATE メッセージを使うとできます。
コンポーネント化は、ちょっと長くなるので、詳細は [Delphi-ML:19607] を見てください。
以下、スペースキーでの例です。
procedure TForm1.Button1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #32 then
SendMessage(Button1.Handle,BM_SETSTATE,1,0);
end;
procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = 32 then
SendMessage(Button1.Handle,BM_SETSTATE,0,0);
end;
コーディングだけで呼ぶ場合は
SendMessage(Button1.Handle,BM_SETSTATE,1,0);
Button1.Click;
Sleep(100); // 適当に好みで決める
PostMessage(Button1.Handle,BM_SETSTATE,0,0);
参照: [Delphi-ML:19607] <Standard>
0237 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/06 西坂良幸 rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/06 西坂良幸 編集
カーソルキーでボタン(TButton)のフォーカス移動をやめさせたい
TButtonのOnKeyPress、OnKeyDownなどでやってみてもダメですね。これは、Windowsのボタンの仕様です。
フォームへのCM_DialogKeyメッセージをとらえて処理すると可能です。
procedure TForm1.CMDialogKey(var Msg:TCMDialogKey);
begin
case Msg.CharCode of
VK_UP,VK_DOWN,VK_LEFT,VK_RIGHT : Msg.CharCode:=0;
end;
inherited;
end;
このメッセ−ジはタブキー(VK_TAB)もとらえることが出来ます。
参照: [Delphi-ML:3691] [Delphi-ML:33541] <フォーム> <Standard>
0236 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/09/06 西坂良幸 rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/06 西坂良幸 編集
エディットコントロールにコンボボックスのようなボタンをつけたい
エディットをParentとするフォーカスを持たないTSpeedButtonを、貼り付けてやれば簡単です。
注意するのは、編集領域がボタンに重ならないようにEM_SETRECTNPを送ることですが、このメッセージが有効になるには、TEditのスタイルフラッグにES_MULTILINEを加えなければなりません。
以下の例は、ボタンを押せば単にメッセージボックスがでるだけのものです。
// 定義部
TxEdit = class(TEdit)
private
FButton: TSpeedButton;
FOnButtonClick: TNotifyEvent;
procedure SetEditRect;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
procedure ButtonClick (Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
public
constructor Create(AOwner: TComponent); override;
published
property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
end;
// 実装部
constructor TxEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// ボタンを作成する
FButton := TSpeedButton.Create (Self);
with FButton do
begin
Parent := Self;
Width := 18;
Height := Height - 4;
// リソースから ▼ のビットマップ(10×8程度×2)を読むのは省略
// NumGlyphs := 2;
// result.Glyph.LoadFromResourceName(HInstance,'????');
CurSor := crArrow;
OnClick := ButtonClick;
end;
end;
// スタイルフラッグにES_MULTILINEが必要です。
procedure TxEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE;
end;
// ハンドルが生成されてからSetEditRectを呼ぶ
procedure TxEdit.CreateWnd;
begin
inherited CreateWnd;
SetEditRect;
end;
// エディット(編集)領域を再設定する(ボタンの部分を排除)
procedure TxEdit.SetEditRect;
var
Loc: TRect;
begin
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
Loc.Right := ClientWidth - FButton.Width - 2;
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
end;
// 常に左端にアジャストさせる
procedure TxEdit.WMSize(var Message: TWMSize);
begin
inherited;
if FButton <> nil then
begin
if NewStyleControls and Ctl3D then
FButton.SetBounds(Width - FButton.Width - 4, 0, FButton.Width, Height - 4)
else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 2);
SetEditRect;
end;
end;
// ボタンのクリックに対応するイベントを設定する
procedure TxEdit.ButtonClick (Sender: TObject);
begin
if Assigned(FOnButtonClick) then FOnButtonClick(self);
ShowMessage('ボタンが押されました')
// ここに必要な処理を書く
end;
この他、CM_EnabledChangeを捕まえて、EditとボタンのEnabledを同期させることが必要でしょうか。
参照: <コンポーネント開発> <Standard>
0198 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/07/09 osamu rev 1.3 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/05 西坂良幸 編集
ドッカブルメニュー(ツールバー形式のメニュー)を実現したい。
Delphi4でドッカブルメニューを実現するにはどうしたら良いのでしょうか?
IDEでは実現されているので、出来るとは思うのですが...。
アメリカのインプライズのサイトで、ドッカブルメニューのコンポが配られていますよ。使用した感じ日本語環境でも大丈夫そうです。まぁ、多分かなりの問い合わせがあったんでしょうね。
TMenubar -> http://www.borland.com/devsupport/delphi/downloads/index.html
このコンポーネントを使わない場合は、以下の手順で行います。[Delphi-ML:35243][Delphi-ML:35223] Oyats、fumika
・フォームにTCoolBarを配置し、そのTCoolBarの上にTToolBarを配置
・TToolBarのShowCaptionプロパティをTrue、FlatプロパティをTrue、EdgeBordersのedTopプロパティをFalseにする
・フォームにTMainMenuを配置
・TMainMenuのメニューエディッタで、作りたいメニューを作る(MenuItemの作成)
・TToolBarの上にTToolButtonを作成し、各TToolButtonのMenuItemプロパティにTMainMenuの各MenuItem(Parent)を対応させる
・各TToolButtonのGroupedプロパティをTrue、AutoSizeプロパティをTrueにする
・フォームのMenuプロパティをnilにする(メニュー表示を消す)
・フォームのOnShortCutイベントに次のハンドラを設定する
procedure TForm1.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
Handled := Handled or MainMenu1.IsShortCut(Msg);
end;
TMenuBarを使う人も
http://member.nifty.ne.jp/cosmic/delphi/tips_vcl.html#tmenubar
は覗いておきましょう。
参照: [Delphi-ML:32742] [Delphi-ML:35223] <Win95> <Standard>
0216 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/25 おばQ rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/09/01 おばQ 編集
RichEditでHTMLタグを色・書式付き表示をする
HTMLソースを表示する時タグだけ色分けや書式付きで表示されると便利です。
以下のソースを入力して、RichEditにHTMLソースを表示させて
ボタンを押すと、なかなか高速にタグだけに色がつきます。
テキストを検索してSelAttributesで色付けしてもいいのですが、
あまりにも遅いのでほとんどAPIを使います。
タグを入力してリアルタイムに色をつけることは少々ムズカシそうだったので
実装していません。こちらと組み合わせてみるのもよいでしょう。
そちらの方法は、自分で考えてね(^^;;;
//関数部
procedure RichEditHTMLTagPickUp(RichEdit: TRichEdit; TagColor: TColor);
function ColorToStringHex(Value: TColor): string;
begin
Result := '$00' + IntToHex(ColorToRGB(Value),6)
end;
var
mask: Longint;
CFmt: TCharFormat;
Str: String;
PTop, PPos, PEnd, PNext: PChar;
CR: TCharRange;
begin
try
RichEdit.Lines.BeginUpdate;//高速化、1
mask := SendMessage(RichEdit.Handle, EM_GETEVENTMASK, 0, 0);//高速化、2
SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, 0);
with RichEdit do
begin
SelStart := length(Text);//高速化、3
Perform(EM_SCROLLCARET, 0, 0);
case 1 of
0:
begin
CFmt.cbSize := sizeof(CFmt);
CFmt.dwMask := CFM_BOLD;
CFmt.dwEffects := CFE_BOLD;
end;
1:
begin
CFmt.cbSize := sizeof(CFmt);
CFmt.dwMask := CFM_COLOR;
CFmt.crTextColor := ColorToRGB(TagColor);
end;
end;
Str := RichEdit.Text;
PTop := PChar(Str);
PPos := PTop;
while (AnsiStrScan(PPos, '<') <> nil) do//高速化、4
begin
PPos := AnsiStrScan(PPos, '<');
PEnd := PPos;
while (AnsiStrScan(PEnd +1 , '>') <> nil) do
begin
PNext := AnsiStrScan(PEnd +1 , '>');
PEnd := PNext +1;
while (PEnd = PChar(#13)) or (PEnd = PChar(#10)) do
Inc(PEnd);
if PEnd <> PChar('<') then Break;
end;
CR.cpMin := PPos - PTop;
CR.cpMax := PEnd - PTop;
RichEdit.Perform(EM_EXSETSEL, 0, lParam(@CR));
RichEdit.Perform(EM_SETCHARFORMAT, 1, lParam(@CFmt));//書式決定
PPos := PEnd;
end;
end;
finally
SendMessage(RichEdit.Handle, EM_SETEVENTMASK, 0, mask);//高速化、2終
RichEdit.Lines.EndUpdate;//高速化、1終
end;
end;
//実装部
procedure TForm1.Button2Click(Sender: TObject);
begin
RichEditHTMLTagPickUp(RichEdit1, Form1.Color);
end;
注意:タグが綺麗に閉じられていないと無限ループに
はまってしまう事が考えられます。気をつけてください
内部でcase文に1を設定している所があります。
ここを0にしますとHTMLタグがBold属性になります。
1の場合ですとForm1.Colorになります。
適当に書きなおしてください。
RichEditのUndoバッファは影響を受けますので注意です。
元々はC++BuilderMLでのC++Builder用のTipsでしたが、
Delphiに書き換えました。
MLのC++BuilderでのサンプルソースはMLを参照してください。
Delphi版とほぼ同じ内容です。
参照: [builder:8463] <WWW> <通信> <Win95>
0231 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/31 おばQ rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/08/31 おばQ 編集
LinesプロパティエディタでTabを入力する
TMemoやTRichEditでは設計時にLinesプロパティを
設定することが出来ます。
文字列リストの設定ダイアログ(という名前か?)
というLinesのプロパティエディタが表示されて編集します。
常識ですね。
さて、ここでTabキーを押してもTabが入力出来ません!
さあ、困った困ったどうしよう。
そういう時にはCtrl+Tabキーを押します。
参照: <Win95> <Standard>
0215 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/25 花井@自宅 rev 1.5 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/08/31 花井@自宅 編集
RichEdit の全パラグラフのタブ幅を設定する
RichEdit では、各パラグラフごとにタブ位置を設定できます。
[DelphiML:41963]にて、全パラグラフに一定間隔のタブ位置を
設定する関数を紹介しています。等幅フォント専用です。
(補足)
Tab の幅は書式なので書式付きテキストの OLE D&D と
ペースト処理時にはTabの幅が変化すると予想されます。
ペースト時の書式消しは可能ですが OLE D&D を防ぐ事は
まず無理ですので、そのあたりはご容赦ください。
参照: [Delphi-ML:41963] <Win95>
0211 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/21 おばQ rev 1.7 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/08/31 花井@自宅 編集
TRichEdit.Paragraph.Tab[] の設定(Tab位置の設定)
<書式>
RichEdit1.Paragraph.Tab[iIndex] := ptsAbsolute
<値>
iIndex: Byte
タブインデックス。段落の何番目のタブ位置を設定するかを示す。
範囲は 0 から MAX_TAB_STOPS - 1 まで。
(定数 MAX_TAB_STOPS は RichEdit.pasで定義)
ptsAbsolute: LongInt
タブ位置。コントロール水平端からの絶対位置で単位は論理ポイント。
(1論理ポイントは 1/72論理インチ)
<解説>
・現在選択範囲のパラグラフのタブ位置設定を行います。範囲選択がされて
いないときは、キャレット(文字カーソル)のあるパラグラフになります。
・ptsAbsoluteにスクリーンのピクセル値を元にした値を設定
したい場合には、次のように変換します。
(論理ポイント) =
72 * ( ピクセル値 / 水平方向1論理インチ当りのピクセル数 )
<備考>
・Delphi のバージョンによっては、バグのために Tab[] プロパティの設定
が行われないパターンが発生します。詳細は[Delphi-ML:41966] をご覧下さい。
(Delphi 4.0 Update 3 には存在しています。)
<サンプル>
テキスト選択範囲内にあるパラグラフの最初のタブ位置をコントロール
中央に設定します
// 四捨五入します
function RoundOff(X: Extended): LongInt;
begin
if X >= 0 then
Result := Trunc(0.5 + X)
else
Result := Trunc(-0.5 + X);
end;
// テキスト選択範囲内にあるパラグラフの最初のタブ位置を
// コントロール中央に設定します
procedure TForm1.RichEdit1SetFirstTabAtCenter;
var
DC: HDC;
PixelsPerInch: Integer;
CenterByPixels: Currency;
CenterByPoints: Currency;
begin
// 水平方向1論理インチ当りのピクセル数を取得します。
DC := GetDC(0);
PixelsPerInch := GetDeviceCaps(DC, LOGPIXELSX);
ReleaseDC(0, DC);
// RichEdit1 の中央を得ます(ピクセル値)
CenterByPixels := RichEdit1.ClientWidth / 2;
// スクリーンのピクセル値から論理ポイント値に変換します
CenterByPoints := 72 * (CenterByPixels / PixelsPerInch);
// タブ位置を設定します。
RichEdit1.Paragraph.Tab[1] := 0; // バグ回避のため
RichEdit1.Paragraph.Tab[0] := RoundOff(CenterByPoints);
end;
// RichEdit1SetFirstTabAtCenter を呼び出します。
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1SetFirstTabAtCenter;
end;
参照: [Delphi-ML:41923] [Delphi-ML:41966] <Win95>
0222 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/28 西坂良幸 rev 1.2 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/08/28 西坂良幸 編集
データコントロールのDataLinkオブジェクトを取得する方法(ReadOnlyプロパティのバグの解決法)
VCLでは、DataControlのFDataLinkは、プロパティになっていないので、アクセスできませんが、
DataControlにCM_GETDATALINKメッセージを投げる事で取得(参照)できます。[Delphi-ML:41387]田原
多重継承ができないので、こうなっているそうです。
これによって、MLでも多い質問ですが、いわゆる「極東仕様」問題、すなわち、TDBEdit の ReadOnly と継承元の TCustomEdit のReadOnly の同期がとれないバグを解決することができます。[Delphi-ML:41051]藤中
以下は、藤中さんの例示コード(省略部あり)です。
// このデータコントロール(フィールド対応)は編集可能か?
function IsCanModifyFieldDataControl(Control: TControl) : Boolean;
var
DataLink : TFieldDataLink;
begin
// データリンクを取得
DataLink := TFieldDataLink(Control.Perform(CM_GETDATALINK,0,0));
if (DataLink = nil) then
DatabaseError('CM_GETDATALINK は無効', Control);
// データリンクが編集可能かどうか調べる
Result := DataLink.CanModify and
( DataLink.DataSource.AutoEdit or
(DataLink.DataSource.State in [dsInsert, dsEdit]) );
end;
// たとえば、Table1のAfterScrollイベントなどで動的にReadOnlyを変更する
type TCustomEditCracker = class(TCustomEdit);
procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
var
Flg :Boolean;
begin
// 条件
if DataSet.FieldByName('制御フラグ').AsString = '1' then
Flg := True
else
Flg := False;
// 以下でReadOnlyを変更
DBEdit1.ReadOnly := Flg;
if (Flg = False) then
begin
TCustomEditCracker(DBEdit1).ReadOnly :=
not IsCanModifyFieldDataControl(DBEdit1);
end
else begin
TCustomEditCracker(DBEdit1).ReadOnly := True;
end;
end;
参照: [Delphi-ML:41387] [Delphi-ML:17611] [Delphi-ML:41051] <データベース> <バグ> <DataControls>
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> <その他コンポーネント関連>
0220 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/08/26 西坂良幸 rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/08/26 西坂良幸 編集
ツリービューのノードをドラッグ&ドロップで移動させる
TTreeViewでは、DragImageにこだわらなければ,DragModeプロパティを dmAutomatic に設定すれば、OnDragOver、OnDragDropイベントを使うだけで簡単にできます。
OnDragOverイベントのAcceptは,ユーザーがドロップするオブジェクトをそのコントロールが受け入れることを示すだけです。
ツリー構造ですので、移動が無限ルーチンに陥らないように工夫します。
下記では、
IsFamilyメソッドで、ファミリー内にその上位ノードを移動するのか
を判定し、MoveNodeメソッドですべての子ノードが移動できるように
しています。
type
TForm1 = class(TForm)
// <省略>
・・・・・
・・・・・
private
procedure MoveNode(Parent, Source: TTreeNode);
function IsFamily(Parent, Source: TTreeNode):boolean;
public
end;
// <省略>
・・・・・
・・・・・
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
Node:TTreeNode;
begin
// 適当にtreeを作成
for i := 1 to 20 do
begin
node := TreeView1.Items.Add(nil,'A00'+IntToStr(i));
node.ImageIndex := 0;
node.SelectedIndex := 1;
end;
end;
// 移動と削除−−すべての子ノードを移動する
procedure TForm1.MoveNode(Parent, Source: TTreeNode);
var
node: TTreeNode;
begin
node := TreeView1.Items.AddChild(Parent,Source.Text);
node.ImageIndex := Source.ImageIndex;
node.SelectedIndex := Source.SelectedIndex;
while Source.Count > 0 do
// 再帰させる
MoveNode(Node, TTreeNode(Source.Item[0]));
Source.Delete;
end;
// Sourceの一族にParentがあれば true の判定
function TForm1.IsFamily(Parent, Source: TTreeNode):boolean;
var
i:integer;
node: TTreeNode;
begin
result := false;
for i := 0 to Source.Count - 1 do
begin
node := Source.Item[i];
if Node.AbsoluteIndex = Parent.AbsoluteIndex then
result := true
else
// 再帰させる
result := IsFamily(Parent, Node);
if result then break;
end;
end;
// ドロップ後の処理
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
Var
Node:TTreeNode;
begin
if (Sender is TTreeView) and (Source is TTreeView) then
begin //ツリーからツリー
with Sender, Source as TTreeView do
begin
//新親の親
Node := GetNodeAt(X,Y);
if Node = Selected then
begin
MessageDlg('同じ所に移動はできません。', mtInformation, [mbOk], 0);
Exit;
end;
//ツリーのアイテムを移動し削除
Items.BeginUpdate;
if IsFamily(Node, Selected) then
//無限循環を避ける
MessageDlg('この移動はできません。', mtInformation, [mbOk], 0)
else
MoveNode(Node, Selected);
Items.EndUpdate;
end;
end;
end;
// ソースを確認する
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := (Source as TTreeView) = TreeView1;
end;
参照: [Delphi-ML:3727] [Delphi-ML:22691] [Delphi-ML:30411] <Win95>
0217 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 西坂良幸 編集
書式付きメモ型項目へアクセスしたい
ヘルプなどでは、Streamをつかった方法が紹介されています。
DataSet.FieldByName('Field1').AsString := RichEdit1.Text;
や
DataSet.FieldByName('Field1').AsVariant := RichEdit1.Text;
では、PlainText となり、書式が保存されません。
Field1 書式付きメモ型とし、
DataSetは開かれているとします。
// リッチエディットからフィールドへの書き込み
procedure TForm1.Button8Click(Sender: TObject);
var
Stream1 : TMemoryStream;
begin
Stream1 := TMemoryStream.Create;
try
RichEdit1.Lines.SavetoStream(Stream1);
Query1.Edit;
TBlobField(Query1.FieldByName('Field1')).LoadFromStream(Stream1);
Query1.Post;
finally
Stream1.Free;
end;
end;
// フィールドからリッチエヂットへの読み出し
procedure TForm1.Button4Click(Sender: TObject);
var
Stream1 : TBlobStream;
begin
Stream1 := TBlobStream.Create(TBlobField(Query1.FieldByName('Field1')), bmRead);
try
RichEdit1.Lines.LoadFromStream(Stream1);
finally
Stream1.Free;
end;
end;
TRichEdit系は、いくつかのバグが報告されています。
データが大きくなるとヤバイという噂です。
D4では、大部改善されたようですが、気をつけて下さい。
バグ情報は
http://www.dataweb.nl/~r.p.sterkenburg/indexpag.htm
参照: [Delphi-ML:5484] [Delphi-ML:41858] <データベース> <DataAccess>
0004 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 更新: 1999/08/14 osamu 編集
ショートカットキーのキー名を独自に設定する
例えば、テンキーの + キーをショートカットにした場合に、'Num +'とか表示させたい。
TMenuItem.AppendTo()を参照すると、
TestMenu1.Caption:=TestMenu1.Caption+#9+'Num +'+#0;
とすればよいことが分かる。
キャプションとショートカット名との間にはさんだタブ文字と、自動で追加されるショートカットを隠すために最後にくっつけられた #0 とが味噌。
参照: [Delphi-ML:17989] <Standard> <メニュー>
0192 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/05/28 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/05/28 osamu 編集
TFileListBox にファイル名が重複して表示されてしまう
TFileListBox.Mask に、'*.txt;*.?x?' などと入力した場合、もし複数の Mask に合致するファイル(例えば、example.txt)があると、そのファイルはダブって表示されてしまいます。これを回避する単純な方法は、TDirectoryListBox.OnChange にて、重複しているファイル名を削除してやることです。
procedure Form1.DirectoryListBox1Change(Sender: TObject);
var i: Integer;
begin
for i:=FileListBox1.Items.Count-2 downto 0 do
if FileListBox1.Items[i]=FileListBox1.Items[i+1] then
FileListBox1.Items.Delete(i+1);
end;
この位のことは、TFileListBox 自身で面倒を見てもらいたいものですが。。。
参照: <System>
0191 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/05/19 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/05/19 osamu 編集
コンボボックスのリスト部分の幅を指定する
>コンボボックスをクリックして表示されるリストの幅を
>コンボボックスコントロール自体の幅よりも広くして
>表示することはできないでしょうか?
ComboBox1->Perform(CB_SETDROPPEDWIDTH, 幅, 0);
です。詳細は Win32.hlp(English) を参照してください。
参照: [builder:12689] <Standard>
0188 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/05/19 osamu rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/05/19 osamu 編集
TRichEdit の内容を高速に変更する
> RichEdit の Lines の内容を、次の様に変更しているんですが、
> 3000行で10秒もかかってしまいます。
>
> var sl: TStringList;
>
> for i:=1 to 3000 do
> sl.Add(IntToStr(i));
> RichEdit1.Lines.Assign(sl);
ストリームを経由すると速いですよ。
var ms: TMemoryStream;
ms := TMemoryStream.Create;
try
sl.SaveToStream(ms);
ms.Position := 0;
RichEdit1.Lines.LoadFromStream(ms);
finally
ms.Free;
end;
3000行で一秒以下でした。(Pentium 150MHz)
参照: [builder:16379] <Win95>
0179 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/05/01 おばQ rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/05/01 おばQ 編集
右の項目の幅が固定されるTStatusBar
Delphiで普通にTStatusBarを使用してスターテスバーを作り
複数のTStatusPanelを設定すると
Formをリサイズする時、右の項目の幅が変化します。
IEエクスプローラやワードパッドなどでは
WindowをResizeした時に
StatusBarの項目の右の方のものが幅が固定されていて
左の項目の幅が変化するものがあります。
推定ですが、VC++アプリケーションウィザードを普通に
用いるとこのようなものが自動で生成されるようです。
これをDelphiで実現します。
StatusBarのResizeイベントに以下のようなコードを書きます。
procedure TForm1.StatusBarResize(Sender: TObject);
const
ResizePanelNumber=0; //リサイズするStatusbarのパネル番号を指定
MinSize=0; //リサイズされても維持したい最小のWidthを指定
var
BarWidth,i: Integer;
begin
with StatusBar do
begin
BarWidth := 0;
for i:=0 to Panels.Count-1 do
begin
if not(i=ResizePanelNumber) then
BarWidth := BarWidth + Panels[i].Width;
end;
if (Width-BarWidth)<=MinSize then
Panels[ResizePanelNumber].Width := MinSize
else
Panels[ResizePanelNumber].Width := Width - BarWidth;
end;
end;
これで項目のうちResizePanelNumberで指定したパネルのWidthが
StatusBarのResize、つまりFormのリサイズに合わせてリサイズします。
また、
すべての項目において右の項目の幅が優先されて維持される
IEブラウザのような動作をさせるには工夫が必要です。
設計時のPanelのWidthを保持して
Panels.Widthを変化させます。
TForm1 = class(TForm)
…
private
FBarWidths: array of Integer;
end;
procedure TForm1.FormCreate(Sender: TObject);
procedure SetStatusBarWidth;
var //右項目固定StatusBarの為に設計時のpanelのWidthを保存
i: Integer;
begin
with StatusBar do
begin
SetLength(FBarWidths,Panels.Count);
for i:=0 to Panels.Count-1 do
FBarWidths[i]:= Panels[i].Width;
end;
end;
begin
SetStatusBarWidth;
end;
procedure TForm1.StatusBarResize(Sender: TObject);
var
BarWidth,i,PointPanel,k: Integer;
begin
BarWidth:=0;
with StatusBar do
begin
PointPanel := Panels.Count;
repeat
dec(PointPanel); //何番のパネルをリサイズするべきか決定する
BarWidth := BarWidth + FBarWidths[PointPanel];
until (Width < BarWidth)or(PointPanel=0) ;
for i:=0 to PointPanel-1 do //消えるべきパネルをWidth:=0にする
Panels[i].Width := 0;
BarWidth := 0;
for i:=PointPanel+1 to Panels.Count-1 do
begin
Panels[i].Width := FBarWidths[i];
BarWidth := BarWidth + FBarWidths[i];
end;
Panels[PointPanel].Width := StatusBar.Width - BarWidth;
end;
end;
分かりにくい説明ですが、プログラムを実行すると分かります。
VCL化してみるのも面白いでしょう。
参照: <Win95>
0178 D1 D2 D3 D4 D5 D6 D7 3.1 95 98 作成: 1999/04/29 おばQ rev 1.1 B1 B3 B4 B5 B6 B7 NT3 NT4 2K XP 更新: 1999/04/29 おばQ 編集
TCoolBarを用いたツールバーの位置保存
クールバーでツールバーを作った場合、
その位置を起動時に前回の状態に戻す為の処理です。
この場合Delphi4で採用されているドッカブルツールバーには
対応していません。もう少し、工夫が必要になるでしょう。
今回はIniファイルにに保存すると言う前提で解説します。
クールバー上のツールバーの数をBandCountとして
const
BandCount=5;
後はFormのクリエイトイベントとクローズイベントに
以下の様なコードを書きます。
procedure TForm1.FormCreate(Sender: TObject);
procedure BandPositionRead;
var
ini: TIniFile;
BandIDNumber,BandWidth: array[0..BandCount-1] of Integer;
BandBreak: array[0..BandCount-1] of Boolean;
i: Integer;
begin
ini := TIniFile.Create(
ExtractFilePath(Application.ExeName)+'BandPos.ini');
with ini do
try
for i:=0 to BandCount-1 do
begin //Bandの位置とBreakを読込む
BandIDNumber[i]:=
ReadInteger('Bar','Band'+IntToStr(i)+'ID',i);
BandWidth[i] :=
ReadInteger('Bar','Band'+IntToStr(i)+'Width',200);
BandBreak[i] :=
ReadBool('Bar','Band'+IntToStr(i)+'Break',true);
end;
finally
Free;
end;
CoolBar1.Bands.BeginUpdate;
for i:=0 to BandCount-1 do
begin //Bandの位置とBreakを復元します。
CoolBar1.Bands.FindItemID(BandIDNumber[i]).Index := i;
CoolBar1.Bands[i].Break := BandBreak[i];
CoolBar1.Bands[i].Width := BandWidth[i];
end;
CoolBar1.Bands.EndUpdate;
end;
begin
BandPositionRead;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
procedure BandPositionWrite;
var
ini: TIniFile;
i: Integer;
begin
ini := TIniFile.Create(
ExtractFilePath(Application.ExeName)+'BandPos.ini');
with ini do
try
for i:=0 to BandCount-1 do
begin //Bandの位置とBreakを書きこむ
WriteInteger('Bar','Band'+IntToStr(i)
+'ID',CoolBar1.Bands[i].ID);
WriteInteger('Bar','Band'+IntToStr(i)
+'Width',CoolBar1.Bands[i].Width);
WriteBool('Bar','Band'+IntToStr(i)
+'Break',CoolBar1.Bands[i].Break);
end;
finally
Free;
end;
end;
begin
BandPositionWrite;
end;
参照: [Delphi-ML:32427] <Win95>
0168 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 編集
IME 入力で読み仮名を取得する
以下のコードを含んだ関数を作成し、追跡したいところで
Application->OnMessage = AppMessage;
と書けばよいのではないでしょうか? はずしていたらすみません。
void __fastcall TForm1::AppMessage(TMessage &Msg, bool &Handled)
{
if (Msg.message == WM_IME_ENDCOMPOSITION)
{
int nRetVal; //APIの戻り値を格納
HIMC hImcIMEHandle; //IMEのコンテキストを格納
char cBuff[256];
hImcIMEHandle = ImmGetContext(Handle);
//変換結果の「読み」を取得
nRetVal = ImmGetCompositionString(hImcIMEHandle,
GCS_RESULTREADSTR,
cBuff, sizeof(cBuff));
cBuff[nRetVal] = '\0';
AnsiString strTemp = cBuff;
//IMEのコンテキストを開放する
nRetVal = ImmReleaseContext(Handle, hImcIMEHandle);
//cBuffに対して処理をする(入力された文字列)
}
}
でcBuffに入力された文字が入ってきていると思います。
このコードを実行するにはimm.hが必要です。
参照: [builder:6815] <その他Windows関連> <Windows> <Standard>
0165 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 編集
DBGrid のスクロールバーを非表示に
この DBGrid のスクロールバーを力で消す方法,大変参考になりました。じっと見ているとちらりと映りますが,言われなければたぶん誰も気づかないでしょう(^^)
> private
> { Private 宣言 }
> FCellBottom : Integer;
>
> procedure TForm1.DBGrid1DrawColumnCell
> (Sender: TObject; const Rect: TRect;
> DataCol: Integer; Column: TColumn; State: TGridDrawState);
> begin
> if (FCellBottom < Rect.bottom) then FCellBottom := Rect.bottom;
> end;
>
> procedure TForm1.Query1BeforeInsert(DataSet: TDataSet);
> begin
> Abort;
> end;
>
> procedure TForm1.Query1AfterScroll(DataSet: TDataSet);
> begin
> ShowScrollBar(DBGrid1.Handle, SB_VERT, False);
> end;
>
> procedure TForm1.Button1Click(Sender: TObject);
> begin
> DBGrid1.Height := FCellBottom - DBGrid1.Top + 6;
> end;
参照: [Delphi-ML:31864] <データベース> <DataControls>
0160 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 編集
半角カナを確定無しで直接入力させる
> IMEの制御についてお聞きしたいのですが、例えばTEditのIMEMode
> プロパティを半角カナに設定した時、「アイウエオ(半角)」と打
> ちこんだ後リターンキーで確定をしなければなりませんが、ここで
> 入力される文字(半角カナ)を随時確定していきたいのですが、どの
> ようにすればよろしいでしょうか?
[スマートな解法]
Edit1の ImeMode プロパティを imSKata にして
uses Imm;
procedure TForm1.Edit1Enter(Sender: TObject);
var
Imc: HIMC;
Conversion, Sentence: DWORD;
begin
Imc := ImmGetContext(Handle);
ImmGetConversionStatus(Imc, Conversion, Sentence);
ImmSetConversionStatus(Imc, Conversion, IME_SMODE_NONE);
ImmReleaseContext(Handle, Imc);
end;
[スマートではないがいろいろ応用が利きそう]
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
type
TLetters = set of 'A'..'z';
const
Vowels: TLetters = ['A', 'E', 'I', 'O', 'U', 'a', 'e', 'i', 'o', 'u'];
begin
if (Key<>VK_RETURN) and (Chr(Key) in Vowels) then
begin
Keybd_event(VK_RETURN,0,0,0);
Keybd_event(VK_RETURN,0,KEYEVENTF_KEYUP,0);
end;
end;
参照: [Delphi-ML:31097] <その他Windows関連> <Windows> <Standard>
0142 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 編集
長すぎる TreeView アイテムを補完するチップヘルプを出さなくする
TreeView からはみだすアイテムをマウスでポイントしたときに出るチップヘルプを出さないようにしたい。
const
TVS_NOTOOLTIPS = $0080; // comctl32.dll ver4.70(IE3) 以上で使用可
var
Style: DWORD;
begin
Style := GetWindowLong(TreeView1.Handle, GWL_STYLE);
Style := Style or TVS_NOTOOLTIPS;
SetWindowLong(TreeView1.Handle, GWL_STYLE, Style);
end;
参照: [Delphi-ML:24847] [Delphi-ML:24861] <Win95>
0139 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 編集
下の図柄がすける透明パネル
実行時に透明になるパネルコンポーネントです。
unit NkTransparent;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs;
type
// 透明で 背景消去を行わない コンテナウィンドウコントロール
TNkTransparent = class(TCustomControl)
private
procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd);
message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
procedure Register;
implementation
constructor TNkTransparent.Create;
begin
inherited;
Width := 100; Height := 100;
// 上にコントロールが貼りつけられるようにする
ControlStyle := ControlStyle + [csAcceptsControls];
end;
procedure TNkTransparent.WMEraseBkGnd;
begin
// 実行時は背景消去をしない
if csDesigning in ComponentState then inherited;
end;
procedure TNkTransParent.CreateParams(var Params: TCreateParams);
begin
inherited;
// 実行時は「透明」なウィンドウ
if not (csDesigning in ComponentState) then
Params.ExStyle := Params.Exstyle + WS_EX_TRANSPARENT;
end;
procedure Register;
begin
RegisterComponents('NakCtrl', [TNkTransparent]);
end;
end.
参照: [Delphi-ML:24485] <Standard>
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] <描画> <その他コンポーネント関連>
0135 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 編集
表示中のポップアップメニューを消す
>プログラム上でポップアップメニューを表示するにはPopup メソッドを
>使えば出来るのですが、逆に非表示させるにはどうしたらよいのでしょう。
>よろしくお願いします。
キーボードイベントを送って非表示にする、というのはどうでしょう。
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Interval := 1000;
Timer1.Enabled := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := True;
PopupMenu1.Popup(Button1.ClientOrigin.x,
Button1.ClientOrigin.y + Button1.Height);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_ESCAPE, 0, 0, 0);
keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0);
Timer1.Enabled := False;
end;
以上のコードで実行すると、ボタンを押すとポップアップしますが、約1秒後にポップアップが非表示になります。
参照: [Delphi-ML:24269] <Standard> <メニュー>
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> <バグ> <その他コンポーネント関連>
0131 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 編集
超高速 ListView
> 推測ではありますが、Explorer等は ListView コモンコントロールが備えている
> コールバック機構を利用して、初期化処理の遅延を図っているのだと思います。
> ここでいうコールバックの機能は、画面に表示するハメになった ListItem について
> 「Caption はなんですか?」「ImageIndex は何番ですか?」「SubItem(n)は?」
> と聞いてくる、というものです。
この処理を実現しているコンポーネントが[Delphi-ML:23838]で紹介されています。
参照: [Delphi-ML:23838] <Win95>
0132 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 編集
ステータスバーにプログレスバーを置きたい
>ステータスバーを二つのパネルに分割して一方に文字、もう一方にprogress barを
>表示したい。
動的に作って置けばできます。Panels[0]に文字列、Panels[1]にProgressBarを置くとします。
ProgressBar1 := TProgressBar.Create(StatusBar1);
try
with ProgressBar1 do begin
Top := 2;
Height := StatusBar1.Height -2 ;
Width := StatusBar1.Panels[1].Width -2;
Left := StatusBar1.Panels[0].Width +2;
Max := ***.Count;
Step := 1;
end;
for i := 0 to ***.Count -1 do begin
//何らかの処理
ProgressBar1.StepIt;
Progressbar1.Update;
end;
finally
ProgressBar.Free;
end;
参照: [Delphi-ML:23558] <Win95>
0066 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 編集
PopupMenu に MainMenu のサブ項目をそのまま表示する
一つのメニューアイテムを、同時に二つのメニューに結び付ける事は出来ないようなので、実行時に、MainMenu と PopupMenu 、それぞれが開く時点で、共有するアイテムをそのメニューに結びつけ直す、という方法をとりました。ある位置から下を全部共有アイテムとする仕様です。
結び付け直すタイミングですが、PopupMenu の方は、OnPopup イベントで良いのですが、MainMenu の方は、(エディットメニュー以下をすべて使う場合に) Edit1 のOnClick だと、位置がずれたりしてうまくないので、WndProc をオーバーライドして、WM_INITMENU メッセージに応答させました。
以下は PASCAL 翻訳版
const COMMON_ITEM_START = 3; // 共有アイテムの始まる位置
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var Item: TMenuItem;
begin
while Edit1.Count > COMMON_ITEM_START do begin
Item:= Edit1.Items[COMMON_ITEM_START];
Edit1.Remove(Item);
PopupMenu1.Items.Add(Item);
end;
end;
procedure TForm1.WndProc(var Msg: TMessage);
var Item: TMenuItem;
begin
if (Msg.Msg=WM_INITMENU) and (Msg.WParam=Menu.Handle) then begin
while PopupMenu1.Items.Count > COMMON_ITEM_START do begin
Item:= PopupMenu1.Items[COMMON_ITEM_START];
PopupMenu1.Items.Remove(Item);
Edit1.Add(Item);
end;
end;
inherited WndProc(Msg);
end;
参照: [builder:5012] <Standard> <メニュー>
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> <その他コンポーネント関連>
0083 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 編集
自作コントロールで IME 入力時の変換候補をキャレット位置に表示したい
IMEが編集を開始する直前にWM_IMESTARTCOMPOSITION というメッセージを送って来るので、そのメッセージを捕らえて設定してやります。
class TCustom : public TCustomControl
{
・・・・・・・・・・・・
void __fastcall IMEStart(TMessage& Message);
BEGIN_MESSAGE_MAP
MESSAGE_HANDLER( WM_IME_STARTCOMPOSITION ,TMessage,IMEStart)
END_MESSAGE_MAP(TCustomControl)
};
void __fastcall TCustom::IMEStart(TMessage& Message)
{
// IMEの位置をキャレットのポジションに設定
COMPOSITIONFORM CompForm;
POINT pt;
LOGFONT lf;
HIMC hImc=ImmGetContext(Handle);
//キャンバスのフォントと同じに設定する
GetObject(Canvas->Font->Handle,sizeof(LOGFONT),&lf);
ImmSetCompositionFont(hImc,&lf);
//キャレットのポジションに設定する
ImmGetCompositionWindow(hImc,&CompForm);
CompForm.dwStyle=CFS_POINT;
GetCaretPos(&pt);
CompForm.ptCurrentPos=pt;
ImmSetCompositionWindow(hImc,&CompForm);
ImmReleaseContext(Handle, hImc);
// その他の処理
・・・・・・・・・・・・・
}
参照: [builder:5269] <その他Windows関連> <コンポーネント開発> <Windows> <Standard>
0084 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 編集
TDDEClientConvで最初の行しか実行されない?
TDDEClientConv を使って、ステップ実行を行うとちゃんとマクロは実行されるのですが、そのまま実行すると、最初のコマンドのみ実行してその後が実行されません。
これは2.0からのバグです。3.0/3.1用のパッチを当てると直ると思います。
http://www.dataweb.nl/~r.p.sterkenburg/bugsall.htmが詳しいです。
日本語版でも通用する個所が多いです。参考にしてみて下さい。
1)必要なったらTDDEClientConvをCreate
2)マクロを実行
3)用が済んだらFree
で逃げられます。
参照: [Delphi-ML:19657] <その他Windows関連> <System> <ShellApi> <Windows> <バグ>
0085 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 編集
TUpDown の不具合
TUpDown コントロールは OnChange/OnClick イベントがらみで、様々な問題を抱えているようです。
詳しくは、まとめとして投げられた、[Delphi-ML:20127]からたどれるスレッドを参照してください。
参照: [Delphi-ML:20127] <バグ> <Win95>
0091 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 編集
TPageControl を TabPosition=tpBottom にすると不具合
Windowsのバージョンによって、tpBottom での利用に制限がある場合があるようです。[Delphi-ML:20099]からのスレッドに、いくつか報告例があるので、参考にしてください。
参照: [Delphi-ML:20099] <バグ> <Win95>
0111 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 編集
超高速タイマーコンポーネント(サブミリ秒)
DSPで見つけたのは「TZTimer」コンポーネントでした。
以下 Readme からの抜粋。
----------
Similar to the vcl Ttimer component, but with a resolution of 0.1ms and accurate to 0.015ms.
(略)
Resolution could be improved considerably when the RDTSC (pentium) instruction is utilized, however I had to get this timer working on a 486 also.
It was tested on D2 and D3 for W95, it should also work on D1 and W3.1.
However it will not work in Windows NT (?).
Some observed timing measurements of Tztimer, compared with the (vcl) Ttimer
:
{ evaluation of 60 runs on W95, P133, D3}
interval (vcl) Ttimer Tztimer
100 ms 108 +/- 4 ms 99.3 +/- 0.14 ms
10 ms 59 +/- 5 ms 10.1 +/- 0.07 ms
1 ms 59 +/- 6 ms (!) 1.00 +/- 0.02 ms
0.1ms Not available 0.098+/- 0.015 ms
----------
参照: [Delphi-ML:21828] <System>
0029 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で選択セルのハイライト表示を無くしたい
>> TStringGridについてなんですが、それにFocusが当たってない場合に一つのセルの色
>> が青で塗りつぶされています。これを塗りつぶされていなくしたいのですが、やり方
>> をご存知の方、ご教授願います。
以下のような方法でできます。
// TForm1のメンバ
StringGrid1Selection:TGridRect;
// implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1Selection:=TGridRect(Rect(-1,-1,-1,-1));
end;
procedure TForm1.StringGrid1Exit(Sender: TObject);
begin
StringGrid1Selection:=StringGrid1.Selection;
StringGrid1.Selection:=TGridRect(Rect(-1,-1,-1,-1));
end;
procedure TForm1.StringGrid1Enter(Sender: TObject);
begin
StringGrid1.Selection:=StringGrid1Selection;
end;
ただし、
TGridRect(Rect(-1,-1,-1,-1))は、ちょっと無理をしているので、
Delphi1.0や、将来のバージョンでは動かないことも考えられます。
> function GridRect(l,t,r,b:LongInt):TGridRect;
> begin
> with Result do begin
> Left:=l;
> Top:=t;
> Right:=r;
> Bottom:=b;
> end;
> end;
を作っておいて
StringGrid1.Selection:=GridRect(-1,-1,-1,-1);
とするのが正攻法です。
参照: [Delphi-ML:17189] <Additional>
0040 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 編集
フォームの印刷時にComboBoxの内容が印刷されない
Delphi3 になって、フォームの印刷時に TComboBox の内容(テキスト)が印刷表示されなくなりました。
Delphi2 ではちゃんと印刷されます。
kohiroさんが[Delphi-ML:19070]で解法を示してくださっています。
参照: [Delphi-ML:19070] <印刷> <バグ> <フォーム> <Standard>
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> <その他コンポーネント関連>
0017 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 編集
TDriveComboBoxの内容の更新
ネットワークドライブの割当てをした後、TDriveComboBoxにて割当てたドライブを反映させたいのですが、方法が解りません。
DriveComboBox1.TextCase:=DriveComboBox1.TextCase;
たぶんこれが一番楽な方法だと思います。
非常に裏わざ臭いですが。。。
参照: [Delphi-ML:7162] <System> <バグ> <ファイル>
0018 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 編集
TMemoで入力*行数*を制限したい
アンドゥを犠牲にすれば、
procedure TForm1.Memo1Change(Sender: TObject);
const MaxLineCount=5;
begin
if Memo1.Lines.Count>MaxLineCount then
Memo1.Perform(EM_UNDO,0,0);
Memo1.Perform(EM_EMPTYUNDOBUFFER,0,0);
end;
というのがうまく動きそうです。
参照: [Delphi-ML:5738] <Win95> <Standard>
0021 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 編集
TListViewで列を指定してソート
以下のようにすると簡単にできます。
// ソートに使うColumnを表す。
var ListViewSort:Integer;
// Formのメンバ変数にするのがいいとおもいます。
// 0でソートしない。
// ゼロ以外ならば、Abs(ListViewSort)コラムをキーにする
// 正負で正・逆順ソート
// 汎用的に使える比較ルーチン
procedure TMainForm.ListViewCompare(Sender: TObject; Item1, Item2:
TListItem; Data: Integer; var Compare: Integer);
begin
case ListViewSort of
0: Compare:=0;
1,-1: Compare:=AnsiCompareStr(Item1.Caption,Item2.Caption);
else Compare:=AnsiCompareStr(Item1.SubItems[Abs(ListViewSort)-2],
Item2.SubItems[Abs(ListViewSort)-2]);
end;
if ListViewSort<0 then Compare:=-Compare;
end;
// コラムヘッダがクリックされたらソートしなおす。
procedure TMainForm.ListViewColumnClick(Sender: TObject; Column:
TListColumn);
begin
if Abs(ListViewSort)=Column.Index+1 then begin
ListViewSort:=-ListViewSort;
end else begin
ListViewSort:=Column.Index+1;
end;
ListView.SortType:=stNone;
ListView.SortType:=stData;
end;
参照: [Delphi-ML:11526] <Win95>
0023 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 編集
TStringGridのソート
> StringGrid上に表示したデータを、ある列(Col)をKEYとしてソートし、
> 再表示させたいのですが、どのようにしたらよいのでしょうか?
エレガントさを求めず、力わざで良ければ、
procedure TForm1.FormCreate(Sender: TObject);
var i,j:Integer;
begin
for i:=0 to StringGrid1.ColCount-1 do
for j:=0 to StringGrid1.RowCount-1 do
StringGrid1.Cells[i,j]:=IntToStr(Random(100));
end;
procedure TForm1.StringGrid1DblClick(Sender: TObject);
var c,min,i,j:Integer;
s:string;
begin
c:=StringGrid1.Col;
for i:=0 to StringGrid1.RowCount-2 do begin
min:=i;
for j:=i+1 to StringGrid1.RowCount-1 do
if StrToInt(StringGrid1.Cells[c, j ]) <
StrToInt(StringGrid1.Cells[c,min]) then
min:=j;
if min<>i then
for j:=0 to StringGrid1.ColCount-1 do begin
s:=StringGrid1.Cells[j,i];
StringGrid1.Cells[j,i]:=StringGrid1.Cells[j,min];
StringGrid1.Cells[j,min]:=s;
end;
end;
end;
としてできますが、セル数が1万を超えると速度的にチョットきつくなってきます。大きなグリッドに対してこのようなことをやりたければTListViewを使うことをお勧めします。
参照: [Delphi-ML:12259] <Additional>
0009 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/DBGrid でのセル編集の動作を細かく指定する
下のような関数を使って、TCustomGridで定義されているインプレースエディタを取得すれば、
GetGridEditor(StringGrid1).SelStart:=0;
などとできます。
function GetGridEditor(Grid: TCustomGrid): TCustomEdit;
var i: Integer;
begin
Result:=nil;
for i:=0 to Grid.ControlCount-1 do
if Grid.Controls[i] is TCustomEdit then begin
Result:=TCustomEdit(Grid.Controls[i]);
Exit;
end;
end;
参照: [Delphi-ML:18726] <データベース> <Additional> <DataControls>
[新規作成] [最新の情報に更新]
How To
Lounge
KeyWords
Osamu Takeuchi osamu@big.or.jp
Tips
Delphi
Home