Newsgroups: comp.lang.pascal
From: mick@vxxx.demon.co.uk (Michael Mimms)
Subject: Re: Delphi: Background Fill
Date: Sat, 29 Apr 1995 09:19:34 +0000

 
> ----------------------------------------------------------------------
> 
> { 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.
> 
> ----------------------------------------------------------------------
> 
> 
> 
> 
> 

This all looks very complicated, why not just create a FormPaint Method
a bit like the following :

procedure TForm1.FormPaint(Sender: TObject);

var
   row, height, width: integer;

begin

     height := (Clientheight + 255) div 256;
     width  := (ClientWidth + 2) div 3;
     for row := 0 to 255 do
     begin
          canvas.brush.color := rgb(row, 0, 0);
          canvas.fillrect(rect(0, row*height,
                          width, (row + 1) * height));
          canvas.brush.color := rgb(0, row, 0);
          canvas.fillrect(rect(width, row*height,
                          width*2, (row + 1) * height));
          canvas.brush.color := rgb(0, 0, row);
          canvas.fillrect(rect(width*2, row*height,
                          width*3, (row + 1) * height));
     end;

end;


This divides the screen into 255 strips and the just paints them with each 
colour in turn...

	Hope this helps
-- 

Mick Mimms

mick@vxxx.demon.co.uk





