Difference between revisions of "Graphics - Working with TCanvas"
From Free Pascal wiki
Jump to navigationJump to searchLine 25: | Line 25: | ||
Some widgetsets like the gtk2 do not support this and always paint antialiased. Here is a simple procedure to draw text with sharp edges under gtk2. It does not consider all cases, but it should give an idea: | Some widgetsets like the gtk2 do not support this and always paint antialiased. Here is a simple procedure to draw text with sharp edges under gtk2. It does not consider all cases, but it should give an idea: | ||
− | <syntaxhighlight>procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string); | + | <syntaxhighlight>procedure PaintAliased(Canvas: TCanvas; x, y: integer; const TheText: string); |
var | var | ||
− | w,h: | + | w, h, dx, dy: Integer; |
− | IntfImg: TLazIntfImage; | + | IntfImg: TLazIntfImage; |
− | Img: TBitmap | + | Img: TBitmap; |
− | + | col: TFPColor; | |
− | + | FontColor, c: TColor; | |
− | col: TFPColor; | ||
− | FontColor | ||
− | |||
begin | begin | ||
− | w:=0; | + | w := 0; |
− | h:=0; | + | h := 0; |
− | Canvas.GetTextSize(TheText,w,h); | + | Canvas.GetTextSize(TheText, w, h); |
− | if (w<=0) or (h<=0) then exit; | + | if (w <= 0) or (h <= 0) then exit; |
− | Img:=TBitmap.Create; | + | Img := TBitmap.Create; |
− | IntfImg:=nil; | + | IntfImg := nil; |
try | try | ||
// paint text to a bitmap | // paint text to a bitmap | ||
− | Img.Masked:=true; | + | Img.Masked := true; |
Img.SetSize(w,h); | Img.SetSize(w,h); | ||
− | Img.Canvas.Brush.Style:=bsSolid; | + | Img.Canvas.Brush.Style := bsSolid; |
− | Img.Canvas.Brush.Color:=clWhite; | + | Img.Canvas.Brush.Color := clWhite; |
− | Img.Canvas.FillRect(0,0,w,h); | + | Img.Canvas.FillRect(0, 0, w, h); |
− | Img.Canvas.Font:=Canvas.Font; | + | Img.Canvas.Font := Canvas.Font; |
− | Img.Canvas.TextOut(0,0,TheText); | + | Img.Canvas.TextOut(0, 0, TheText); |
// get memory image | // get memory image | ||
− | IntfImg:=Img.CreateIntfImage; | + | IntfImg := Img.CreateIntfImage; |
// replace gray pixels | // replace gray pixels | ||
− | FontColor:=ColorToRGB(Canvas.Font.Color); | + | FontColor := ColorToRGB(Canvas.Font.Color); |
− | for dy:=0 to h-1 do begin | + | for dy := 0 to h - 1 do begin |
− | for dx:=0 to w-1 do begin | + | for dx := 0 to w - 1 do begin |
− | col:=IntfImg.Colors[dx,dy]; | + | col := IntfImg.Colors[dx, dy]; |
− | c:=FPColorToTColor(col); | + | c := FPColorToTColor(col); |
− | if c<>FontColor then | + | if c <> FontColor then |
− | IntfImg.Colors[dx,dy]:=colTransparent; | + | IntfImg.Colors[dx, dy] := colTransparent; |
end; | end; | ||
end; | end; | ||
Line 66: | Line 63: | ||
Img.LoadFromIntfImage(IntfImg); | Img.LoadFromIntfImage(IntfImg); | ||
// paint | // paint | ||
− | Canvas.Draw(x,y,Img); | + | Canvas.Draw(x, y, Img); |
finally | finally | ||
IntfImg.Free; | IntfImg.Free; |
Revision as of 16:51, 26 May 2018
│
English (en) │
français (fr) │
italiano (it) │
русский (ru) │
Using the default GUI font
This can be done with the following simple code:
SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT));
Drawing a text limited on the width
Use the DrawText routine, first with DT_CALCRECT and then without it.
// First calculate the text size then draw it
TextBox := Rect(0, currentPos.Y, Width, High(Integer));
DrawText(ACanvas.Handle, PChar(Text), Length(Text),
TextBox, DT_WORDBREAK or DT_INTERNAL or DT_CALCRECT);
DrawText(ACanvas.Handle, PChar(Text), Length(Text),
TextBox, DT_WORDBREAK or DT_INTERNAL);
Drawing text with sharp edges (non antialiased)
Some widgetsets support this via
Canvas.Font.Quality := fqNonAntialiased;
Some widgetsets like the gtk2 do not support this and always paint antialiased. Here is a simple procedure to draw text with sharp edges under gtk2. It does not consider all cases, but it should give an idea:
procedure PaintAliased(Canvas: TCanvas; x, y: integer; const TheText: string);
var
w, h, dx, dy: Integer;
IntfImg: TLazIntfImage;
Img: TBitmap;
col: TFPColor;
FontColor, c: TColor;
begin
w := 0;
h := 0;
Canvas.GetTextSize(TheText, w, h);
if (w <= 0) or (h <= 0) then exit;
Img := TBitmap.Create;
IntfImg := nil;
try
// paint text to a bitmap
Img.Masked := true;
Img.SetSize(w,h);
Img.Canvas.Brush.Style := bsSolid;
Img.Canvas.Brush.Color := clWhite;
Img.Canvas.FillRect(0, 0, w, h);
Img.Canvas.Font := Canvas.Font;
Img.Canvas.TextOut(0, 0, TheText);
// get memory image
IntfImg := Img.CreateIntfImage;
// replace gray pixels
FontColor := ColorToRGB(Canvas.Font.Color);
for dy := 0 to h - 1 do begin
for dx := 0 to w - 1 do begin
col := IntfImg.Colors[dx, dy];
c := FPColorToTColor(col);
if c <> FontColor then
IntfImg.Colors[dx, dy] := colTransparent;
end;
end;
// create bitmap
Img.LoadFromIntfImage(IntfImg);
// paint
Canvas.Draw(x, y, Img);
finally
IntfImg.Free;
Img.Free;
end;
end;