Canvas上如何使用不同颜色勾画字体轮廓？急。。。

Question

日前小虾使用Textout在Canvas上写字
想将字体的轮廓使用不同的颜色勾画
一下，不知各位大虾有和高见？分不够再加。

Answer 1

to ： chechy(简简单单的活) 
这样不够简练，麻烦，有更好的意见吗？

Answer 2

Shit，加分加不上，气死我也“你最大只能给100分，加上这个分，已经超出范围了” 
 

Answer 3

to ： chechy(简简单单的活) 给字造阴影，加凸凹，就是这样干的。Could you send a sample to me ?,thank you and best [email protected]

Answer 4

你是初级用户，只能给100分。至于例子，网上有关3D的Label的控件，都是这么写的。你随便下载两个就可以看到了。比如vcl.vclxx.org

Answer 5

CSDN上没有高手 哎。
失望。。

Answer 6

用richedit来代替输出控件，相应属性自己修改后代码如下：
   richedit1.PlainText:=false;
   richedit1.Lines.LoadFromFile(extractfilepath(application.ExeName)+'a.rtf');
   richedit1.Enabled:=false;
所要输出的文字放在a.rtf中就行了，这样你想要什么字体都可以在word中编辑了。

Answer 7

procedure TForm1.FormPaint(Sender: TObject);
const
  c_clrFrom = clRed;
  c_clrTo = clBlue;
var
  r: TRect;
  i, j: Integer;
  w: Integer;
  k: Double;
  l_hRgn: HRGN;
  l_clrFill: TColor;
begin
  BeginPath(Canvas.Handle);
  Canvas.Font.Size := 72;
  Canvas.Font.Name := '宋体';
  Canvas.Brush.Style := bsClear;
  r := Rect(0, 0, Width, Height);
  DrawText(Canvas.Handle, PChar('TAXI'), -1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  EndPath(Canvas.Handle);  l_hRgn := PathToRegion(Canvas.Handle);
  if l_hRgn <> 0 then
  begin
    GetRgnBox(l_hRgn, r);
    w := r.Right - r.Left;
    for i := r.Left to r.Right do
    begin
      k := (i - r.Left) / w;
      l_clrFill := RGB(Round(GetRValue(c_clrFrom) * (1 - k) + GetRValue(c_clrTo) * k),
                       Round(GetGValue(c_clrFrom) * (1 - k) + GetGValue(c_clrTo) * k),
                       Round(GetBValue(c_clrFrom) * (1 - k) + GetBValue(c_clrTo) * k));
      for j := r.Top to r.Bottom do
      begin
        if PtInRegion(l_hRgn, i, j) then
          Canvas.Pixels[i, j] := l_clrFill;
      end;
    end;
    DeleteObject(l_hRgn);
  end;
end;

Answer 8

用 Path 相关的 API 试试

Answer 9

to ： taxi(游少爷) 注意是 字体的轮廓

Answer 10

procedure TForm1.FormPaint(Sender: TObject);
var
  r: TRect;
  i, j: Integer;
  l_hRgn: HRGN;
begin
  BeginPath(Canvas.Handle);
  Canvas.Font.Size := 72;
  Canvas.Font.Name := '宋体';
  Canvas.Brush.Style := bsClear;
  r := Rect(0, 0, Width, Height);
  DrawText(Canvas.Handle, PChar('TAXI'), -1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  EndPath(Canvas.Handle);  l_hRgn := PathToRegion(Canvas.Handle);
  if l_hRgn <> 0 then
  begin
    GetRgnBox(l_hRgn, r);
    for i := r.Left to r.Right do
    begin
      for j := r.Top to r.Bottom do
      begin
        if PtInRegion(l_hRgn, i, j)
          and ((not PtInRegion(l_hRgn, i - 1, j - 1))
          or (not PtInRegion(l_hRgn, i, j - 1))
          or (not PtInRegion(l_hRgn, i + 1, j - 1))
          or (not PtInRegion(l_hRgn, i - 1, j))
          or (not PtInRegion(l_hRgn, i + 1, j))
          or (not PtInRegion(l_hRgn, i - 1, j + 1))
          or (not PtInRegion(l_hRgn, i, j + 1))
          or (not PtInRegion(l_hRgn, i + 1, j + 1))) then
          Canvas.Pixels[i, j] := RGB(Random(255), Random(255), Random(255));
      end;
    end;
    DeleteObject(l_hRgn);
  end;
end;

Answer 11

用通道，给一个范例：
procedure TForm1.FormPaint(Sender: TObject);
begin
  {开始通道分组}
  BeginPath(Canvas.Handle);  {绘制一些文本}
  SetBkMode(Canvas.Handle, TRANSPARENT);
  Canvas.TextOut(10, 10, 'DELPHI ROCKS!');  {结束通道分组}
  EndPath(Canvas.Handle);{初始化画笔来绘制通道轮廓}
  Canvas.Pen.Color := clRed;
  Canvas.Pen.Style := psSolid;  {绘制通道轮廓}
  StrokePath(Canvas.Handle);
end;

Answer 12

procedure TForm1.FormPaint(Sender: TObject);
const
  c_clrFrom = clRed;
  c_clrTo = clYellow;
var
  r: TRect;
  i, j, w: Integer;
  k: Double;
  c: TColor;
  l_hRgn: HRGN;
begin
  BeginPath(Canvas.Handle);
  Canvas.Font.Size := 72;
  Canvas.Font.Name := '宋体';
  Canvas.Brush.Style := bsClear;
  r := Rect(0, 0, Width, Height);
  DrawText(Canvas.Handle, PChar('TAXI'), -1, r, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  EndPath(Canvas.Handle);  l_hRgn := PathToRegion(Canvas.Handle);
  if l_hRgn <> 0 then
  begin
    GetRgnBox(l_hRgn, r);
    w := r.Right - r.Left;
    for i := r.Left to r.Right do
    begin
      for j := r.Top to r.Bottom do
      begin
        if PtInRegion(l_hRgn, i, j)
          and ((not PtInRegion(l_hRgn, i - 1, j - 1))
          or (not PtInRegion(l_hRgn, i, j - 1))
          or (not PtInRegion(l_hRgn, i + 1, j - 1))
          or (not PtInRegion(l_hRgn, i - 1, j))
          or (not PtInRegion(l_hRgn, i + 1, j))
          or (not PtInRegion(l_hRgn, i - 1, j + 1))
          or (not PtInRegion(l_hRgn, i, j + 1))
          or (not PtInRegion(l_hRgn, i + 1, j + 1))) then
        begin
          k := (i - r.Left) / w;
          c := RGB(Round(GetRValue(c_clrFrom) * (1 - k) + GetRValue(c_clrTo) * k),
                   Round(GetGValue(c_clrFrom) * (1 - k) + GetGValue(c_clrTo) * k),
                   Round(GetBValue(c_clrFrom) * (1 - k) + GetBValue(c_clrTo) * k));
          Canvas.Pixels[i, j] := c;
        end;
      end;
    end;
    DeleteObject(l_hRgn);
  end;
end;