Canvas TextRect

Issue #66 resolved
Friedrich Westermann created an issue

Differences MAC WIN

Screenshot 2017-03-16 um 15.27.04.png

procedure TForm28.PaintBox1Paint(Sender: TObject);
Var pb : TPaintBox;
    r : TRect;
    pos : Tpoint;
    TextFormat: TTextFormat;

 const ym = 50;

Procedure DrawTestText(const ac : Tcanvas; const aRectBackGound, aTextBackGound : tcolor;
r : Trect; apos : Tpoint;  TextFormat: TTextFormat; const s : string);
  var ts : String;
begin
  ts := s;
  r.Location := apos;
  ac.Brush.Color := aRectBackGound;
  ac.Rectangle(r);
  ac.Brush.Color := aTextBackGound;
  textformat := textformat + [tfSingleLine, tfnoclip];
  ac.TextRect(r, ts,TextFormat);
end;



begin
 pb := sender as TPaintBox;
 // Fill Background
 pb.Canvas.Brush.Color := clSilver;
 pb.Canvas.Brush.Style := bsSolid;
 pb.Canvas.FillRect(clientrect);
 pb.canvas.pen.Style := psDot;
 pb.Canvas.Pen.Color := clBlue;

 r := Trect.Create(point(0,0), 200, ym-5);
 pos.SetLocation(10,10);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfLeft, tftop], 'Left Top');
 pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfCenter, tftop], 'Center Top');
  pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfRight, tftop], 'Right Top');
  pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfRight, tfVerticalCenter], 'Right VCenter');
  pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfCenter, tfVerticalCenter], 'Center VCenter');
  pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfLeft, tfVerticalCenter], 'Left VCenter');
  pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfLeft, tfBottom], 'Left Bottom');
   pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfCenter, tfBottom], 'Center Bottom');

  pos.Offset(0,ym);
 DrawTestText(pb.canvas, clSilver, clBlue, r, pos, [tfRight, tfBottom], 'Right Bottom');
end;

procedure TForm28.FormCreate(Sender: TObject);
begin
  ffont := Font;
  ffont.Size := 14;
  ffont.Color := clWhite;
  PaintBox1.Font := ffont;
end;

Comments (2)

  1. Log in to comment