From: mav@dseg.ti.com (Michael Vincze)
Newsgroups: comp.lang.pascal
Subject: Re: Delphi: Background Fill
Date: 27 Apr 1995 18:27:23 GMT
Organization: Texas Instruments


{ Purpose:  Draws a gradient fill on the background of an application.
  Author:   Michael Vincze (vincze@ti.com)
  Usage:    Create a blank form, named Form1, compile and run.
            Optionally set the following form properties:

                BorderIcons.biSystemMenu := False;
                BorderIcons.Minimize     := False;
                BorderIcons.biMaximize   := False;
                BorderStyle              := bsNone;

            Note that the OnResize event should also call the FormPaint
            method if this form is allowed to be resizable.  This is because
            if it is not called then when the window is resized the gradient
            will not match the rest of the form.
  Limits:   None.
  Notes:    If this file is to be used for any purpose please leave
            this header intact.  Give credit to the author if used for
            any purpose.
            Please contact the author if any improvements are made.
            The author does not claim any usefullness or purpose for this
            program.
  Version:  1.00  04/28/95  Initial creation
}

unit Fadeu;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
    Label1: TLabel;
  procedure GradientRect (FromRGB, ToRGB: TColor);
public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
if CmdShow = SW_SHOWMINNOACTIVE then
  WindowState := wsMinimized
else
  WindowState := wsMaximized;
Label1 := TLabel.Create (Form1);
Label1.Parent := Form1;
Label1.Caption := 'Click with the mouse to close this application.';
Label1.Top := 40;
Label1.Left := 20;
Label1.Font.Height := 40;
Label1.Font.Style := [fsBold, fsItalic];
Label1.Font.Name := 'Ariel';
Label1.Transparent := True;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
Label1.Destroy;
Close;
end;

procedure TForm1.GradientRect (FromRGB, ToRGB: TColor);
var
  RGBFrom   : array[0..2] of Byte;    { from RGB values                     }
  RGBDiff   : array[0..2] of integer; { difference of from/to RGB values    }
  ColorBand : TRect;                  { color band rectangular coordinates  }
  I         : Integer;                { color band index                    }
  R         : Byte;                   { a color band's R value              }
  G         : Byte;                   { a color band's G value              }
  B         : Byte;                   { a color band's B value              }
begin
{ extract from RGB values
}
RGBFrom[0] := GetRValue (ColorToRGB (FromRGB));
RGBFrom[1] := GetGValue (ColorToRGB (FromRGB));
RGBFrom[2] := GetBValue (ColorToRGB (FromRGB));
{ calculate difference of from and to RGB values
}
RGBDiff[0] := GetRValue (ColorToRGB (ToRGB)) - RGBFrom[0];
RGBDiff[1] := GetGValue (ColorToRGB (ToRGB)) - RGBFrom[1];
RGBDiff[2] := GetBValue (ColorToRGB (ToRGB)) - RGBFrom[2];

{ set pen sytle and mode
}
Canvas.Pen.Style := psSolid;
Canvas.Pen.Mode := pmCopy;

{ set color band's left and right coordinates
}
ColorBand.Left := 0;
ColorBand.Right := Width;

for I := 0 to $ff do
  begin
  { calculate color band's top and bottom coordinates
  }
  ColorBand.Top    := MulDiv (I    , Height, $100);
  ColorBand.Bottom := MulDiv (I + 1, Height, $100);

  { calculate color band color
  }
  R := RGBFrom[0] + MulDiv (I, RGBDiff[0], $ff);
  G := RGBFrom[1] + MulDiv (I, RGBDiff[1], $ff);
  B := RGBFrom[2] + MulDiv (I, RGBDiff[2], $ff);

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

end;

procedure TForm1.FormPaint(Sender: TObject);
begin
GradientRect (clBlue, clBlack);
end;

end.

----------------------------------------------------------------------



