Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kolekce/d456/DCSLIB25.ZIP/DCExtCtrls.pas

Pascal/Delphi Source File | 2001-01-20 | 7.0 KB | 279 lines

{
 BUSINESS CONSULTING
 s a i n t - p e t e r s b u r g

         Components Library for Borland Delphi 4.x, 5.x
         Copyright (c) 1998-2000 Alex'EM

}
unit DCExtCtrls;

interface

uses Messages, Windows, SysUtils, Classes, Controls, Graphics,
     StdCtrls, DCConst;

type

  TDCGradientProgress = class(TCustomControl)
  private
    FColor: TColor;
    FBrushColor: TColor;
    FPosition: integer;
    FDirection: integer;
    FGradientBitmap: TBitmap;
    FTimer: boolean;
    FInterval: integer;
    procedure CreateGradientBitmap;
    procedure SetPosition(AValue: integer);
    procedure SetBrushColor(const Value: TColor);
    procedure SetColor(const Value: TColor);
    procedure SetDirection(const Value: integer);
    procedure SetInterval(const Value: integer);
    function GetActive: boolean;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  public
    procedure Paint; override;
    constructor Create(AComponent: TComponent); override;
    destructor Destroy; override;
    procedure Resume;
    procedure Suspend;
    property Active: boolean read GetActive;
  published
    property Align;
    property Color: TColor read FColor write SetColor;
    property BrushColor: TColor read FBrushColor write SetBrushColor;
    property Direction: integer read FDirection write SetDirection;
    property Interval: integer read FInterval write SetInterval;
    property Position: integer read FPosition write SetPosition;
  end;

implementation

const
  PRGTIMER_IDEVENT = $200;

{ TDCGradientProgress }

constructor TDCGradientProgress.Create(AComponent: TComponent);
begin
  inherited;
  ControlStyle := [csNoDesignVisible];

  Height := 5;

  FGradientBitmap := TBitmap.Create;

  FColor      := clSelectedLight;
  FBrushColor := clNavy;
  FPosition   := 0;
  FDirection  := 0;
  FTimer      := False;
  FInterval   := 35;
end;

procedure TDCGradientProgress.CreateGradientBitmap;
 var
  Red1, Blue1, Green1, Red2,Blue2, Green2: byte;
  Color1, Color2: longint;
  i: integer;
  hWidth: integer;
  gPos: extended;
begin
  if (Width > 0) and (Height > 0) then with FGradientBitmap do
  begin
    Width  := Self.Width;
    Height := Self.Height;

    Color1 := ColorToRGB(FBrushColor);
    Color2 := ColorToRGB(FColor);
    Red1   := GetRValue(Color1);
    Green1 := GetGValue(Color1);
    Blue1  := GetBValue(Color1);
    Red2   := GetRValue(Color2);
    Green2 := GetGValue(Color2);
    Blue2  := GetBValue(Color2);

    hWidth := (Width div 2);
    for i := 0 to hWidth do
    begin
      gPos := {SQRT}(i / hWidth);
      Canvas.Pen.Color := RGB(Trunc(Red1 + (Red2 - Red1) * gPos),
                              Trunc(Green1 + (Green2 - Green1) * gPos),
                              Trunc(Blue1 + (Blue2 - Blue1) * gPos));
      Canvas.MoveTo(i, 0);
      Canvas.LineTo(i, Height);
    end;

    for i := 1 to hWidth do
    begin
      gPos := {SQR}(i / hWidth);
      Canvas.Pen.Color := RGB(Trunc(Red2 + (Red1 - Red2) * gPos),
                              Trunc(Green2 + (Green1 - Green2) * gPos),
                              Trunc(Blue2 + (Blue1 - Blue2) * gPos));
      Canvas.MoveTo(i + hWidth, 0);
      Canvas.LineTo(i + hWidth, Height);
    end;
  end;
end;

procedure TDCGradientProgress.CreateParams(var Params: TCreateParams);
begin
  inherited;
end;

destructor TDCGradientProgress.Destroy;
begin
  Suspend;
  FGradientBitmap.Free;
  inherited;
end;

function TDCGradientProgress.GetActive: boolean;
begin
  Result := FTimer;
end;

procedure TDCGradientProgress.Paint;
 var
  i: integer;
  ARect, BRect, CRect: TRect;
begin
  BRect := BoundsRect;
  OffsetRect(BRect, -BRect.Left, -BRect.Top);

  if FDirection < 0 then
  begin
    if FPosition = FGradientBitmap.Width then FPosition := 0;
    i := 0;
    ARect := Rect(FPosition, 0, FGradientBitmap.Width, FGradientBitmap.Height);

    while (ARect.Right - ARect.Left + i) <= BRect.Right do
    begin
      CRect := ARect;
      OffsetRect(CRect, -CRect.Left + i, -CRect.Top);

      Canvas.CopyRect(CRect, FGradientBitmap.Canvas, ARect);

      Inc(i, ARect.Right - ARect.Left);
      ARect := Rect(0, 0, FGradientBitmap.Width, FGradientBitmap.Height);
    end;

    if (ARect.Right + i) > BRect.Right then ARect.Right := BRect.Right - i;

    CRect := ARect;
    OffsetRect(CRect, -CRect.Left + i, -CRect.Top);

    Canvas.CopyRect(CRect,  FGradientBitmap.Canvas, ARect);
  end
  else begin
    if FPosition = FGradientBitmap.Width then FPosition := 0;
    ARect := Rect(0, 0, FGradientBitmap.Width - FPosition, FGradientBitmap.Height);
    i := BRect.Right;
    while i >= 0 do
    begin
      Dec(i, ARect.Right - ARect.Left);

      CRect := ARect;
      OffsetRect(CRect, -CRect.Left + i, -CRect.Top);

      Canvas.CopyRect(CRect, FGradientBitmap.Canvas, ARect);
      ARect := Rect(0, 0, FGradientBitmap.Width, FGradientBitmap.Height);
    end;

    if i < 0 then ARect.Left := -i;
    CRect := ARect;
    OffsetRect(CRect, -CRect.Left, -CRect.Top);

    Canvas.CopyRect(CRect,  FGradientBitmap.Canvas, ARect);
  end;
end;

procedure TDCGradientProgress.Resume;
begin
  if not FTimer then
  begin
    SetTimer(Handle, PRGTIMER_IDEVENT, FInterval, nil);
    FTimer := True;
  end;
end;

procedure TDCGradientProgress.SetBrushColor(const Value: TColor);
begin
  FBrushColor := Value;
  CreateGradientBitmap;
  invalidate;
end;

procedure TDCGradientProgress.SetColor(const Value: TColor);
begin
  FColor := Value;
  CreateGradientBitmap;
  invalidate;
end;

procedure TDCGradientProgress.SetDirection(const Value: integer);
 var
  lActive: boolean;
begin
  if FDirection <> Value then
  begin
    lActive := Active;
    Suspend;
    FPosition  := FGradientBitmap.Width - ((Width + FPosition) mod FGradientBitmap.Width);
    FDirection := Value;
    if lActive then Resume;
  end;
end;

procedure TDCGradientProgress.SetInterval(const Value: integer);
 var
  lActive: boolean;
begin
  if FInterval <> Value then
  begin
    lActive := Active;
    Suspend;
    FInterval := Value;
    if lActive then Resume;
  end;
end;

procedure TDCGradientProgress.SetPosition(AValue: integer);
begin
  FPosition := AValue;
  Paint;
end;

procedure TDCGradientProgress.Suspend;
begin
  if FTimer and HandleAllocated then KillTimer(Handle, PRGTIMER_IDEVENT);
  FTimer := False;
end;

procedure TDCGradientProgress.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  Message.Result := 0;
end;

procedure TDCGradientProgress.WMSize(var Message: TWMSize);
begin
  CreateGradientBitmap;
  inherited;
end;

procedure TDCGradientProgress.WMTimer(var Message: TWMTimer);
begin
  inherited;
  if HandleAllocated then
  begin
    if Message.TimerID = PRGTIMER_IDEVENT then SetPosition(FPosition + 5);
  end;
end;

end.