TrueType und OpenType Fonts unterscheiden

[ChrisE]

Hallo,

also zunächst einmal hat mich dieser Artikel dazu gebracht mehr über den Font zur Laufzeit heraus bekommen zu wollen. Leider klappt es nicht so ganz wie ich mir das vorstelle. Viele Fonteigenschaften erhält man ja über die API-Funktion

Delphi-Quellcode:

GetTextMetrics(...)

Vielleicht hat einer von euch ja die Lösung für meine Probleme:
1. Wie unterscheide ich OpenType und TrueType-Schriftarten?
2. Wie erhalte ich die Icons für TrueType, OpenType etc. Die müßten doch im System hinterlegt sein.

Vielen Dank für eure Hilfe.

Gruß, Chris

[toms]

Hallo,

Habe folgenden Quellcode mit den Stichworten: OpenType TrueType GetTextMetrics bei Google-Groups gefunden.

Delphi-Quellcode:

(* 
  This can be used for Streams OR files. Set AStream parameter to nil 
  if passing a FileName. 


  Usage: 
    Scan a Stream: 
      ScanIt('texttofind', False, MyMemoryStream); 


    Scan a File: 
     ScanIt('texttofind', False, nil, 'c:\mytextfile.txt'); 


*) 


function ScanIt(const forString: String; 
                caseSensitive: Boolean; 
                AStream: TStream; 
                AFilename: TFileName = ''): LongInt; 
{ 
  returns position of string in stream or file, 
  returns -1 if not found 


} 


const 
  BufferSize= $8001; { 32K+1 bytes } 
var 
  pBuf, pend, pScan, pPos : Pchar; 
  bytesRemaining: Integer; 
  bytesToRead: Integer; 
  SearchFor: Pchar; 
  filesize: LongInt; 
  fsTemp: TFileStream; 
begin 
  Result := -1; { assume failure } 
  if (Length(forString) = 0) or 
     ((AStream <> nil) and (AStream.Size = 0)) and 
     ((AStream = nil) and (Length(AFilename) = 0)) then 
    Exit; 
  SearchFor := nil; 
  pBuf := nil; 
  { open file as binary, 1 byte recordsize } 
  if not Assigned(AStream) then 
  begin 
    fsTemp := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); 
    try 
      Result := ScanIt(forString, caseSensitive, fsTemp); 
    finally 
      fsTemp.free; 
    end; 
  end 
  else 
  begin 
    try { allocate memory for buffer and pchar search string } 
      SearchFor := StrAlloc(Length(forString)+1); 
      StrPCopy(SearchFor, forString); 
      if not caseSensitive then { convert to upper case } 
        AnsiUpper(SearchFor); 
      GetMem(pBuf, BufferSize); 
      filesize := AStream.Size; 
      bytesRemaining := filesize; 
      pPos := nil; 
      while bytesRemaining > 0 do 
      begin 
        { calc how many bytes to read this round } 
        if bytesRemaining >= BufferSize then 
          bytesToRead := Pred(BufferSize) 
        else 
          bytesToRead := bytesRemaining; 

        AStream.ReadBuffer(pBuf^, bytesToRead); 
        { read a buffer full and zero-terminate the buffer } 
        pend := @pBuf[ bytesToRead ]; 
        pend^:= #0; 
        { scan the buffer. Problem: buffer may contain #0 chars! So we 
          treat it as a concatenation of zero-terminated strings. } 
        pScan := pBuf; 
        while pScan < pend do 
        begin 
          if not caseSensitive then { convert to upper case } 
            AnsiUpper(pScan); 
          pPos := StrPos(pScan, SearchFor); { search for substring } 
          if pPos <> nil then { Found it! } 
          begin 
            Result := fileSize - bytesRemaining + 
                      LongInt(pPos) - LongInt(pBuf); 
            break; 
          end; 
          pScan := Strend(pScan); 
          Inc(pScan); 
        end; 
        if pPos <> nil then 
          break; 
        bytesRemaining := bytesRemaining - bytesToRead; 
        if bytesRemaining > 0 then 
        begin 
          { no luck in this buffers load. We need to handle the case of 
          the search string spanning two chunks of file now. We simply 
          go back a bit in the file and read from there, thus inspecting 
          some characters twice 
          } 
          AStream.Seek(-Length(forString), soFromCurrent); 
          bytesRemaining := bytesRemaining + Length(forString); 
        end; 
      end; { while } 
    finally 
      if SearchFor <> nil then StrDispose(SearchFor); 
      if pBuf <> nil then FreeMem(pBuf, BufferSize); 
    end; 
  end; 
end; { ScanIt } 


type 
  TFontType = (tftOpenType, tftTrueType, tftRaster); 


function GetFontType(AFontFileName: String): TFontType; 
var 
  fs: TFileStream; 
begin 
  Result := tftRaster; 
  fs := TFileStream.Create(AFontFileName, fmOpenRead); 
  try 
    fs.Position := 0; 
    // OpenType fonts have this signature in them 
    if ScanIt('DSIG', False, fs) > 0 then 
    begin 
      Result := tftOpenType; 
    end 
    else 
    begin 
      Result := tftTrueType; 
    end; 
  finally 
    fs.Free; 
  end; 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
  case GetFontType('c:\Windows\Fonts\Amerigo Bold BT.TTF') of 
  tftOpenType: 
    begin 
      ShowMessage('OpenType'); 
    end; 
  tftTrueType: 
    begin 
      ShowMessage('TrueType'); 
    end; 
  end; 
end;

[ChrisE]

Hallo toms,

danke erstmal für die Antwort. Ich wurde also doch gehört :-)
Aber ich muss schon sagen, es würde mich ziemlich hart treffen, wenn ich nur die möglichkeit hätte OpenType und TrueType zu unterscheiden. Aber es ist zumindest ein Möglichkeit. Das ist ja schonmal gut.

Danke dafür. Ich werde das gleich mal ausprobieren.