Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Красота - это страшная сила (Дизайн окон)

Оформил: 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;
Это - способ быстрого (в отличие, например, от Canvas.Pixels) рисования на холсте формы. Результат действия этого кода - заполнение формы точками случайного цвета (рис.1). Дальнейшие изменения кода будут прозводится мною в основном с тремя строками, вкоторых происходит заполнение точки холста - в коде они выделены красным цветом. Для получени горизонтального градиента (я буду использовать термины градиент или заливка вместо градиентная заливка) нужно изменять величину r,g,b не случайным образом, а в цикле по х. Например, зафиксирова два цвета и измняя третий от 0 до 255 мы получим горизонтальную заливку от белого до смеси фиксированных цветов. Следующий код даст нам бело - жёлтый градиент на форме (рис. 2):
p[x].r := 255;
p[x].g := 255;
p[x].b := -255 * x
div b.width;
При применении горизонтальной заливки следует учесть, что пустой залитый объект кажется неустойчивым и его нужно уравновесить, разместив что-то на нём (рис.3).
Вертикальную заливку получить не намного сложней. Для этого нужно изменять цвета не по х, а по у. Например, следующий код даст нам столь любимую инсталляторами сине - белую заливку ( рис. 4).
p[x].r := 255 * y div b.Height;
p[x].g := 255 * y div b.Height;
p[x].b := 255;
Обратите внимание - чтобы получить сине - белый градиент я изменяю красный и зелёный цвета, а синий оставляю неизменным. Вообще получение нужной цветовой растяжки я считаю одним из самых хитрым вопросов данной темы, и я вернусь к нему в конце данной статьи.
Ещё более красивого эффекта можно достигнуть накложив градиенты друг на друга. Например изменяя красный цвет по вертикали, а зелёный по вертикали мы получим следующую картину (рис. 5)
p[x].r := 255 * y div b.Height;
p[x].g := 255 * x div b.Width;
p[x].b := 255;
Полученному градиенту можно придать зернистую структуру, изменяя один или несколько основных цветов случайным образом. Что вы скажете о заливках на рисунках 6 и 7?

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)
Для получения более сложного распределения градиента по форме придётся использовать более сложные формулы при присвоении значений цветов. Рассмотрим получение заливки "к центру". Очевидно изменяемый цвет должен уменьшаться или увеличиваться от края к центру формы, а затем изменяться в обратном порядке. Этого можно достичь с помощью условного оператора (более наглядный способ) (рис 8).
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;
Более сложный способ - составить функцию, изменяющую цвет нужным образом. Для следующего примера нам понадобится функция Sgn:
function Sgn(i:integer):integer;
begin
if i<>0 then Sgn:=round(i/abs(i))
else Sgn:=1
end;
Функция Sign из модуля Math не подходит, т.к. возвращает 0 при значении аргумента 0.
Следующий код даёт такой вариант заливки (рис. 9):
p[x].r := 150;
p[x].g := Sgn(b.Width div 2 - x) * (255 * x * 2 div b.Width);
p[x].b := 50;
На рисунке 9а показан результат замены функции Sgn, определённой нами на функцию Sign из модуля Math. Возвращаемый ноль приводит к появлению полосы в середине формы.
Комбинируя рассмотренные способы заливок можно получить формы, вид которых изумит всех, включая создателя (рис 10 - 12).
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)
Вас не интригует число 255, присутствующее в формулах? Очевидно, уменьшая его мы изменяем цвет, с которого начинается заливка, а вот увеличение числа приводит к интересному эффекту "жалюзи" - дублированию градиентной заливки по форме (рис. 13)
p[x].r := 0;
p[x].g := 255 * 4 * y div b.Height;
p[x].b := 155;
Здесь я не стал писать 1020 вместо 255*4, чтобы было видно откуда взялись четыре "волны" градиентной заливки.
Ещё один эффект (рис. 14) - плавно переходящие градиентные волны получаются с помощью следующего, правда довольно неуклюжего кода:
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;
Впрочем, этот эффект будет получен в конце статьи другим, более простым способом.
Итак, вы получили красиво залитую форму и стали изменять её размеры. И тут вы столкнулись с некрасивым эффектом - на форме отпечатываются артефакты от заливки (рис 15).
Способов исправить эту ситуацию существует много. Воспользуемся самым очевидным из них:
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
Picture, как на рис 18а. Результат на рис. 18. Рис. 18а:
procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Brush.Bitmap := Image1.Picture.Bitmap;
end;
Круто! Можно нарисовать градиент (или текстуру) с помощью мощного редактора (Фотошоп, например, или Гимп, кому что нравится) поместить на форму и с помощью волшебной строки залить форму. Но есть тут один нюансик. При изменении размеров формы фоновые картинки дублируются. Если для заливки на рис. 18а или текстуры это не страшно, то для градиента мы получим довольно неприглядную картинку (рис. 19)
Простые способы, вроде описанного выше Resaize'а здесь не помогут, т.к. BitMap, в отличие от Image, имеет фиксированные длину и ширину. Здесь надобы написать какую-то процедурку, масштабирующую BitMap, но вообще масштабирование изображения - не очень простая задача. Но этот алгоритм уже реализован в Delphi и в следующем примере я просто им пользуюсь.
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;
Чтобы избежать глюков при разворачивании формы присвойте Form.OnPaint FormResize.
Итак, всё работает. Какой же из двух способов лучше? Второй способ проще, картинку для заливки можно нарисовать вручную. Но полученная программа больше, да и заливки, подобные изображённым на рисунках 5 - 12 получить не удасться. Поэтому используйте тот способ, который более подходит для нужной вам ситуации. Отмечу только, что в первом случае мы имеем дело с векторной, а во втором с растровой графикой.
Ну и маленький совет по применению. Поместите на форму таймер и вставьте один из вариантов вышеизложенного кода в OnTimer. Вы получите основу для ScreenSaver'a или заставки WindowsMedia...
Успехов! :)))))
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.