Article #15293: Changing Fonts in Edits Controls

 Technical Information Database

TI293D.txt   Changing Fonts in Edits Controls
Category   :OWL
Platform    :All
Product    :Pascal  All

Description:

{$X+}
program EditFonts;
{
  Changing an edit controls font settings.
}

uses WObjects, WinProcs, WinTypes, Strings;

const
  id_Font = 201;

Type
  TMyApplication = object(TApplication)
    procedure InitMainWindow; virtual;
  end;

  PMyWIndow = ^TMyWindow;
  TMyWindow = object(TWindow)
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    procedure Font(var Msg: TMessage);
                   virtual id_First + id_Font;
    procedure SetupWindow; virtual;
  end;

var
  MyEdit: PEdit;
  Button: PButton;

{ TMyApplication }
procedure TMyApplication.InitMainWindow;
begin
   MainWindow:= new(PMyWindow,init(nil,
                    'Changing TEdit Control''s Font'));
end;

Constructor TMyWindow.Init(AParent: PWindowsObject; ATitle:
PChar);
begin
  TWindow.Init(AParent, ATitle);
  MyEdit := new(PEdit, Init(
 Self, 200, 'Information',
                1,1,100,50,0, False));
  Button := new(PButton, init(
 Self, 201, '&Font',
                100,100,100,50,True));
end;

procedure TMyWindow.SetupWindow;
begin
 TWindow.SetupWindow;
 SetFocus(Button^.hWindow);
end;

procedure TMyWindow.Font(var Msg: TMessage);
var
  LogFont: TLogFont;
  DC: hDC;
begin
  { set up the LogFont structure }
  With LogFont do
    begin
      lfHeight := 15;
      lfWidth:=0;
      lfEscapement:=0;
      lfOrientation:=0;
      lfWeight:= FW_Normal or FW_Regular;
      lfItalic:= 0;
      lfUnderLine:= 0;
      lfStrikeOut:= 0;
      lfCharSet:= ANSI_CharSet;
      lfOutPrecision:= Out_Default_Precis;
      lfClipPrecision:= Clip_Default_Precis;
      lfQuality:=Default_Quality;
      lfPitchandFamily:= Default_Pitch and ff_DontCare;
      StrCopy(lfFaceName, 'Courier');
    end;

  DC := GetDC(HWindow);

  { send message to change the font }
  SendMessage(MyEdit^.hWindow, WM_SetFont,
              CreateFontIndirect(LogFont) , 1);
  DeleteObject(CreateFontIndirect(LogFont));

  { change the button's text to 'Done' }
  SetWindowText(Button^.hWindow, 'Done');
  { must send message to button's paint }
  { to update the button's text         }
  SendMessage(Button^.HWindow, wm_Paint, 0, 1);
  ReleaseDC(HWindow, DC);
end;

var
  MyApp: TMyApplication;
begin
  MyApp.Init('MyProgram');
  MyApp.Run;
  MyApp.Done;
end.


Reference:


7/16/98 4:33:41 PM
 

Last Modified: 01-SEP-99