var 
  ncm: NONCLIENTMETRICS; 
  CaptionFontMerk: array[0..32] of char; 
  gemerkt: boolean = false; 
 
procedure MerkCaptionFontName; 
begin 
  if gemerkt then exit; 
  zeromemory(@CaptionFontMerk, sizeof(CaptionFontMerk)); 
  ncm.cbSize := sizeof(NONCLIENTMETRICS); 
  systemparametersinfo(SPI_GETNONCLIENTMETRICS, 0, @ncm, 0); 
  lstrcpy(CaptionFontMerk, ncm.lfCaptionFont.lfFaceName); 
  gemerkt := true; 
end; 
 
procedure CaptionFontAendern(p: Pchar); 
begin 
  if (p <> nil) and gemerkt then begin 
    lstrcpy(ncm.lfCaptionFont.lfFaceName, p); 
    systemparametersinfo(SPI_SETNONCLIENTMETRICS, 0, @ncm, 
      SPIF_UPDATEINIFILE); 
  end; 
end; 
 
// Schrift in Captionbar ändern 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  screen.cursor := crHourglass; 
  MerkCaptionFontName; 
  CaptionFontAendern('Courier New'); 
  screen.cursor := crdefault; 
end; 
 
// Schrift in Captionbar zurücksetzen 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  screen.cursor := crHourglass; 
  CaptionFontAendern(CaptionFontMerk); 
  screen.cursor := crdefault; 
end;