gfvcl.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

{ ----------------------------------------------------------------------------}
{ A Gradient Fill component for Delphi.                                       }
{ Copyright 1995, Curtis White.  All Rights Reserved.                         }
{ This component can be freely used and distributed in commercial and private }
{ environments, provied this notice is not modified in any way.               }
{ ----------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions  }
{ at [e-mail]                                                      }
{ ----------------------------------------------------------------------------}
{ Date last modified:  05/05/95                                               }
{ ----------------------------------------------------------------------------}
{ ----------------------------------------------------------------------------}
{ TGradientFill v1.00                                                         }
{ ----------------------------------------------------------------------------}
{ Description:                                                                }
{   A graphic control that displays a gradient beginning with a chosen color  }
{   and ending with another chosen color.                                     }
{ Features:                                                                   }
{   The begin and end colors can be any colors.                               }
{   The fill direction can be set to Top-To-Bottom, Bottom-To-Top,            }
{     Right-To-Left, or Left-To-Right.                                        }
{   The number of colors, between 1 and 255 can be set for the fill.          }
{ ----------------------------------------------------------------------------}
{ ----------------------------------------------------------------------------}
{ Revision History:                                                           }
{ 1.00:  Initial release                                                    }
{ ----------------------------------------------------------------------------}

unit Gfvcl;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Menus,
  Forms, Dialogs, ExtCtrls;

type
  { Direction of fill }
  TFillDirection = (fdTopToBottom, fdBottomToTop, fdLeftToRight, fdRightToLeft);
  { Range of valid colors }
  TNumberOfColors = 1..255;

  TGradientFill = class(TGraphicControl)
  private
    { Variables for properties }
    FDirection: TFillDirection;
    FBeginColor: TColor;
    FEndColor: TColor;
    FCenter: Boolean;
    FAutoSize: Boolean;
    FNumberOfColors: TNumberOfColors;

    { Procedures for setting property values }
    procedure SetFillDirection(Value: TFillDirection);
    procedure SetAutoSize(Value: Boolean);
    procedure SetBeginColor(Value: TColor);
    procedure SetEndColor(Value: TColor);
    procedure SetNumberOfColors(Value: TNumberOfColors);

    { Fill procedure }
    procedure GradientFill;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    { Repaint when autosized }
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    { Starting color of fill }
    property BeginColor: TColor read FBeginColor write SetBeginColor
        default clBlue;
    { Ending color of fill }
    property EndColor: TColor read FEndColor write SetEndColor default clBlack;
    { Direction of fill }
    property FillDirection: TFillDirection read FDirection
        write SetFillDirection default fdTopToBottom;
    { Number of colors to use in the fill (1 - 256) - default is 16.  If 1 }
    { then it uses the Begin Color.                                        }
    property NumberOfColors: TNumberOfColors read FNumberOfColors
        write SetNumberOfColors default 16;
    { Enable standard properties }
    property Align;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

{ TGradientFill }

{ Override the constructor to initialize variables }
constructor TGradientFill.Create(AOwner: TComponent);
begin
  { Inherit original constructor }
  inherited Create(AOwner);
  { Add new initializations }
  Height := 105;
  Width := 105;
  FBeginColor := clBlue;
  FEndColor := clBlack;
  FDirection := fdTopToBottom;
  FNumberOfColors := 16;
end;

{ Set begin color when property is changed }
procedure TGradientFill.SetBeginColor(Value: TColor);
begin
  FBeginColor := Value;
  GradientFill;
  Invalidate;
end;

{ Set end color when property is changed }
procedure TGradientFill.SetEndColor(Value: TColor);
begin
  FEndColor := Value;
  GradientFill;
  Invalidate;
end;

{ Repaint the screen upon a resize }
procedure TGradientFill.SetAutoSize(Value: Boolean);
begin
  FAutoSize := Value;
  Invalidate;
end;

{ Set the number of colors to be used in the fill }
procedure TGradientFill.SetNumberOfColors(Value: TNumberOfColors);
begin
  FNumberOfColors := Value;
  Invalidate;
end;

{ Perform the fill when paint is called }
procedure TGradientFill.Paint;
begin
  GradientFill;
end;

{ Gradient fill procedure - the actual routine }
procedure TGradientFill.GradientFill;
var
  { Set up working variables }
  BeginRGBValue  : array[0..2] of Byte;    { Begin RGB values }
  RGBDifference  : array[0..2] of integer; { Difference between begin and end }
                                           { RGB values                       }
  ColorBand : TRect;    { Color band rectangular coordinates }
  I         : Integer;  { Color band index }
  R         : Byte;     { Color band Red value }
  G         : Byte;     { Color band Green value }
  B         : Byte;     { Color band Blue value }
  WorkBmp   : TBitmap;  { Off screen working bitmap }
begin
{ Create the working bitmap and set its width and height }
WorkBmp := TBitmap.Create;
WorkBmp.Width := Width;
WorkBmp.Height := Height;

{ Use working bitmap to draw the gradient }
with WorkBmp do
begin
  { Extract the begin RGB values }
  case FDirection of

    { If direction is set to TopToBottom or LeftToRight }
    fdTopToBottom, fdLeftToRight:
      begin
        { Set the Red, Green and Blue colors }
        BeginRGBValue[0] := GetRValue (ColorToRGB (FBeginColor));
        BeginRGBValue[1] := GetGValue (ColorToRGB (FBeginColor));
        BeginRGBValue[2] := GetBValue (ColorToRGB (FBeginColor));
        { Calculate the difference between begin and end RGB values }
        RGBDifference[0] := GetRValue (ColorToRGB (FEndColor)) -
                            BeginRGBValue[0];
        RGBDifference[1] := GetGValue (ColorToRGB (FEndColor)) -
                            BeginRGBValue[1];
        RGBDifference[2] := GetBValue (ColorToRGB (FEndColor)) -
                            BeginRGBValue[2];
      end;

    { If direction is set to BottomToTop or RightToLeft}
    fdBottomToTop, fdRightToLeft:
      begin
        { Set the Red, Green and Blue colors }
        { Reverse of TopToBottom and LeftToRight directions }
        BeginRGBValue[0] := GetRValue (ColorToRGB (FEndColor));
        BeginRGBValue[1] := GetGValue (ColorToRGB (FEndColor));
        BeginRGBValue[2] := GetBValue (ColorToRGB (FEndColor));
        { Calculate the difference between begin and end RGB values }
        { Reverse of TopToBottom and LeftToRight directions }
        RGBDifference[0] := GetRValue (ColorToRGB (FBeginColor)) -
                            BeginRGBValue[0];
        RGBDifference[1] := GetGValue (ColorToRGB (FBeginColor)) -
                            BeginRGBValue[1];
        RGBDifference[2] := GetBValue (ColorToRGB (FBeginColor)) -
                            BeginRGBValue[2];
      end;
  end;

  { Set the pen style and mode }
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Mode := pmCopy;

  case FDirection of

    { Calculate the color band's top and bottom coordinates }
    { for TopToBottom and BottomToTop fills }
    fdTopToBottom, fdBottomToTop:
      begin
        ColorBand.Left := 0;
        ColorBand.Right := Width;
      end;

    { Calculate the color band's left and right coordinates }
    { for LeftToRight and RightToLeft fills }
    fdLeftToRight, fdRightToLeft:
      begin
        ColorBand.Top := 0;
        ColorBand.Bottom := Height;
      end;
  end;

  { Perform the fill }
  for I := 0 to FNumberOfColors do
    begin
    case FDirection of

      { Calculate the color band's top and bottom coordinates }
      fdTopToBottom, fdBottomToTop:
        begin
          ColorBand.Top    := MulDiv (I    , Height, FNumberOfColors);
          ColorBand.Bottom := MulDiv (I + 1, Height, FNumberOfColors);
        end;

      { Calculate the color band's left and right coordinates }
      fdLeftToRight, fdRightToLeft:
        begin
          ColorBand.Left    := MulDiv (I    , Width, FNumberOfColors);
          ColorBand.Right := MulDiv (I + 1, Width, FNumberOfColors);
        end;
    end;

    { Calculate the color band's color }
    if FNumberOfColors > 1 then
    begin
      R := BeginRGBValue[0] + MulDiv (I, RGBDifference[0], FNumberOfColors - 1);
      G := BeginRGBValue[1] + MulDiv (I, RGBDifference[1], FNumberOfColors - 1);
      B := BeginRGBValue[2] + MulDiv (I, RGBDifference[2], FNumberOfColors - 1);
    end
    else
    { Set to the Begin Color if set to only one color }
    begin
      R := BeginRGBValue[0];
      G := BeginRGBValue[1];
      B := BeginRGBValue[2];
    end;

    { Select the brush and paint the color band }
    Canvas.Brush.Color := RGB (R, G, B);
    Canvas.FillRect (ColorBand);
    end;
  end;

  { Copy the working bitmap to the main canvas }
  Canvas.Draw(0, 0, WorkBmp);

  { Release the working bitmap resources }
  WorkBmp.Free;
end;

{ Set the fill direction }
procedure TGradientFill.SetFillDirection(Value: TFillDirection);
begin
  if Value <> FDirection then
  begin
    FDirection := Value;
    GradientFill;
    Invalidate;
  end;
end;

{ Register the component }
procedure Register;
begin
  RegisterComponents('Custom', [TGradientFill]);
end;

end.