TMemoの垂直スクロールバー自動表示
解決TMemoの(行数)*(一行の高さ) が ClientHeightを超えるか、
Splitterをいどうして、ClientHeightが変わったら、
自動で垂直方向のスクロールバーを必要に応じて
自動で表示するというのを作っています。
一応、下にあるコードで実現できているのですが、
IMEがONの状態で、スクロールバー表示する境目の所で、
始めの一文字しか入力されません。
どのようにすれば、正しく動作するようになるのでしょうか？
//-------------------------------------
// メモの行数に対して自動でスクロールバー表示
procedure TForm1.Memo1Change(Sender: TObject);
begin
MemoScrollBarsAutoShow;
end;
procedure TForm1.Splitter3Moved(Sender: TObject);
begin
MemoScrollBarsAutoShow;
end;
procedure TForm1.MemoScrollBarsAutoShow;
var
xPos: Integer;
begin
// スクロールバーの設定が変わり、再描画されると
// キャレットの位置が始めの位置に戻ってしまうので一時保存して戻す
// ★IMEがONで直接日本語を入力するとキャレットの位置が更新、取得できないため？、始めの1文字しか入力されない
if ((Canvas.TextHeight('H') * (Memo1.Lines.Count +1)) > Memo1.ClientHeight)
and (Memo1.ScrollBars = ssNone) then
begin
xPos := Memo1.SelStart;
Memo1.ScrollBars := ssVertical;
Memo1.SelStart := xPos;
end
else
if ((Canvas.TextHeight('H') * (Memo1.Lines.Count +1)) <= Memo1.ClientHeight)
and (Memo1.ScrollBars = ssVertical) then
begin
xPos := Memo1.SelStart;
Memo1.ScrollBars := ssNone;
Memo1.SelStart := xPos;
end;
end;
//-------------------------------------
すみませんが再現できません。
WinXp+Delphi7 xp style非適用
>> IMEがONの状態で、スクロールバー表示する境目の所で、
>> 始めの一文字しか入力されません。
IMEがON Memoのスクロールバーは無し(Height > 行数*行高)
Memoにカーソル状態でsplitterを動かす
Height < 行数*行高 になりスクロールバー出現
文字入力
でよいのですか？これですと再現できません。
splitterは動かしません
1. IMEがON、Memoのスクロールバーは無し(Height > 行数*行高)
2. splitterは動かさないで、適当に改行しながら文字を入力していく
3. やがてMemoのClient領域の一番下の行にきて、次に文字を入力すると(Height < 行数*行高)となり、スクロールバーが表示される行頭にくる。ここで、文字を入力すると変換後には最初の一文字しか表示されない
という状態です。
WinXP(xp style非適用) Delphi6Per
ずっと以前からあちこちで、この問題を追求されているようですが、
初めからスクロールバーを表示しておくのはなにか重大な不都合が
あるのでしょうか。
Memo1のChangイベントで動作させているようですが、これだと最初の１文字が入った時点で動作してしまい一文字しか表示されなくなります。
changイベントで行数が変わるのを調べて動作させればうまくいくようです。
ex.
private
{ Private 宣言 }
lCount : Longint;
procedure TForm1.Memo1Change(Sender: TObject);
begin
if lCount <> Memo1.Lines.Count then
begin
lCount := Memo1.Lines.Count;
MemoScrollBarsAutoShow;
end;
>>えーと さん
>ずっと以前からあちこちで、
これが初めての投稿です。
検索しても見つからなかったので質問したのですが、
同じような質問が過去にあったのでしょうか？
調査不足ですみません。
もし、すでに解決したことならばリンク先を教えてくれないでしょうか。
>初めからスクロールバーを表示しておくのはなにか重大な不都合が
>あるのでしょうか。
重大な不都合 ではありませんが、
デザイン的、少しでも画面を有効活用したい
などの理由です。
だから、ちゃんと動く方法がないのならば、それはそれで別に困らないのですが、
だれか、知っていれば教えてくれないかなと思い質問してみたのです。
>>HOta さん
示してくれたコードを試してみましたが、
同じく、文字変換後に ScrollBars が表示される場合
始めの1文字しか入力されませんでした。
行数のプロパティーが変わるのが、Enterキーを押したときではなく、
あたらしいラインに文字を入力したあとに生じるためだと考えられます。
すみません。
Changイベントだとおなじですね。
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key in [VK_RETURN,VK_BACK,VK_DELETE] then
begin
lCount := Memo1.Lines.Count;
MemoScrollBarsAutoShow;
end;
end;
でどうでしょう。
HOta さんの示したコードで、
スクロールバーが表示されるときも正しく動作しました。
みなさん、ありがとうございました。
うはっ。出遅れた…
既に不要かとは思いますが、コンポーネント作成しました。
この方法ですとグレースクロールバーがほぼ出ません。
WMCharで２バイトチェックしてないのはご愛嬌で。
unit MemoEx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
StdCtrls, imm;
type
TMemoEx = class(TCustomMemo)
private
{ Private 宣言 }
siIMEWCharCount:integer;
siLineHeight :integer;
siStopFlag :boolean;
procedure siCheckLineHeight;
procedure siScrollBarsAutoShow(CharCode:Word);
procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
procedure WMImeComposition(var Msg : TMessage); message WM_IME_COMPOSITION;
procedure WMSize (var Msg: TWMSize); message WM_SIZE;
protected
procedure KeyUp (var Key:Word; Shift:TShiftState); override;
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
end;
implementation
{ TMemoEx }
procedure TMemoEx.CMFontChanged(var Msg: TMessage);
begin
inherited;
siCheckLineHeight;
end;
constructor TMemoEx.Create(AOwner: TComponent);
begin
inherited;
siIMEWCharCount :=0;
siLineHeight :=0;
siCheckLineHeight;
end;
procedure TMemoEx.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited;
siStopFlag:=True;
case key of
//本当は他の方法で実装したいけどVK_DELETEがここでしか検出できなかった。
VK_DELETE:siScrollBarsAutoShow(8);
end;
siStopFlag:=False;
end;
procedure TMemoEx.siCheckLineHeight;
var bufBMP:TBitmap;
begin
//手抜き
bufBmp:=TBitmap.Create;
bufBmp.Canvas.Font.Assign(Font);
siLineHeight:=bufBmp.Canvas.TextHeight('H');
bufBmp.Free;
end;
procedure TMemoEx.siScrollBarsAutoShow(CharCode:Word);
var
xPos,i : Integer;
LCount : Integer;
begin
case CharCode of
13:LCount:=Lines.Count+1;
else begin
if (Lines.Text<>'') and (Lines.Text[Length(Lines.Text)-1]=#13) then
LCount:=Lines.Count+1
else
LCount:=Lines.Count;
end;
end;
//+1は微調整 原因不明 orz
if ((siLineHeight * LCount +1) >= ClientHeight) and
(ScrollBars = ssNone) then
begin
xPos := SelStart;
ScrollBars := ssVertical;
SelStart := xPos;
for i:=0 to Lines.Count-1 do
Perform(EM_SCROLL, SB_VERT, Lines.Count);
//SendMessage(Handle, EM_SCROLL, SB_LINEDOWN, Lines.Count);
end
else
//+1は微調整 原因不明 orz
if ((siLineHeight * LCount +1) < ClientHeight)
and (ScrollBars = ssVertical) then
begin
xPos := SelStart;
ScrollBars := ssNone;
SelStart := xPos;
end;
end;
procedure TMemoEx.WMChar(var Msg: TWMChar);
begin
inherited;
if siIMEWCharCount>0 then
begin
dec(siIMEWCharCount);
exit;
end else begin
siStopFlag:=True;
siScrollBarsAutoShow(Msg.CharCode);
siStopFlag:=False;
end;
end;
procedure TMemoEx.WMImeComposition(var Msg: TMessage);
var
IMC : HIMC;
begin
inherited;
if Msg.lParam and GCS_RESULTSTR <> 0 then
begin
IMC := ImmGetContext(Handle);
if IMC <> 0 then
siIMEWCharCount:= ImmGetCompositionStringW(IMC, GCS_RESULTSTR, nil, 0) div
SizeOf(WideChar) -1;
ImmReleaseContext(Handle, IMC);
end;
end;
procedure TMemoEx.WMSize(var Msg: TWMSize);
begin
inherited;
if siStopFlag=True then exit;
siStopFlag:=True;
siScrollBarsAutoShow(0);
siStopFlag:=False;
end;
end.
>>ママん さん
コンポーネントまで作成してくれて
ありがとうございます。
じつは、Memo1KeyUpで行の変化を検出する方法だけでは
コピペのとき検出できなかったり、
グレースクロールバーが表示されたり、
キャレットが隠れたり、などいろいろ不具合があったのですが、
unit MemoEx を試したところ、
私の想定以上の動作をしていて感心しました。
少しの不具合に対処するために、コードの多くの割合を割く
ということ(2:8の法則？)を実感しました。
| ツイート |  |