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

キーワード:Win95

>> Index

06/25 RichEdit を印刷したい
05/17 2つの TRichEdit のスクロールを同期させる
05/17 TreeView で D&D 中の描画処理
02/09 TListView の ... 表示をなくす
06/11 ListView をスクロールする
09/15 TRichEdit.Add でリソース不足
09/15 TPageControl に OnDblClick を追加する
09/15 TTreeView で5つ以上のオーバレイ・イメージを使う
09/09 TPageControl でタブをドラッグして順序入れ替え
09/05 ドッカブルメニュー(ツールバー形式のメニュー)を実現したい。
09/01 RichEditでHTMLタグを色・書式付き表示をする
08/31 LinesプロパティエディタでTabを入力する
08/31 RichEdit の全パラグラフのタブ幅を設定する
08/31 TRichEdit.Paragraph.Tab[] の設定(Tab位置の設定)
08/26 ツリービューのノードをドラッグ&ドロップで移動させる
05/19 TRichEdit の内容を高速に変更する
05/01 右の項目の幅が固定されるTStatusBar
04/29 TCoolBarを用いたツールバーの位置保存
02/11 長すぎる TreeView アイテムを補完するチップヘルプを出さなくする
02/08 超高速 ListView
02/08 ステータスバーにプログレスバーを置きたい
02/08 TUpDown の不具合
02/08 TPageControl を TabPosition=tpBottom にすると不具合
02/08 TMemoで入力*行数*を制限したい
02/08 TListViewで列を指定してソート

最終更新: 7824 日前

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] <印刷> <コンポーネント >

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] <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] <コンポーネント >

0314  D1   D2   D3   D4   D5   D6   D7   3.1   95   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] <コンポーネント >

0312  D1   D2   D3   D4   D5   D6   D7   3.1   95   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] <コンポーネント >

0258  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 編集
TRichEdit.Add でリソース不足

> 現在、通信関係のソフトを開発しているのですが、RichEdit の Add メソッドで
> EOutOfResources(リソース不足)の例外が発生するようになってしまい
> ました。
>
> RichEdit の MaxLength には、20000000 の値を入れており、まだそんなに
> Add していない状態で発生します。

Lines.Add メソッドで読み込んでいるということですね。
私も同じトラブルを経験しましたが、Lines.Add の代わりに、一旦 TMemoryStream に書き出してから、LoadFromStream メソッドを使うという方法で回避しました。
参照: [Delphi-ML:34075] <コンポーネント >

0257  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 編集
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] <コンポーネント >

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] <コンポーネント >

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] <コンポーネント >

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] <コンポーネント > <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> <通信> <コンポーネント >

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キーを押します。
参照: <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] <コンポーネント >

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] <コンポーネント >

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] <コンポーネント >

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] <コンポーネント >

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化してみるのも面白いでしょう。
参照: <コンポーネント >

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] <コンポーネント >

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] <コンポーネント >

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] <コンポーネント >

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] <コンポーネント >

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] <バグ> <コンポーネント >

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] <バグ> <コンポーネント >

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] <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] <コンポーネント >

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

How To
Lounge
KeyWords

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