Delphi Programming / Object Pascal

[掲載 2015年07月23日] [更新 2015年07月23日] Delphi サンプルプログラム集 |
| 076_TRichEdit のスクロールバーの表示制御 |
| 動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
 |
076_TRichEdit_ScrollBar.zip [1,126 KB] 2015年07月23日版 (EXE 同梱) |
TRichEdit のスクロールバーの設定関係のサンプルです。
|
[備考]
TMemo は Windows のエディットコントロールをカプセル化したコンポーネントです。TRichEdit はリッチエディットコントロールをカプセル化したものですが、メッセージは EM_XXX という形式となっていて、共通して使用可能なメッセージが多くあります。
|
| 01_TRichEdit のスクロールバーを常に表示 |
TRichEdit の ScrollBars プロパティの値を ssBoth にしても、例えば、垂直方向に表示すべきテキストが全て表示された状態になると、垂直スクロールバーは非表示になります。
水平方向にテキストが収まれば、水平スクロールバーが非表示となります。これが TRichEdit のデフォルトの仕様です。
HideScrollBars プロパティの値を False にすると常にスクロールバーを表示するようになります。その動作確認用のサンプルです。
|

|
図1
設計時の画面 |
 |
図2
実行開始画面
- 垂直方向 (縦方向) にスクロールする部分がない場合
- スクロールバーが見えているが、スクロール操作はできない
|
 |
図3
フォームをリサイズ
|
リスト1
TRichEdit の垂直スクロールバーを常に表示
HideScrollBars プロパティの値を False にする |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
RichEdit1: TRichEdit;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1.WordWrap := False;
RichEdit1.ScrollBars := ssBoth;
RichEdit1.HideScrollBars := False;
RichEdit1.Lines.LoadFromFile('RichText.RTF');
end;
//=============================================================================
// フォームのOnResizeイベント処理
// 筆者の環境では、TRichEditのクライアント領域にテキストが収まるようになっても
// スクロールバーが操作可能な状態にならなかったので、その対策
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
RichEdit1.Invalidate;
end;
//=============================================================================
// スクロールバー表示・非表示のトグル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.HideScrollBars := not RichEdit1.HideScrollBars;
end;
end.
| 02_TRichEdit のスクロールバーのコンテキストメニュー |
TRichEdit のスクロールバー上で、マウスの右ボタンをクリックすると、下図のようなコンテキストメニューが現れます。このコンテキストメニューを表示しないようにするサンプルです。
コンテキストメニューが表示する際、WM_CONTEXTMENU メッセージが発生します。このメッセージ処理内で何もしなければコンテキストメニューは現れません。何もしないと、TRichEdit で TPopupMenue コンポーネント等を使用していると、そのポップアップメニューも表示しなくなってしまいます。
そこで、マウスクリックの位置が、TRichEdit のクライアント領域の時は、WM_CONTEXTMENU メッセージ本来の処理を実行するようにしています。
以下のコードは、TRichEdit の継承クラスを生成して処理する場合です。サブクラス化関数を使用する方法は、TScrollBox の場合のサンプルを参考にしてください。 |

|
図4
スクロールバーのコンテキストメニュー
|
リスト2
TRichEdit のスクロールバーのコンテキストメニューを表示しないようにする
継承クラス (コンポーネント) を使用して処理する場合 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus;
type
TplRichEdit = class(TRichEdit)
protected
procedure WMContextMenu(var Message: TWMContextMenu);
message WM_CONTEXTMENU;
end;
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
plRichEdit1 : TplRichEdit;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses Types;
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
plRichEdit1 := TplRichEdit.Create(Self);
plRichEdit1.Parent := Self;
plRichEdit1.Align := alClient;
plRichEdit1.WordWrap := False;
plRichEdit1.ScrollBars := ssBoth;
plRichEdit1.HideScrollBars := False;
plRichEdit1.Lines.LoadFromFile('RichText.RTF');
end;
{ TplRichEdit }
//=============================================================================
// WM_CONTEXTMENUメッセージ処理
// スクロールバーのコンテキストメニューを表示しないようにする
//=============================================================================
procedure TplRichEdit.WMContextMenu(var Message: TWMContextMenu);
var
LPos : TPoint;
begin
LPos := ScreenToClient(Point(Message.XPos, Message.YPos));
if PtInRect(ClientRect, LPos) then begin
inherited;
end else begin
Message.Result := 0;
end;
end;
end.
|