Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Окно в виде кольца с изогнутой заголовочной полосой

Delphi , Программа и Интерфейс , Заголовок формы

Окно в виде кольца с изогнутой заголовочной полосой


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, Buttons, StdCtrls;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    rTitleBar : THandle;
    Center : TPoint;
    CapY : Integer;
    Circum : Double;
    SB1 : TSpeedButton;
    RL, RR : Double;
    procedure TitleBar(Act : Boolean);
    procedure WMNCHITTEST(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE); message WM_NCACTIVATE;
    procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
  public
  { Public declarations }
end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

const
  TitlColors : array[Boolean] of TColor = (clInactiveCaption, clActiveCaption);
  TxtColors : array[Boolean] of TColor = (clInactiveCaptionText, clCaptionText);

procedure TForm1.FormCreate(Sender: TObject);
var
  rTemp, rTemp2 : THandle;
  Vertices : array[0..2] of TPoint;
  X, Y : INteger;
begin
  Caption := 'Delphi World is great!';
  BorderStyle := bsNone; {required}
  if Width > Height then
    Width := Height
  else
    Height := Width; {harder to calc if width <> height}
  Center := Point(Width div 2, Height div 2);
  CapY := GetSystemMetrics(SM_CYCAPTION)+8;
  rTemp := CreateEllipticRgn(0, 0, Width, Height);
  rTemp2 := CreateEllipticRgn((Width div 4), (Height div 4),
  3*(Width div 4), 3*(Height div 4));
  CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);
  SetWindowRgn(Handle, rTemp, True);
  DeleteObject(rTemp2);
  rTitleBar := CreateEllipticRgn(4, 4, Width-4, Height-4);
  rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);
  Vertices[0] := Point(0,0);
  Vertices[1] := Point(Width, 0);
  Vertices[2] := Point(Width div 2, Height div 2);
  rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);
  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);
  DeleteObject(rTemp);
  RL := ArcTan(Width / Height);
  RR := -RL + (22 / Center.X);
  X := Center.X-Round((Center.X-1-(CapY div 2))*Sin(RR));
  Y := Center.Y-Round((Center.Y-1-(CapY div 2))*Cos(RR));
  SB1 := TSpeedButton.Create(Self);
  with SB1 do
  begin
    Parent := Self;
    Left := X;
    Top := Y;
    Width := 14;
    Height := 14;
    OnClick := Button1Click;
    Caption := 'X';
    Font.Style := [fsBold];
  end;
end;

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);
begin
  inherited;
  with Msg do
    with ScreenToClient(Point(XPos,YPos)) do
      if PtInRegion(rTitleBar, X, Y) and
      (not PtInRect(SB1.BoundsRect, Point(X,Y))) then
        Result := htCaption;
end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);
begin
  inherited;
  TitleBar(Msg.Active);
end;

procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
  inherited;
  TitleBar(Active);
end;

procedure TForm1.TitleBar(Act: Boolean);
var
  TF : TLogFont;
  R : Double;
  N, X, Y : Integer;
begin
  if Center.X = 0 then
    Exit;
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := TitlColors[Act];
    PaintRgn(Handle, rTitleBar);
    R := RL;
    Brush.Color := TitlColors[Act];
    Font.name := 'Arial';
    Font.Size := 12;
    Font.Color := TxtColors[Act];
    Font.Style := [fsBold];
    GetObject(Font.Handle, SizeOf(TLogFont), @TF);
    for N := 1 to Length(Caption) do
    begin
      X := Center.X-Round((Center.X-6)*Sin(R));
      Y := Center.Y-Round((Center.Y-6)*Cos(R));
      TF.lfEscapement := Round(R * 1800 / pi);
      Font.Handle := CreateFontIndirect(TF);
      TextOut(X, Y, Caption[N]);
      R := R - (((TextWidth(Caption[N]))+2) / Center.X);
      if R < RR then
        Break;
    end;
    Font.name := 'MS Sans Serif';
    Font.Size := 8;
    Font.Color := clWindowText;
    Font.Style := [];
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  with Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Style := bsClear;
    Pen.Width := 1;
    Pen.Color := clWhite;
    Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);
    Arc((Width div 4)-1, (Height div 4)-1,
    3*(Width div 4)+1, 3*(Height div 4)+1, 0, Height, Width, 0);
    Pen.Color := clBlack;
    Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);
    Arc((Width div 4)-1, (Height div 4)-1,
    3*(Width div 4)+1, 3*(Height div 4)+1, Width, 0, 0, Height);
    TitleBar(Active);
  end;
end;

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

end.

Программа на Delphi, которая создает окно с круглым контуром и эллиптическим заголовком. Заголовок имеет жирный шрифт и может изменять цвет в зависимости от активности окна.

Обзор кода:

  1. Класс TForm1 наследуется от TForm и определяет несколько приватных переменных: rTitleBar, Center, CapY, Circum, SB1, RL и RR. Эти переменные используются для хранения.handle области заголовка, центр точки окна, координаты y-координаты заголовка и других значений.
  2. Процедура FormCreate вызывается при создании формы. Она настраивает свойства окна, создает эллиптическую область для заголовка и объединяет ее с другой областью для создания круглого контура.
  3. Процедура WMNCHITTEST обрабатывает сообщение WM_ NCHITTEST, которое отправляется при клике пользователя на не-клиентскую зону окна (т.е., заголовок или рамки). Она проверяет, была ли кликка внутри области заголовка, и возвращает htCaption если это так.
  4. Процедура WMNCActivate обрабатывает сообщение WM_ NCACTIVATE, которое отправляется при изменении состояния активности окна. Она вызывает процедуру TitleBar для обновления цвета и шрифта заголовка.
  5. Процедура WMSetText обрабатывает сообщение WM_ SETTEXT, которое отправляется при изменении текста окна. Она также вызывает процедуру TitleBar для обновления цвета и шрифта заголовка.
  6. Процедура TitleBar обновляет цвет и шрифт заголовка в зависимости от активности окна. Она использует свойство Canvas формы для рисования области заголовка с жирным шрифтом и указанным цветом.
  7. Процедура FormPaint вызывается при необходимости перерисовки формы (например, при изменении размера окна). Она рисует круглый контур с помощью метода Arc, а затем вызывает процедуру TitleBar для обновления цвета и шрифта заголовка.
  8. Процедура Button1Click обрабатывает событие клика кнопки на форме. При клике она закрывает окно.

Советы по улучшению:

  • Код использует магические числа (например, 4, 22), которые не объясняются в комментариях. Лучше было бы определить константы для этих значений.
  • Процедура FormCreate является quite длинной и сложной. Она может быть разбита на более маленькие процедуры или функции, выполняющие конкретные задачи.
  • Код использует много глобальных переменных (например, rTitleBar, Center). Лучше было бы обернуть эти переменные в приватную секцию формы или использовать свойства для доступа к ним.
  • Цвет и шрифт заголовка обновляются в зависимости от активности окна. Это можно улучшить, используя отдельные процедуры для обновления внешнего вида заголовка при активации или деактивации окна.

В целом, это код хорошего начала, но он может выиграть от рефакторинга для улучшения его maintainability и эффективности.

В статье описывается создание окна в виде кольца с изогнутой заголовочной полосой на языке Delphi.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




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



:: Главная :: Заголовок формы ::


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-06-02 10:20:12
2024-07-13 05:10:02/0.0037639141082764/0