unit myLabel;
{Unicodeの表示に対応したLabel}

interface

uses
	Classes,
	Forms,
	Graphics,
	Windows,
	StdCtrls;

type
	TMyLabel = class(TLabel)
	private
		{ Private 宣言 }
		F_bsBorderStyle:  TBorderStyle;	//ボーダースタイル
		F_bDisabledStyle: Boolean; //Enabled = False の時に影つきのグレイテキストにするか
		F_bTextShadow:    Boolean; //影つき
		F_bSingleLine:    Boolean; //改行を無視して一行表示にするか
		F_bEndEllipsis:   Boolean; //文字列を範囲内に収まらないとき末尾を...にするか
		F_iLeftMargin,             //左マージン
		F_iRightMargin,            //右マージン
		F_iTopMargin,              //上マージン
		F_iBottomMargin:  Integer; //下マージン

		function F_AnsiToWide(sSrc: AnsiString): WideString;
		function F_WideToAnsi(sSrc: WideString): AnsiString;
		function  GetText: WideString;
		procedure SetText(sText: WideString);

		procedure F_SetBorderStyle  (bsStyle: TBorderStyle);
		procedure F_SetDisabledStyle(bFlag: Boolean);
		procedure F_SetEndEllipsis  (bFlag: Boolean);
		procedure F_SetSingleLine   (bFlag: Boolean);
		procedure F_SetTextShadow   (bFlag: Boolean);
		procedure F_SetLeftMargin   (iLeft:   Integer);
		procedure F_SetRightMargin  (iRight:  Integer);
		procedure F_SetTopMargin    (iTop:    Integer);
		procedure F_SetBottomMargin (iBottom: Integer);
	protected
		{ Protected 宣言 }
		procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
	public
		constructor Create(AOwner: TComponent); override;
	published
		{ Published 宣言 }
		property Border:        TBorderStyle read F_bsBorderStyle  write F_SetBorderStyle   default bsNone;
		property Caption:       WideString   read GetText          write SetText;
		property DisabledStyle: Boolean      read F_bDisabledStyle write F_SetDisabledStyle default True;
		property EndEllipsis:   Boolean      read F_bEndEllipsis   write F_SetEndEllipsis   default False;
		property SingleLine:    Boolean      read F_bSingleLine    write F_SetSingleLine    default False;
		property Shadow:        Boolean      read F_bTextShadow    write F_SetTextShadow    default False;
		property LeftMargin:    Integer      read F_iLeftMargin    write F_SetLeftMargin    default 0;
		property TopMargin:     Integer      read F_iTopMargin     write F_SetTopMargin     default 0;
		property RightMargin:   Integer      read F_iRightMargin   write F_SetRightMargin   default 0;
		property BottomMargin:  Integer      read F_iBottomMargin  write F_SetBottomMargin  default 0;

		property OnResize;
{
		property Align;
		property Alignment;
		property Anchors;
		property AutoSize;
		property BiDiMode;
		property Color default clBtnFace;
		property Constraints;
		property DragCursor;
		property DragKind;
		property DragMode;
		property Enabled;
		property FocusControl;
		property Font;
		property ParentBiDiMode;
		property ParentColor default False;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property ShowAccelChar;
		property ShowHint;
		property Transparent;
		property Layout;
		property Visible;
		property WordWrap;
		property OnClick;
		property OnContextPopup;
		property OnDblClick;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDock;
		property OnEndDrag;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnMouseEnter;
		property OnMouseLeave;
		property OnStartDock;
		property OnStartDrag;
}
	end;

procedure Register;

//==============================================================================
implementation
uses
	SysUtils;


//------------------------------------------------------------------------------
function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer;
begin
	if (iMin = iMax) then begin
		Result := iMin;
	end else begin
		//間違いの元なので気を利かせるのをやめた
		//l_pcNumSwap_MinMax(iMin, iMax);
		if (iNum < iMin) then begin
			Result := iMin;
		end else if (iNum > iMax) then begin
			Result := iMax;
		end else begin
			Result := iNum;
		end;
	end;
end;


//------------------------------------------------------------------------------
{ MyLabel }
constructor TMyLabel.Create(AOwner: TComponent);
begin
	inherited;

	F_bsBorderStyle  := bsNone;
	F_bDisabledStyle := True;
	F_bEndEllipsis   := False;
	F_bSingleLine    := False;
	F_bTextShadow    := False;
	F_iLeftMargin    := 0;
	F_iTopMargin     := 0;
	F_iRightMargin   := 0;
	F_iBottomMargin  := 0;

	Color       := clBtnFace;
	ParentColor := False;
end;

function TMyLabel.F_WideToAnsi(sSrc: WideString): AnsiString;
//WideStringをUTF-7にエンコードして返す
var
	li_Len:  Integer;
	lp_Buff: PAnsiChar;
begin
	//WC_COMPOSITECHECKはNG
	li_Len  := WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, nil, 0, nil, nil);
	lp_Buff := AllocMem(li_Len + 1);
	try
		WideCharToMultiByte(CP_UTF7, 0, PWideChar(sSrc), -1, lp_Buff, li_Len, nil, nil);
		Result := AnsiString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;

function TMyLabel.F_AnsiToWide(sSrc: AnsiString): WideString;
//UTF-7でエンコードされている文字列をWideStringにして返す
var
	li_Len:  Integer;
	lp_Buff: PWideChar;
begin
	li_Len  := MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, nil, 0);
	lp_Buff := AllocMem((li_Len + 1) * 2);
	try
		MultiByteToWideChar(CP_UTF7, 0, PAnsiChar(sSrc), -1, lp_Buff, li_Len);
		Result := WideString(lp_Buff);
	finally
		FreeMem(lp_Buff);
	end;
end;

function TMyLabel.GetText: WideString;
//AnsiStringに可逆変換したTLabelのCaptionをWideStringに戻して返す。
begin
	Result := F_AnsiToWide(inherited Caption);
end;
procedure TMyLabel.SetText(sText: WideString);
//TLabelのCaptionにWideStringを可逆変換関数でAnsiStringにしてセット。
begin
	inherited Caption := F_WideToAnsi(sText);
end;

procedure TMyLabel.F_SetBorderStyle(bsStyle: TBorderStyle);
begin
	F_bsBorderStyle := bsStyle;
	Paint;
end;
procedure TMyLabel.F_SetDisabledStyle(bFlag: Boolean);
begin
	F_bDisabledStyle := bFlag;
	Paint;
end;
procedure TMyLabel.F_SetEndEllipsis(bFlag: Boolean);
begin
	F_bEndEllipsis := bFlag;
	Paint;
end;
procedure TMyLabel.F_SetSingleLine(bFlag: Boolean);
begin
	F_bSingleLine := bFlag;
	Paint;
end;
procedure TMyLabel.F_SetTextShadow(bFlag: Boolean);
begin
	F_bTextShadow := bFlag;
	Paint;
	Invalidate;
end;
procedure TMyLabel.F_SetLeftMargin(iLeft: Integer);
begin
	F_iLeftMargin := iLeft;
	Paint;
end;
procedure TMyLabel.F_SetRightMargin(iRight: Integer);
begin
	F_iRightMargin := iRight;
	Paint;
end;
procedure TMyLabel.F_SetTopMargin(iTop: Integer);
begin
	F_iTopMargin := iTop;
	Paint;
end;
procedure TMyLabel.F_SetBottomMargin(iBottom: Integer);
begin
	F_iBottomMargin := iBottom;
	Paint;
end;

procedure TMyLabel.DoDrawText(var Rect: TRect; Flags: Longint);
//Unicode表示。
//オリジナルのDrawTextをDrawTextWに変えた。
//2009-03-03:ボーダーラインを描くとレイアウトがうまくいっていなかった不具合を修正
const
	lci_SHADOW = $20;
var
	ls_Text:   WideString;
	lcl_Color: TColor;
	li_Red, li_Green, li_Blue: Integer;
begin
	ls_Text := F_AnsiToWide(GetLabelText);
	if  (Flags and DT_CALCRECT <> 0)
	and ((ls_Text = '') or ShowAccelChar and (Text[1] = '&') and (Text[2] = #0))
	then begin
		ls_Text := ls_Text + ' ';
	end;

	if not(ShowAccelChar) then Flags := Flags or DT_NOPREFIX;

	if (F_bSingleLine) then begin
		Flags := Flags or DT_SINGLELINE;
	end else begin
		if ((Flags and DT_SINGLELINE) <> 0) then begin
			Flags := Flags - DT_SINGLELINE;
		end;
	end;

	if (F_bEndEllipsis) then begin
		Flags := Flags or DT_END_ELLIPSIS;
	end else begin
		if ((Flags and DT_END_ELLIPSIS) <> 0) then begin
			Flags := Flags - DT_END_ELLIPSIS;
		end;
	end;

	Flags := DrawTextBiDiModeFlags(Flags);
	Canvas.Font := Font;

	if (Enabled = False) and (F_bDisabledStyle = True) then begin
		OffsetRect(Rect, 1, 1);
		Canvas.Font.Color := clBtnHighlight;
		DrawTextW(Canvas.Handle, PWideChar(ls_Text), Length(ls_Text), Rect, Flags);
		OffsetRect(Rect, -1, -1);
		Canvas.Font.Color := clBtnShadow;
		DrawTextW(Canvas.Handle, PWideChar(ls_Text), Length(ls_Text), Rect, Flags);
	end else begin
		if ((Flags and DT_CALCRECT) = 0) then begin
			Inc(Rect.Left,   F_iLeftMargin);
			Inc(Rect.Top,    F_iTopMargin);
			Dec(Rect.Right,  F_iRightMargin);
			Dec(Rect.Bottom, F_iBottomMargin);
			if (F_bsBorderStyle = bsSingle) then begin
				//枠を描画するのでその分を調整
				Inc(Rect.Left);
				Inc(Rect.Top);
				Dec(Rect.Right);
				Dec(Rect.Bottom);
			end;
			//影つき
			if (F_bTextShadow) then begin
				OffsetRect(Rect, 1, 1);
				lcl_Color := Canvas.Font.Color;
				li_Blue  := gfniNumLimit( lcl_Color shr 16          - lci_SHADOW, 0, $FFFFFF) shl 16;
				li_Green := gfniNumLimit((lcl_Color shr 8) mod $100 - lci_SHADOW, 0, $FFFFFF) shl  8;
				li_Red   := gfniNumLimit( lcl_Color        mod $100 - lci_SHADOW, 0, $FFFFFF);
//				Canvas.Font.Color := gfniNumLimit(lcl_Color - $606060, 0, $FFFFFF);
				Canvas.Font.Color := li_Blue + li_Green + li_Red;
				DrawTextW(Canvas.Handle, PWideChar(ls_Text), Length(ls_Text), Rect, Flags);
				Canvas.Font.Color := lcl_Color;
				OffsetRect(Rect, -1, -1);
			end;
		end;
		DrawTextW(Canvas.Handle, PWideChar(ls_Text), Length(ls_Text), Rect, Flags);

		if ((Flags and DT_CALCRECT) <> 0) then begin
{
			//計算するだけ
			Dec(Rect.Left,   F_iLeftMargin);
			Dec(Rect.Top,    F_iTopMargin);
			Inc(Rect.Right,  F_iRightMargin);
			Inc(Rect.Bottom, F_iBottomMargin);
			if (F_bsBorderStyle = bsSingle) then begin
				//枠を描画するのでその分を調整
				Dec(Rect.Left);
				Dec(Rect.Top);
				Inc(Rect.Right);
				Inc(Rect.Bottom);
			end;
}
			Inc(Rect.Right,  F_iLeftMargin + F_iRightMargin);
			Inc(Rect.Bottom, F_iTopMargin  + F_iBottomMargin);
			if (F_bsBorderStyle = bsSingle) then begin
				//枠を描画するのでその分を調整
				Inc(Rect.Right,  2);
				Inc(Rect.Bottom, 2);
			end;
		end;
	end;

	//枠の描画
	if ((Flags and DT_CALCRECT) = 0) and (F_bsBorderStyle = bsSingle) then begin
		with Self do begin
			Canvas.Pen.Color := clBtnShadow;
			Canvas.MoveTo(0,        0);
			Canvas.LineTo(Width -1, 0);
			Canvas.LineTo(Width -1, Height -1);
			Canvas.LineTo(0,        Height -1);
			Canvas.LineTo(0,        0);
		end;
	end;
end;

//------------------------------------------------------------------------------
procedure Register;
begin
	RegisterComponents('Samples', [TMyLabel]);
end;

end.