Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Object-Pascal / Delphi-Language (https://www.delphipraxis.net/35-library-object-pascal-delphi-language/)
-   -   Delphi Schriftart eines Kontrolls ermitteln (https://www.delphipraxis.net/2590-schriftart-eines-kontrolls-ermitteln.html)

Luckie 30. Jan 2003 10:48


Schriftart eines Kontrolls ermitteln
 
Delphi-Quellcode:
type

TCharSetRec = packed record
   Name: String;
   ID: Integer;
end;

const
   NumCharSets = 19;

   CharSets: array[0..NumCharSets - 1] of TCharSetRec = ( 
     (Name: 'ANSI_CHARSET'; ID: 0),
     (Name: 'DEFAULT_CHARSET'; ID: 1),
     (Name: 'SYMBOL_CHARSET'; ID: 2),
     (Name: 'SHIFTJIS_CHARSET'; ID: $80),
     (Name: 'HANGEUL_CHARSET'; ID: 129),
     (Name: 'GB2312_CHARSET'; ID: 134),
     (Name: 'CHINESEBIG5_CHARSET'; ID: 136),
     (Name: 'OEM_CHARSET'; ID: 255),
     (Name: 'JOHAB_CHARSET'; ID: 130),
     (Name: 'HEBREW_CHARSET'; ID: 177),
     (Name: 'ARABIC_CHARSET'; ID: 178),
     (Name: 'GREEK_CHARSET'; ID: 161),
     (Name: 'TURKISH_CHARSET'; ID: 162),
     (Name: 'VIETNAMESE_CHARSET'; ID: 163),
     (Name: 'THAI_CHARSET'; ID: 222),
     (Name: 'EASTEUROPE_CHARSET'; ID: 238),
     (Name: 'RUSSIAN_CHARSET'; ID: 204),
     (Name: 'MAC_CHARSET'; ID: 77),
     (Name: 'BALTIC_CHARSET'; ID: 186));
     
procedure TForm1.Button1Click(Sender: TObject);
var
  LogFont: TLogFont;
  Fonthandle: HFont;
  ID: Integer;
begin
  // Handle auf Schriftart ermitteln
  Fonthandle := SendMessage(Control_Handle, WM_GETFONT, 0, 0);
  FillChar(LogFont, SizeOf(LogFont), 0);
  // LogFont Details ermitteln
  GetObject(Fonthandle, SizeOf(logfont), @LogFont);
  with LogFont do
  begin
    label1.Caption := StrPas(lffaceName); // Schriftname
    label1.Height := -lfHeight; // Höhe
    if lfWeight <> FW_MEDIUM then // Fett
    if lfItalic <> 0 then  // Kursiv
    if lfUnderline <> 0 then // Unterstrichen
    if lfStrikeout <> 0 then // Durchgestrichen

    case (lfPitchAndFamily and 3) of
      VARIABLE_PITCH: // fpVariable Schrift;
      FIXED_PITCH: // fpFixed Schrift;
    end;

    ID := lfCharSet;

    for I := 0 to NumCharSets - 1 do
     if CharSets[I].ID = ID then begin
       ShowMessage(CharSets[I].Name); // Charakterset anzeigen
       Break;
    end;
   
    // usw...
  end;
end;
Aus einem Beitrag von Tom.


Alle Zeitangaben in WEZ +1. Es ist jetzt 19:57 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz