Виртуальная библиотека Delphi

  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;

end.

Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==> "c:\progra~1")

GetShortPathName()

Как создать свою кнопку в заголовке формы (на Caption Bar)

Непосредственно такой функции вроде нет, но можно изловчиться. Нарисовать там кнопку вручную и обрабатывать команды нажатия мышки на Caption Bar.

Пример.

unit Main;

interface

uses

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

type

  TForm1 = class(TForm)

    procedure FormResize(Sender: TObject);

  private

    CaptionBtn : TRect;

    procedure DrawCaptButton;

    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;

    procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;

    procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;

    procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;

    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;

  public

   { Public declarations }

  end;

var

  Form1: TForm1;

implementation

const

  htCaptionBtn = htSizeLast + 1;

{$R *.DFM}

procedure TForm1.DrawCaptButton;

var

  xFrame,  yFrame,  xSize,  ySize  : Integer;

  R : TRect;

begin

  //Dimensions of Sizeable Frame

  xFrame := GetSystemMetrics(SM_CXFRAME);

  yFrame := GetSystemMetrics(SM_CYFRAME);

  //Dimensions of Caption Buttons

  xSize  := GetSystemMetrics(SM_CXSIZE);

  ySize  := GetSystemMetrics(SM_CYSIZE);

  //Define the placement of the new caption button

  CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,