Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Delphi 2009 Handbook

Project: AppFont.dproj

Project Structure

AppFont.dpr
program AppFont;

uses
  Forms, SysUtils,
  AppFont_MainForm in 'AppFont_MainForm.pas' {FormAppFont},
  AppFont_Secondary in 'AppFont_Secondary.pas' {FormSecondary};

{$R *.res}

begin
  Application.Initialize;

  if CheckWin32Version(6) then
  begin
    Application.DefaultFont.Name := 'Segoe UI';
    Application.DefaultFont.Size := 9;
  end;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormAppFont, FormAppFont);
  Application.CreateForm(TFormSecondary, FormSecondary);
  Application.Run;
end.
AppFont_MainForm.pas
unit AppFont_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFormAppFont = class(TForm)
    Memo1: TMemo;
    btnScreenFont: TButton;
    btnGetMyFont: TButton;
    cbUseLatestCommonDialogs: TCheckBox;
    btnChangeFont: TButton;
    procedure btnGetMyFontClick(Sender: TObject);
    procedure btnScreenFontClick(Sender: TObject);
    procedure btnChangeFontClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormAppFont: TFormAppFont;

implementation

{$R *.dfm}

procedure TFormAppFont.btnChangeFontClick(Sender: TObject);
begin
  Application.DefaultFont.Name := 'Times New Roman';
  Application.DefaultFont.Size := 10;
end;

procedure TFormAppFont.btnGetMyFontClick(Sender: TObject);
begin
  Memo1.Lines.Add (btnGetMyFont.Font.Name);
end;

procedure TFormAppFont.btnScreenFontClick(Sender: TObject);
begin
  Screen.MessageFont.Name := 'Segoe UI';
  Screen.MessageFont.Size := Screen.MessageFont.Size + 2;
  UseLatestCommonDialogs := cbUseLatestCommonDialogs.Checked;
  ShowMessage ('Hello');
  MessageDlg ('Hello', mtINformation, [mbOK], 0);
end;

end.
AppFont_MainForm.pas.dfm
object FormAppFont: TFormAppFont
  Left = 0
  Top = 0
  Caption = 'AppFont'
  ClientHeight = 292
  ClientWidth = 554
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 240
    Top = 40
    Width = 249
    Height = 201
    TabOrder = 0
  end
  object btnScreenFont: TButton
    Left = 56
    Top = 128
    Width = 121
    Height = 25
    Caption = 'btnScreenFont'
    TabOrder = 1
    OnClick = btnScreenFontClick
  end
  object btnGetMyFont: TButton
    Left = 56
    Top = 38
    Width = 121
    Height = 25
    Caption = 'btnGetMyFont'
    TabOrder = 2
    OnClick = btnGetMyFontClick
  end
  object cbUseLatestCommonDialogs: TCheckBox
    Left = 56
    Top = 160
    Width = 145
    Height = 17
    Caption = 'LatestCommonDialogs'
    TabOrder = 3
  end
  object btnChangeFont: TButton
    Left = 56
    Top = 72
    Width = 121
    Height = 25
    Caption = 'btnChangeFont'
    TabOrder = 4
    OnClick = btnChangeFontClick
  end
end
AppFont_Secondary.pas
unit AppFont_Secondary;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFormSecondary = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    btnGetMyFont: TButton;
    procedure btnGetMyFontClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormSecondary: TFormSecondary;

implementation

{$R *.dfm}

procedure TFormSecondary.btnGetMyFontClick(Sender: TObject);
begin
  Edit1.Text := btnGetMyFont.Font.Name;
end;

end.
AppFont_Secondary.pas.dfm
object FormSecondary: TFormSecondary
  Left = 0
  Top = 0
  Caption = 'Secondary'
  ClientHeight = 292
  ClientWidth = 554
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  Visible = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 80
    Top = 40
    Width = 31
    Height = 13
    Caption = 'Label1'
  end
  object Label2: TLabel
    Left = 80
    Top = 64
    Width = 31
    Height = 13
    Caption = 'Label2'
  end
  object Edit1: TEdit
    Left = 136
    Top = 37
    Width = 121
    Height = 21
    TabOrder = 0
    Text = 'Edit1'
  end
  object btnGetMyFont: TButton
    Left = 136
    Top = 96
    Width = 121
    Height = 25
    Caption = 'btnGetMyFont'
    TabOrder = 1
    OnClick = btnGetMyFontClick
  end
end
HTML file generated by PasToWeb, a tool by Marco Cantù
Copyright 2008 Marco Cantù