?? suifontcombobox.pas
字號:
////////////////////////////////////////////////////////////////////////////////
//
//
// FileName : SUIFontComboBox.pas
// Creator : Steve McDonald
// Merger : Shen Min
// Date : 2003-04-01 V1-V3
// 2003-06-24 V4
// Comment :
//
// Copyright (c) 2002-2003 Sunisoft
// http://www.sunisoft.com
// Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////
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 }
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -