unit dpbFontListBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TdpbFontListBox = class(TCustomListBox)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('dpb', [TdpbFontListBox]);
end;

end.

procedure CreateWnd; override;
procedure FillFontList;

constructor Create(AOwner : TComponent); override;
property SelectedFont : string read GetSelectedFont write SetSelectedFont;

property Device : TdpbFontDevice read FDevice write SetDevie;

unit dpbFontListBox;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Printers;

type
  TdpbFontDevice = ( dfdAll, dfdScreen, dfdPrinter );

  TdpbFontListBox = class(TCustomListBox)
  private
    { Private declarations }
    FDevice : TdpbFontDevice;

    function GetSelectedFont: string;
    procedure SetDevie(const Value: TdpbFontDevice);
    procedure SetSelectedFont(const Value: string);
  protected
    { Protected declarations }
    procedure CreateWnd; override;
    procedure FillFontList;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    property SelectedFont : string read GetSelectedFont write SetSelectedFont;
  published
    { Published declarations }
    property Device : TdpbFontDevice read FDevice write SetDevie;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('dpb', [TdpbFontListBox]);
end;

{ TdpbFontListBox }

constructor TdpbFontListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ExtendedSelect := False;
  MultiSelect := False;
  FDevice := dfdAll;
end;

procedure TdpbFontListBox.CreateWnd;
begin
  inherited CreateWnd;
  FillFontList;
end;

procedure TdpbFontListBox.FillFontList;
var
  nIndex : Integer;
begin
  Items.BeginUpdate;
  Items.Clear;
  if (FDevice = dfdScreen) or (FDevice = dfdAll) then
    Items.AddStrings(Screen.Fonts);

  if (FDevice = dfdPrinter) or (FDevice = dfdAll) then
  begin
    for nIndex := 0 to Pred(Printer.Fonts.Count) do
    begin
      if Items.IndexOf(Printer.Fonts[nIndex]) = -1 then
        Items.Add(Printer.Fonts[nIndex]);
    end;
  end;
  Sorted := True;
  Items.EndUpdate;
  if Items.Count > 0 then
    ItemIndex := 0;
end;

function TdpbFontListBox.GetSelectedFont: string;
begin
  Result := '';
  if ItemIndex <> -1 then
    Result := Items[ItemIndex];
end;

procedure TdpbFontListBox.SetDevie(const Value: TdpbFontDevice);
begin
  if FDevice <> Value then
  begin
    FDevice := Value;
    FillFontList;
  end;
end;

procedure TdpbFontListBox.SetSelectedFont(const Value: string);
begin
  ItemIndex := Items.IndexOf(Value);
end;

end.

unit FontListBoxTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, dpbFontListBox;

type
  TfrmFontListBoxTest = class(TForm)
    btnNewFontListBox: TButton;
    btnGetSelectedFont: TButton;
    btnSetGulim: TButton;
    panSelectedFont: TPanel;
    procedure btnNewFontListBoxClick(Sender: TObject);
    procedure btnGetSelectedFontClick(Sender: TObject);
    procedure btnSetGulimClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FontListBox : TdpbFontListBox;
  end;

var
  frmFontListBoxTest: TfrmFontListBoxTest;

implementation

{$R *.DFM}

procedure TfrmFontListBoxTest.btnNewFontListBoxClick(Sender: TObject);
begin
  FontListBox := TdpbFontListBox.Create(Self);
  FontListBox.Width := 133;
  FontListBox.Height := 145;
  FontListBox.Left := 144;
  FontListBox.Top := 4;
  FontListBox.Parent := Self;
end;

procedure TfrmFontListBoxTest.btnGetSelectedFontClick(Sender: TObject);
begin
  if FontListBox <> nil then
    panSelectedFont.Caption := FontListBox.SelectedFont;
end;

procedure TfrmFontListBoxTest.btnSetGulimClick(Sender: TObject);
begin
  if FontListBox <> nil then
    FontListBox.SelectedFont := '±¼¸²';
end;

end.

property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property Style;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;