source: trunk/Components/CustomFontDialog.PAS@ 459

Last change on this file since 459 was 459, checked in by ataylor, 2 years ago

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