Delphi控件源码

开发平台：
C++ Builder

am2000title.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       T_AM2000_Title                                  }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000title;
{$I am2000.inc}
interface
uses
  Windows, Classes, Graphics;
type
  // menu title alignment
  T_AM2000_TitleAlign = (atLeft, atRight);
  // New property by Erick I. Jimenez Alvarado -- many thanks!
  T_AM2000_GradientDirection = (gdTopToBottom, gdLeftToRight,
    gdBottomToTop, gdRightToLeft, gdInsideOut, gdOutsideIn,
    gdDualVertical, gdDualHorizontal);
  // menu title
  T_AM2000_Title = class(TPersistent)
  private
    FAlign           : T_AM2000_TitleAlign;
    FAlignment       : TAlignment;
    FText            : String;
    FFont            : TFont;
    FColorBegin      : TColor;
    FColorEnd        : TColor;
    FWidth           : Integer;
    FDirection       : Boolean;
    FVisible         : Boolean;
    FBitmap          : TBitmap;
    FGradientDirection : T_AM2000_GradientDirection;
    procedure SetFont(Value: TFont);
    procedure SetBitmap(Value: TBitmap);
    function IsBitmapStored: Boolean;
    function IsFontStored: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Paint(Canvas: TCanvas);
    function TextAlign(Width, TextWidth: Integer): Integer;
    procedure Assign(Source: TPersistent); override;
    function IsDefault: Boolean;
  published
    property Align      : T_AM2000_TitleAlign
      read FAlign write FAlign default atLeft;
    property Alignment  : TAlignment
      read FAlignment write FAlignment default taLeftJustify;
    property Text       : String
      read FText write FText;
    property Font       : TFont
      read FFont write SetFont stored IsFontStored;
    property ColorBegin : TColor
      read FColorBegin write FColorBegin default clBlue;
    property ColorEnd   : TColor
      read FColorEnd write FColorEnd default clBlack;
    property Width      : Integer
      read FWidth write FWidth default 50;
    property TextDirection : Boolean
      read FDirection write FDirection default True;
    property Visible    : Boolean
      read FVisible write FVisible default False;
    property Bitmap     : TBitmap
      read FBitmap write SetBitmap stored IsBitmapStored;
    property GradientDirection : T_AM2000_GradientDirection
      read FGradientDirection write FGradientDirection default gdTopToBottom;
  end;
implementation
uses
  SysUtils;
{ T_AM2000_Title }
constructor T_AM2000_Title.Create;
begin
  inherited Create;
  FAlign:=      atLeft;
  FColorBegin:= clBlue;
  FColorEnd:=   clBlack;
  FDirection:=  True;
  FWidth:=      50;
  FFont:= TFont.Create;
  FFont.Name:= 'Arial';
  FFont.Size:=  24;
  FFont.Style:= [fsBold];
  FFont.Color:= clWhite;
  FBitmap:= TBitmap.Create;
end;
destructor T_AM2000_Title.Destroy;
begin
  FFont.Free;
  FBitmap.Free;
  
  inherited;
end;
function T_AM2000_Title.IsBitmapStored: Boolean;
begin
  Result:= not FBitmap.Empty;
end;
function T_AM2000_Title.IsFontStored: Boolean;
begin
  Result:= (Font.Name <> 'Arial')
    or (Font.Size <> 24)
    or (Font.Style <> [fsBold])
    or (Font.Color <> clWhite)
{$IFDEF Delphi3OrHigher}     
    or (Font.CharSet <> Default_Charset)
{$ENDIF}
    ;
end;
procedure T_AM2000_Title.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;
procedure T_AM2000_Title.SetBitmap(Value: TBitmap);
begin
  FBitmap.Assign(Value);
end;
function T_AM2000_Title.TextAlign(Width, TextWidth: Integer): Integer;
begin
  Result:= 0;
  case FAlignment of
    taLeftJustify:  Result:= Width -10;
    taCenter:       Result:= (Width + TextWidth ) shr 1 +10;
    taRightJustify: Result:= TextWidth +30;
  end;
end;
procedure T_AM2000_Title.Paint(Canvas: TCanvas);
var
  R: TRect;
  Bmp: TBitmap;
  lf: TLogFont;
  hfnt, holdfnt: HFont;
  X, Y, W, H, C1, C2, R1, G1, B1, Temp: Integer;
  DR, DG, DB, DH, DH2: Real;
  procedure InitRGBValues(C1, C2: Integer);
  var
    D: Integer;
  begin
    if FGradientDirection in [gdDualHorizontal, gdDualVertical]
    then D:= 127
    else D:= 256;
    R1:= GetRValue(C1);
    G1:= GetGValue(C1);
    B1:= GetBValue(C1);
    DR:= (GetRValue(C2) - R1 +1) / D;
    DG:= (GetGValue(C2) - G1 +1) / D;
    DB:= (GetBValue(C2) - B1 +1) / D;
  end;
begin
  if not FVisible then Exit;
  with Canvas.ClipRect do
    case FAlign of
      atLeft:   R:= Rect(2, 2, Width +2, Bottom -2);
      atRight:  R:= Rect(Right - Width -2, 2, Right -2, Bottom -2);
    end;
  Bmp:= TBitmap.Create;
  Bmp.Width:= R.Right - R.Left;
  Bmp.Height:= R.Bottom - R.Top;
  with Bmp.Canvas do begin
    // fill bitmap with FColorBegin and FColorEnd
    Brush.Style:= bsSolid;
    if FColorBegin <> FColorEnd then begin
      C1:= ColorToRgb(FColorEnd);
      C2:= ColorToRgb(FColorBegin);
      // swap colors
      if (FGradientDirection in [gdBottomToTop, gdRightToLeft, gdOutsideIn]) then begin
        Temp:= C1; C1:= C2; C2:= Temp;
      end;
      // calculate
      InitRGBValues(C1, C2);
      // draw
      case FGradientDirection of
        gdTopToBottom, gdBottomToTop, gdDualHorizontal:
          begin
            DH:= Bmp.Height/256;
            Y:= Bmp.Width;
            for X:= 0 to 255 do begin
              Brush.Color:= Rgb(R1 + Round(DR*X), G1 + Round(DG*X), B1 + Round(DB*X));
              FillRect(Rect(0, Round(X*DH), Y, Round((X+1)*DH)));
              if (FGradientDirection = gdDualHorizontal)
              and (X = 127)
              then InitRGBValues(C2, C1);
            end;
          end;
        gdLeftToRight, gdRightToLeft, gdDualVertical:
          begin
            DH:= Bmp.Width/256;
            Y:= Bmp.Height;
            for X:= 0 to 255 do begin
              Brush.Color:= Rgb(R1 + Round(DR*X), G1 + Round(DG*X), B1 + Round(DB*X));
              FillRect(Rect(Round(X*DH),0, Round((X +1)*DH), Y));
              if (FGradientDirection = gdDualVertical)
              and (X = 127)
              then InitRGBValues(C2, C1);
            end;
          end;
        gdInsideOut, gdOutsideIn:
          begin
            DH:= Bmp.Width/256;
            DH2:= Bmp.Height/256;
            Y:= 0;
            for X:= 0 to 127 do begin
              Brush.Color:= Rgb(R1 + Round(DR*Y), G1 + Round(DG*Y), B1 + Round(DB*Y));
              Inc(Y, 2);
              FillRect(Rect(Round(X*DH), Round(X*DH2), Round((255 - X)* DH ), Round((255 - X)* DH2)));
            end;
          end;
      end;
    end
    else begin
      // solid color
      Brush.Color:= FColorBegin;
      FillRect(ClipRect);
    end;
    if not FBitmap.Empty then begin
      // draw bitmap
      X:= (Bmp.Width - FBitmap.Width) shr 1;
      Y:= 0;
      case FAlignment of
        taLeftJustify:  Y:= Bmp.Height - FBitmap.Height;
        taRightJustify: Y:= 0;
        taCenter:       Y:= (Bmp.Height - FBitmap.Height) shr 1;
      end;
      BitBlt(Bmp.Canvas.Handle, X, Y, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SrcCopy);
    end;
    if FText <> '' then begin
      // calculate text bounds
      Font:= Self.Font;
      W:= TextWidth(FText);
      H:= TextHeight(FText);
      // initialize TLogFont structure
      FillChar(lf, SizeOf(lf), 0);
      StrPCopy(lf.lfFaceName, Font.Name);
{$IFDEF Delphi3OrHigher}
      lf.lfCharSet:= Font.Charset;
{$ELSE}
      lf.lfCharSet:= Default_Charset;
{$ENDIF}
      lf.lfHeight:= Font.Height;
      if fsBold in Font.Style
      then lf.lfWeight:= fw_Bold
      else lf.lfWeight:= fw_Normal;
      lf.lfItalic:=    Integer(fsItalic    in Font.Style);
      lf.lfUnderline:= Integer(fsUnderline in Font.Style);
      lf.lfStrikeOut:= Integer(fsStrikeout in Font.Style);
      if FDirection
      then begin lf.lfEscapement:=  900;  X:= (Bmp.Width - H) shr 1 -2;  Y:= TextAlign(Bmp.Height, W); end
      else begin lf.lfEscapement:= 2700;  X:= (Bmp.Width + H) shr 1 +2;  Y:= Bmp.Height - TextAlign(Bmp.Height, W); end;
      hfnt:= CreateFontIndirect(lf);
      holdfnt:= SelectObject(Handle, hfnt);
      SetTextColor(Handle, ColorToRgb(Self.Font.Color));
      SetBkMode(Handle, Transparent);
      TextOut(X, Y, FText);
      SelectObject(Handle, holdfnt);
      DeleteObject(hfnt);
    end;
  end;
  BitBlt(Canvas.Handle, R.Left, R.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SrcCopy);
  Bmp.Free;
end;
procedure T_AM2000_Title.Assign(Source: TPersistent);
var
  Src: T_AM2000_Title;
begin
  if Source is T_AM2000_Title then begin
    Src:= T_AM2000_Title(Source);
    Align:=      Src.Align;
    Alignment:=  Src.Alignment;
    Text:=       Src.Text;
    ColorBegin:= Src.ColorBegin;
    ColorEnd:=   Src.ColorEnd;
    Width:=      Src.Width;
    FDirection:=  Src.FDirection;
    FGradientDirection:=  Src.FGradientDirection;
    Visible:=    Src.Visible;
    Font.Assign(Src.Font);
    Bitmap.Assign(Src.Bitmap);
  end
  else
    inherited;
end;
function T_AM2000_Title.IsDefault: Boolean;
begin
  Result:=
    (Align = atLeft) and
    (Alignment = taLeftJustify) and
    (Text = '') and
    (ColorBegin = clBlue) and
    (ColorEnd = clBlack) and
    (Width = 50) and
    (TextDirection) and
    (not Visible) and
    (Bitmap.Empty) and
    (GradientDirection = gdTopToBottom);
end;
end.

						