お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"TConversion で色を変える"



 Withです。キーワードを付け忘れていたので、発言しなおします。#325 は
削除しました。



 えっと、nifty:FDELPHI/MES/06/14711 関連のサンプルプログラムです。ちょっ
と長いし、マルチバイトコードへの対策としていないなどの問題がありますが、参
考にしてください。

 内容は、TSampleConv という「1文字ごとに色を変える」という変換をするよう
なクラスを TConversion から派生させ、DefaultConverter として利用するという
ものです。
 実際に使う場合には、Form に RichEdit と Button を貼り付けてください。

-------- 8< -------- 8< -------- 8< -------- 8< -------- 8< --------

implementation

{$R *.DFM}

type
  TSampleConv = class(TConversion)
  private
    RtfStr: String;
    EndFlag: Boolean;
    TextCount: Integer;
  public
    function ConvertReadStream(Stream: TStream; Buffer: PChar;
                               BufSize: Integer): Integer; override;
  end;

function TSampleConv.ConvertReadStream(Stream: TStream; Buffer: PChar;
                                       BufSize: Integer): Integer;
  function GetColor: String;
  begin
    if Odd(TextCount) then  Result := '\cf0 '
    else                    Result := '\cf1 ';
  end;

const
  CRLF = #13 + #10;

var
  len: Integer;
  i: Integer;
  Ch: Char;
begin
  if Stream.Position = 0 then
  begin
    RtfStr := '{\rtf1' +
              '{\colortbl\red255\green0\blue0;\red0\green0\blue255;}' +
              CRLF;
    EndFlag := False;
    TextCount := -1;
  end;

  if Length(RtfStr) >= BufSize -1 then
  begin
    StrPLCopy(Buffer, RtfStr, BufSize -1);
    Delete(RtfStr, 1, StrLen(Buffer));
    Result := StrLen(Buffer);
    Exit;
  end;
  if not EndFlag then
  begin
    len := Stream.Read(Buffer^, BufSize -1);
    Buffer[len] := #0;
    EndFlag := len < BufSize -1;

    for i := 0 to len -1 do
    begin
      Inc(TextCount);
      Ch := Buffer[i];

      if Ch = #13 then
      begin
        Dec(TextCount);
        Continue;
      end;

      case Ch of
        '\', '{', '}' :  RtfStr := RtfStr + GetColor + '\' + Ch;
        #10 : RtfStr := RtfStr + CRLF + '\par ';
        #13 : ;
        else  RtfStr := RtfStr + GetColor + Ch;
       end;
    end;
    if EndFlag then
      RtfStr := RtfStr + CRLF + '\par}';
  end;

  StrPLCopy(Buffer, RtfStr, BufSize -1);
  Delete(RtfStr, 1, StrLen(Buffer));
  Result := StrLen(Buffer);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.DefaultConverter := TConversion;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    with RichEdit1 do
    begin
      PlainText := True;
      Lines.SaveToStream(Stream);
      Stream.Position := 0;
      DefaultConverter := TSampleConv;
      PlainText := False;
      Lines.LoadFromStream(Stream);
      DefaultConverter := TConversion;
    end;
  finally
    Stream.Free;
  end;
end;

end.

-------- 8< -------- 8< -------- 8< -------- 8< -------- 8< --------

 また、ファイルを読み込む場合は LoadFromFile を使わずに、LoadFromStream
を使って読み込むようにしてください。これは、TRichEdit のバグだと思っていま
す。具体的には、

    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromFile(File);
      RichEdit1.Lines.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;

のようなコードを書きます。


 ではでは。


                                         ) -------  )  ) . _)_  )_ With )
          DFC flying with AirCraft 97   ( HGC02275 (/(/ (  (_  ( ( --- (
     Kazuhiko Iwama <with@zakkyo.or.jp>  ----------------  98/01/10 18:17

Original document by With        氏 ID:(HGC02275)


ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum