ezfont.mod: Translation to XDS Modula-2

Last updated: 21. 2.1998, 0:52

<* +M2EXTENSIONS *>

IMPLEMENTATION MODULE ezfont;
(*---------------------------------------
   EZFONT.C        --- Easy Font Creation
                   (c) Charles Petzold, 1996
   ezfont.mod      --- Translation to XDS Modula-2
                   (c) Peter Stadler,   1997
   ---------------------------------------*)
IMPORT Windows;  



IMPORT SYSTEM;
IMPORT Str;


PROCEDURE EzCreateFont (hdc            :  Windows.HDC;
                        szFaceName     :  ARRAY OF CHAR;
                        iDeciPtHeight  :  INTEGER;
                        iDeciPtWidth   :  INTEGER;
                        iAttributes    :  INTEGER;
                        fLogRes        :  BOOLEAN) : Windows.HFONT;
VAR
  cxDpi,cyDpi   :  REAL;
  hFont         :  Windows.HFONT;
  lf            :  Windows.LOGFONT;
  pt            :  ARRAY[0..1] OF Windows.POINT;
  tm            :  Windows.TEXTMETRIC;

BEGIN
     Windows.SaveDC (hdc);

     Windows.SetGraphicsMode (hdc, Windows.GM_ADVANCED);
     Windows.ModifyWorldTransform (hdc, NIL, Windows.MWT_IDENTITY);
     Windows.SetViewportOrgEx (hdc, 0, 0, NIL);
     Windows.SetWindowOrgEx   (hdc, 0, 0, NIL);

     IF (fLogRes) THEN
          cxDpi := SYSTEM.CAST(REAL,Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSX));
          cyDpi := SYSTEM.CAST(REAL,Windows.GetDeviceCaps (hdc, Windows.LOGPIXELSY));
     ELSE
          cxDpi := 25.4 * SYSTEM.CAST(REAL,Windows.GetDeviceCaps (hdc, Windows.HORZRES) /
                                  Windows.GetDeviceCaps (hdc, Windows.HORZSIZE));

          cyDpi := 25.4 * SYSTEM.CAST(REAL,Windows.GetDeviceCaps (hdc, Windows.VERTRES) /
                                  Windows.GetDeviceCaps (hdc, Windows.VERTSIZE));
     END;

     pt[0].x := VAL(INTEGER,FLOAT(iDeciPtWidth)  * cxDpi / 72.);
     pt[0].y := VAL(INTEGER,FLOAT(iDeciPtHeight) * cyDpi / 72.);

     Windows.DPtoLP (hdc, pt, 1);

     lf.lfHeight         := - VAL(INTEGER,FLOAT(ABS(pt[0].y)) / 10.0 + 0.5);
     lf.lfWidth          := 0;
     lf.lfEscapement     := 0;
     lf.lfOrientation    := 0;

     IF (iAttributes - EZ_ATTR_BOLD=1) THEN
       lf.lfWeight := 700;
     ELSE
       lf.lfWeight := 0;
     END;

     IF (iAttributes - EZ_ATTR_ITALIC=1) THEN
       lf.lfItalic := TRUE;
     ELSE
       lf.lfItalic := FALSE;
     END;

     IF (iAttributes - EZ_ATTR_UNDERLINE=1) THEN
       lf.lfUnderline := TRUE;
     ELSE
       lf.lfUnderline := FALSE;
     END;

     IF (iAttributes - EZ_ATTR_STRIKEOUT=1) THEN
       lf.lfStrikeOut := TRUE;
     ELSE
       lf.lfStrikeOut := FALSE;
     END;

     lf.lfCharSet        := 0;
     lf.lfOutPrecision   := SYSTEM.CAST(Windows.OUT_PRECIS_ENUM,0);
     lf.lfClipPrecision  := SYSTEM.CAST(Windows.CLIP_PRECIS_SET,0);
     lf.lfQuality        := SYSTEM.CAST(Windows.QUALITY_ENUM,0);
     lf.lfPitchAndFamily := SYSTEM.CAST(Windows.PITCH_AND_FAMILY_SET,0);

     Str.Copy(lf.lfFaceName, szFaceName);

     hFont := Windows.CreateFontIndirect (lf);

     IF (iDeciPtWidth # 0) THEN
          hFont := SYSTEM.CAST(Windows.HFONT,Windows.SelectObject (hdc, SYSTEM.CAST(Windows.HGDIOBJ,hFont)));

          Windows.GetTextMetrics (hdc, tm);

          Windows.DeleteObject (Windows.SelectObject (hdc, SYSTEM.CAST(Windows.HGDIOBJ,hFont)));

          lf.lfWidth := VAL(INTEGER,FLOAT(tm.tmAveCharWidth) *
                              FLOAT(ABS(pt[0].x)) / FLOAT(ABS(pt[0].y)) + 0.5);

          hFont := Windows.CreateFontIndirect (lf);
     END;

     Windows.RestoreDC (hdc, -1);

     RETURN hFont;
END EzCreateFont;
BEGIN
END ezfont.