Как создать такую форму?

[[DisAssembleR]]

Как по мне - лучше задавать цвет при создании СтатусБара и выбрать подходящую секцию. Например, секцию ФОРМА. SkinData->SkinSection->FORM. В этом случае, "покраска" статус бара будет проведена согласно "покраске" формы и получится "монолитный" вид, только треугольник будет выделяться.

Ага, ошибочка...
Сейчас попытаюсь что-нибудь придумать.
Вот, что вышло:

Только форма все портит...
Буду думать над решением. Аж самому интересно стало

Все, вспомнил, что я применял подобный метод в своем приложении)))
Вот пример:


Вот код:

procedure TForm3.FormPaint(Sender: TObject);
begin
   SetWindowLong(Form3.Handle, GWL_STYLE, GetWindowLong    (Form3.Handle, GWL_STYLE) and not WS_CAPTION);
  Form3.Invalidate;
end;

Форма растягивается, передвигается и выглядит таак, как хочется.
Однако при первом показе без изменения размеров, заголовок таки выдает себя. Как обойти это - не пойму. Без скинов такого не случается.

[dmitriegorovih]

Сделать изменение размера формы за треугольник

ну я бы применил классику

var
  Form1: TForm1;
  b: boolean;
  po: TPoint;
implementation

{$R *.dfm}

procedure TForm1.sStatusBar1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (x > (sstatusbar1.Width - 10)) and (x < sstatusbar1.Width)
    and (y > (sstatusbar1.Height - 10)) and (y < sstatusbar1.Height) then
  begin
    po.X := X;
    po.Y := y;
    b := true;
  end;
end;

procedure TForm1.sStatusBar1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (x > (sstatusbar1.Width - 10)) and (x < sstatusbar1.Width)
    and (y > (sstatusbar1.Height - 10)) and (y < sstatusbar1.Height) then
  begin
    sstatusbar1.Cursor := crSizeNWSE;
  end
  else
  begin
    sstatusbar1.Cursor := crDefault;
  end;
  if b = true then
  begin

    form1.Height := form1.Height + (y - po.Y);
    form1.Width := form1.Width + (x - po.X);
    po.x := x;

  end;
end;

procedure TForm1.sStatusBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  b := false;
end;

вроде работает.

[artemavd]

Спасибо всем за отклики. Наверное, если я воспользуюсь теперь кодом dmitriegorovih, то закончу эти дурацкие заметки почти. Я вот сделал выше код так:

procedure TForm1.sStatusBarOnMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
var
 Form: TForm;
 sStatusBar: TsStatusBar;
begin
if (x > (sStatusbar.Width - 10)) and (x < sStatusbar.Width)
    and (y > (sStatusbar.Height - 10)) and (y < sStatusbar.Height) then
  begin
    po.X := X;
    po.Y := y;
    b := true;
  end;
end;
procedure TForm1.sStatusBarOnMouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
var
 Form: TForm;
 sStatusBar: TsStatusBar;
begin
if (x > (sStatusbar.Width - 10)) and (x < sStatusbar.Width)
    and (y > (sStatusbar.Height - 10)) and (y < sStatusbar.Height) then
  begin
    sStatusbar.Cursor := crSizeNWSE;
  end
  else
  begin
    sStatusbar.Cursor := crDefault;
  end;
  if b = true then
  begin

    Form.Height := Form.Height + (y - po.Y);
    Form.Width := Form.Width + (x - po.X);
    po.x := x;

  end;
end;

procedure TForm1.sStatusBarOnMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
 b := false;
end;

Присвоил эти обработчики при создании sStatusBar так:

     StatusBar:=TsStatusBar.Create(Form);
     StatusBar.SizeGrip:=True;
     StatusBar.SkinData.CustomColor:=True;
     StatusBar.SkinData.SkinSection:='ALPHACOMBOBOX';
     StatusBar.Color:=$00B6F7F8;
     StatusBar.OnMouseDown:=sStatusBarOnMouseDown;
     StatusBar.OnMouseMove:=sStatusBarOnMouseMove;
     StatusBar.OnMouseUp:=sStatusBarOnMouseUp;
     StatusBar.Parent:=Form;

Скомпилировал, запустил. Когда курсор попадает в область заметки, то выдается ошибка EAccessViolation

[dmitriegorovih]

procedure TForm1.sStatusBar1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (x > (TsStatusBar(sender).Width - 10)) and (x < TsStatusBar(sender).Width)
    and (y > (TsStatusBar(sender).Height - 10)) and (y < TsStatusBar(sender).Height) then
  begin
    po.X := X;
    po.Y := y;
    b := true;
  end;
end;

procedure TForm1.sStatusBar1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (x > (TsStatusBar(sender).Width - 10)) and (x < TsStatusBar(sender).Width)
    and (y > (TsStatusBar(sender).Height - 10)) and (y < TsStatusBar(sender).Height) then
  begin
    TsStatusBar(sender).Cursor := crSizeNWSE;
  end
  else
  begin
    TsStatusBar(sender).Cursor := crDefault;
  end;
  if b = true then
  begin

    form1.Height := form1.Height + (y - po.Y);
    form1.Width := form1.Width + (x - po.X);
    po.x := x;

  end;
end;

procedure TForm1.sStatusBar1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  b := false;
end;

а если так

[artemavd]

той ошибки нет. Только я немного изменил процедуру перемещения мыши на такую:

procedure TForm1.sStatusBarOnMouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
var
 Form: TForm;
 sStatusBar: TsStatusBar;
begin
if (x > (TsStatusBar(Sender).Width - 10)) and (x < TsStatusBar(Sender).Width)
    and (y > (TsStatusBar(Sender).Height - 10)) and (y < TsStatusBar(Sender).Height) then
  begin
    TsStatusBar(Sender).Cursor := crSizeNWSE;
  end
  else
  begin
    TsStatusBar(Sender).Cursor := crDefault;
  end;
  if b = true then
  begin

   (Sender as TForm).Height := (Sender as TForm).Height + (y - po.Y);
   (Sender as TForm).Width := (Sender as TForm).Width + (x - po.X);
    po.x := x;
  end;
end;

У меня же обработчики должны к каждой созданной форме выполняться. Правильно я написал?
Остальной код такой же как и выше. Но при попытке перемещения за треугольник, появляется ошибка: "Invalid class typecast". Где-то я классы неправильно привожу. Где?

[dmitriegorovih]

(Sender as TForm).Height := (Sender as TForm).Height + (y - po.Y);
   (Sender as TForm).Width := (Sender as TForm).Width + (x - po.X);

TsStatusBar(Sender).Parent.Height := TsStatusBar(Sender).Parent.Height + (y - po.Y);
   TsStatusBar(Sender).Parent.Width := TsStatusBar(Sender).Parent.Width + (x - po.X);

[artemavd]

Отлично, dmitriegorovih, спасибо! То, что нужно!
Только теперь последнее уточнение. Вот я написал процедуру удаления формы, которая должна закрыть текущую форму:

procedure TForm1.sButton1Click(Sender: TObject);
var
 Form: TForm;
begin
 (Sender as TForm).Parent.Free;
end;

И вот так присваиваю ее созданной кнопке:

SB.OnClick:=Form1.sButton1.OnClick;

Получаю ошибку: "Invalid class typecast"

Есть готовая процедура закрытия, которая работала ранее в событии FormCloseQuery динамически созданной формы. Выглядит она так:

procedure TForm1.ChildrenFormClose(Sender: TObject; var Action: TCloseAction);
begin
 if Application.MessageBox(PWideChar('Закрыть?'),
                          'Cool',
                          MB_OKCANCEL + MB_ICONINFORMATION) = mrOk then
 begin
  Action:=caFree;
 end
 else
 begin
  //
 end;
end;

Она работала почти правильно, но:
1. Если я в появившемся сообщении нажму или "ОК" или "Отмена", то форма закрывается, а по идее, форма не должна закрываться по нажатию на кнопку "Отмена" (т.е. отказ от закрытия)
2. Можно ли процедуру выше присвоить созданной кнопке и подправить логику работы этой процедуры?

[3D Hunter]

Касательно закрытия формы:

procedure TForm1.ChildrenFormClose(Sender: TObject; var Action: TCloseAction);
begin
 if Application.MessageBox(PWideChar('Закрыть?'),
                          'Cool',
                          MB_OKCANCEL + MB_ICONINFORMATION) = mrOk then
 begin
  Action:=caFree;
 end
 else
 begin
  Action:=caNone;//чтобы форма не закрывалась при нажатии 'OK'
 end;
end;

Странно, что не работает по уничтожению формы... попробуйте как вариант:

SB.OnClick:=sButton1Click;

А еще лучше, покажите объявление метода и в интерфейсной части тоже. Может компонент SB не типа TButton и его метод OnClick имеет другие входные параметры?

[phomm]

Можно поинтересоваться, почему опять каст сендера идёт к непонять какому компоненту, хотя заголовок метода четко указывает, чей обработчик?
В данном случае - обработчик кнопки , а кастуем к тформ.

[dmitriegorovih]

2. Можно ли процедуру выше присвоить созданной кнопке и подправить логику работы этой процедуры?

Можно, я бы сделал так, если больше не где нет уничтожения то условие можно вставить в кнопку то-есть как-то так

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Application.MessageBox(PAnsiChar('Закрыть?'),PAnsiChar('Cool'),
  MB_OKCANCEL + MB_ICONINFORMATION) = mrOk then
  begin
    Tsbutton(sender).Parent.Free;
  end;
end;