字符间距

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.