Form Caption

[S_Azeri]

Formun Caption'nun fontunu nasil deyismek olur. Lutfen yardim edin/

[mrmarman]

Selam...

- Bilgisayarimdan uzaktayim. Deneme sansim yok. Bir Internet Cafe'den cevap yaziyorum...

- Yaptigim arastirma sonucu asagidaki kodu buldum. Cozum olacagini degerlendiriyorum.

- Mantik, formun boyandigi her an, kendi fontumuz ve renginde tekrar boyayip istedigimiz font, style ve renge donusturmek seklinde...

- Kod uzerinde degisiklik yapmaksizin, birebir kopyaladim... Font adi vs. kendine gore duzenlemelisin...

Kod: Tümünü seç

// You have to write a handler for Form's OnPaint event;
procedure TForm1.FormPaint(Sender: TObject);
const sc_title = 'This is the caption text which you want to write';
var MyRect, RealRect : TRect;
    MyHDC : HDC;
    x, y : integer;
    SysLogFont, LogFont : TLogFont;
begin
  // here is full form's rectangle
  GetWindowRect(Handle, RealRect);
  MyHDC := GetWindowDC(Handle);

  // Let's set font size to system font's size and select it
  if GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont)<>0 then begin
    if GetObject(GetStockObject(SYSTEM_FONT), SizeOf(SysLogFont),
@SysLogFont)<>0 then begin
      LogFont.lfHeight := SysLogFont.lfHeight;
    end;
    SelectObject(MyHDC, CreateFontIndirect(LogFont));
  end;

 // Now lets calculate the rectangular region where you want to write your
text on
  x := GetSystemMetrics( SM_CXSIZE )+
       GetSystemMetrics( SM_CXBORDER )+
       GetSystemMetrics( SM_CXFRAME );
  y := GetSystemMetrics( SM_CYFRAME ) +
       GetSystemMetrics( SM_CYBORDER );
  MyRect.Left := x;
  MyRect.Top := y;

  MyRect.Right := RealRect.Right - RealRect.Left -2*x -
                  GetSystemMetrics( SM_CXFRAME );
  MyRect.Bottom :=
       GetSystemMetrics( SM_CYFRAME ) +
       GetSystemMetrics( SM_CYBORDER ) +
       GetSystemMetrics(SM_CYSIZE );

  if Active
     then SetBkColor( MyHDC, GetSysColor(COLOR_ACTIVECAPTION) )
     else SetBkColor( MyHDC, GetSysColor(COLOR_INACTIVECAPTION) );

  // This enables to view gradient color change under Windows 2000
  SetBkMode( MyHDC, TRANSPARENT );

  // Text color must be retrieved from system also
  if Active
     then SetTextColor( MyHDC, GetSysColor(COLOR_CAPTIONTEXT) )
     else SetTextColor( MyHDC, GetSysColor(COLOR_INACTIVECAPTIONTEXT) );

  // Here is actual text output on the caption
  DrawText( MyHDC, sc_title, -1, MyRect, DT_LEFT );
  ReleaseDC( Handle, MyHDC );
end;


You have to write a handler for form's OnCreate event as follows:

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Just set canvas font to your font.
  // I used this to write Lithuanian font text on the systems which doesn't
supported Lithuanian language
  // Well, this may contradict to Microsoft rule that form's caption must be
written in System's font, but I denied it
  // for the sake of Lithuanian user
  Font.Name := 'TimesLT Stressed';
  Font.Size :=12;
  Font.Charset := ANSI_CHARSET;

  Canvas.Font.Name := 'TimesLT Stressed';
  Canvas.Font.Size :=12;
  Canvas.Font.Charset := ANSI_CHARSET;

  // It is necessary to set Form's caption to empty string in order system
doesn't implement Caption drawing
  Caption := '';

  // Form has to be repainted when a user switches to another application's
window
  Application.OnDeactivate := AppDeactivate;

end;


procedure TForm1.AppDeactivate(Sender: TObject);
begin
  Form1.Repaint;
end;

// Also form has to be repainted here too
procedure TForm1.FormDeactivate(Sender: TObject);
begin
  Form1.Repaint;
end;

[husonet]

Merhaba,

Öncelikle Form'umuza Method umuzu tanıtalım.

Kod: Tümünü seç

  TForm1 = class(TForm)
  private
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    { Private declarations }
  public
    { Public declarations }
  end;

Ardından kodumuzu yazalım çok basit bir olay düzenlemeleri yaparsınız.

Kod: Tümünü seç

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var ACanvas: TCanvas;
   intLeftShift, intTopShift: Integer;
begin
 inherited;
 Form1.caption := '';
 ACanvas := TCanvas.Create;
 try
   ACanvas.Handle := GetWindowDC(Form1.Handle);
   with ACanvas do
   begin
     Brush.Style := bsclear;
     Font.Style := [fsItalic, fsBold];
     font.Height := 20;
     intLeftShift := GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER);
     intTopShift := (GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height)) div 2 + 2;
     TextOut(intLeftShift, intTopShift, 'Hüseyin ÖZDEMİR')
   end;
 finally
   ReleaseDC(Form1.Handle, ACanvas.Handle);
   ACanvas.Free
 end;
end;

Kolay Gelsin...
İyi Geceler .