Category : Pascal Source Code
Archive   : PASS_ALL.ZIP
Filename : TI990.ASC

PRODUCT : Turbo Pascal NUMBER : 990
VERSION : 1.0
OS : Windows
DATE : May 19, 1992 PAGE : 1/3

TITLE : Changing Fonts in Edits Controls




{$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));













PRODUCT : Turbo Pascal NUMBER : 990
VERSION : 1.0
OS : Windows
DATE : May 19, 1992 PAGE : 2/3

TITLE : Changing Fonts in Edits Controls




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 }













PRODUCT : Turbo Pascal NUMBER : 990
VERSION : 1.0
OS : Windows
DATE : May 19, 1992 PAGE : 3/3

TITLE : Changing Fonts in Edits Controls




SendMessage(Button^.HWindow, wm_Paint, 0, 1);
ReleaseDC(HWindow, DC);
end;

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