home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / GRADIENT.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-02  |  5KB  |  187 lines
  1. UNIT Gradient;
  2.  
  3. INTERFACE
  4.  
  5. USES Classes, Forms, Graphics;
  6.  
  7. TYPE
  8.   TDirection = (dLeft, dRight, dUp, dDown);
  9.  
  10.   TGradient = CLASS(TControl)
  11.    PRIVATE
  12.          FDirection  : TDirection;
  13.          FStartColor : TColor;
  14.          FEndColor   : TColor;
  15.          PROCEDURE SetDirection(NewDirection:TDirection);
  16.          PROCEDURE SetStartColor(NewColor:TColor);
  17.          PROCEDURE SetEndColor(NewColor:TColor);
  18.          PROPERTY Caption;
  19.          PROPERTY Font;
  20.          PROPERTY Color;
  21.          PROPERTY PenColor;
  22.          PROPERTY ParentColor;
  23.          PROPERTY ParentPenColor;
  24.          PROPERTY TabStop;
  25.    PROTECTED
  26.          PROCEDURE SetupComponent; OVERRIDE;
  27.    PUBLIC
  28.          PROCEDURE Redraw(CONST rc:TRect); OVERRIDE;
  29.    PUBLISHED
  30.          PROPERTY Align;
  31.          PROPERTY DragCursor;
  32.          PROPERTY DragMode;
  33.          PROPERTY Enabled;
  34.          PROPERTY ParentFont;
  35.          PROPERTY ParentShowHint;
  36.          PROPERTY PopupMenu;
  37.          PROPERTY ShowHint;
  38.          PROPERTY TabOrder;
  39.          PROPERTY Visible;
  40.          PROPERTY ZOrder;
  41.  
  42.          PROPERTY OnCanDrag;
  43.          PROPERTY OnCommand;
  44.          PROPERTY OnDblClick;
  45.          PROPERTY OnDragDrop;
  46.          PROPERTY OnDragOver;
  47.          PROPERTY OnEndDrag;
  48.          PROPERTY OnEnter;
  49.          PROPERTY OnExit;
  50.          PROPERTY OnFontChange;
  51.          PROPERTY OnMouseClick;
  52.          PROPERTY OnMouseDblClick;
  53.          PROPERTY OnMouseDown;
  54.          PROPERTY OnMouseMove;
  55.          PROPERTY OnMouseUp;
  56.          PROPERTY OnResize;
  57.          PROPERTY OnSetupShow;
  58.          PROPERTY OnStartDrag;
  59.          PROPERTY Direction:TDirection read FDirection write SetDirection;
  60.          PROPERTY StartColor:TColor read FStartColor write SetStartColor;
  61.          PROPERTY EndColor:TColor read FEndColor write SetEndColor;
  62.   END;
  63.  
  64. IMPLEMENTATION
  65.  
  66. PROCEDURE TGradient.SetDirection(NewDirection:TDirection);
  67. BEGIN
  68.    FDirection:=NewDirection;
  69.    Invalidate;
  70. END;
  71.  
  72. PROCEDURE TGradient.SetStartColor(NewColor:TColor);
  73. BEGIN
  74.      FStartColor:=NewColor;
  75.      Invalidate;
  76. END;
  77.  
  78. PROCEDURE TGradient.SetEndColor(NewColor:TColor);
  79. BEGIN
  80.      FEndColor:=NewColor;
  81.      Invalidate;
  82. END;
  83.  
  84. PROCEDURE TGradient.SetupComponent;
  85. BEGIN
  86.    Inherited SetUpComponent;
  87.    Name:= 'Gradient';
  88.    FDirection:= dUp;
  89.    FStartColor:=clBlack;
  90.    FEndColor:=clBlue;
  91.    Width:=200;
  92.    Height:=200;
  93.    ZOrder:=zoBottom;
  94.    TabStop:=FALSE;
  95. END;
  96.  
  97. PROCEDURE TGradient.Redraw(CONST rc:TRect);
  98. VAR
  99.     SaveColor:TColor;
  100.     DRed,DGreen,DBlue,DR,DG,DB:Extended;
  101.     StartLoop,EndLoop:LONGINT;
  102.     rec:TRect;
  103.     t,x,y:LONGINT;
  104. BEGIN
  105.      SaveColor:=Canvas.Pen.Color;
  106.      Canvas.ClipRect:=rc;
  107.  
  108.      DRed:=TRGB(FStartColor).Red;
  109.      DGreen:=TRGB(FStartColor).Green;
  110.      DBlue:=TRGB(FStartColor).Blue;
  111.      DR:=TRGB(FEndColor).Red-DRed;
  112.      DG:=TRGB(FEndColor).Green-DGreen;
  113.      DB:=TRGB(FEndColor).Blue-DBlue;
  114.  
  115.      CASE FDirection OF
  116.         dUp,dDown,dLeft,dRight:
  117.         BEGIN
  118.              IF FDirection IN [dUp,dDown] THEN
  119.              BEGIN
  120.                   DR:=DR / Height;
  121.                   DG:=DG / Height;
  122.                   DB:=DB / Height;
  123.              END
  124.              ELSE
  125.              BEGIN
  126.                   DR:=DR / Width;
  127.                   DG:=DG / Width;
  128.                   DB:=DB / Width;
  129.              END;
  130.  
  131.              IF FDirection=dUp THEN
  132.              BEGIN
  133.                   StartLoop:=0;
  134.                   EndLoop:=Height+1;
  135.              END
  136.              ELSE IF FDirection=dDown THEN
  137.              BEGIN
  138.                   StartLoop:=Height+1;
  139.                   EndLoop:=0;
  140.              END
  141.              ELSE IF FDirection=dLeft THEN
  142.              BEGIN
  143.                   StartLoop:=0;
  144.                   EndLoop:=Width+1;
  145.              END
  146.              ELSE
  147.              BEGIN
  148.                   StartLoop:=Width+1;
  149.                   EndLoop:=0;
  150.              END;
  151.  
  152.              WHILE StartLoop<>EndLoop DO
  153.              BEGIN
  154.                   IF FDirection IN [dUp,dDown] THEN
  155.                   BEGIN
  156.                        rec.Left:=0;
  157.                        rec.Right:=Width;
  158.                        rec.Bottom:=StartLoop;
  159.                        rec.Top:=rec.Bottom+1;
  160.                   END
  161.                   ELSE
  162.                   BEGIN
  163.                        rec.Left:=StartLoop;
  164.                        rec.Right:=rec.Left+1;
  165.                        rec.Bottom:=0;
  166.                        rec.Top:=Height;
  167.                   END;
  168.                   Canvas.FillRect(rec,ValuesToRGB(Round(DRed),Round(DGreen),Round(DBlue)));
  169.  
  170.                   DRed:=DRed+DR;
  171.                   DGreen:=DGreen+DG;
  172.                   DBlue:=DBlue+DB;
  173.  
  174.                   IF FDirection IN [dUp,dLeft] THEN inc(StartLoop)
  175.                   ELSE dec(StartLoop);
  176.              END;
  177.         END;
  178.      END; //case
  179.  
  180.      Canvas.Pen.Color:=SaveColor;
  181.      Canvas.DeleteClipRegion;
  182. end;
  183.  
  184. begin
  185.   RegisterClasses([TGradient]);
  186. end.
  187.