408 lines
12 KiB
ObjectPascal
408 lines
12 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ ExpressWeb Framework by Developer Express }
|
|
{ Text Metrics Utils }
|
|
{ }
|
|
{ Copyright (c) 2000-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSWEB FRAMEWORK AND ALL }
|
|
{ ACCOMPANYING VCL CLASSES AS PART OF AN EXECUTABLE WEB }
|
|
{ APPLICATION ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
unit cxWebMetrics;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
{$IFDEF VCL}
|
|
Windows, Graphics, Jpeg,
|
|
{$ELSE}
|
|
Types, Qt, QGraphics,
|
|
{$ENDIF}
|
|
cxWebUtils, cxWebTypes, cxWebGraphics;
|
|
|
|
type
|
|
TcxWebMetricsUtils = class(TcxAbstractWebMetricsUtils)
|
|
private
|
|
FPixelsPerInch: Integer;
|
|
FCheckWidth, FCheckHeight: Integer;
|
|
procedure GetCheckSize;
|
|
procedure GetPixelsPerInch;
|
|
function GetFontSizeInPoints(AFontSize: TcxWebFontSize): Integer;
|
|
function GetTextSize(const AText: string; AWebFont: TcxWebFont): TSize;
|
|
protected
|
|
function GetCheckWidth: Integer; override;
|
|
function GetCheckHeight: Integer; override;
|
|
function WebFontToFont(AWebFont: TcxWebFont): {$IFDEF VCL}HFONT{$ELSE}QFontH{$ENDIF};
|
|
public
|
|
constructor Create;
|
|
function CalcEditHeight(AFont: TcxWebFont): Integer; override;
|
|
function GetAweCharWidth(AWebFont: TcxWebFont): Integer; override;
|
|
function GetTextHeight(const AText: string; AWebFont: TcxWebFont): Integer; override;
|
|
function GetTextWidth(const AText: string; AWebFont: TcxWebFont): Integer; override;
|
|
end;
|
|
|
|
TcxWebImageUtils = class(TcxAbstractWebImageUtils)
|
|
private
|
|
FPicture: TPicture;
|
|
FErrMessage: string;
|
|
protected
|
|
function GetGraphic: TGraphic;
|
|
public
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
function GetErrMessage: string; override;
|
|
function GetHeight: Integer; override;
|
|
function GetWidth: Integer; override;
|
|
function IsEmpty: Boolean; override;
|
|
procedure SetPath(const APath: string); override;
|
|
procedure SetImage(Value: Variant); override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses Variants, cxWebDataUtils, Consts;
|
|
|
|
{ TcxWebMetricsUtils }
|
|
|
|
constructor TcxWebMetricsUtils.Create;
|
|
begin
|
|
inherited;
|
|
GetCheckSize;
|
|
GetPixelsPerInch;
|
|
end;
|
|
|
|
procedure TcxWebMetricsUtils.GetPixelsPerInch;
|
|
{$IFDEF VCL}
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
DC := GetDC(0);
|
|
FPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
|
|
ReleaseDC(0, DC);
|
|
{$ELSE}
|
|
var
|
|
Metrics: QPaintDeviceMetricsH;
|
|
begin
|
|
Metrics := QPaintDeviceMetrics_create(QWidget_to_QPaintDevice(QApplication_desktop));
|
|
FPixelsPerInch := QPaintDeviceMetrics_logicalDpiY(Metrics);
|
|
QPaintDeviceMetrics_destroy(Metrics);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetFontSizeInPoints(AFontSize: TcxWebFontSize): Integer;
|
|
begin
|
|
case AFontSize.Units of
|
|
wuPixels:
|
|
Result := MulDiv(AFontSize.Value, 72, FPixelsPerInch); // 1 pt = 1/72 in
|
|
wuPicas:
|
|
Result := MulDiv(AFontSize.Value, 6, FPixelsPerInch); // 1 pc = 12 pt = 1/6 in
|
|
wuMillimeters:
|
|
Result := MulDiv(AFontSize.Value * 10, 72, 254); // 1 in = 25.4 mm
|
|
wuCentimeters:
|
|
Result := MulDiv(AFontSize.Value * 100, 72, 254); // 1 in = 2.54 cm
|
|
wuInches:
|
|
Result := 72 * AFontSize.Value;
|
|
// wuEm: TODO: it is equal to the font size of the parent element
|
|
// wuEx: TODO: it is equal to the height of the lowercase "x".
|
|
// wuPercentage: TODO: it is rate of the font size of the parent element
|
|
else {in points}
|
|
Result := AFontSize.Value;
|
|
end;
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.WebFontToFont(AWebFont: TcxWebFont): {$IFDEF VCL}HFONT{$ELSE}QFontH{$ENDIF};
|
|
{$IFDEF VCL}
|
|
var
|
|
LogFont: TLogFont;
|
|
begin
|
|
FillChar(LogFont, SizeOf(TLogFont), 0);
|
|
with LogFont do
|
|
begin
|
|
lfHeight := -MulDiv(GetFontSizeInPoints(AWebFont.Size), FPixelsPerInch, 72);
|
|
lfWidth := 0;
|
|
lfEscapement := 0;
|
|
lfOrientation := 0;
|
|
if AWebFont.Bold then
|
|
lfWeight := FW_BOLD
|
|
else
|
|
lfWeight := FW_NORMAL;
|
|
lfItalic := Byte(AWebFont.Italic);
|
|
lfUnderline := Byte(AWebFont.Underline);
|
|
lfStrikeOut := Byte(AWebFont.Strikeout);
|
|
lfCharSet := DEFAULT_CHARSET;//Byte(Font.Charset);
|
|
lfOutPrecision := OUT_DEFAULT_PRECIS;
|
|
lfClipPrecision := CLIP_DEFAULT_PRECIS;
|
|
lfQuality := DEFAULT_QUALITY;
|
|
lfPitchAndFamily := DEFAULT_PITCH;
|
|
StrPCopy(lfFaceName, AWebFont.Name);
|
|
end;
|
|
Result := CreateFontIndirect(LogFont);
|
|
{$ELSE}
|
|
var
|
|
AFontName: WideString;
|
|
begin
|
|
Result := QFont_Create();
|
|
AFontName := AWebFont.Name;
|
|
QFont_setFamily(Result, @AFontName);
|
|
QFont_setPixelSize(Result, GetFontSizeInPoints(AWebFont.Size));
|
|
QFont_setBold(Result, AWebFont.Bold);
|
|
QFont_setItalic(Result, AWebFont.Italic);
|
|
QFont_setStrikeOut(Result, AWebFont.StrikeOut);
|
|
QFont_setUnderline(Result, AWebFont.Underline);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetAweCharWidth(AWebFont: TcxWebFont): Integer;
|
|
{$IFDEF VCL}
|
|
var
|
|
DC: HDC;
|
|
PrevFont: HFONT;
|
|
TM: TTextMetric;
|
|
begin
|
|
DC := GetDC(0);
|
|
PrevFont := SelectObject(DC, WebFontToFont(AWebFont));
|
|
GetTextMetrics(DC, TM);
|
|
Result := TM.tmAveCharWidth;
|
|
DeleteObject(SelectObject(DC, PrevFont));
|
|
ReleaseDC(0, DC);
|
|
{$ELSE}
|
|
var
|
|
AFont: QFontH;
|
|
AFontMetrics: QFontMetricsH;
|
|
begin
|
|
AFont := WebFontToFont(AWebFont);
|
|
AFontMetrics := QFontMetrics_Create(AFont);
|
|
Result:= QFontMetrics_maxWidth(AFontMetrics);
|
|
QFontMetrics_Destroy(AFontMetrics);
|
|
QFont_Destroy(AFont);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TcxWebMetricsUtils.GetCheckSize;
|
|
{$IFDEF VCL}
|
|
const
|
|
OBM_CHECKBOXES = 32759;
|
|
begin
|
|
with TBitmap.Create do
|
|
try
|
|
Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
|
|
FCheckWidth := Width div 4;
|
|
FCheckHeight := Height div 3;
|
|
finally
|
|
Free;
|
|
end;
|
|
{$ELSE}
|
|
var
|
|
ChSize: TSize;
|
|
begin
|
|
QStyle_indicatorSize(QApplication_style, @ChSize);
|
|
if (ChSize.cx <> 0) and (ChSize.cy <> 0) then
|
|
begin
|
|
FCheckWidth := ChSize.cx;
|
|
FCheckHeight := ChSize.cy;
|
|
end
|
|
else
|
|
begin
|
|
FCheckWidth := 13;
|
|
FCheckHeight := 13;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetTextSize(const AText: string; AWebFont: TcxWebFont): TSize;
|
|
{$IFDEF VCL}
|
|
var
|
|
DC: HDC;
|
|
PrevFont: HFONT;
|
|
begin
|
|
DC := GetDC(0);
|
|
PrevFont := SelectObject(DC, WebFontToFont(AWebFont));
|
|
GetTextExtentPoint32(DC, PChar(AText), Length(AText), Result);
|
|
DeleteObject(SelectObject(DC, PrevFont));
|
|
ReleaseDC(0, DC);
|
|
{$ELSE}
|
|
var
|
|
AFont: QFontH;
|
|
AFontMetrics: QFontMetricsH;
|
|
AWideText: WideString;
|
|
begin
|
|
AFont := WebFontToFont(AWebFont);
|
|
AFontMetrics := QFontMetrics_Create(AFont);
|
|
Result.cy := QFontMetrics_height(AFontMetrics);
|
|
AWideText := AText;
|
|
Result.cx := QFontMetrics_width(AFontMetrics, @AWideText, Length(AText));
|
|
QFontMetrics_Destroy(AFontMetrics);
|
|
QFont_Destroy(AFont);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetCheckWidth: Integer;
|
|
begin
|
|
Result := FCheckWidth;
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetCheckHeight: Integer;
|
|
begin
|
|
Result := FCheckHeight;
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetTextHeight(const AText: string; AWebFont: TcxWebFont): Integer;
|
|
begin
|
|
Result := GetTextSize(AText, AWebFont).cy;
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.GetTextWidth(const AText: string; AWebFont: TcxWebFont): Integer;
|
|
begin
|
|
Result := GetTextSize(AText, AWebFont).cx;
|
|
end;
|
|
|
|
function TcxWebMetricsUtils.CalcEditHeight(AFont: TcxWebFont): Integer;
|
|
{$IFDEF VCL}
|
|
var
|
|
DC: HDC;
|
|
PrevFont: HFont;
|
|
Metrics: TTextMetric;
|
|
begin
|
|
DC := GetDC(0);
|
|
PrevFont := SelectObject(DC, WebFontToFont(AFont));
|
|
GetTextMetrics(DC, Metrics);
|
|
DeleteObject(SelectObject(DC, PrevFont));
|
|
ReleaseDC(0, DC);
|
|
Result := Metrics.tmHeight + 2 * GetSystemMetrics(SM_CYBORDER);
|
|
{$ELSE}
|
|
begin
|
|
Result := 2 + GetTextHeight('Wq', AFont) + 2;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TcxWebImageUtils }
|
|
|
|
constructor TcxWebImageUtils.Create;
|
|
begin
|
|
FPicture := TPicture.Create;
|
|
FErrMessage := '';
|
|
end;
|
|
|
|
destructor TcxWebImageUtils.Destroy;
|
|
begin
|
|
FPicture.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TcxWebImageUtils.GetErrMessage: string;
|
|
begin
|
|
Result := FErrMessage;
|
|
end;
|
|
|
|
function TcxWebImageUtils.GetHeight: Integer;
|
|
begin
|
|
Result := FPicture.Height;
|
|
end;
|
|
|
|
function TcxWebImageUtils.GetWidth: Integer;
|
|
begin
|
|
Result := FPicture.Width;
|
|
end;
|
|
|
|
function TcxWebImageUtils.IsEmpty: Boolean;
|
|
begin
|
|
Result := (FPicture.Graphic = nil) or FPicture.Graphic.Empty;
|
|
end;
|
|
|
|
procedure TcxWebImageUtils.SetPath(const APath: string);
|
|
var
|
|
Ext: string;
|
|
begin
|
|
if APath = '' then
|
|
begin
|
|
FPicture.Graphic := nil;
|
|
FErrMessage := '';
|
|
end
|
|
else
|
|
try
|
|
Ext := ExtractFileExt(APath);
|
|
Delete(Ext, 1, 1);
|
|
if Ext = '' then
|
|
raise EInvalidGraphic.CreateFmt(SUnknownExtension, [Ext]);
|
|
FPicture.LoadFromFile(APath);
|
|
FErrMessage := '';
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FPicture.Graphic := nil;
|
|
FErrMessage := 'DESIGNER WARNING:' + #13#10 + E.Message + #13#10 + 'Image may be missing or displayed incorrectly.';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TcxWebImageUtils.SetImage(Value: Variant);
|
|
var
|
|
AStream: TStream;
|
|
AHeight, AWidth: Integer;
|
|
NewGraphic: TGraphic;
|
|
begin
|
|
if VarIsType(Value, [varEmpty, VarNull]) then Exit;
|
|
{$IFDEF VCL}
|
|
NewGraphic := TJPEGImage.Create;
|
|
{$ELSE}
|
|
NewGraphic := TBitmap.Create;
|
|
{$ENDIF}
|
|
try
|
|
AStream := TMemoryStream.Create;
|
|
LoadPicture(AStream, {$IFDEF VCL}nil,{$ENDIF} Value, AHeight, AWidth);
|
|
try
|
|
AStream.Position := 0;
|
|
NewGraphic.LoadFromStream(AStream);
|
|
FPicture.Graphic := NewGraphic;
|
|
finally
|
|
AStream.Free;
|
|
end;
|
|
finally
|
|
NewGraphic.Free;
|
|
end;
|
|
end;
|
|
|
|
function TcxWebImageUtils.GetGraphic: TGraphic;
|
|
begin
|
|
Result := FPicture.Graphic;
|
|
end;
|
|
|
|
initialization
|
|
if Assigned(cxWebMetricsUtils) then
|
|
cxWebMetricsUtils.Free;
|
|
cxWebMetricsUtils := TcxWebMetricsUtils.Create;
|
|
cxWebImageUtilsClass := TcxWebImageUtils;
|
|
|
|
finalization
|
|
FreeAndNil(cxWebMetricsUtils);
|
|
cxWebImageUtilsClass := nil;
|
|
|
|
end.
|