Как известно формы в приложениях имеют прямоугольный вид. Сегодня я покажу вам как изменить стандартную форму на более привлекательную, например круг, треугольник или форму исходя из картинки TBitmap.

И так для начала давай-те немного подготовимся для создания формы из картинки. Для этого нам нужно буквально нарисовать форму в графическом редакторе в черно-белом формате. Учтите что размер картинки должен быть токай же как и у вашей формы. Я не стал вырисовывать красоту картинки, поэтому может не очень прилежно, но для примера подойдет.

На самом деле картинка выглядит так:

Ее мы тоже сохраним и выбросим отдельным TImage на форме.

Итак после того как мы создали картинку приступим к созданию формы. Создаем формы с размерами нашей картинки, закидываем туда TImage с картинкой будущей формы. И кнопки для изменения формы. В итоге у вас должно получится что-то похожее:

Теперь займемся программированием кнопок.

Первая и самая интересная кнопка создающая вид по картинке:

procedure TForm1.Button1Click(Sender: TObject);
var
  ABitmap: TBitmap;
begin
  // Скрыть заголовок окна
  BorderStyle:= bsNone;
  ABitmap:= TBitmap.Create;
  // Загружаем картинку 
  ABitmap.LoadFromFile('1.bmp');
  ABitmap.Monochrome:=True;
  SetShape(ABitmap);

  ABitmap.Free;
end;

Кнопка треугольник:

procedure TForm1.Button3Click(Sender: TObject);
var
  ABitmap: TBitmap;
  Points: array of TPoint;
begin
  BorderStyle:=bsNone;
  ABitmap := TBitmap.Create;
  ABitmap.Monochrome := True;
  ABitmap.Width := Width;
  ABitmap.Height := Height;

  ABitmap.Canvas.Brush.Color:=clBlack;
  ABitmap.Canvas.FillRect(0, 0, Width, Height);

  SetLength(Points, 3);
  Points[0] := Point(Width div 2, 0);
  Points[1] := Point(Width, Height);
  Points[2] := Point(0, Height);

  ABitmap.Canvas.Brush.Color:=clWhite;
  ABitmap.Canvas.Polygon(Points);
  SetShape(ABitmap);

  ABitmap.Free;
end;

Кнопка круг:

procedure TForm1.Button2Click(Sender: TObject);
var
  ABitmap: TBitmap;
begin
  BorderStyle:=bsNone;
  ABitmap := TBitmap.Create;
  ABitmap.Monochrome := True;
  ABitmap.Width := Width;
  ABitmap.Height := Height;

  ABitmap.Canvas.Brush.Color:=clBlack;
  ABitmap.Canvas.FillRect(0, 0, Width, Height);

  ABitmap.Canvas.Brush.Color:=clWhite;
  ABitmap.Canvas.Ellipse(0, 0, Width, Height);
  SetShape(ABitmap);

  ABitmap.Free;
end;

Кнопка None, возвращаем исходное состояние формы:

procedure TForm1.Button4Click(Sender: TObject);
var
  ABitmap: TBitmap;
begin
  ABitmap:=TBitmap.Create;
  ABitmap.Monochrome:=True;
  ABitmap.Canvas.Brush.Color:=clBlack;
  ABitmap.Canvas.FillRect(0, 0, Width, Height);

  SetShape(ABitmap);
  BorderStyle:=bsSizeable;

  ABitmap.Free;
end;

Заголовка у формы теперь не будет сделаем так, чтобы мы могли передвигать форму по экрану нажимая на другой элемент. Т.к на форме у нас растянут TImage сделаем перемещение формы по нажатию на картинку.

На событие OnMouseMove впишем следующий код.

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
  if Shift=[ssLeft] then
   begin
     Left:=Left+(X-XX);
     Top:=Top+(Y-YY);
   end else
   begin
     XX:=X;
     YY:=Y;
   end;
end;

Данный код мы можем использовать на любом элементе, будь то картинка, кнопка или сама форма.

Так же нам нужно объявить 2 глобальные переменные, это XX и YY. В них мы будем запоминать предыдущее расположение формы.

var
...
 XX,YY:integer;
...

Вот и все, запускаем и наслаждаемся результатом.

Если у вас что-то не выходит, выкладываю для вас исходники. Скачать 906кб