Самостоятельно отрисованное окно

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Самостоятельно отрисованное окно

Сообщение Лекс Айрин » 29.11.2017 15:23:09

Пытаюсь создать окно нарисованное с заголовком-ярлычком. Пока не формирую компонент, но потом хочется сделать.
Затык пока в том, что не знаю как изменять размеры окна. Рамка формируется самостоятельно, а стандартная отключена.

Код: Выделить всё
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Menus;

type

  { TTestForm }

  TTestForm = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    ExitItem: TMenuItem;
    HideItem: TMenuItem;
    MaximizeItem: TMenuItem;
    Panel1: TPanel;
    CaptionMenu: TPopupMenu;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    HTitle: integer;         // ширина заголовка и
    WTitle: integer;// его высота.
    WinPoint: array [1..7] of TPoint;// здесь чтобы постоянно не перевычислять при обновлении
    RealCaption:TCaption; //отображаемый заголовок
    LenghtRealCaption:integer;// его длинна
    Procedure DrawTitle (Sender: TObject);
  public
    ColorCaption:TColor;//цвет заливки заголовка окна
  end;

var
  TestForm: TTestForm;

implementation

{$R *.lfm}

{ TTestForm }

procedure TTestForm.Button1Click(Sender: TObject);
begin
  TestForm.Close;
end;

procedure TTestForm.FormCreate(Sender: TObject);
begin
  DrawTitle(self);
end;

procedure TTestForm.DrawTitle(Sender: TObject);
var
  ABitmap: TBitmap;

  //
begin
  { Заголовок рисуется на канвасе как полигон (для пробы)а потом внутрь него помещается
  текст.
  }
  //вычисление опорных констант. Пока для варианта выровненного по левому краю
  WTitle:=TestForm.Canvas.TextWidth(TestForm.Caption);
  HTitle:=TestForm.Canvas.TextHeight(TestForm.Caption);
  {результат -- заголовок в виде ярлычка  на время проверки только выравненено
  по левому краю. в будущем ярлычок выравнивается либо по краям, либо по центру
  }
  // координаты оконные !!!

  //первая точка опускается на высоту заголовка относительно верхнего левого угла.
  WinPoint[1].x:=0;
  WinPoint[1].y:=HTitle;
  //вторая точка сдвигается вправо на высоту заголовка относительно верхнего левого угла
  WinPoint[2].x:=HTitle;
  WinPoint[2].y:=0;
  // третья точка сдвигается относительно второй на величину текста + 20 точек
       // или занимает весь заголовок - высоту текста относительно правого верзнего угла
  WinPoint[3].x:=HTitle+WTitle + 20;// пока не сокращаем заголовок!!
  WinPoint[3].y:=0;
  // четвертая точка сдвигается на высоту заголовка относительно правого верзнего угла.
  WinPoint[4].x:=WinPoint[3].x+HTitle;//чтобы не перевычислять
  WinPoint[4].y:=HTitle;
  // пятая точка опущена ниже правого верхнего угла на высоту заголовка
  WinPoint[5].x:=TestForm.Width;
  WinPoint[5].y:=Htitle;
  // шестая точка совпадает с нижним правым углом окна.
  WinPoint[6].x:=TestForm.Width;
  WinPoint[6].y:=TestForm.Height;
  // седьмая точка совпадает с нижним левым углом окна.
  WinPoint[7].x:=0;
  WinPoint[7].y:=TestForm.Height;
  // текст пишется относительно начала заголовка на 10 точек. При необходимости,
     //отсекается по границе заголовка -10точек.
     //создание области отрисовки!!!
  ABitmap := TBitmap.Create;
  ABitmap.Monochrome := True;
  ABitmap.Width := TestForm.Width;
  ABitmap.Height := TestForm.Height;
   with ABitmap.Canvas do
  begin
    Brush.Color := clBlack; // transparent color
    FillRect(0, 0, ABitmap.Width, ABitmap.Height);
    Brush.Color := clWhite; // mask color
    Polygon(WinPoint);
  end;
  TestForm.SetShape(ABitmap);
  ABitmap.Free;
  TestForm.Panel1.Top:=Htitle+3;
  TestForm.Panel1.Left:=3;
  TestForm.Panel1.Width:=TestForm.Width-6;
  TestForm.Panel1.Height:=TestForm.Height-6 - HTitle;
  Panel1.Repaint;
end;

end.

У вас нет необходимых прав для просмотра вложений в этом сообщении.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4167
Зарегистрирован: 19.02.2013 16:54:51

Re: Самостоятельно отрисованное окно

Сообщение MysticCoder » 29.11.2017 20:22:52

Повесь событие на OnResize
MysticCoder
постоялец
 
Сообщения: 117
Зарегистрирован: 14.09.2013 00:20:28

Re: Самостоятельно отрисованное окно

Сообщение olegy123 » 30.11.2017 01:27:32

MysticCoder писал(а):OnResize


может проще создать свой класс и переопределить методы.
TScrollingWinControl.DoOnResize
olegy123
энтузиаст
 
Сообщения: 756
Зарегистрирован: 25.02.2016 12:10:20

Re: Самостоятельно отрисованное окно

Сообщение Лекс Айрин » 30.11.2017 10:26:03

MysticCoder, на что повесить? Просто на окно?

olegy123 писал(а):может проще создать свой класс и переопределить методы.
TScrollingWinControl.DoOnResize


Это, собственно, и есть отдельный класс.

Вообще, вечером пришла идея обработать onMove и объединить перемещение и изменение размеров окна, но очень уж это похоже на костыль(((

Добавлено спустя 3 часа 43 минуты 32 секунды:
Попытался так же изменить форму TPanel, но почему-то форма не изменилась. Такое впечатление, что для него это просто не применимо(((

Код: Выделить всё
procedure TTestForm.DrawTitle(Sender: TObject);
var
  FoneBitmap, //фон заголовка
    ABitmap: TBitmap;// окно
begin
  { Заголовок рисуется на канвасе как полигон (для пробы)а потом внутрь него помещается
  текст.
  }
  //вычисление опорных констант. Пока для варианта выровненного по левому краю
//  Label1.Caption:=TestForm.Caption;
  WTitle:=Label1.Canvas.TextWidth(Label1.Caption);//TestForm.Canvas.TextWidth(Label1.Caption);
  HTitle:=Label1.Canvas.TextHeight(Label1.Caption);//TestForm.Canvas.TextHeight (Label1.Caption);
  {результат -- заголовок в виде ярлычка  на время проверки только выравненено
  по левому краю. в будущем ярлычок выравнивается либо по краям, либо по центру
  }
  // координаты оконные !!!

  //первая точка опускается на высоту заголовка относительно верхнего левого угла.
  WinPoint[1].x:=0;
  WinPoint[1].y:=HTitle;
  //вторая точка сдвигается вправо на высоту заголовка относительно верхнего левого угла
  WinPoint[2].x:=HTitle;
  WinPoint[2].y:=0;
  // третья точка сдвигается относительно второй на величину текста + 20 точек
       // или занимает весь заголовок - высоту текста относительно правого верзнего угла
  WinPoint[3].x:=HTitle+WTitle + 20;// пока не сокращаем заголовок!!
  WinPoint[3].y:=0;
  // четвертая точка сдвигается на высоту заголовка относительно правого верзнего угла.
  WinPoint[4].x:=WinPoint[3].x+HTitle;//чтобы не перевычислять
  WinPoint[4].y:=HTitle;
  // пятая точка опущена ниже правого верхнего угла на высоту заголовка
  WinPoint[5].x:=TestForm.Width;
  WinPoint[5].y:=Htitle;
  // шестая точка совпадает с нижним правым углом окна.
  WinPoint[6].x:=TestForm.Width;
  WinPoint[6].y:=TestForm.Height;
  // седьмая точка совпадает с нижним левым углом окна.
  WinPoint[7].x:=0;
  WinPoint[7].y:=TestForm.Height;
  // текст пишется относительно начала заголовка на 10 точек. При необходимости,
     //отсекается по границе заголовка -10точек.
     //создание области отрисовки!!!
  ABitmap := TBitmap.Create;
  ABitmap.Monochrome := True;
  ABitmap.Width := TestForm.Width;
  ABitmap.Height := TestForm.Height;
   with ABitmap.Canvas do
  begin
    Brush.Color := clBlack; // transparent color
    FillRect(0, 0, ABitmap.Width, ABitmap.Height);
    Brush.Color := clWhite; // mask color
    Polygon(WinPoint);
  end;
  TestForm.SetShape(ABitmap);
  ABitmap.Free;
  // формирование панели под заголовком
  // 1-5 точки совпадают с формой окна
  TitlePoint[1].x:=WinPoint[1].x;
  TitlePoint[1].y:=WinPoint[1].y;
  TitlePoint[2].x:=WinPoint[2].x;
  TitlePoint[2].y:=WinPoint[2].y;
  TitlePoint[3].x:=WinPoint[3].x;
  TitlePoint[3].y:=WinPoint[3].y;
  TitlePoint[4].x:=WinPoint[4].x;
  TitlePoint[4].y:=WinPoint[4].y;
  TitlePoint[5].x:=WinPoint[5].x;
  TitlePoint[5].y:=WinPoint[5].y;

    //6 точка ниже 5на 100 пикселей
  TitlePoint[6].x:=TestForm.Width;
  TitlePoint[6].y:=500;
  //7 точка выше левого нижнего угла на 20 пикселей
  TitlePoint[7].x:=0;
  TitlePoint[7].y:=TestForm.Height - 300;
//отображение заголовка
  FoneBitmap := TBitmap.Create;
  FoneBitmap.Monochrome := True;
  FoneBitmap.Width := TestForm.Width;
  FoneBitmap.Height := TestForm.Height -300;
   with FoneBitmap.Canvas do
  begin
    Brush.Color := clBlack; // transparent color
    FillRect(0, 0, FoneBitmap.Width, FoneBitmap.Height);
    Brush.Color := clWhite; // mask color
    Polygon(TitlePoint);
  end;
  Panel2.SetShape(FoneBitmap);
  Panel2.Repaint;
  FoneBitmap.Free;
  //конец отображения заголовка

  //формирование панели под рабочую область
  TestForm.Panel1.Top:=Htitle+3;
  TestForm.Panel1.Left:=3;
  TestForm.Panel1.Width:=TestForm.Width-6;
  TestForm.Panel1.Height:=TestForm.Height-6 - HTitle;
  Panel1.Repaint;
  //пишем заголовок
  //TestForm.Canvas.MoveTo(HTitle+10, 3);//пока так
  Label1.Left:=HTitle +10;
  Label1.Top:=3;

end;               
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4167
Зарегистрирован: 19.02.2013 16:54:51

Re: Самостоятельно отрисованное окно

Сообщение Лекс Айрин » 06.12.2017 12:31:10

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

Добавлено спустя 4 часа 10 минут 11 секунд:
Самое смешное, что в итоге я просто написал Application.Minimize, а стандартную иконку отключил.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4167
Зарегистрирован: 19.02.2013 16:54:51


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot], Google Adsense [Bot] и гости: 13

Рейтинг@Mail.ru