source: trunk/Components/CustomFontDialog.PAS@ 470

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

Always update minimum size of font dialog to fit controls.
  • Property svn:eol-style set to native
File size: 21.2 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
[466]379 // Divide the top half controls at 50% of the total width
380 TopLW := W div 2; // Width of top left area
[459]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
[466]567 // Make sure the dialog is big enough for the controls
568 MinTrackWidth := Font.Width * 60;
569 if MinTrackWidth < 400 then
570 MinTrackWidth := 400;
571
572 MinTrackHeight := Font.Height * 20;
573 if MinTrackHeight < 350 then
574 MinTrackHeight := 350;
575
[15]576 Screen.Cursor := crDefault;
577end;
578
579Procedure TCustomFontDialog.SetEditFont( NewFont:TFont );
580Begin
581 If NewFont = Nil Then
582 NewFont := Screen.DefaultFont;
583
584 DereferenceFont( FEditFont );
585 FEditFont := NewFont;
586 ReferenceFont( FEditFont );
587
588 if Handle <> 0 then
589 begin
590 FaceName := GetFontFamilyName( NewFont );
591 StyleName := GetFontStyleName( NewFont );
592 PointSize := NewFont.PointSize;
593 Attributes := NewFont.Attributes;
594 end
595 else
596 begin
597 FFontLoadRequired := true;
598 end;
599End;
600
601const
602 StandardOutlineSizes: array[ 0 .. 11 ] of longint =
603 (
604 4, 5, 6, 8, 10, 12,
605 15, 18, 24, 36, 48, 72
606 );
607
608function LongintListCompare( Item1: pointer;
609 Item2: pointer ): longint;
610begin
611 if item1 < item2 then
612 result := -1
613 else if item1 > item2 then
614 result := 1
615 else
616 result := 0;
617end;
618
619Procedure TCustomFontDialog.InsertStyles;
620var
621 FontList: TStringList;
622 OldStyleName: string;
623 NewIndex: longint;
624begin
625 FontList := FNameList.Items.Objects[ FNameList.ItemIndex ] as TStringList;
626 if FStyleListbox.ItemIndex <> -1 then
627 OldStyleName := FStyleListbox.Items[ FStyleListbox.ItemIndex ]
628 else
629 OldStyleName := 'Normal';
630 FStyleListbox.Items.Assign( FontList );
631
632 NewIndex := FStyleListbox.Items.IndexOf( OldStyleName );
633 if NewIndex = -1 then
634 NewIndex := FStyleListbox.Items.IndexOf( 'Normal' );
635 if NewIndex = -1 then
636 NewIndex := 0;
637 FStyleListbox.ItemIndex := NewIndex;
638end;
639
640Procedure TCustomFontDialog.InsertSizes;
641var
642 Face: string;
643 TheFont: TFont;
644 FontIndex: longint;
645 SizeIndex: longint;
646 OldSize: longint;
647 SizeString: string;
648
649 LimitedSizes: boolean;
650 Size: longint;
651 NearestSize: longint;
652 NearestSizeIndex: longint;
653
654 Sizes: TList;
655
656 procedure AddSize( const size: longint );
657 begin
658 if Sizes.IndexOf( pointer( size ) ) = -1 then
659 Sizes.Add( pointer( size ) );
660 end;
661Begin
662 Sizes := TList.Create;
663
664 Face := GetStyleFont.FaceName;
665 try
666 OldSize := StrToInt( FSizeCombo.Caption );
667 except
668 OldSize := 8;
669 end;
670
671 FSizeCombo.BeginUpdate;
672 FSizeCombo.Clear;
673
674 LimitedSizes := true;
675
676 For FontIndex := 0 To Screen.FontCount - 1 Do
677 Begin
678 TheFont := Screen.Fonts[ FontIndex ];
679 If TheFont.FaceName = Face Then
680 Begin
681 // this is a font for the current face.
682 if TheFont.FontType = ftBitmap then
683 begin
684 // just insert the specified point size
685 AddSize( TheFont.NominalPointSize );
686 end
687 else
688 begin
689 // an outline font...
690 LimitedSizes := false;
691 for SizeIndex := Low( StandardOutlineSizes ) to High( StandardOutlineSizes ) do
692 begin
693 AddSize( StandardOutlineSizes[ SizeIndex ] );
694 end;
695 end;
696 end;
697 End;
698
699 // sort from small to large
700 Sizes.Sort( LongintListCompare );
701
702 // add to combobox
703 For SizeIndex := 0 to Sizes.Count - 1 do
704 begin
705 SizeString := IntToStr( longint( Sizes[ SizeIndex ] ) );
706 FSizeCombo.Items.Add( SizeString );
707 end;
708
709 if LimitedSizes then
710 begin
711 // Find nearest match for old size
712 if Sizes.Count > 0 then
713 begin
714 NearestSizeIndex := 0;
715 NearestSize := longint( Sizes[ 0 ] );
716 for SizeIndex := 1 to Sizes.Count - 1 do
717 begin
718 Size := longint( Sizes[ SizeIndex ] );
719 if Abs( Size - OldSize ) < Abs( NearestSize - OldSize ) then
720 begin
721 // closer,
722 NearestSizeIndex := SizeIndex;
723 NearestSize := Size;
724 end;
725 end;
726 end
727 else
728 begin
729 NearestSizeIndex := -1;
730 end;
731
732 FSizeCombo.ItemIndex := NearestSizeIndex;
733 end
734 else
735 begin
736 FSizeCombo.Text := IntToStr( OldSize );
737
738 // if there's an exact match, select it, if not select nothing
739 NearestSizeIndex := FSizeCombo.Items.IndexOf( IntToStr( OldSize ) );
740
741 FSizeCombo.ItemIndex := NearestSizeIndex
742
743 end;
744
745 FSizeCombo.EndUpdate;
746
747 Sizes.Destroy;
748End;
749
750
751{$HINTS OFF}
752Procedure TCustomFontDialog.OnSelectFace( Sender: TObject; Index: LongInt );
753Begin
754 FUpdating := true;
755 InsertStyles;
756 InsertSizes;
757 FUpdating := false;
758 SelectFont;
759End;
760
761Procedure TCustomFontDialog.OnSelectStyle( Sender: TObject; Index: LongInt );
762Begin
763 if FUpdating then
764 exit;
765 FUpdating := true;
766 InsertSizes;
767 FUpdating := false;
768 SelectFont;
769End;
770
771Procedure TCustomFontDialog.OnSetSize( Sender: TObject );
772Begin
773 if FUpdating then
774 exit;
775 SelectFont;
776End;
777
778Procedure TCustomFontDialog.OnSizeClick( Sender: TObject; Index: longint );
779Begin
780 // make a single click select
781 FSizeCombo.Text := FSizeCombo.Items[ Index ];
782End;
783
784Procedure TCustomFontDialog.OnStyleChanged( Sender:TObject );
785Begin
786 SelectFont;
787End;
788
789Initialization
790 {Register classes}
791 RegisterClasses([TCustomFontDialog]);
792End.
793
Note: See TracBrowser for help on using the repository browser.