SetTextCharacterExtra(Canvas.Handle, 15);

Canvas.TextOut(0, 0, '每个字符间隔15象素');

：DreamTiger：

提供一个可以控制行距和字距的控件，以前写的是控制行距的，使用了another_eyes的

方法，可以控制字距了。大家共享。如果发现什么Bug，一定要告诉我哦！另外，高度

还不能自动调整到完全显示Caption（如果Caption包含多行的话），如果那位有兴趣，

可以改写一下。

unit SqhLabel;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 StdCtrls;

type

 TSqhLabel = class(TCustomLabel)

 private

   FRowSpacing:integer;

   FColSpacing:integer;

   procedure SetRowSpacing(Value:Integer);

   procedure SetColSpacing(Value:Integer);

 protected

   procedure DoDrawText(var Rect: TRect; Flags: Longint); override;

 public

   property RowSpacing:integer read FRowSpacing Write SetRowSpacing;

   property ColSpacing:integer read FColSpacing Write SetColSpacing;

 published

   property Align;

   property Alignment;

   property Anchors;

   property AutoSize;

   property BiDiMode;

   property Caption;

   property Color;

   property Constraints;

   property DragCursor;

   property DragKind;

   property DragMode;

   property Enabled;

   property FocusControl;

   property Font;

   property ParentBiDiMode;

   property ParentColor;

   property ParentFont;

   property ParentShowHint;

   property PopupMenu;

   property ShowHint;

   property Transparent;

   property Layout;

   property Visible;

   property OnClick;

   property OnContextPopup;

   property OnDblClick;

   property OnDragDrop;

   property OnDragOver;

   property OnEndDock;

   property OnEndDrag;

   property OnMouseDown;

   property OnMouseMove;

   property OnMouseUp;

   property OnStartDock;

   property OnStartDrag;

 end;

procedure Register;

implementation

procedure Register;

begin

 RegisterComponents('SQH', [TSqhLabel]);

end;

{ TSqhLabel }

procedure TSqhLabel.DoDrawText(var Rect: TRect; Flags: Integer);

var

 Text: string;

 FontHeight:integer;

 tslLines:TStringList;

 procedure MyDrawText(ARect:TRect);

 var

   iLoop:integer;

   sLine:String;

   NewRect:TRect;

   iTrueWidth:integer;

 begin

   for iLoop := 0 to tslLines.Count - 1 do

   begin

     sLine := tslLines[iLoop];

     NewRect.Left := ARect.Left;

     NewRect.Top := ARect.Top + iLoop * (FontHeight + FRowSpacing);

     NewRect.Right := ARect.Right;

     NewRect.Bottom := NewRect.Top + FontHeight;

     DrawText(Canvas.Handle,PChar(sLine),Length(sLine),NewRect,Flags or DT_CALCRECT);

     if NewRect.Right > Width then

       Width := NewRect.Right;

     DrawText(Canvas.Handle,PChar(sLine),Length(sLine),NewRect,Flags)

   end;

 end;

begin

 Text := GetLabelText;

 FontHeight := Canvas.TextHeight('M');

 Flags := Flags or DT_NOPREFIX;

 Flags := DrawTextBiDiModeFlags(Flags);

 tslLines := TStringList.Create;

 try

   tslLines.Text := Text;

   Canvas.Font := Font;

   SetTextCharacterExtra(Canvas.Handle,FColSpacing);

   if not Enabled then

   begin

     OffsetRect(Rect, 1, 1);

     Canvas.Font.Color := clBtnHighlight;

     MyDrawText(Rect);

     OffsetRect(Rect, -1, -1);

     Canvas.Font.Color := clBtnShadow;

     MyDrawText(Rect);

   end

   else

     MyDrawText(Rect);

 finally

   tslLines.Free;

 end;

end;

procedure TSqhLabel.SetColSpacing(Value: Integer);

begin

 if FColSpacing <> Value then

 begin

   FColSpacing := Value;

   Repaint;

 end;

end;

procedure TSqhLabel.SetRowSpacing(Value: Integer);

begin

 if FRowSpacing <> Value then

 begin

   FRowSpacing := Value;

   Repaint;

 end;

end;

end.