suifontcombobox.pas

SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIFontComboBox.pas
//  Creator     :   Steve McDonald
//  Merger      :   Shen Min
//  Date        :   2003-04-01 V1-V3
//                  2003-06-24 V4
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUIFontComboBox;

{$B-} {- Complete Boolean Evaluation }
{$R-} {- Range-Checking }
{$V-} {- Var-String Checking }
{$T-} {- Typed @ operator }
{$X+} {- Extended syntax }
{$P+} {- Open string params }
{$J+} {- Writeable structured consts }
{$H+} {- Use long strings by default }
{$W-,T-}

interface

{$I SUIPack.inc}

uses
  Windows, Messages, Classes, Controls, Graphics, StdCtrls, Forms, SUIThemes,
  SUIComboBox;

resourcestring
  SResNotFound = 'Resource %s not found';

type
{ TsuiFontDrawComboBox }

  TFontDrawComboStyle = csDropDown..csDropDownList;

  TsuiFontDrawComboBox = class(TsuiCustomComboBox)
  private
    FStyle: TFontDrawComboStyle;
    FItemHeightChanging: Boolean;
    procedure SetComboStyle(Value: TFontDrawComboStyle);
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure ResetItemHeight;
    function MinItemHeight: Integer; virtual;
    property Style: TFontDrawComboStyle read FStyle write SetComboStyle default csDropDownList;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TsuiFontComboBox }

  TFontDevice = (fdScreen, fdPrinter, fdBoth);
  TFontListOption = (foAnsiOnly, foTrueTypeOnly, foFixedPitchOnly, foNoOEMFonts, foOEMFontsOnly, foScalableOnly, foNoSymbolFonts);
  TFontListOptions = set of TFontListOption;

  TsuiFontComboBox = class(TsuiFontDrawComboBox)
  private
    FTrueTypeBMP: TBitmap;
    FDeviceBMP: TBitmap;
    FOnChange: TNotifyEvent;
    FDevice: TFontDevice;
    FUpdate: Boolean;
    FUseFonts: Boolean;
    FOptions: TFontListOptions;

    procedure SetFontName(const NewFontName: TFontName);
    function GetFontName: TFontName;
    procedure SetDevice(Value: TFontDevice);
    procedure SetOptions(Value: TFontListOptions);
    procedure SetUseFonts(Value: Boolean);
    procedure Reset;
    procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE;

  protected
    procedure PopulateList; virtual;
    procedure Change; override;
    procedure Click; override;
    procedure DoChange; dynamic;
    procedure CreateWnd; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    function MinItemHeight: Integer; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Text;

  published
    property Device: TFontDevice read FDevice write SetDevice default fdScreen;
    property FontName: TFontName read GetFontName write SetFontName;
    property Options: TFontListOptions read FOptions write SetOptions default [];
    property UseFonts: Boolean read FUseFonts write SetUseFonts default False;
    property ItemHeight;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property Enabled;
    property Font;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property ImeMode;
    property ImeName;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Style;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
    property OnContextPopup;
    property OnEndDock;
    property OnStartDock;
  end;

  TsuiFontSizeComboBox = class(TsuiCustomComboBox)
  private
    PixelsPerInch : Integer;
    FFontName : TFontName;

    procedure SetFontName( const Value : TFontName );
    procedure Build;
    function GetFontSize: Integer;
    procedure SetFontSize(const Value: Integer);

  public
    constructor Create(AOwner: TComponent); override;

  published
    property FontName : TFontName read FFontName write SetFontName;
    property FontSize : Integer read GetFontSize write SetFontSize;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property Enabled;
    property Font;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property ImeMode;
    property ImeName;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Style;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
    property OnContextPopup;
    property OnEndDock;
    property OnStartDock;
  end;


implementation

uses
  SysUtils,
  Consts,
  Printers,
  Dialogs,
  SUIPublic,
  SUIResDef;


{ Utility routines }

procedure ResourceNotFound(ResID: PChar);
var
  S: string;
begin
  if LongRec(ResID).Hi = 0 then
    S := IntToStr(LongRec(ResID).Lo)
  else
    S := StrPas(ResID);
  raise EResNotFound.CreateFmt(SResNotFound, [S]);
end;

function MakeModuleBitmap(Module: THandle; ResID: PChar): TBitmap;
begin
  Result := TBitmap.Create;
  try
    if Module <> 0 then begin
      if LongRec(ResID).Hi = 0 then
        Result.LoadFromResourceID(Module, LongRec(ResID).Lo)
      else
        Result.LoadFromResourceName(Module, StrPas(ResID));
    end
    else begin
      Result.Handle := LoadBitmap(Module, ResID);
      if Result.Handle = 0 then
        ResourceNotFound(ResID);
    end;
  except
    Result.Free;
    Result := nil;
  end;
end;

function CreateBitmap(ResName: PChar): TBitmap;
begin
  Result := MakeModuleBitmap(HInstance, ResName);
  if Result = nil then
    ResourceNotFound(ResName);
end;

function GetItemHeight(Font: TFont): Integer;
var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  try
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
  finally
    ReleaseDC(0, DC);
  end;
  Result := Metrics.tmHeight + 1;
  if Result = 14 then
      Result := 15;
end;

{ TsuiFontDrawComboBox }

constructor TsuiFontDrawComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited Style := csDropDownList;
  FStyle := csDropDownList;
end;

procedure TsuiFontDrawComboBox.SetComboStyle(Value: TFontDrawComboStyle);
begin
  if FStyle <> Value then begin
    FStyle := Value;
    inherited Style := Value;
  end;
end;

function TsuiFontDrawComboBox.MinItemHeight: Integer;
begin
  Result := GetItemHeight(Font);
  if Result < 9 then
    Result := 9;
end;

procedure TsuiFontDrawComboBox.ResetItemHeight;
var
  H: Integer;
begin
  H := MinItemHeight;
  FItemHeightChanging := True;
  try
    inherited ItemHeight := H;
  finally
    FItemHeightChanging := False;
  end;
  if HandleAllocated then
    SendMessage(Handle, CB_SETITEMHEIGHT, 0, H);
end;

procedure TsuiFontDrawComboBox.CreateParams(var Params: TCreateParams);
const
  ComboBoxStyles: array[TFontDrawComboStyle] of DWORD =
    (CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST);
begin
  inherited CreateParams(Params);
  with Params do
    Style := (Style and not CBS_DROPDOWNLIST) or CBS_OWNERDRAWFIXED or
      ComboBoxStyles[FStyle];
end;

procedure TsuiFontDrawComboBox.CreateWnd;
begin
  inherited CreateWnd;
  ResetItemHeight;
end;

procedure TsuiFontDrawComboBox.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ResetItemHeight;
  RecreateWnd;
end;

procedure TsuiFontDrawComboBox.CMRecreateWnd(var Message: TMessage);
begin
  if not FItemHeightChanging then
    inherited;
end;

{ TsuiFontComboBox }