home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCExtCtrls.pas < prev    next >
Pascal/Delphi Source File  |  2001-01-20  |  7KB  |  279 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2000 Alex'EM
  7.  
  8. }
  9. unit DCExtCtrls;
  10.  
  11. interface
  12.  
  13. uses Messages, Windows, SysUtils, Classes, Controls, Graphics,
  14.      StdCtrls, DCConst;
  15.  
  16. type
  17.  
  18.   TDCGradientProgress = class(TCustomControl)
  19.   private
  20.     FColor: TColor;
  21.     FBrushColor: TColor;
  22.     FPosition: integer;
  23.     FDirection: integer;
  24.     FGradientBitmap: TBitmap;
  25.     FTimer: boolean;
  26.     FInterval: integer;
  27.     procedure CreateGradientBitmap;
  28.     procedure SetPosition(AValue: integer);
  29.     procedure SetBrushColor(const Value: TColor);
  30.     procedure SetColor(const Value: TColor);
  31.     procedure SetDirection(const Value: integer);
  32.     procedure SetInterval(const Value: integer);
  33.     function GetActive: boolean;
  34.   protected
  35.     procedure CreateParams(var Params: TCreateParams); override;
  36.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  37.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  38.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  39.   public
  40.     procedure Paint; override;
  41.     constructor Create(AComponent: TComponent); override;
  42.     destructor Destroy; override;
  43.     procedure Resume;
  44.     procedure Suspend;
  45.     property Active: boolean read GetActive;
  46.   published
  47.     property Align;
  48.     property Color: TColor read FColor write SetColor;
  49.     property BrushColor: TColor read FBrushColor write SetBrushColor;
  50.     property Direction: integer read FDirection write SetDirection;
  51.     property Interval: integer read FInterval write SetInterval;
  52.     property Position: integer read FPosition write SetPosition;
  53.   end;
  54.  
  55. implementation
  56.  
  57. const
  58.   PRGTIMER_IDEVENT = $200;
  59.  
  60. { TDCGradientProgress }
  61.  
  62. constructor TDCGradientProgress.Create(AComponent: TComponent);
  63. begin
  64.   inherited;
  65.   ControlStyle := [csNoDesignVisible];
  66.  
  67.   Height := 5;
  68.  
  69.   FGradientBitmap := TBitmap.Create;
  70.  
  71.   FColor      := clSelectedLight;
  72.   FBrushColor := clNavy;
  73.   FPosition   := 0;
  74.   FDirection  := 0;
  75.   FTimer      := False;
  76.   FInterval   := 35;
  77. end;
  78.  
  79. procedure TDCGradientProgress.CreateGradientBitmap;
  80.  var
  81.   Red1, Blue1, Green1, Red2,Blue2, Green2: byte;
  82.   Color1, Color2: longint;
  83.   i: integer;
  84.   hWidth: integer;
  85.   gPos: extended;
  86. begin
  87.   if (Width > 0) and (Height > 0) then with FGradientBitmap do
  88.   begin
  89.     Width  := Self.Width;
  90.     Height := Self.Height;
  91.  
  92.     Color1 := ColorToRGB(FBrushColor);
  93.     Color2 := ColorToRGB(FColor);
  94.     Red1   := GetRValue(Color1);
  95.     Green1 := GetGValue(Color1);
  96.     Blue1  := GetBValue(Color1);
  97.     Red2   := GetRValue(Color2);
  98.     Green2 := GetGValue(Color2);
  99.     Blue2  := GetBValue(Color2);
  100.  
  101.     hWidth := (Width div 2);
  102.     for i := 0 to hWidth do
  103.     begin
  104.       gPos := {SQRT}(i / hWidth);
  105.       Canvas.Pen.Color := RGB(Trunc(Red1 + (Red2 - Red1) * gPos),
  106.                               Trunc(Green1 + (Green2 - Green1) * gPos),
  107.                               Trunc(Blue1 + (Blue2 - Blue1) * gPos));
  108.       Canvas.MoveTo(i, 0);
  109.       Canvas.LineTo(i, Height);
  110.     end;
  111.  
  112.     for i := 1 to hWidth do
  113.     begin
  114.       gPos := {SQR}(i / hWidth);
  115.       Canvas.Pen.Color := RGB(Trunc(Red2 + (Red1 - Red2) * gPos),
  116.                               Trunc(Green2 + (Green1 - Green2) * gPos),
  117.                               Trunc(Blue2 + (Blue1 - Blue2) * gPos));
  118.       Canvas.MoveTo(i + hWidth, 0);
  119.       Canvas.LineTo(i + hWidth, Height);
  120.     end;
  121.   end;
  122. end;
  123.  
  124. procedure TDCGradientProgress.CreateParams(var Params: TCreateParams);
  125. begin
  126.   inherited;
  127. end;
  128.  
  129. destructor TDCGradientProgress.Destroy;
  130. begin
  131.   Suspend;
  132.   FGradientBitmap.Free;
  133.   inherited;
  134. end;
  135.  
  136. function TDCGradientProgress.GetActive: boolean;
  137. begin
  138.   Result := FTimer;
  139. end;
  140.  
  141. procedure TDCGradientProgress.Paint;
  142.  var
  143.   i: integer;
  144.   ARect, BRect, CRect: TRect;
  145. begin
  146.   BRect := BoundsRect;
  147.   OffsetRect(BRect, -BRect.Left, -BRect.Top);
  148.  
  149.   if FDirection < 0 then
  150.   begin
  151.     if FPosition = FGradientBitmap.Width then FPosition := 0;
  152.     i := 0;
  153.     ARect := Rect(FPosition, 0, FGradientBitmap.Width, FGradientBitmap.Height);
  154.  
  155.     while (ARect.Right - ARect.Left + i) <= BRect.Right do
  156.     begin
  157.       CRect := ARect;
  158.       OffsetRect(CRect, -CRect.Left + i, -CRect.Top);
  159.  
  160.       Canvas.CopyRect(CRect, FGradientBitmap.Canvas, ARect);
  161.  
  162.       Inc(i, ARect.Right - ARect.Left);
  163.       ARect := Rect(0, 0, FGradientBitmap.Width, FGradientBitmap.Height);
  164.     end;
  165.  
  166.     if (ARect.Right + i) > BRect.Right then ARect.Right := BRect.Right - i;
  167.  
  168.     CRect := ARect;
  169.     OffsetRect(CRect, -CRect.Left + i, -CRect.Top);
  170.  
  171.     Canvas.CopyRect(CRect,  FGradientBitmap.Canvas, ARect);
  172.   end
  173.   else begin
  174.     if FPosition = FGradientBitmap.Width then FPosition := 0;
  175.     ARect := Rect(0, 0, FGradientBitmap.Width - FPosition, FGradientBitmap.Height);
  176.     i := BRect.Right;
  177.     while i >= 0 do
  178.     begin
  179.       Dec(i, ARect.Right - ARect.Left);
  180.  
  181.       CRect := ARect;
  182.       OffsetRect(CRect, -CRect.Left + i, -CRect.Top);
  183.  
  184.       Canvas.CopyRect(CRect, FGradientBitmap.Canvas, ARect);
  185.       ARect := Rect(0, 0, FGradientBitmap.Width, FGradientBitmap.Height);
  186.     end;
  187.  
  188.     if i < 0 then ARect.Left := -i;
  189.     CRect := ARect;
  190.     OffsetRect(CRect, -CRect.Left, -CRect.Top);
  191.  
  192.     Canvas.CopyRect(CRect,  FGradientBitmap.Canvas, ARect);
  193.   end;
  194. end;
  195.  
  196. procedure TDCGradientProgress.Resume;
  197. begin
  198.   if not FTimer then
  199.   begin
  200.     SetTimer(Handle, PRGTIMER_IDEVENT, FInterval, nil);
  201.     FTimer := True;
  202.   end;
  203. end;
  204.  
  205. procedure TDCGradientProgress.SetBrushColor(const Value: TColor);
  206. begin
  207.   FBrushColor := Value;
  208.   CreateGradientBitmap;
  209.   invalidate;
  210. end;
  211.  
  212. procedure TDCGradientProgress.SetColor(const Value: TColor);
  213. begin
  214.   FColor := Value;
  215.   CreateGradientBitmap;
  216.   invalidate;
  217. end;
  218.  
  219. procedure TDCGradientProgress.SetDirection(const Value: integer);
  220.  var
  221.   lActive: boolean;
  222. begin
  223.   if FDirection <> Value then
  224.   begin
  225.     lActive := Active;
  226.     Suspend;
  227.     FPosition  := FGradientBitmap.Width - ((Width + FPosition) mod FGradientBitmap.Width);
  228.     FDirection := Value;
  229.     if lActive then Resume;
  230.   end;
  231. end;
  232.  
  233. procedure TDCGradientProgress.SetInterval(const Value: integer);
  234.  var
  235.   lActive: boolean;
  236. begin
  237.   if FInterval <> Value then
  238.   begin
  239.     lActive := Active;
  240.     Suspend;
  241.     FInterval := Value;
  242.     if lActive then Resume;
  243.   end;
  244. end;
  245.  
  246. procedure TDCGradientProgress.SetPosition(AValue: integer);
  247. begin
  248.   FPosition := AValue;
  249.   Paint;
  250. end;
  251.  
  252. procedure TDCGradientProgress.Suspend;
  253. begin
  254.   if FTimer and HandleAllocated then KillTimer(Handle, PRGTIMER_IDEVENT);
  255.   FTimer := False;
  256. end;
  257.  
  258. procedure TDCGradientProgress.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  259. begin
  260.   Message.Result := 0;
  261. end;
  262.  
  263. procedure TDCGradientProgress.WMSize(var Message: TWMSize);
  264. begin
  265.   CreateGradientBitmap;
  266.   inherited;
  267. end;
  268.  
  269. procedure TDCGradientProgress.WMTimer(var Message: TWMTimer);
  270. begin
  271.   inherited;
  272.   if HandleAllocated then
  273.   begin
  274.     if Message.TimerID = PRGTIMER_IDEVENT then SetPosition(FPosition + 5);
  275.   end;  
  276. end;
  277.  
  278. end.
  279.