Оформил: DeeCo

Автор: Ян Валерьевич

В этой статье я рассматриваю несколько способов сделать форму красивой. Примеры, рассмотренные здесь, имеют скорее эстетическую, чем практическую ценность, но, я думаю, ими можно воспользоваться при оформлении окон вашей, уважаемые читатели,программы. Для оформления я рассмотрю несколько способов залития формы градиентной заливкой (пример такой заливки - инсталляторы, в которых пользователь любуется красивым окном, пока программа делает своё чёрное дело). В различных Faq я встречал примеры, заливающие форму каким - либо градиентом, и существуют компоненты, применяющие градиентную заливку для оформления (например TRxGradientCaption из RxLib), но статьи, систематизирующей информацию по этому вопросу я не встречал. Поэтому я надеюсь, что этот материал окажется вам полезным.
Для заполнения холста (Canvas) формы я использую код, основа которого взята мною у достопочтенного Nomadic'а из Озеровского FAQ. Его код я преобразовал в одно событие OnPaint (у Nomadic'а в примере был размещён Timer и обрабатывлись FormCreate,Timer.OnTimer, FormDestroy). Вот этот код:

procedure TForm1.FormPaint(sender: TObject);
type
  TRGB = record b, g, r: byte;
  end;
  ARGB = array[0..1] of TRGB;
  PARGB = ^ARGB;
var
  b: TBitMap;
  p: PARGB;
  x, y: integer;
begin
  b := TBitMap.Create;
  b.pixelformat := pf24bit;
  b.width := Clientwidth;
  b.height := Clientheight;
  for
    y := 0 to b.height - 1 do
  begin
    p := b.scanline[y];
    for
      x := 0 to b.width - 1 do
    begin //эту часть кода
      будем изменять p[x].r := random(256);
      p[x].g := random(256);
      p[x].b := random(256);
    end;
  end;
  canvas.draw(0, 0, b);
  b.free;
end;

p[x].r := 255;
p[x].g := 255;
p[x].b := -255 * x
div b.width;

p[x].r := 255 * y div b.Height;
p[x].g := 255 * y div b.Height;
p[x].b := 255;

p[x].r := 255 * y div b.Height;
p[x].g := 255 * x div b.Width;
p[x].b := 255;

p[x].r := random(250);
p[x].g := 255;
p[x].b := 255 * x div b.Width;
//(рис.6)
p[x].r := random(250);
p[x].g := 255 * y div b.Height;
p[x].b := 255 * x div b.Width;
//(рис.7)

p[x].r := 0;
if y <= b.Height div 2 then
  p[x].g := 255 * y * 2 div b.Heightelse p[x].g := -255 * y * 2 div b.Height;
if abs(y - b.Height div 2) < 3 then
  p[x].g := 255;
{без этой строки образуется полоса в центре заливки при увеличении размеров формы}
p[x].b := 200;

p[x].r := 150;
p[x].g := Sgn(b.Width div 2 - x) * (255 * x * 2 div b.Width);
p[x].b := 50;

p[x].r := 50;
p[x].g := sgn(b.Width div 2 - x) * (255 * x * 2 div b.Width);
p[x].b := sgn(b.Height div 2 - y) * (255 * y * 2 div b.Height);
{ Зелёная составляющая изменяется к центру по
горизонтали, а синяя по вертикали}
//(рис.10)
p[x].r := 150 * x div b.Width;
p[x].g := sgn(b.Width div 2 - x) * (255 * x * 2 div b.Width);

p[x].b := 155 * y div b.Height;
{Красная составляющая изменяется слева направо,
зелёная по горизонтали к центру, синяя сверху вниз}
//(рис.11)
p[x].r := 150 * x div b.Width;
p[x].g := sgn(b.Width div 2 - x) * (255 * x * 2 div b.Width);
p[x].b := 155 + random(100);
{Тоже, но синий цвет изменяется случайным образом}
//(рис.12)

p[x].r := 0;
p[x].g := 255 * 4 * y div b.Height;
p[x].b := 155;

p[x].g := 0;
if (x <= b.Width div 4) or ((x <= 3 * b.Width div 4) and (x >= b.Width div 2))
  then
  p[x].r := 255 * x * 4 div b.Widthelse p[x].r := -255 * x * 4 div b.Width;
if abs(x - b.Width div 2) < 3 then
  p[x].r := 0;
if (abs(x - b.Width div 4) < 3) or (abs(x - 3 * b.Width div 4) < 3) then
  p[x].r := 255;
p[x].b := 0;

procedure TForm1.FormResize(Sender: TObject);
begin
  form1.DoubleBuffered := true;
  form1.Repaint;
end;

Следующий вопрос, который нельзя обойти вниманием в этой статье - это вопрос выбора цветов для создания градиента. Для его исследования в общем случае нужно иметь представление о RGB цветовой модели. Цветовой переход градиента представляет собой кривую в этой модели, уравнение которой нужно задать в программе. Изучение цветовой модели и создание произвольного цветового градиента - задача не для статьи. Здесь рассмотрим, как получить двухцветный переход. Довольно понятно решение для основных цветов (красный, синий, зелёный) и их смесей. Так RG даёт жёлтый цвет, RB - фиолетовый, GB - лазурный. Например, для получения сине - жёлтой раcтяжки нужно изменять B от 255 до 0, R и G от 0 до 255 - вот так (рис. 16).

p[x].r := 255 * y div b.Height;
p[x].g := 255 * y div b.Height;
p[x].b := -255 * y div b.Height;

procedure Grad(Holst: TCanvas; FColor, LColor: TColor;
  VertOrientation: boolean);
{Holst - Canvas, на котором мы будем
рисовать, FColor - начальный,а LColor - конечный цвет градиента,
VertOrientation указывает на вертикальнуюили горизонтальную ориентацию заливки}
type
  TRGB = record
    b, g, r: byte;
  end;
  ARGB = array[0..1] of TRGB;
  PARGB = ^ARGB;
var
  b: TBitMap;
  p: PARGB;
  x, y: integer;
  s1, s2, fb, fg, fr, lb, lg, lr: string;
  r1, r2, g1, g2, b1, b2: byte;
    //Эти переменные нужны для анализа заданных цветов
begin
  s1 := IntToHex(FColor, 6);
  s2 := IntToHex(LColor, 6);
  if Length(s1) > 6 then
    Delete(s1, 1, Length(s1) - 6);
  if Length(s2) > 6 then
    Delete(s2, 1, Length(s2) - 6);
  fb := Copy(s1, 1, 2);
  fg := Copy(s1, 3, 2);
  fr := Copy(s1, 5, 2);
  lb := Copy(s2, 1, 2);
  lg := Copy(s2, 3, 2);
  lr := Copy(s2, 5, 2); //Анализируем заданные цвета
  b1 := StrToInt('$' + fb);
  b2 := StrToInt('$' + lb);
  g1 := StrToInt('$' + fg);
  g2 := StrToInt('$' + lg);
  r1 := StrToInt('$' + fr);
  r2 := StrToInt('$' + lr);
    //Определяем начальное и конечное значение для каждого из
  RGB составляющегоb := TBitMap.Create;
  b.PixelFormat := pf24bit;
  b.Width := Holst.ClipRect.Right - Holst.ClipRect.Left;
  b.Height := Holst.ClipRect.Bottom - Holst.ClipRect.Top;
  {У TCanvas нет свойств Width и Height, для определения размеров
  BitMap вычисляем размеры отрисовываемой области}
  for y := 0 to b.Height - 1 do
  begin
    p := b.ScanLine[y];
    for x := 0 to b.Width - 1 do
    begin //Выполняем заливку
      if VertOrientation then
      begin
        p[x].r := r1 - (r1 - r2) * y div b.Height;
        p[x].g := g1 - (g1 - g2) * y div b.Height;
        p[x].b := b1 - (b1 - b2) * y div b.Height;
      end
      else
      begin
        p[x].r := r1 - (r1 - r2) * x div b.Width;
        p[x].g := g1 - (g1 - g2) * x div b.Width;
        p[x].b := b1 - (b1 - b2) * x div b.Width;
      end
    end;
  end;
  Holst.Draw(0, 0, b);
  b.Free;
end;

Применять эту процедуру можно к любому объекту имеющему Canvas, например к TImage (рис. 17)

procedure TForm1.FormPaint(Sender: TObject);
begin
  Grad(Form1.Canvas, $1654D3, $8BAACF, true);
  Grad(Image1.Canvas, $FF, $FF00, false)
end;
{Существует, как я указывал
выше, иной способ разукрашивания формы.Фон формы можно заполнить
повторяющимся рисунком с помощью следующего кода:}
Form1.Brush.Bitmap := Bitmap
// нужного изображения. В следующем примере я размещаю на форме Image1, Visible = false

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Brush.Bitmap := Image1.Picture.Bitmap;
end;

Image1.Stretch := true // где-нибудь, можно на этапе проектирования.

procedure TForm1.FormResize(Sender: TObject);
var
  b: TBitMap;
  beginb := TBitMap.Create;
  Image1.Height := Form1.ClientHeight;
  //растягиваем Image до нужных размеров
  b.Width := Image1.Width;
  b.Height := Image1.Height; //создаём BitMap нужных размеров
  b.Canvas.CopyRect(b.Canvas.ClipRect, Image1.Canvas, Image1.Canvas.ClipRect);
  //и копируем в BitMap растянутое изображение
  Form1.Brush.Bitmap := b;
  Form1.Repaint; //затем пишем волшебную фразу и перерисовываем форму
end;

procedure TForm1.FormResize(Sender: TObject);
var
  b: TBitMap;
  i: integer;
  beginb := TBitMap.Create;
  Image1.Height := Form1.ClientHeight;
  b.Width := Image1.Width;
  b.Height := Image1.Height;
  b.Canvas.CopyRect(b.Canvas.ClipRect, Image1.Canvas, Image1.Canvas.ClipRect);
  for i := 0 to Form1.ClientWidth div b.Width do
    Form1.Canvas.Draw(b.Width * i, 0, b);
end;