推荐订阅源

unit QCanvasTextWriter;

//QCanvasTextWriter V1.0
//qevan(郭栋) 2005-3-31
//introduction:
//  QCanvasTextWriter can help u write text infomations on a canvas
//feathers:
//support different fonts styles
//support line break
//
//examples:
// Canvas.FillRect(rect);
// rtw:=TCanvasTextWriter.create(Canvas, Rect.TopLeft);
// rtw.writeln('Thank u for using QCanvasTextWriter',clBlack,[fsBold]);
// rtw.writeln(' Author: qevan',clLtGray,[]);
// rtw.writeln('http://cnblogs.com/qevan',clBlue,[fsUnderline,fsItalic]);
// rtw.free;

interface

uses Graphics,windows;

const endl=#$D#$A;

type
TCanvasTextWriter = class
private
       FCanvas:TCanvas;
       FCurrent:TPoint;
       FLineMaxHeight:integer;
    function getFont: TFont;
    procedure setFont(const Value: TFont);
    procedure newLine;

public
      constructor create(canvas:TCanvas;StartPosition:TPoint);
      procedure write(s:string;color:TColor;Style:TFontStyles);overload;
      procedure write(s:string);overload;
      procedure writeln(s:string;color:TColor;Style:TFontStyles);overload;
      procedure writeln(s:string='');overload;
      property Font:TFont read getFont write setFont;

end;

implementation

{ TRectTextWriter }

function TCanvasTextWriter.getFont: TFont;
begin
     result:=FCanvas.Font;
end;

procedure TCanvasTextWriter.setFont(const Value: TFont);
begin
     FCanvas.Font:=value;
end;

procedure TCanvasTextWriter.write(s: string);
begin
     FCanvas.TextOut(FCurrent.X,FCurrent.Y,s);
     inc(FCurrent.X,FCanvas.TextWidth(s));
     if FCanvas.TextHeight(s)>FLineMaxHeight then
        FLineMaxHeight:=FCanvas.TextHeight(s);
end;

procedure TCanvasTextWriter.write(s: string; color:TColor; Style: TFontStyles);
var oldcolor:TColor;
    oldStyle:TFontStyles;
begin
     OldColor:=FCanvas.Font.Color;
     OldStyle:=FCanvas.Font.Style;
     FCanvas.Font.Color:=Color;
     FCanvas.Font.Style:=Style;
     write(s);
     FCanvas.Font.Color:=OldColor;
     FCanvas.Font.Style:=oldStyle;
end;

constructor TCanvasTextWriter.create(canvas: TCanvas;StartPosition: TPoint);
begin
     FCanvas:=Canvas;
     FCurrent:=StartPosition;
     FLineMaxHeight:=0;
end;

procedure TCanvasTextWriter.writeln(s: string='');
begin
     write(s);
     newLine;
end;

procedure TCanvasTextWriter.writeln(s: string; color:TColor;Style: TFontStyles);
begin
     write(s,color,style);
     newLine;
end;

procedure TCanvasTextWriter.newLine;
begin
     inc(FCurrent.Y,FLineMaxHeight);
     FCurrent.X:=0;
     FLineMaxHeight:=0;
end;

end.