unit woFontListBox;
{
        Webocton - FontListBox

        Von TListBox abgeleitete Komponente welche alle
        auf dem System installierten Schriftarten
        auflistet und in der entsprechenden Schriftart ausgibt
        Geladen wird die Schriftarten-Liste entweder
        automatisch (AutoLoad) oder manuell (LoadFonts).
        Entsprechend existiert die Webocton - FontComboBox.

        Version vom: 08.05.2004

        Copyright 2004-2008 by Benedikt Loepp
        Webocton

        benedikt@webocton.de
        www.webocton.de

        ---

        Benötigt wird Borland Delphi+Visual Component Library
}

interface

uses
    SysUtils,
    Classes,
    Controls,
    StdCtrls,
    Forms,
    Graphics,
    Types,
    Windows;

type
    TwoFontListBox = class(TListBox)
    private
        FAutoLoad: Boolean;
        procedure WriteSelected(Value: string);
        function ReadSelected: string;
    public
        property Selected: string read ReadSelected write WriteSelected;
        procedure LoadFonts;
        constructor Create(AOwner: TComponent); override;
    protected
        procedure Loaded; override;
        procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    published
        property Style;
        property OnMeasureItem;
        property OnDrawItem;
        property AutoLoad: Boolean read FAutoLoad write FAutoLoad;
    end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('Webocton - Components', [TwoFontListBox]);
end;

constructor TwoFontListBox.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    FAutoLoad := TRUE;
    Style := lbOwnerDrawFixed;
end;

procedure TwoFontListBox.LoadFonts;
begin
    Items.Assign(Screen.Fonts);
end;

procedure TwoFontListBox.Loaded;
begin
    inherited Loaded;

    if (FAutoLoad = TRUE) then
        Items.Assign(Screen.Fonts);
end;

procedure TwoFontListBox.WriteSelected(Value: string);
begin
    Items[ItemIndex] := Value;
end;

function TwoFontListBox.ReadSelected: string;
begin
    Result := Items[ItemIndex];
end;

procedure TwoFontListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
    Canvas.FillRect(Rect);
    Canvas.Font.Name := Items[Index];
    Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
end;

end.