{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}

unit MainFrm;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Mask, Spin;

const

// Array to represent the TLOGFONT.lfCharSet values
CharSetArray: array[0..4] of byte = (ANSI_CHARSET, DEFAULT_CHARSET,
  SYMBOL_CHARSET, SHIFTJIS_CHARSET, OEM_CHARSET);

// Array to represent the TLOGFONT.lfWeight values
WeightArray: array[0..9] of integer =
 (FW_DONTCARE, FW_THIN, FW_EXTRALIGHT, FW_LIGHT, FW_NORMAL, FW_MEDIUM,
  FW_SEMIBOLD, FW_BOLD, FW_EXTRABOLD, FW_HEAVY);

// Array to represent the TLOGFONT.lfOutPrecision values
OutPrecArray: array[0..7] of byte = (OUT_DEFAULT_PRECIS,
  OUT_STRING_PRECIS, OUT_CHARACTER_PRECIS, OUT_STROKE_PRECIS,
  OUT_TT_PRECIS, OUT_DEVICE_PRECIS, OUT_RASTER_PRECIS,
  OUT_TT_ONLY_PRECIS);

// Array to represent the TLOGFONT.lfPitchAndFamily higher four-bit values
FamilyArray: array[0..5] of byte = (FF_DONTCARE, FF_ROMAN,
  FF_SWISS, FF_MODERN, FF_SCRIPT, FF_DECORATIVE);

// Array to represent the TLOGFONT.lfPitchAndFamily lower two-bit values
PitchArray: array[0..2] of byte = (DEFAULT_PITCH, FIXED_PITCH,
   VARIABLE_PITCH);

// Array to represent the TLOGFONT.lfClipPrecision values
ClipPrecArray: array[0..6] of byte = (CLIP_DEFAULT_PRECIS,
  CLIP_CHARACTER_PRECIS, CLIP_STROKE_PRECIS, CLIP_MASK, CLIP_LH_ANGLES,
  CLIP_TT_ALWAYS, CLIP_EMBEDDED);

// Array to represent the TLOGFONT.lfQuality values
QualityArray: array[0..2] of byte = (DEFAULT_QUALITY, DRAFT_QUALITY,
  PROOF_QUALITY);

type

  TMainForm = class(TForm)
    lblHeight: TLabel;
    lblWidth: TLabel;
    gbEffects: TGroupBox;
    cbxItalic: TCheckBox;
    cbxUnderline: TCheckBox;
    cbxStrikeOut: TCheckBox;
    cbWeight: TComboBox;
    lblWeight: TLabel;
    lblEscapement: TLabel;
    cbEscapement: TComboBox;
    pbxFont: TPaintBox;
    cbCharSet: TComboBox;
    lblCharSet: TLabel;
    cbOutPrec: TComboBox;
    lblOutPrecision: TLabel;
    cbFontFace: TComboBox;
    rgPitch: TRadioGroup;
    cbFamily: TComboBox;
    lblFamily: TLabel;
    lblClipPrecision: TLabel;
    cbClipPrec: TComboBox;
    rgQuality: TRadioGroup;
    btnSetDefaults: TButton;
    btnFontInfo: TButton;
    lblFaceName: TLabel;
    rgGraphicsMode: TRadioGroup;
    lblOrientation: TLabel;
    cbOrientation: TComboBox;
    seHeight: TSpinEdit;
    seWidth: TSpinEdit;
    procedure pbxFontPaint(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure btnFontInfoClick(Sender: TObject);
    procedure btnSetDefaultsClick(Sender: TObject);
    procedure rgGraphicsModeClick(Sender: TObject);
    procedure cbEscapementChange(Sender: TObject);
    procedure FontChanged(Sender: TObject);
  private
    { Private declarations }
    FLogFont: TLogFont;
    FHFont:   HFont;
    procedure MakeFont;
    procedure SetDefaults;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
uses FontInfoFrm;

{$R *.DFM}

procedure TMainForm.MakeFont;
begin
  // Clear the contents of FLogFont
  FillChar(FLogFont, sizeof(TLogFont), 0);
  // Set the TLOGFONT's fields
  with FLogFont do
  begin
    lfHeight         := StrToInt(seHeight.Text);
    lfWidth          := StrToInt(seWidth.Text);
    lfEscapement     := StrToInt(cbEscapement.Items[cbEscapement.ItemIndex]);
    lfOrientation    := StrToInt(cbOrientation.Items[cbOrientation.ItemIndex]);
    lfWeight         := WeightArray[cbWeight.ItemIndex];
    lfItalic         := ord(cbxItalic.Checked);
    lfUnderline      := ord(cbxUnderLine.Checked);
    lfStrikeOut      := ord(cbxStrikeOut.Checked);
    lfCharSet        := CharSetArray[cbCharset.ItemIndex];
    lfOutPrecision   := OutPrecArray[cbOutPrec.ItemIndex];
    lfClipPrecision  := ClipPrecArray[cbClipPrec.ItemIndex];
    lfQuality        := QualityArray[rgQuality.ItemIndex];
    lfPitchAndFamily := PitchArray[rgPitch.ItemIndex] or FamilyArray[cbFamily.ItemIndex];
    StrPCopy(lfFaceName, cbFontFace.Items[cbFontFace.ItemIndex]);
  end;
  // Retrieve the requested font
  FHFont := CreateFontIndirect(FLogFont);
  // Assign to the Font.Handle
  pbxFont.Font.Handle := FHFont;
  pbxFont.Refresh;
end;

procedure TMainForm.SetDefaults;
begin
  // Set the various conrols to default values for ALogFont
  seHeight.Text           := '0';
  seWidth.Text            := '0';
  cbxItalic.Checked       := false;
  cbxStrikeOut.Checked    := false;
  cbxUnderline.Checked    := false;
  cbWeight.ItemIndex      := 0;
  cbEscapement.ItemIndex  := 0;
  cbOrientation.ItemIndex := 0;
  cbCharset.ItemIndex     := 1;
  cbOutPrec.Itemindex     := 0;
  cbFamily.ItemIndex      := 0;
  cbClipPrec.ItemIndex    := 0;
  rgPitch.ItemIndex       := 0;
  rgQuality.ItemIndex     := 0;
  // Fill CBFontFace TComboBox with the screen's fonts
  cbFontFace.Items.Assign(Screen.Fonts);
  cbFontFace.ItemIndex := cbFontFace.Items.IndexOf(Font.Name);
end;

procedure TMainForm.pbxFontPaint(Sender: TObject);
begin
  with pbxFont do
  begin
    { Note that in Windows 95, the graphics mode will always be GM_COMPATIBLE
      as GM_ADVANCED is recognized only by Windows NT. }
    case rgGraphicsMode.ItemIndex of
      0: SetGraphicsMode(pbxFont.Canvas.Handle, GM_COMPATIBLE);
      1: SetGraphicsMode(pbxFont.Canvas.Handle, GM_ADVANCED);
    end;
    Canvas.Rectangle(2, 2, Width-2, Height-2);
    // Write the fonts name 
    Canvas.TextOut(Width div 2, Height div 2, CBFontFace.Text);
  end;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  SetDefaults;
  MakeFont;    
end;

procedure TMainForm.btnFontInfoClick(Sender: TObject);
begin
  FontInfoForm.ShowModal;
end;

procedure TMainForm.btnSetDefaultsClick(Sender: TObject);
begin
  SetDefaults;
  MakeFont;
end;

procedure TMainForm.rgGraphicsModeClick(Sender: TObject);
begin
  cbOrientation.Enabled := rgGraphicsMode.ItemIndex = 1;
  if not cbOrientation.Enabled then
    cbOrientation.ItemIndex := cbEscapement.ItemIndex;
  MakeFont;
end;

procedure TMainForm.cbEscapementChange(Sender: TObject);
begin
  if not cbOrientation.Enabled then
    cbOrientation.ItemIndex := cbEscapement.ItemIndex;
end;

procedure TMainForm.FontChanged(Sender: TObject);
begin
  MakeFont;
end;

end.