unit effect; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs ,stdCtrls; type TTextEffect = ( teNone, te3Dup, te3DDown, teShadow, teOutline ); TEffect = class(TCustomLabel) private { Private declarations } FColorStart: TColor; FColorEnd: TColor; FTextEffect: TTextEffect; FTextEffectColor: TColor; Pal:array[0..255] of TColor; procedure SetColorStart ( color:TColor); procedure SetColorEnd ( color:TColor); procedure SetTextEffect ( e:TTextEffect); procedure SetTextEffectColor ( color:TColor); procedure DrawBackGround; procedure DrawTextEffect; procedure DrawEffect; procedure SetPalette (sc,ec: TColor); // start color ,end color protected { Protected declarations } public { Public declarations } procedure Paint; override; procedure SetAutoSize(Value:Boolean); override; constructor Create(AOwner: TComponent); override; published { Published declarations } property TextEffect: TTextEffect read FTextEffect write SetTextEffect default teNone; property TextEffectColor: TColor read FTextEffectColor write SetTextEffectColor default clBlack; property ColorStart: TColor read FColorStart write SetColorStart default clRed; property ColorEnd: TColor read FColorEnd write SetColorEnd default clBlack; // Events property Align; property Alignment; property AutoSize; property Caption; property Color; property DragCursor; property DragMode; property Enabled; property FocusControl; property Font; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowAccelChar; property ShowHint; property Transparent; property Visible; property WordWrap; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; end; procedure Register; implementation procedure Register; begin RegisterComponents('Samples', [TEffect]); end; constructor TEffect.Create(AOwner: TComponent); begin inherited Create(AOwner); FTextEffect:= teNone; FTextEffectColor:= clBlack; FColorStart:= clRed; FColorEnd:= clBlack; SetPalette (FColorStart, FColorEnd); end; procedure TEffect.SetTextEffect ( e:TTextEffect); begin FTextEffect:= e; Invalidate; end; procedure TEffect.SetTextEffectColor ( color:TColor); begin FTextEffectColor:= color; Invalidate; end; procedure TEffect.SetColorStart ( color:TColor); begin FColorStart:= color; SetPalette (FColorStart, FColorEnd); Invalidate; end; procedure TEffect.SetColorEnd ( color:TColor); begin FColorEnd:= color; SetPalette (FColorStart, FColorEnd); Invalidate; end; procedure TEffect.SetAutoSize(Value:Boolean); begin inherited SetAutoSize(Value); width:= width + 2; height:= height + 2; Invalidate; end; procedure TEffect.Paint; begin { Draw BackGround } DrawBackGround; { Draw TextEffect } DrawTextEffect; { Draw Shade Object} DrawEffect; end; procedure TEffect.DrawBackGround; begin if not transparent then begin canvas.brush.color:= color; canvas.pen.style := psClear; canvas.rectangle (0,0, width, height); end; end; procedure TEffect.DrawTextEffect; begin canvas.brush.Style:= BsClear; canvas.font:= font; case TextEffect of te3dup: begin { Draw 3D Effect Up } canvas.font.color:= clWhite; canvas.Textout (0,0,Caption); canvas.Textout (0,1,Caption); canvas.font.color:= clBlack; canvas.Textout (2,1,Caption); canvas.Textout (2,2,Caption); end; te3dDown: begin { Draw 3D Effect Up } canvas.font.color:= clBlack; canvas.Textout (0,0,Caption); canvas.Textout (0,1,Caption); canvas.font.color:= clWhite; canvas.Textout (2,1,Caption); canvas.Textout (2,2,Caption); end; teShadow: begin { Draw Shadow } canvas.font.color:= FTextEffectColor; canvas.Textout (2,2,Caption); canvas.Textout (3,3,Caption); end; teOutline: begin { Draw Outline } canvas.font.color:= FTextEffectColor; canvas.Textout (0,0,Caption); canvas.Textout (0,1,Caption); canvas.Textout (0,2,Caption); canvas.Textout (2,0,Caption); canvas.Textout (2,1,Caption); canvas.Textout (2,2,Caption); end; end; end; procedure TEffect.DrawEffect; var S,M:TBitmap; str:String; r,r2:TRect; i:integer; begin str:=Caption; S:=TBitmap.Create; S.Width:= width; S.height:= height; for i:=1 to s.height do begin S.canvas.Pen.Color:= pal [round (i/s.height * 255)]; S.Canvas.MoveTo (0,i); S.Canvas.LineTo (s.width,i); end; //S.assign (Image1.Picture.Bitmap); M:=TBitmap.Create; M.canvas.Font:= font; M.width:= width; M.height:= height; M.canvas.font.color:= clWhite; M.canvas.brush.color:= clBlack; M.canvas.rectangle (0,0,width,height); M.canvas.Textout (0,0, str); M.canvas.copymode:= cmSrcAnd; r:= Rect (0,0,M.width, M.height); M.canvas.CopyRect ( r, S.Canvas , r); r2:= Rect (1,1,M.width+1, M.height+1); canvas.font := font; canvas.font.color := clBlack; canvas.brush.style:= bsClear; canvas. TextOut (1,1, str); canvas. CopyMode := cmSrcPaint; canvas. CopyRect( r2, M.canvas , r); S.Free; M.Free; end; procedure TEffect.SetPalette (sc,ec: TColor); // start color ,end color var tr,tg,tb, br,bg,bb:dword; i:integer; begin tr:= (ec and $FF); tg:= (ec and $FF00) shr 8; tb:= (ec and $FF0000) shr 16; br:= (sc and $FF); bg:= (sc and $FF00) shr 8; bb:= (sc and $FF0000) shr 16; for i:=0 to 255 do pal[i]:= br + trunc( (tr-br)*(i/255) ) or((bg + trunc( (tg-bg)*(i/255) ))shl 8 ) or((bb + trunc( (tb-bb)*(i/255) ))shl 16 ); end; end.