Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2010.10.03;
Скачать: CL | DM;

Вниз

Изменить шрифт заголовка окна   Найти похожие ветки 

 
DC-AC   (2010-07-07 15:21) [0]

Доброго времени суток.
Нужно написать заголовок основной формы меньшим шрифтом. Делаю так :

type
TForm1 = class(TForm)
private
  procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
ACanvas: TCanvas;
begin
inherited;
ACanvas := TCanvas.Create;
try
  ACanvas.Handle := GetWindowDC(Form1.Handle);
  with ACanvas do
  begin
    Brush.Color := clActiveCaption;
    Font.Name := "Tahoma";
    Font.Size := 8;
    Font.Color := clWhite;
    Font.Style := [fsBold];
    TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
      Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) / 2) + 1,
        " Мой текст");
  end;
finally
  ReleaseDC(Form1.Handle, ACanvas.Handle);
  ACanvas.Free;
end;
end;


Поставил обработчик OnPaint

procedure TForm1.FormPaint(Sender: TObject);
begin
SendMessage(Form1.Handle, WM_NCPAINT, 0, 0);
end;

Этот обработчик помогает при сворачивании-разворачивании окна, а при вызове любой модальной формы или MessageDlg - заголовок у формы пропадает. Какой обработчик еще нужно поставить ?


 
aka   (2010-07-07 15:30) [1]


> Какой обработчик еще нужно поставить ?

их не много, втыком нет?


 
Юрий Зотов ©   (2010-07-07 15:31) [2]

WM_NCACTIVATE ?


 
DC-AC   (2010-07-07 16:05) [3]

Частично помогло

 private
   { Private declarations }
  procedure WMNCACTIVATE(var M: TWMNCACTIVATE); message WM_NCACTIVATE;
...
procedure TForm1.WMNCACTIVATE(var M: TWMNCACTIVATE);
var
ACanvas: TCanvas;
begin
inherited;
ACanvas := TCanvas.Create;
try
  ACanvas.Handle := GetWindowDC(Form1.Handle);
  with ACanvas do
  begin
    if M.Active then Brush.Color := clActiveCaption
    else Brush.Color := clInActiveCaption;
    Font.Name := "Tahoma";
    Font.Size := 8;
    Font.Color := clWhite;
    Font.Style := [fsBold];
    TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
      Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) / 2) + 1,
        " Мой текст");
  end;
finally
  ReleaseDC(Form1.Handle, ACanvas.Handle);
  ACanvas.Free;
end;
end;

Но : при вызове модальной формы фон заголовка нормальный, при вызове MessageDlg все равно clActiveCaption
if M.Active then Brush.Color := clActiveCaption else Brush.Color := clInActiveCaption не помогает...


 
Игорь Шевченко ©   (2010-07-07 16:31) [4]

Брось ты эту затею


 
DC-AC   (2010-07-08 07:55) [5]

Наверное придется бросить. Просто потребовалось увеличить длину Caption а куча контролов на форме уже расставлены, так неохота было все заново выравнивать. Несколько десятков MessageDlgPos тоже придется переделывать :-(. Всем спасибо.


 
Юрий Зотов ©   (2010-07-08 09:37) [6]


> DC-AC   (08.07.10 07:55) [5]

Когда-то делал я класс формы с собственной прорисовкой Caption. Сделать-то сделал, но не запросто. Там действительно не все так просто, пришлось вставлять порядка десятка обработчиков.



Страницы: 1 вся ветка

Текущий архив: 2010.10.03;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.008 c
15-1278348746
SemNic
2010-07-05 20:52
2010.10.03
Могут ли быть проблемы в WIN7 при эксплуатации для проги


15-1271848907
12
2010-04-21 15:21
2010.10.03
Заключение Комиссии по проведению экспертизы работ Петрика В.И.


2-1278360825
AKE
2010-07-06 00:13
2010.10.03
Как отключить оптимизацию...


15-1278309120
Ulugbek
2010-07-05 09:52
2010.10.03
Как удалить в самом Delphi Recent open files?


2-1278433099
Delphist2
2010-07-06 20:18
2010.10.03
полупрозрачность