Gradient Nasıl Yapılıyor Biliyo musunuz? İşte Böyle :)

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
mavsar

Gradient Nasıl Yapılıyor Biliyo musunuz? İşte Böyle :)

Mesaj gönderen mavsar »

Kod: Tümünü seç

//  Copyright (c) 1998-1999 Developer Express Inc.  All Rights Reserved

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type

  TfStyle = (fHorz, fVert, fRectangle, fDiagonal, fCircle);

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Fill(BColor, EColor : TColor; Style : TfStyle);
  end;

var
  Form1: TForm1;
  BColor, EColor : TColor;
  Style : TfStyle;

implementation

{$R *.DFM}

procedure TForm1.Fill(BColor, EColor : TColor; Style : TfStyle);
var i, H, dx, dy, AHeight, AWidth : integer;
  function GetColor(N,H : integer) : TColor;
  begin
    Result := RGB(Trunc(GetRValue(BColor) + (GetRValue(EColor)-GetRValue(BColor)) * N / H),
                  Trunc(GetGValue(BColor) + (GetGValue(EColor)-GetGValue(BColor)) * N / H),
                  Trunc(GetBValue(BColor) + (GetBValue(EColor)-GetBValue(BColor)) * N / H));
  end;
begin
  AHeight := ClientHeight;
  AWidth  := ClientWidth;
  case Style of
   fHorz   :   for i := 0 to AWidth - 1 do begin
                Canvas.Pen.Color := GetColor(i, AWidth);
                Canvas.MoveTo(i,0);
                Canvas.LineTo(i,AHeight);
               end;
   fVert     : for i := 0 to AHeight - 1 do begin
                Canvas.Pen.Color := GetColor(i, AHeight);
                Canvas.MoveTo(0,i);
                Canvas.LineTo(AWidth,i);
               end;
   fRectangle: begin
                 H := Trunc(SQRT(AHeight*AHeight + AWidth*AWidth)/ 4);
                 for i := H downto 0 do begin
                  dx := Trunc((AWidth/2 * i )/ H) * 2;
                  dy := Trunc((AHeight/2 * i )/ H) * 2;
                  Canvas.Pen.Color := GetColor(i, H);
                  Canvas.Brush.Color := GetColor(i, H);
                  Canvas.Rectangle(AWidth div 2 - dx , AHeight div 2 - dy,
                                   AWidth div 2 + dx , AHeight div 2 + dy);
                 end;
               end;
   fDiagonal : begin
                H := Trunc(SQRT(AHeight*AHeight + AWidth*AWidth))*2;
                for i := 0 to H do begin
                 dx := Trunc((AWidth  *2 * i )/ H);
                 dy := Trunc((AHeight *2 * i )/ H);
                 Canvas.Pen.Color := GetColor(i, H);
                 Canvas.MoveTo(0,dy);
                 Canvas.LineTo(dx,0);
                end;
               end;
   fCircle   : begin
                H := Trunc(SQRT(AHeight*AHeight + AWidth*AWidth) / 5);
                for i := H downto 0 do begin
                 dx := i * 5;
                 dy := i * 5;
                 Canvas.Pen.Color := GetColor(i, H);
                 Canvas.Brush.Color := GetColor(i, H);
                 Canvas.Ellipse(AWidth div 2 - dx, AHeight div 2 - dy,
                                AWidth div 2 + dx, AHeight div 2 + dy);
                end;
               end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Randomize;
 BColor := RGB(Random(256),Random(256),Random(256));
 EColor := RGB(Random(256),Random(256),Random(256));
 Style := TfStyle(Random(5));
 Fill(BColor, EColor, Style );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Button1Click(Sender);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Fill(BColor, EColor, Style );
end;

end.
Cevapla