Затык пока в том, что не знаю как изменять размеры окна. Рамка формируется самостоятельно, а стандартная отключена.
- Код: Выделить всё
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.