Delphi World - Вертикальный TitleBar
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Вертикальный TitleBar

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

type
   TForm1 = class(TForm)
     procedure FormResize(Sender: TObject);
     procedure FormPaint(Sender: TObject);
   private
     procedure VerticalTitleBar(Texto: string; Size: Integer);
   end;

 const
   MY_TITLE_TEXT = 'Vertical Text';
 var
   Form1: TForm1;

 implementation

 {$R *.DFM}

 procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
 var
   LogFont: TLogFont;
   tmpCanvas: TCanvas;
   tmpRect: TRect;
   x1, x2, y1, y2: integer;
 begin
   tmpCanvas        := TCanvas.Create;
   tmpCanvas.Handle := GetWindowDc(Handle);
   try
     GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
     with LogFont do
     begin
       lfEscapement   := 90 * 10;
       lfOrientation  := 90 * 10;
       lfOutPrecision := OUT_TT_ONLY_PRECIS;
       lfFaceName     := 'Arial';
       lfHeight       := Size;
       lfWeight       := FW_BOLD;
       lfQuality      := PROOF_QUALITY;
     end;
     with tmpCanvas do
     begin
       Font.Handle := CreateFontIndirect(LogFont);
       Font.Color  := clWhite;
       Brush.Color := clNavy;
     end;
     x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
     x2 := 20;
     y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) +
           GetSystemMetrics(SM_CYBORDER) + 1;
     y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
     tmpRect := Rect(x1, y1, x2, y2);
     tmpCanvas.FillRect(tmpRect);
     DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or
       DT_SINGLELINE);
   finally
     tmpCanvas.Free;
   end;
 end;

 procedure TForm1.FormResize(Sender: TObject);
 begin
   VerticalTitleBar(MY_TITLE_TEXT, 12);
 end;

 procedure TForm1.FormPaint(Sender: TObject);
 begin
   VerticalTitleBar(MY_TITLE_TEXT, 12);
 end;

 end.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования