MdFontbox.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:2k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit MdFontbox;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   StdCtrls;
  6. type
  7.   TMdFontCombo = class(TComboBox)
  8.   private
  9.     FChangeFormFont: Boolean;
  10.     procedure SetChangeFormFont(const Value: Boolean);
  11.   public
  12.     constructor Create (AOwner: TComponent); override;
  13.     procedure CreateWnd; override;
  14.     procedure Change; override;
  15.   published
  16.     property Style default csDropDownList;
  17.     property Items stored False;
  18.     property ChangeFormFont: Boolean
  19.       read FChangeFormFont write SetChangeFormFont
  20.       default True;
  21.   end;
  22. procedure Register;
  23. implementation
  24. procedure Register;
  25. begin
  26.   RegisterComponents('Md', [TMdFontCombo]);
  27. end;
  28. { TMdFontCombo class }
  29. procedure TMdFontCombo.Change;
  30. begin
  31.   // assign the font to the owner form
  32.   if FChangeFormFont and Assigned (Owner) and (Owner is TForm) then
  33.     TForm (Owner).Font.Name := Text;
  34.   inherited;
  35. end;
  36. constructor TMdFontCombo.Create (AOwner: TComponent);
  37. begin
  38.   inherited Create (AOwner);
  39.   Style := csDropDownList;
  40.   FChangeFormFont := True;
  41. end;
  42. procedure TMdFontCombo.CreateWnd;
  43. begin
  44.   inherited CreateWnd;
  45.   Items.Assign (Screen.Fonts);
  46.   // grab the default font of the owner form
  47.   if FChangeFormFont and Assigned (Owner) and (Owner is TForm) then
  48.     ItemIndex := Items.IndexOf (
  49.       (Owner as TForm).Font.Name);
  50. end;
  51. procedure TMdFontCombo.SetChangeFormFont(const Value: Boolean);
  52. begin
  53.   FChangeFormFont := Value;
  54.   // refresh font
  55.   if FChangeFormFont then
  56.     Change;
  57. end;
  58. end.