rvfontcombos.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       TRVFontSizeComboBox, TRVFontCharsetComboBox,    }
{       TRVFontComboBox                                 }
{                                                       }
{       Copyright (c) 2002-2007, Sergey Tkachenko       }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}


{==============================================================================}
{
 TRVFontSizeComboBox - combobox for selecting sizes of font
 TRVFontCharsetComboBox - combobox for selecting character sets of font
 TRVFontComboBox - combobox with font names
 Assign FontName property of these combos and they will be filled with values
}
{==============================================================================}

{$I RV_Defs.inc}
{$I RichViewActions.inc}

unit RVFontCombos;

{------------------------------------------------------------------------------}
{

  Changes:

  v1.5
  chg: TRVFontComboBox does not include fonts started with '@'

  v1.4
  fix: TRVFontComboBox stored font names in DFM (and even worse - used these
  font names)

  v1.3
  fix: correct drawing of parent background if style is "simple"
  added: TRVFontCombobox - mainly for having a combobox drawing background
     correctly
  v1.2
  chg: unit SVFontCombos is separated into two parts: RVFontCombos.pas and
       RVFontCombosReg.pas
  chg: RV prefix added

  ----------------------------------------------------------------------------

 TRVFontCharsetComboBox uses Items.Objects property itself, do not use it.
 TRVFontCharsetComboBox has additional properties:
 AddDefaultCharset: Boolean - if True, DEFAULT_CHARSET item will be added
 DefaultCharsetCaption: String - caption of list item above
 Charsets[Index: Integer]: TFontCharset - returns Charset of the Index-th item
 function IndexOfCharset(Charset: TFontCharset):Integer - returns index of
 item with specified Charset in combo, or -1 if not found
}
{------------------------------------------------------------------------------}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  {$IFDEF USERVKSDEVTE}
  te_theme,
  {$ENDIF}  
  StdCtrls, RVXPTheme;

type
  TRVFontSizeComboBox = class(TComboBox)
  private
    { Private declarations }
    PixelsPerInch: Integer;
    FFontName: TFontName;
    procedure SetFontName(const Value: TFontName);
    procedure Build;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    { Protected declarations }
    function IsValidChar(Key: Char): Boolean;
    procedure KeyPress(var Key: Char); override;
  public
    { Public declarations }
    property FontName: TFontName read FFontName write SetFontName;
  published
    { Published declarations }
  end;

  TRVFontCharsetComboBox = class(TComboBox)
  private
    { Private declarations }
    FFontName: TFontName;
    FAddDefaultCharset: Boolean;
    FDefaultCharsetCaption: String;
    procedure SetFontName(const Value: TFontName);
    procedure Build;
    function GetCharsets(Index: Integer): TFontCharset;
    procedure SetAddDefaultCharset(const Value: Boolean);
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    function IndexOfCharset(Charset: TFontCharset):Integer;
    property FontName: TFontName read FFontName write SetFontName;
    property Charsets[Index: Integer]: TFontCharset read GetCharsets;
  published
    { Published declarations }
    property AddDefaultCharset: Boolean read FAddDefaultCharset write SetAddDefaultCharset;
    property DefaultCharsetCaption: String read FDefaultCharsetCaption write FDefaultCharsetCaption;
  end;

  TRVFontComboBox = class(TComboBox)
    private
      procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    protected
      procedure CreateWnd; override;
    published
      property Items stored False;
  end;

implementation

{============================= TRVFontSizeComboBox ==============================}
function EnumFontSizes(var EnumLogFont: TEnumLogFont;
  PTextMetric: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer;
  export; stdcall;
var s: String;
    i,v,v2: Integer;
begin
  if (FontType and TRUETYPE_FONTTYPE)<>0 then begin
    TRVFontSizeComboBox(Data).Items.Add('8');
    TRVFontSizeComboBox(Data).Items.Add('9');
    TRVFontSizeComboBox(Data).Items.Add('10');
    TRVFontSizeComboBox(Data).Items.Add('11');
    TRVFontSizeComboBox(Data).Items.Add('12');
    TRVFontSizeComboBox(Data).Items.Add('14');
    TRVFontSizeComboBox(Data).Items.Add('16');
    TRVFontSizeComboBox(Data).Items.Add('18');
    TRVFontSizeComboBox(Data).Items.Add('20');
    TRVFontSizeComboBox(Data).Items.Add('22');
    TRVFontSizeComboBox(Data).Items.Add('24');
    TRVFontSizeComboBox(Data).Items.Add('26');
    TRVFontSizeComboBox(Data).Items.Add('28');
    TRVFontSizeComboBox(Data).Items.Add('36');
    TRVFontSizeComboBox(Data).Items.Add('48');
    TRVFontSizeComboBox(Data).Items.Add('72');
    Result := 0;
    end
  else begin
    v := Round((EnumLogFont.elfLogFont.lfHeight-PTextMetric.tmInternalLeading)*72 /
      TRVFontSizeComboBox(Data).PixelsPerInch);
    s := IntToStr(v);
    Result := 1;
    for i := 0 to TRVFontSizeComboBox(Data).Items.Count-1 do begin
      v2 := StrToInt(TRVFontSizeComboBox(Data).Items[i]);
      if v2=v then
        exit;
      if v2>v then begin
        TRVFontSizeComboBox(Data).Items.Insert(i,s);
        exit;
      end;
    end;
    TRVFontSizeComboBox(Data).Items.Add(s);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVFontSizeComboBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  {$IFDEF USERVKSDEVTE}
  DrawControlBackground(Self, Msg.DC);
  exit;
  {$ENDIF}
  if (Assigned(RV_IsThemeActive)) and RV_IsThemeActive and RV_IsAppThemed then begin
    RV_DrawThemeParentBackground(Handle, Msg.DC, nil);
    Msg.Result := 1
    end
  else
    inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVFontSizeComboBox.Build;
var
  DC: HDC;
  OC: TNotifyEvent;
begin
  DC := GetDC(0);
  Items.BeginUpdate;
  try
    Items.Clear;
    if FontName<>'' then begin
      PixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
      EnumFontFamilies(DC, PChar(FontName), @EnumFontSizes, Longint(Self));
      OC := OnClick;
      OnClick := nil;
      ItemIndex := Items.IndexOf(Text);
      OnClick := OC;
      if Assigned(OnClick) then
        OnClick(Self);
    end;
  finally
    Items.EndUpdate;
    ReleaseDC(0, DC);
  end;
end;
{------------------------------------------------------------------------------}
function TRVFontSizeComboBox.IsValidChar(Key: Char): Boolean;
begin
  Result := (Key in ['0'..'9']) or
            ((Key < #32) and (Key <> Chr(VK_RETURN)));
end;

procedure TRVFontSizeComboBox.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then begin
    Key := #0;
    MessageBeep(0)
  end;
  if (Key <> #0) then
    inherited KeyPress(Key);
end;

procedure TRVFontSizeComboBox.SetFontName(const Value: TFontName);
begin
  FFontName := Value;
  Build;
end;
{============================= TRVFontCharsetComboBox ===========================}
function EnumFontCharsets(var EnumLogFont: TEnumLogFontEx;
  PTextMetric: PNewTextMetricEx; FontType: Integer; Data: LPARAM): Integer;
  export; stdcall;
var s: String;
    l,cs: Integer;
begin
  Result := 1;
  cs := EnumLogFont.elfLogFont.lfCharSet;
  if cs<>MAC_CHARSET then begin
    l := StrLen(EnumLogFont.elfScript);
    SetLength(s,l);
    Move(EnumLogFont.elfScript, PChar(s)^,  l);
    for l := 0 to TRVFontCharsetComboBox(Data).Items.Count-1 do begin
      if Integer(TRVFontCharsetComboBox(Data).Items.Objects[l])=cs then
        exit;
      if AnsiCompareText(TRVFontCharsetComboBox(Data).Items[l],s)>0 then begin
        TRVFontCharsetComboBox(Data).Items.InsertObject(l,s,TObject(cs));
        exit;
      end;
    end;
    TRVFontCharsetComboBox(Data).Items.AddObject(s, TObject(cs));
  end;
end;
{------------------------------------------------------------------------------}
constructor TRVFontCharsetComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDefaultCharsetCaption := '(Default)';
end;
{------------------------------------------------------------------------------}
procedure TRVFontCharsetComboBox.Build;
var
  DC: HDC;
  lf: TLogFont;
  CurrentCharset,idx: Integer;
  OC: TNotifyEvent;
begin
  DC := GetDC(0);
  Items.BeginUpdate;
  try
    if ItemIndex=-1 then
      CurrentCharset := -1
    else
      CurrentCharset := Integer(Charsets[ItemIndex]);
    Items.Clear;
    if FontName<>'' then begin
      FillChar(lf, sizeof(lf), 0);
      lf.lfCharset  := DEFAULT_CHARSET;
      Move(PChar(FontName)^, lf.lfFaceName, Length(FontName));
      EnumFontFamiliesEx(DC, lf, @EnumFontCharsets, Longint(Self),0);
      if AddDefaultCharset then
        Items.AddObject(DefaultCharsetCaption, TObject(DEFAULT_CHARSET));
      idx := Items.IndexOfObject(TObject(CurrentCharset));
      OC := OnClick;
      OnClick := nil;
      if (idx<>-1) then
        ItemIndex := idx
      else
        if Items.Count>0 then
          ItemIndex := 0;
      OnClick := OC;
      if Assigned(OnClick) then
        OnClick(Self);
    end;
  finally
    Items.EndUpdate;
    ReleaseDC(0, DC);
  end;
end;
{------------------------------------------------------------------------------}
function TRVFontCharsetComboBox.GetCharsets(Index: Integer): TFontCharset;
begin
  Result := TFontCharset(Items.Objects[Index]);
end;
{------------------------------------------------------------------------------}
function TRVFontCharsetComboBox.IndexOfCharset(
  Charset: TFontCharset): Integer;
begin
  Result := Items.IndexOfObject(TObject(Charset));
end;
{------------------------------------------------------------------------------}
procedure TRVFontCharsetComboBox.SetAddDefaultCharset(const Value: Boolean);
begin
  if FAddDefaultCharset<>Value then begin
    FAddDefaultCharset := Value;
    Build;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVFontCharsetComboBox.SetFontName(const Value: TFontName);
begin
  FFontName := Value;
  Build;
end;
{------------------------------------------------------------------------------}
procedure TRVFontCharsetComboBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  {$IFDEF USERVKSDEVTE}
  DrawControlBackground(Self, Msg.DC);
  exit;
  {$ENDIF}
  if (Assigned(RV_IsThemeActive)) and RV_IsThemeActive and RV_IsAppThemed then begin
    RV_DrawThemeParentBackground(Handle, Msg.DC, nil);
    Msg.Result := 1
    end
  else
    inherited;
end;
{============================== TRVFontComboBox ===============================}
procedure TRVFontComboBox.CreateWnd;
var SL: TStringList;
  i: Integer;
begin
  inherited;
  SL := TStringList.Create;
  SL.Assign(Screen.Fonts);
  SL.BeginUpdate;
  for i := SL.Count-1 downto 0 do
    if (SL[i]='') or (SL[i][1]='@') then
      SL.Delete(i);
  SL.EndUpdate;
  Items := SL;
  SL.Free;
end;
{------------------------------------------------------------------------------}
procedure TRVFontComboBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  {$IFDEF USERVKSDEVTE}
  DrawControlBackground(Self, Msg.DC);
  exit;
  {$ENDIF}
  if (Assigned(RV_IsThemeActive)) and RV_IsThemeActive and RV_IsAppThemed then begin
    RV_DrawThemeParentBackground(Handle, Msg.DC, nil);
    Msg.Result := 1
    end
  else
    inherited;
end;

end.