source: trunk/Components/CustomFontDialog.PAS@ 369

Last change on this file since 369 was 250, checked in by RBRi, 18 years ago

fix usage of StrStartsWithIgnoringCase
  • Property svn:eol-style set to native
File size: 19.9 KB
RevLine 
[15]1Unit CustomFontDialog;
2
3Interface
4
5Uses
[214]6 Classes,
7 Forms,
8 Dialogs,
9 StdCtrls,
10 Buttons,
11 Graphics;
[15]12
13Type
14
15 TCustomFontDialog=Class(TDialog)
16 Private
17 FNameList: TListBox;
18 FNameLabel: TLabel;
19 FSizeCombo: TComboBox;
20 FSizeLabel: TLabel;
21 FStyleLabel: TLabel;
22 FStyleListbox: TListBox;
23 FExampleText: TEdit;
24 FItalicCheck:TCheckBox;
25 FBoldCheck:TCheckBox;
26 FOutlineCheck:TCheckBox;
27 FUnderscoreCheck:TCheckBox;
28 FStrikeOutCheck:TCheckBox;
29 FActualFaceLabel:TLabel;
30 FOKButton:TButton;
31 FCancelButton:TButton;
32 FEditFont: TFont;
33
34 FAllowSimulations: boolean;
35
36 FUpdating: boolean;
37 FFontLoadRequired: boolean;
38
39 Function GetFaceName: String;
40 Procedure SetFaceName( s: String );
41
42 Function GetStyleName: String;
43 Procedure SetStyleName( s: String );
44
45 Function GetPointSize: LongInt;
46 Procedure SetPointSize( Value:LongInt );
47
48 Function GetStyleFont: TFont;
49
50 Function GetAttributes: TFontAttributes;
51 Procedure SetAttributes( NewValue: TFontAttributes );
52
53 Procedure InsertSizes;
54 Procedure InsertStyles;
55
56 Procedure OnSelectFace( Sender: TObject; Index: LongInt );
57 Procedure OnSelectStyle( Sender: TObject; Index: LongInt );
58 Procedure OnSetSize( Sender: TObject );
59 Procedure OnStyleChanged( Sender:TObject );
60
61 Procedure OnSizeClick( Sender: TObject; Index: longint );
62
63 Procedure SetEditFont( NewFont:TFont );
64
65 Function FindFace( FaceName: string ): TFont;
66
67 Protected
68 Procedure SetupComponent; Override;
69 Procedure SetupShow; Override;
70 Procedure LayoutControls;
71 Procedure Resize; override;
72 Procedure SelectFont;
73 public
74 Property FaceName: String read GetFaceName write SetFaceName;
75 Property StyleName: String read GetStyleName write SetStyleName;
76 Property PointSize: longint read GetPointSize write SetPointSize;
77 Property Attributes: TFontAttributes read GetAttributes write SetAttributes;
78
79 Property EditFont: TFont Read FEditFont Write SetEditFont;
80 Property AllowSimulations: boolean read FAllowSimulations write FAllowSimulations;
81 End;
82
83Exports
84 TCustomFontDialog, 'User', 'CustomFontDialog.bmp';
85
86Implementation
87
88uses
[214]89 SysUtils,
90 PmWin,
91 StringUtilsUnit;
[15]92
93// Returns true if s ends with endstr (case insensitive)
94Function StringAtEnd( const endStr: string; const s: string ): boolean;
95Var
96 i, j: integer;
97Begin
98 Result := false;
99 if Length( s ) < length( endStr ) then
100 exit;
101 j := Length( s );
102 for i := length( endstr ) downto 1 do
103 begin
104 if UpCase( s[ j ] ) <> UpCase( endStr[ i ] ) then
105 exit;
106 dec( j );
107 end;
108 Result := true;
109End;
110
111// Returns S minus count characters from the right
112Function StringLeftWithout( const S:string; const count:integer ):string;
113Begin
114 Result := copy( S, 1, length( S )-count );
115End;
116
117Function RemoveIfMatchAtEnd( Var s: string; const SearchString: string ): boolean;
118begin
119 Result := StringAtEnd( SearchString, s );
120 if Result then
121 s := Trim( StringLeftWithout( s, Length( SearchString ) ) );
122end;
123
124Procedure RemoveStyleNames( Var FaceName: string );
125Begin
126 FaceName := Trim( FaceName );
127 RemoveIfMatchAtEnd( FaceName, 'Italic' );
128 RemoveIfMatchAtEnd( FaceName, 'Oblique' );
129 RemoveIfMatchAtEnd( FaceName, 'Bold' );
130 RemoveIfMatchAtEnd( FaceName, 'Normal' );
131end;
132
133Function GetFontFamilyName( Font: TFont ): string;
134begin
135 Result := Font.Family;
[214]136 SubstituteAllOccurencesOfChar( Result, '-', ' ' );
137 SubstituteAllOccurencesOfChar( Result, '_', ' ' );
[15]138
139 if Result = 'Roman' then
[250]140 if StrStartsWithIgnoringCase(Font.FaceName,'Tms Rmn') then
[15]141 // one particularly stupid example
142 Result := 'Tms Rmn';
143
144 if Result = 'Swiss' then
[250]145 if StrStartsWithIgnoringCase(Font.FaceName, 'Helv') then
[15]146 // one particularly stupid example
147 Result := 'Helv';
148
149 // some fonts have family names with styles!
150 RemoveStyleNames( Result );
151
152end;
153
154Function GetFontStyleName( Font: TFont ): string;
155var
156 FamilyName: string;
157begin
158 Result := Font.FaceName;
[214]159 SubstituteAllOccurencesOfChar( Result, '-', ' ' );
160 SubstituteAllOccurencesOfChar( Result, '_', ' ' );
[15]161
162 FamilyName := GetFontFamilyName( Font );
[250]163 if StrStartsWithIgnoringCase(Result, FamilyName) then
[15]164 begin
[214]165 Result := StrSubstringFrom( Result, length( FamilyName ) + 1 );
166 Result := StrTrimChars( Result, [ ' ', '-', '_' ] );
[15]167
168 if Result = '' then
169 Result := 'Normal';
170 end;
171end;
172
173Procedure TCustomFontDialog.SetupComponent;
174Var
175 FontIndex: LongInt;
176 aFont: TFont;
177 FontList: TStringList;
178 FamilyIndex: longint;
179 FontFamilyName: string;
180 FontStyleName: string;
181Begin
182 Inherited SetupComponent;
183
184 FAllowSimulations := true;
185
186 BorderStyle := bsSizeable;
187 BorderIcons := [ biSystemMenu, biMaximize ];
188
189 Caption := LoadNLSStr( SSelectAFont );
190 Width := 480;
191 Height := 350;
192 MinTrackHeight := 350;
193 MinTrackWidth := 400;
194
195 // Give controls names for purposes of language support...
196
197 FNameList := TListBox.Create( self );
198 FNameList.Parent := self;
199 FNameList.Sorted := true;
200 FNameList.Duplicates := false;
201 FNameList.OnItemFocus := OnSelectFace;
202 FNameList.Name := 'NameList';
203
204 FNameLabel := TLabel.Create( self );
205 FNameLabel.Parent := self;
206 FNameLabel.Caption := '~Name:';
207 FNameLabel.FocusControl := FNameList;
208 FNameLabel.Name := 'NameLabel';
209
210 FStyleListbox := TListBox.Create( self );
211 FStyleListbox.Parent := self;
212 FStyleListbox.Name := 'StyleListBox';
213 FStyleListBox.Sorted := true;
214 FStyleListBox.OnItemFocus := OnSelectStyle;
215
216 FStyleLabel := TLabel.Create( self );
217 FStyleLabel.Parent := self;
218 FStyleLabel.Caption := 'S~tyle:';
219 FStyleLabel.FocusControl := FStyleListBox;
220 FStyleLabel.Name := 'StyleLabel';
221
222 FBoldCheck := TCheckBox.Create( self );
223 FBoldCheck.Parent := self;
224 FBoldCheck.OnClick := OnStyleChanged;
225 FBoldCheck.Caption := '~Bold (Simulated)';
226 FBoldCheck.Name := 'BoldCheck';
227
228 FItalicCheck := TCheckBox.Create( self );
229 FItalicCheck.Parent := self;
230 FItalicCheck.OnClick := OnStyleChanged;
231 FItalicCheck.Caption := '~Italic (Simulated)';
232 FItalicCheck.Name := 'ItalicCheck';
233
234 FUnderscoreCheck := TCheckBox.Create( self );
235 FUnderscoreCheck.Parent := self;
236 FUnderscoreCheck.OnClick := OnStyleChanged;
237 FUnderscoreCheck.Caption := LoadNLSStr( SUnderscore );
238 FUnderscoreCheck.Name := 'UnderscoreCheck';
239
240 FOutlineCheck := TCheckBox.Create( self );
241 FOutlineCheck.Parent := self;
242 FOutlineCheck.OnClick := OnStyleChanged;
243 FOutlineCheck.Caption := LoadNLSStr( SOutline );
244 FOutlineCheck.Name := 'OutlineCheck';
245
246 FStrikeOutCheck := TCheckBox.Create( self );
247 FStrikeOutCheck.Parent := self;
248 FStrikeOutCheck.OnClick := OnStyleChanged;
249 FStrikeOutCheck.Caption := 'St~rikeout';
250 FStrikeOutCheck.Name := 'StrikeOutCheck';
251
252 FSizeCombo := TComboBox.Create( self );
253 FSizeCombo.Style := csSimple;
254 FSizeCombo.Parent := self;
255 FSizeCombo.OnChange := OnSetSize;
256 FSizeCombo.OnItemFocus := OnSizeClick;
257 FSizeCombo.Name := 'SizeCombo';
258
259 FSizeLabel := TLabel.Create( self );
260 FSizeLabel.Parent := self;
261 FSizeLabel.Caption := '~Size:';
262 FSizeLabel.FocusControl := FSizeCombo;
263 FSizeLabel.Name := 'SizeLabel';
264
265 FExampleText := TEdit.Create( self );
266 FExampleText.Parent := self;
267 FExampleText.Text := 'abc ABC def DEF';
268 FExampleText.Autosize := false;
269 FExampleText.Name := 'ExampleText';
270
271 FActualFaceLabel := TLabel.Create( self );
272 FActualFaceLabel.Parent := self;
273 FActualFaceLabel.Caption := '';
274 FActualFaceLabel.Name := 'ActualFaceLabel';
275 FActualFaceLabel.Alignment := taRightJustify;
276
277 For FontIndex := 0 To Screen.FontCount - 1 Do
278 Begin
279 aFont := Screen.Fonts[ FontIndex ];
280
281 FontStyleName := GetFontStyleName( aFont );
282 FontFamilyName := GetFontFamilyName( aFont );
283
284 FamilyIndex := FNameList.Items.IndexOf( FontFamilyName );
285 if FamilyIndex = -1 then
286 begin
287 // new family
288 FontList := TStringList.Create;
289 FNameList.Items.AddObject( FontFamilyName, FontList );
290 end
291 else
292 begin
293 FontList := FNameList.Items.Objects[ FamilyIndex ] as TStringList;
294 end;
295 if FontList.IndexOf( FontStyleName ) = -1 then
296 begin
297 // new font for this family
298 FontList.AddObject( FontStyleName, aFont );
299 end;
300 End;
301
302 FOKButton := InsertButton( Self, 150, 10, 90, 30,
303 LoadNLSStr( SOkButton ),
304 '' );
305 FOKButton.Name := 'OKButton';
306 FOKButton.Default := true;
307 FOKButton.ModalResult := mrOK;
308
309 FCancelButton := InsertButton( Self, 250, 10, 90, 30,
310 LoadNLSStr( SCancelButton ),
311 '' );
312 FCancelButton.Name := 'CancelButton';
313 FCancelButton.Cancel := true;
314 FCancelButton.ModalResult := mrCancel;
315
316 LayoutControls;
317
318 SetEditFont( Screen.DefaultFont );
319End;
320
321Function TCustomFontDialog.FindFace( FaceName: string ): TFont;
322Var
323 FontIndex: LongInt;
324 aFont: TFont;
325begin
326 For FontIndex := 0 To Screen.FontCount - 1 Do
327 Begin
328 aFont := Screen.Fonts[ FontIndex ];
329 if AnsiCompareText( aFont.FaceName, FaceName ) = 0 then
330 begin
331 Result := aFont;
332 exit;
333 end;
334 End;
335 Result := nil;
336end;
337
338Procedure TCustomFontDialog.LayoutControls;
339Var
340 W: longint;
341 H: longint;
342 ExampleH: longint;
343 VSplit: longint;
344 GrpH: longint;
345 TopH: longint;
346Begin
347 W := ClientWidth;
348 H := ClientHeight;
349
350 // Example is minimum 40 pixels, or 20% of height
351 ExampleH := 40;
352 if ( H div 5 ) > ExampleH then
353 ExampleH := H div 5;
354
355 // Base of name/size/style (45 allows for buttons/spacing)
356 VSplit := 45 + ExampleH;
357 TopH := H - VSplit - 25;
358
359 GrpH := TopH + 20;
360 // Left Bottom Width Height
361 FNameLabel .SetWindowPos( 5, H - 25, W - 210, 20 );
362 FNameList .SetWindowPos( 5, VSplit, W - 210, TopH );
363
364 FStyleLabel .SetWindowPos( W - 200, H - 25, 120, 20 );
365
366 FStyleListbox .SetWindowPos( W - 200, H - 100, 145, 75 );
367
368 FBoldCheck .SetWindowPos( W - 200, H - 125, 145, 20 );
369 FItalicCheck .SetWindowPos( W - 200, H - 145, 145, 20 );
370 FUnderscoreCheck.SetWindowPos( W - 200, H - 165, 145, 20 );
371 FOutlineCheck .SetWindowPos( W - 200, H - 185, 145, 20 );
372 FStrikeOutCheck .SetWindowPos( W - 200, H - 205, 145, 20 );
373
374 FSizeLabel .SetWindowPos( W - 50, H - 25, 45, 20 );
375 FSizeCombo .SetWindowPos( W - 50, VSplit, 45, TopH );
376
377 FExampleText .SetWindowPos( 5, 40, W - 10, ExampleH );
378
379 FActualFaceLabel.SetWindowPos( 180, 10, W - 185, 20 );
380
381 FOKButton .SetWindowPos( 5, 5, 80, 30 );
382 FCancelButton .SetWindowPos( 90, 5, 80, 30 );
383
384End;
385
386
387Procedure TCustomFontDialog.SetupShow;
388Begin
389 Inherited SetupShow;
390
391 FNameList.Focus;
392 FOKButton.Default := True;
393
394 FBoldCheck.Enabled := FAllowSimulations;
395 FItalicCheck.Enabled := FAllowSimulations;
396 if not FAllowSimulations then
397 begin
398 FBoldCheck.Checked := false;
399 FItalicCheck.Checked := false;
400 end;
401
402 FaceName := GetFontFamilyName( FEditFont );
403 StyleName := GetFontStyleName( FEditFont );
404 PointSize := FEditFont.PointSize;
405 Attributes := FEditFont.Attributes;
406
407 FFontLoadRequired := false;
408
409 SelectFont; // display it
410
411End;
412
413Procedure TCustomFontDialog.Resize;
414begin
415 inherited Resize;
416 LayoutControls;
417end;
418
419Function TCustomFontDialog.GetFaceName: string;
420begin
421 if FNameList.ItemIndex = -1 then
422 Result := ''
423 else
424 Result := FNameList.Items[ FNameList.ItemIndex ];
425end;
426
427Procedure TCustomFontDialog.SetFaceName( s: string );
428begin
429 FNameList.ItemIndex := FNameList.Items.IndexOf( s );
430
431 if FNameList.ItemIndex > 4 then
432 FNameList.TopIndex := FNameList.ItemIndex - 4
433 else
434 FNameList.TopIndex := 0;
435end;
436
437Function TCustomFontDialog.GetStyleName: String;
438begin
439 if FStyleListBox.ItemIndex = -1 then
440 Result := ''
441 else
442 Result := FStyleListBox.Items[ FStyleListBox.ItemIndex ];
443end;
444
445Procedure TCustomFontDialog.SetStyleName( s: String );
446begin
447 FStyleListBox.ItemIndex := FStyleListBox.Items.IndexOf( s );
448
449 if FNameList.ItemIndex = -1 then
450 FNameList.ItemIndex := 0;
451end;
452
453Function TCustomFontDialog.GetAttributes: TFontAttributes;
454Begin
455 Result :=[];
456 If FItalicCheck.Checked Then
457 Include( Result, faItalic );
458 If FBoldCheck.Checked Then
459 Include( Result, faBold );
460 If FOutlineCheck.Checked Then
461 Include( Result, faOutline );
462 If FStrikeOutCheck.Checked Then
463 Include( Result, faStrikeOut );
464 If FUnderscoreCheck.Checked Then
465 Include( Result, faUnderScore );
466End;
467
468Procedure TCustomFontDialog.SetAttributes( NewValue: TFontAttributes );
469Begin
470 if FAllowSimulations then
471 begin
472 FBoldCheck.Checked := faBold in NewValue;
473 FItalicCheck.Checked := faItalic in NewValue;
474 end;
475 FOutlineCheck.Checked := faOutline in NewValue;
476 FStrikeoutCheck.Checked := faStrikeout in NewValue;
477 FUnderscoreCheck.Checked := faUnderscore in NewValue;
478End;
479
480Function TCustomFontDialog.GetPointSize: LongInt;
481Var
482 S: String;
483 C: Integer;
484Begin
485 S := FSizeCombo.Text;
486 Val( S, Result, C );
487 If C <> 0 Then
488 // invalid conversion
489 Result := 0;
490End;
491
492Procedure TCustomFontDialog.SetPointSize( Value:LongInt );
493Begin
494 If Value = 0 Then
495 Value := 8;
496 FSizeCombo.Text := IntToStr( Value );
497
498 // if there's an exact match, select it, if not select nothing
499 FSizeCombo.ItemIndex := FSizeCombo.Items.IndexOf( IntToStr( Value ) );
500End;
501
502Function TCustomFontDialog.GetStyleFont: TFont;
503begin
504 if FStyleListBox.ItemIndex = -1 then
505 begin
506 // during startup
507 Result := Screen.DefaultFont;
508 exit;
509 end;
510 Result := FStyleListBox.Items.Objects[ FStyleListBox.ItemIndex ] as TFont;
511
512end;
513
514Procedure TCustomFontDialog.SelectFont;
515var
516 Attrs: TFontAttributes;
517 StyleFont: TFont;
518begin
519 if FFontLoadRequired then
520 // we are starting up and don't want to set edit font yet!
521 exit;
522
523 Screen.Cursor := crHourGlass; // in case it takes a while to load up the font
524
525 Attrs := GetAttributes;
526
527 StyleFont := GetStyleFont;
528
529 DereferenceFont( FEditFont );
530 FEditFont :=
531 Screen.CreateCompatibleFont(
532 Screen.GetFontFromPointSize( StyleFont.FaceName,
533 GetPointSize ) );
534 FEditFont.Attributes := GetAttributes;
535
536 FActualFaceLabel.Caption := StyleFont.FaceName;
537
538 FExampleText.Font := FEditFont;
539
540 Screen.Cursor := crDefault;
541end;
542
543Procedure TCustomFontDialog.SetEditFont( NewFont:TFont );
544Begin
545 If NewFont = Nil Then
546 NewFont := Screen.DefaultFont;
547
548 DereferenceFont( FEditFont );
549 FEditFont := NewFont;
550 ReferenceFont( FEditFont );
551
552 if Handle <> 0 then
553 begin
554 FaceName := GetFontFamilyName( NewFont );
555 StyleName := GetFontStyleName( NewFont );
556 PointSize := NewFont.PointSize;
557 Attributes := NewFont.Attributes;
558 end
559 else
560 begin
561 FFontLoadRequired := true;
562 end;
563End;
564
565const
566 StandardOutlineSizes: array[ 0 .. 11 ] of longint =
567 (
568 4, 5, 6, 8, 10, 12,
569 15, 18, 24, 36, 48, 72
570 );
571
572function LongintListCompare( Item1: pointer;
573 Item2: pointer ): longint;
574begin
575 if item1 < item2 then
576 result := -1
577 else if item1 > item2 then
578 result := 1
579 else
580 result := 0;
581end;
582
583Procedure TCustomFontDialog.InsertStyles;
584var
585 FontList: TStringList;
586 OldStyleName: string;
587 NewIndex: longint;
588begin
589 FontList := FNameList.Items.Objects[ FNameList.ItemIndex ] as TStringList;
590 if FStyleListbox.ItemIndex <> -1 then
591 OldStyleName := FStyleListbox.Items[ FStyleListbox.ItemIndex ]
592 else
593 OldStyleName := 'Normal';
594 FStyleListbox.Items.Assign( FontList );
595
596 NewIndex := FStyleListbox.Items.IndexOf( OldStyleName );
597 if NewIndex = -1 then
598 NewIndex := FStyleListbox.Items.IndexOf( 'Normal' );
599 if NewIndex = -1 then
600 NewIndex := 0;
601 FStyleListbox.ItemIndex := NewIndex;
602end;
603
604Procedure TCustomFontDialog.InsertSizes;
605var
606 Face: string;
607 TheFont: TFont;
608 FontIndex: longint;
609 SizeIndex: longint;
610 OldSize: longint;
611 SizeString: string;
612
613 LimitedSizes: boolean;
614 Size: longint;
615 NearestSize: longint;
616 NearestSizeIndex: longint;
617
618 Sizes: TList;
619
620 procedure AddSize( const size: longint );
621 begin
622 if Sizes.IndexOf( pointer( size ) ) = -1 then
623 Sizes.Add( pointer( size ) );
624 end;
625Begin
626 Sizes := TList.Create;
627
628 Face := GetStyleFont.FaceName;
629 try
630 OldSize := StrToInt( FSizeCombo.Caption );
631 except
632 OldSize := 8;
633 end;
634
635 FSizeCombo.BeginUpdate;
636 FSizeCombo.Clear;
637
638 LimitedSizes := true;
639
640 For FontIndex := 0 To Screen.FontCount - 1 Do
641 Begin
642 TheFont := Screen.Fonts[ FontIndex ];
643 If TheFont.FaceName = Face Then
644 Begin
645 // this is a font for the current face.
646 if TheFont.FontType = ftBitmap then
647 begin
648 // just insert the specified point size
649 AddSize( TheFont.NominalPointSize );
650 end
651 else
652 begin
653 // an outline font...
654 LimitedSizes := false;
655 for SizeIndex := Low( StandardOutlineSizes ) to High( StandardOutlineSizes ) do
656 begin
657 AddSize( StandardOutlineSizes[ SizeIndex ] );
658 end;
659 end;
660 end;
661 End;
662
663 // sort from small to large
664 Sizes.Sort( LongintListCompare );
665
666 // add to combobox
667 For SizeIndex := 0 to Sizes.Count - 1 do
668 begin
669 SizeString := IntToStr( longint( Sizes[ SizeIndex ] ) );
670 FSizeCombo.Items.Add( SizeString );
671 end;
672
673 if LimitedSizes then
674 begin
675 // Find nearest match for old size
676 if Sizes.Count > 0 then
677 begin
678 NearestSizeIndex := 0;
679 NearestSize := longint( Sizes[ 0 ] );
680 for SizeIndex := 1 to Sizes.Count - 1 do
681 begin
682 Size := longint( Sizes[ SizeIndex ] );
683 if Abs( Size - OldSize ) < Abs( NearestSize - OldSize ) then
684 begin
685 // closer,
686 NearestSizeIndex := SizeIndex;
687 NearestSize := Size;
688 end;
689 end;
690 end
691 else
692 begin
693 NearestSizeIndex := -1;
694 end;
695
696 FSizeCombo.ItemIndex := NearestSizeIndex;
697 end
698 else
699 begin
700 FSizeCombo.Text := IntToStr( OldSize );
701
702 // if there's an exact match, select it, if not select nothing
703 NearestSizeIndex := FSizeCombo.Items.IndexOf( IntToStr( OldSize ) );
704
705 FSizeCombo.ItemIndex := NearestSizeIndex
706
707 end;
708
709 FSizeCombo.EndUpdate;
710
711 Sizes.Destroy;
712End;
713
714
715{$HINTS OFF}
716Procedure TCustomFontDialog.OnSelectFace( Sender: TObject; Index: LongInt );
717Begin
718 FUpdating := true;
719 InsertStyles;
720 InsertSizes;
721 FUpdating := false;
722 SelectFont;
723End;
724
725Procedure TCustomFontDialog.OnSelectStyle( Sender: TObject; Index: LongInt );
726Begin
727 if FUpdating then
728 exit;
729 FUpdating := true;
730 InsertSizes;
731 FUpdating := false;
732 SelectFont;
733End;
734
735Procedure TCustomFontDialog.OnSetSize( Sender: TObject );
736Begin
737 if FUpdating then
738 exit;
739 SelectFont;
740End;
741
742Procedure TCustomFontDialog.OnSizeClick( Sender: TObject; Index: longint );
743Begin
744 // make a single click select
745 FSizeCombo.Text := FSizeCombo.Items[ Index ];
746End;
747
748Procedure TCustomFontDialog.OnStyleChanged( Sender:TObject );
749Begin
750 SelectFont;
751End;
752
753Initialization
754 {Register classes}
755 RegisterClasses([TCustomFontDialog]);
756End.
757
Note: See TracBrowser for help on using the repository browser.