有没有具有阴影和立体功能的标签?
解决方案 »
- 大哥,帮帮我呀!
- 请问:怎么从一个表中随机抽取其中的若干条记录,如40条,不能重复。用sql!谢谢。急!
- 如何在运行期间拖动 label 、edit 以及 memo?
- 继承来的AdoQuery对象如何重载某个事件,如AfterInsert
- 如何在程序中修改Access的密码!!(请帮帮忙)!!
- csdn好心人真多,无奈我太菜,现在又遇到了问题,关于运行期间如何创建表的
- 如何用image读ico文件?
- 请问分页控件是什么名字,假如我需要分5页,这个5怎么设置?谢谢!!!
- delphi程序员大调查!!!!!
- 关于TChart的一些问题
- 哪里有显示串口的状态的控件?
- 开心放分,我参加的"互联网上网服务营业场所计算机经营管理系统"通过了中国软件测试中心的评测
按住shift键,加上,上,下,左右键,轻轻的移动就是你要的效果。
http://www.playicq.com/dispdocnew.php?t=&id=2083
我这里有代码,你参考参考!
unit mylabel;interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;type
TtdLabel = class(TLabel)
private
{ Private declarations }
procedure Draw3dText(R: TRect);
protected
{ Protected declarations }
procedure paint; override;
public
{ Public declarations }
published
{ Published declarations } end;
procedure Register;implementationprocedure Ttdlabel.Draw3dText(R: trect);
var
CaptionStz : array[0..255] of Char;
TempRct : TRect;
Flags : word;
begin
with Canvas do begin
StrPCopy(CaptionStz, Caption);
if WordWrap then
Flags := dt_WordBreak;
Font := Self.Font;
TempRct := R;
OffsetRect(TempRct, 1, 1);
Font.Color := clBtnShadow;
DrawText(Handle, CaptionStz, -1, TempRct, Flags);
TempRct := R;
OffsetRect(TempRct, -1, -1);
Canvas.Font.Color := clBtnHighLight;
DrawText(Handle, CaptionStz, -1, TempRct, Flags);
Font.Color := Self.Font.Color;
if not Enabled then
Font.Color := clGrayText;
DrawText(Handle, CaptionStz, -1, R, Flags); end;
end;procedure ttdlabel.paint;
begin
with Canvas do begin
if not Transparent then begin
Brush.Color := Self.Color;
Brush.Style := bsSolid;
FillRect(ClientRect); end;
Brush.Style := bsClear;
Draw3DText(ClientRect); end;
end;procedure Register;
begin
RegisterComponents('Additional', [TtdLabel]);
end;
end.
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;type
TTextStyle = ( tsNone, tsRaised, tsLowered ); TLabel3D = class(TLabel)
private
FTextStyle: TTextStyle;
FBevel: Integer;
procedure DrawLabel3D(var TextRect: TRect; SpecialFlags: Word);
protected
procedure Paint; override;
procedure SetTextStyle( Value : TTextStyle );
procedure SetBevel( Value: Integer);
public
constructor Create(AOwner: TComponent); override;
published
{ Style of the 3-D label }
property TextStyle: TTextStyle read FTextStyle write SetTextStyle
default tsRaised;
property Bevel: Integer read FBevel write SetBevel default 1;
end; procedure Register;implementation
{ TLabel3D }
{ Override the constructor to initialize variables }
constructor TLabel3D.Create(AOwner: TComponent);
begin
{ Inherit original constructor }
inherited Create(AOwner);
{ Add new initializations }
FTextStyle := tsRaised;
FBevel := 1;
end;{ Set the 3-D style of the label }
procedure TLabel3D.SetTextStyle( Value : TTextStyle );
begin
if Value <> FTextStyle then
begin
FTextStyle := Value;
Invalidate;
end;
end;procedure TLabel3D.SetBevel( Value : Integer);
begin
if(Value<>FBevel) and (Value>0) then
begin
FBevel := Value;
Invalidate;
end;
end;{ Draw the text and the 3-D bevel }
procedure TLabel3D.DrawLabel3D( var TextRect : TRect; SpecialFlags : Word );
var
Text : array[ 0..255 ] of Char;
WorkRect : TRect;
TopColor : TColor;
BottomColor : TColor;
tmpCount : Integer;
begin
{ Copy the text to a buffer }
GetTextBuf(Text, SizeOf(Text)); { Process special characters }
if (SpecialFlags and DT_CALCRECT <> 0) and
((Text[0] = #0) or ShowAccelChar and
(Text[0] = '&') and
(Text[1] = #0)) then
StrCopy(Text, ' '); if not ShowAccelChar then
SpecialFlags := SpecialFlags or DT_NOPREFIX; { Set the font }
Canvas.Font := Font; { Set highlight and shadow colors }
TopColor := clBtnHighlight;
BottomColor := clBtnShadow; { If the text style is lowered then reverse the highlight and shadow colors }
if FTextStyle = tsLowered then
begin
TopColor := clBtnShadow;
BottomColor := clBtnHighlight;
end; { If the text style is lowered or raised then draw it with its bevel }
if FTextStyle in [ tsLowered, tsRaised ] then
begin
OffsetRect( TextRect, FBevel, FBevel);
{if (FBevel=1) or (FTextStyle=tsLowered) then}
begin
Canvas.Font.Color := BottomColor;
for tmpCount:=1 to FBevel do
begin
WorkRect := TextRect;
OffsetRect( WorkRect, tmpCount, tmpCount );
DrawText(Canvas.Handle, Text, StrLen(Text), WorkRect, SpecialFlags);
end;
end;
{if (FBevel=1) or (FTextStyle=tsRaised) then}
begin
Canvas.Font.Color := TopColor;
for tmpCount:=-1 downto -FBevel do
begin
WorkRect := TextRect;
OffsetRect( WorkRect, tmpCount, tmpCount);
DrawText(Canvas.Handle, Text, StrLen(Text), WorkRect, SpecialFlags);
end;
end;
end; { Set the actual font color }
Canvas.Font.Color := Font.Color;
{ If it is disabled then set the font color to gray }
if not Enabled then
Canvas.Font.Color := clGrayText;
{ Draw the text }
DrawText(Canvas.Handle, Text, StrLen(Text), TextRect, SpecialFlags);
end;{ Paint 3-D Label }
procedure TLabel3D.Paint;
const
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
Rect: TRect;
begin
with Canvas do
begin
{ If transparent property is off then draw background }
if not Transparent then
begin
{ Set brush color and style then paint the background }
Brush.Color := Self.Color;
Brush.Style := bsSolid;
FillRect(ClientRect);
end; { Set the brush style and text rectangle coordinates then paint the text }
Brush.Style := bsClear;
Rect := ClientRect;
DrawLabel3D(Rect, (DT_EXPANDTABS or DT_WORDBREAK ) or
Alignments[Alignment]);
end;
end;{ ----------------------------------------------------------------------------}{ Register the components }
procedure Register;
begin
RegisterComponents('Standard', [TLabel3D]);
end;end.