paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 06:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

customdrawnws: Implements TLabel

Browse Source 
git-svn-id: trunk@34161 -
This commit is contained in:
sekelsenmat 2011-12-13 20:06:36 +00:00
parent 9f43a00709
commit cab34d03db
5 changed files with 389 additions and 370 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/interfaces/customdrawn/customdrawnlclintfh.inc
View File

@ -74,8 +74,10 @@ procedure RemovePipeEventHandler(var AHandler: PPipeEventHandler); override;
procedure RemoveProcessEventHandler(var AHandler: PProcessEventHandler); override;
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); override;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;*)
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;*)
// No need to implement this one as the default is redirecting to ExtTextOut
// which already handles UTF-8
//function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

621
lcl/interfaces/customdrawn/customdrawnwinapi.inc
View File

@ -496,7 +496,7 @@ begin
{$endif}
QtRegion := TQtRegion.Create(True, p1, p2, p3, p4, QRegionEllipse);
Result := HRGN(QtRegion);
end;
end;*)
{------------------------------------------------------------------------------
Function: CreateFontIndirect
@ -505,7 +505,7 @@ end;
Creates a font GDIObject.
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
function TCDWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
begin
Result := CreateFontIndirectEx(LogFont, '');
end;
@ -517,11 +517,19 @@ end;
Creates a font GDIObject.
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT;
function TCDWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT;
var
QtFont: TQtFont;
FamilyName: string;
const
lFont: TFPCustomFont;
// FamilyName: string;
begin
{$ifdef VerboseCDDrawing}
DebugLn(Format('[TCDWidgetSet.CreateFontIndirectEx] LongFontName: %s',
[LongFontName]));
{$endif}
lFont := TFPCustomFont.Create;
Result := HFONT(lFont);
(*const
QStyleStategy: array [DEFAULT_QUALITY..CLEARTYPE_NATURAL_QUALITY] of QFontStyleStrategy = (
{ DEFAULT_QUALITY } QFontPreferDefault,
{ DRAFT_QUALITY } QFontPreferMatch,
@ -530,60 +538,47 @@ const
{ ANTIALIASED_QUALITY } QFontPreferAntialias,
{ CLEARTYPE_QUALITY } QFontPreferAntialias,
{ CLEARTYPE_NATURAL_QUALITY } QFontPreferAntialias
);
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI CreateFontIndirectEx] FontName: ' + LongFontName);
{$endif}
);*)
Result := 0;
(* // -1 has different meaning - it means that font height was set using setPointSize
if LogFont.lfHeight <> -1 then
QtFont.setPixelSize(Abs(LogFont.lfHeight));
QtFont := TQtFont.Create(True);
try
// -1 has different meaning - it means that font height was set using setPointSize
if LogFont.lfHeight <> -1 then
QtFont.setPixelSize(Abs(LogFont.lfHeight));
// Some values at available on Qt documentation at a table
// Others are guesses. The best would be to test different values for those
// See: http://doc.trolltech.com/4.1/qfont.html#Weight-enum
case LogFont.lfWeight of
FW_THIN : QtFont.setWeight(10);
FW_EXTRALIGHT : QtFont.setWeight(15);
FW_LIGHT : QtFont.setWeight(25);
FW_NORMAL : QtFont.setWeight(50);
FW_MEDIUM : QtFont.setWeight(55);
FW_SEMIBOLD : QtFont.setWeight(63);
FW_BOLD : QtFont.setWeight(75);
FW_EXTRABOLD : QtFont.setWeight(80);
FW_HEAVY : QtFont.setWeight(87);
end;
QtFont.Angle := LogFont.lfEscapement;
//LogFont.lfOrientation;
QtFont.setItalic(LogFont.lfItalic = High(Byte));
QtFont.setUnderline(LogFont.lfUnderline = High(Byte));
QtFont.setStrikeOut(LogFont.lfStrikeOut = High(Byte));
FamilyName := StrPas(LogFont.lfFaceName);
if (CompareText(FamilyName, 'default') <> 0) then
QtFont.setFamily(FamilyName)
else
QtFont.setFamily(UTF16ToUTF8(GetDefaultAppFontName));
if (LogFont.lfQuality >= Low(QStyleStategy)) and (LogFont.lfQuality <= High(QStyleStategy)) then
QtFont.setStyleStrategy(QStyleStategy[LogFont.lfQuality]);
Result := HFONT(QtFont);
except
Result := 0;
DebugLn('TQtWidgetSet.CreateFontIndirectEx: Failed');
// Some values at available on Qt documentation at a table
// Others are guesses. The best would be to test different values for those
// See: http://doc.trolltech.com/4.1/qfont.html#Weight-enum
case LogFont.lfWeight of
FW_THIN : QtFont.setWeight(10);
FW_EXTRALIGHT : QtFont.setWeight(15);
FW_LIGHT : QtFont.setWeight(25);
FW_NORMAL : QtFont.setWeight(50);
FW_MEDIUM : QtFont.setWeight(55);
FW_SEMIBOLD : QtFont.setWeight(63);
FW_BOLD : QtFont.setWeight(75);
FW_EXTRABOLD : QtFont.setWeight(80);
FW_HEAVY : QtFont.setWeight(87);
end;
QtFont.Angle := LogFont.lfEscapement;
//LogFont.lfOrientation;
QtFont.setItalic(LogFont.lfItalic = High(Byte));
QtFont.setUnderline(LogFont.lfUnderline = High(Byte));
QtFont.setStrikeOut(LogFont.lfStrikeOut = High(Byte));
FamilyName := StrPas(LogFont.lfFaceName);
if (CompareText(FamilyName, 'default') <> 0) then
QtFont.setFamily(FamilyName)
else
QtFont.setFamily(UTF16ToUTF8(GetDefaultAppFontName));
if (LogFont.lfQuality >= Low(QStyleStategy)) and (LogFont.lfQuality <= High(QStyleStategy)) then
QtFont.setStyleStrategy(QStyleStategy[LogFont.lfQuality]);*)
end;
function TQtWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
(*function TQtWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
var
AIcon: TQtIcon;
APixmap, ATemp: QPixmapH;
@ -3961,7 +3956,7 @@ begin
//DebugLn('Trace:TODO: [TQtWidgetSet.GetSystemMetrics] --> SM_SWAPBUTTON ');
end;
end;
end;
end; *)
{------------------------------------------------------------------------------
Function: GetTextColor
@ -3970,24 +3965,22 @@ end;
Gets the Font Color currently assigned to the Device Context
------------------------------------------------------------------------------}
function TQtWidgetSet.GetTextColor(DC: HDC) : TColorRef;
function TCDWidgetSet.GetTextColor(DC: HDC) : TColorRef;
var
Color: TQColor;
QtDC: TQtDeviceContext;
lFont: TFPCustomFont;
LazDC: TLazCanvas;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI GetTextColor]');
{$ifdef VerboseCDDrawing}
DebugLn(Format('[TCDWidgetSet.SetTextColor] DC: %x', [DC]));
{$endif}
Result := 0;
if not IsValidDC(DC) then Exit;
LazDC := TLazCanvas(DC);
if IsValidDC(DC) then
begin
QtDC := TQtDeviceContext(DC);
ColorRefToTQColor(TColorRef(QtDC.vTextColor), Color);
TQColorToColorRef(Color, Result);
end;
end;*)
if LazDC.Font <> nil then
Result := FPColorToTColor(LazDC.Font.FPColor);
end;
{$ifndef CD_UseNativeText}
{------------------------------------------------------------------------------
@ -4204,43 +4197,34 @@ begin
{$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
WriteLn('***** [WinAPI TQtWidgetSet.GetWindowLong] missing implementation ');
{$endif}
end;
end;*)
{------------------------------------------------------------------------------
Method: GetWindowOrgEx
Params: DC -
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
function TCDWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
var
Matrix: QTransformH;
LazDC: TLazCanvas absolute DC;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace: > [WinAPI GetWindowOrgEx]');
{$ifdef VerboseCDDrawing}
DebugLn(Format(':>[WinAPI GetWindowOrgEx] DC=%s', [dbghex(DC)]));
{$endif}
Result := 0;
if not IsValidDC(DC) and (P<>nil) then
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace: < [WinAPI GetWindowOrgEx] No valid DC or P is nil');
{$endif}
exit;
end;
if not IsValidDC(DC) then Exit;
if P = nil then Exit;
Matrix := QPainter_transform(TQtDeviceContext(DC).Widget);
if Matrix <> nil then
begin
P^.X := -Trunc(QTransform_Dx(Matrix));
P^.Y := -Trunc(QTransform_Dy(Matrix));
Result := 1;
end;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace: < [WinAPI GetWindowOrgEx] Result=', dbgs(p^));
P^.X := LazDC.WindowOrg.X - LazDC.BaseWindowOrg.X;
P^.Y := LazDC.WindowOrg.Y - LazDC.BaseWindowOrg.Y;
Result := 1; // any non-zero will do according to MSDN
{$ifdef VerboseCDDrawing}
DebugLn(':<[WinAPI GetWindowOrgEx] Result='+dbgs(p^));
{$endif}
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Method: GetWindowRect
Params: Handle - handle of window
Rect - record for window coordinates
@ -4249,7 +4233,7 @@ end;
Retrieves the dimensions of the bounding rectangle of the specified window.
------------------------------------------------------------------------------}
function TQtWidgetSet.GetWindowRect(Handle: HWND; var ARect: TRect): Integer;
function TCDWidgetSet.GetWindowRect(Handle: HWND; var ARect: TRect): Integer;
var
APos: TQtPoint;
R: TRect;
@ -4975,7 +4959,8 @@ begin
Exit(False);
end;
// ToDo: Normalize the rectangle, or improve TLazCanvas so that it accepts invalid coordinates
// ToDo: We can normalize the rectangle, but this is not necessary as
// TLazCanvas ignores invalid coordinates
{ R := NormalizeRect(Rect(X1, Y1, X2, Y2));
if IsRectEmpty(R) then Exit(True);}
@ -4983,23 +4968,23 @@ begin
Result := True;
end;
(*
function TQtWidgetSet.RectVisible(dc : hdc; const ARect: TRect) : Boolean;
function TCDWidgetSet.RectVisible(dc : hdc; const ARect: TRect) : Boolean;
var
QtDC: TQtDeviceContext;
LazDC: TLazCanvas;
begin
{$ifdef VerboseQtWinAPI}
writeln('[WinAPI RectVisible] ');
{$ifdef VerboseCDDrawing}
Debugln('[WinAPI RectVisible]');
{$endif}
Result := False;
Result := True;
if not IsValidDC(DC) then Exit;
QtDC := TQtDeviceContext(DC);
LazDC := TLazCanvas(DC);
// as MSDN says only clipping region can play here
if QtDC.getClipping then
Result := QtDC.getClipRegion.containsRect(ARect);
{ if QtDC.getClipping then
Result := QtDC.getClipRegion.containsRect(ARect);}
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: RedrawWindow
Params: Wnd:
lprcUpdate:
@ -5696,210 +5681,6 @@ begin
Result := Integer(False);
end;
function TQtWidgetSet.SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean;
var
R, RW: TRect;
Ratio: Single;
begin
Result := False;
if IsValidDC(DC) then
begin
QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
if OldSize <> nil then
begin
OldSize^.cx := R.Right - R.Left;
OldSize^.cy := R.Bottom - R.Top;
end;
if (XExtent <> R.Right) or (YExtent <> R.Bottom) then
begin
case TQtDeviceContext(DC).vMapMode of
MM_ANISOTROPIC, MM_ISOTROPIC:
begin
if TQtDeviceContext(DC).vMapMode = MM_ISOTROPIC then
begin
// TK: Is here also an adjustment on Windows if DPIX and DPIY are different?
QPainter_Window(TQtDeviceContext(DC).Widget, @RW);
Ratio := RW.Right / RW.Bottom; // no check, programmer cannot put nonsense
if YExtent * Ratio > XExtent then
YExtent := RoundToInt(XExtent / Ratio)
else if YExtent * Ratio < XExtent then
XExtent := RoundToInt(YExtent * Ratio)
end;
QPainter_setViewPort(TQtDeviceContext(DC).Widget, R.Left, R.Top, XExtent, YExtent);
Result := True;
end;
end;
end;
end;
end;
function TQtWidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean;
var
R: TRect;
begin
Result := False;
if IsValidDC(DC) then
begin
QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
if OldPoint <> nil then
OldPoint^ := R.TopLeft;
if (TQtDeviceContext(DC).vMapMode <> MM_TEXT) and (NewX <> R.Left) or (NewY <> R.Top) then
begin
QPainter_setViewPort(TQtDeviceContext(DC).Widget, NewX, NewY, R.Right - R.Left, R.Bottom - R.Top);
Result := True;
end;
end;
end;
function TQtWidgetSet.SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; OldSize: PSize): Boolean;
var
R: TRect;
begin
Result := False;
if IsValidDC(DC) then
begin
QPainter_Window(TQtDeviceContext(DC).Widget, @R);
if OldSize <> nil then
begin
OldSize^.cx := R.Right - R.Left;
OldSize^.cy := R.Bottom - R.Top;
end;
if (XExtent <> R.Right) or (YExtent <> R.Bottom) then
begin
case TQtDeviceContext(DC).vMapMode of
MM_ANISOTROPIC, MM_ISOTROPIC:
begin
QPainter_setWindow(TQtDeviceContext(DC).Widget, R.Left, R.Top, XExtent, YExtent);
Result := True;
end;
end;
end;
end;
end;
{------------------------------------------------------------------------------
Method: SetWindowOrgEx
Params: DC - handle of device context
NewX - new x-coordinate of window origin
NewY - new y-coordinate of window origin
Point - record receiving original origin
Returns: Whether the call was successful
Sets the window origin of the device context by using the specified coordinates.
------------------------------------------------------------------------------}
function TQtWidgetSet.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean;
var
P: TPoint;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetWindowOrgEx] DC: ', dbghex(DC), ' NewX: ', dbgs(NewX), ' NewY: ', dbgs(NewY));
{$endif}
Result := False;
if IsValidDC(DC) then
begin
GetWindowOrgEx(DC, @P);
// restore 0, 0
if (P.X <> 0) or (P.Y <> 0) then
TQtDeviceContext(DC).translate(P.X, P.Y);
if OldPoint <> nil then
OldPoint^ := P;
TQtDeviceContext(DC).translate(-NewX, -NewY);
Result := True;
end;
end;
{------------------------------------------------------------------------------
Method: SetWindowPos
Params: HWnd - handle of window
HWndInsertAfter - placement-order handle
X - horizontal position
Y - vertical position
CX - width
CY - height
UFlags - window-positioning flags
Returns: If the function succeeds
Changes the size, position, and Z order of a child, pop-up, or top-level
window.
------------------------------------------------------------------------------}
function TQtWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx,
cy: Integer; uFlags: UINT): Boolean;
var
DisableUpdates: boolean;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetWindowPos] Handle: ', dbghex(hWnd),
' hWndInsertAfter: ',dbghex(hWnd));
{$endif}
Result := hWnd <> 0;
if not Result then
exit;
DisableUpdates := (SWP_NOREDRAW and uFlags) <> 0;
if DisableUpdates then
TQtWidget(Hwnd).setUpdatesEnabled(False);
try
if (SWP_NOMOVE and uFlags) = 0 then
TQtWidget(Hwnd).move(X, Y);
if (SWP_NOSIZE and uFlags) = 0 then
TQtWidget(Hwnd).resize(CX, CY);
if (SWP_NOZORDER and uFlags) = 0 then
begin
case hWndInsertAfter of
HWND_TOP:
begin
TQtWidget(hWnd).raiseWidget;
if (SWP_NOACTIVATE and uFlags) = 0 then
TQtWidget(hWnd).Activate;
end;
HWND_BOTTOM: TQtWidget(hWnd).lowerWidget;
{TODO: HWND_TOPMOST ,HWND_NOTOPMOST}
end;
end;
finally
if DisableUpdates then
TQtWidget(Hwnd).setUpdatesEnabled(True);
end;
end;
{------------------------------------------------------------------------------
Method: SetWindowRgn
Params: hWnd - handle of the widget
hRgn - handle of the region
bRedraw - ?
Returns: 0 if the call failed, any other value if it was successful
Makes the region specifyed in hRgn be the only part of the window which is
visible.
------------------------------------------------------------------------------}
function TQtWidgetSet.SetWindowRgn(hWnd: HWND;
hRgn: HRGN; bRedraw: Boolean):longint;
var
w: TQtWidget;
r: TQtRegion;
begin
Result := 0;
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetWindowRgn] Handle: ', dbghex(hWnd));
{$endif}
// Basic checks
if (hWnd = 0) or (hRgn = 0) then Exit;
w := TQtWidget(hWnd);
r := TQtRegion(hRgn);
// Now set the mask in the widget
w.setMask(r.FHandle);
Result := 1;
end;
function TQtWidgetSet.ShowCaret(hWnd: HWND): Boolean;
begin
Result := (hWnd <> 0) and (QtCaret.ShowCaret(TQtWidget(hWnd)));
@ -6110,30 +5891,31 @@ begin
if Assigned(ScrollBar) then
Result := UpdateScrollInfo;
end;
end;*)
{------------------------------------------------------------------------------
Method: SetTextColor
Params: Handle -
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
function TCDWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
var
lFont: TFPCustomFont;
LazDC: TLazCanvas;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetTextColor] DC: ', dbghex(DC));
{$ifdef VerboseCDDrawing}
DebugLn(Format('[TCDWidgetSet.SetTextColor] DC: %x Color: %8x', [DC, Color]));
{$endif}
Result := CLR_INVALID;
if not IsValidDC(DC) then begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetTextColor] Invalid DC');
{$endif}
exit;
end;
Result := TQtDeviceContext(DC).vTextColor;
TQtDeviceContext(DC).vTextColor := ColorToRGB(TColor(Color)); // be sure we get TColorRef
if not IsValidDC(DC) then Exit;
LazDC := TLazCanvas(DC);
if LazDC.Font <> nil then
LazDC.Font.FPColor := TColorToFPColor(Color);
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
function ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean;
Params Handle: HWND; wBar: Integer; bShow: Boolean
Result
@ -6194,6 +5976,207 @@ begin
Result := False;
end;
function TQtWidgetSet.SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean;
var
R, RW: TRect;
Ratio: Single;
begin
Result := False;
if IsValidDC(DC) then
begin
QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
if OldSize <> nil then
begin
OldSize^.cx := R.Right - R.Left;
OldSize^.cy := R.Bottom - R.Top;
end;
if (XExtent <> R.Right) or (YExtent <> R.Bottom) then
begin
case TQtDeviceContext(DC).vMapMode of
MM_ANISOTROPIC, MM_ISOTROPIC:
begin
if TQtDeviceContext(DC).vMapMode = MM_ISOTROPIC then
begin
// TK: Is here also an adjustment on Windows if DPIX and DPIY are different?
QPainter_Window(TQtDeviceContext(DC).Widget, @RW);
Ratio := RW.Right / RW.Bottom; // no check, programmer cannot put nonsense
if YExtent * Ratio > XExtent then
YExtent := RoundToInt(XExtent / Ratio)
else if YExtent * Ratio < XExtent then
XExtent := RoundToInt(YExtent * Ratio)
end;
QPainter_setViewPort(TQtDeviceContext(DC).Widget, R.Left, R.Top, XExtent, YExtent);
Result := True;
end;
end;
end;
end;
end;
function TQtWidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean;
var
R: TRect;
begin
Result := False;
if IsValidDC(DC) then
begin
QPainter_ViewPort(TQtDeviceContext(DC).Widget, @R);
if OldPoint <> nil then
OldPoint^ := R.TopLeft;
if (TQtDeviceContext(DC).vMapMode <> MM_TEXT) and (NewX <> R.Left) or (NewY <> R.Top) then
begin
QPainter_setViewPort(TQtDeviceContext(DC).Widget, NewX, NewY, R.Right - R.Left, R.Bottom - R.Top);
Result := True;
end;
end;
end;
function TQtWidgetSet.SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; OldSize: PSize): Boolean;
var
R: TRect;
begin
Result := False;
if IsValidDC(DC) then
begin
QPainter_Window(TQtDeviceContext(DC).Widget, @R);
if OldSize <> nil then
begin
OldSize^.cx := R.Right - R.Left;
OldSize^.cy := R.Bottom - R.Top;
end;
if (XExtent <> R.Right) or (YExtent <> R.Bottom) then
begin
case TQtDeviceContext(DC).vMapMode of
MM_ANISOTROPIC, MM_ISOTROPIC:
begin
QPainter_setWindow(TQtDeviceContext(DC).Widget, R.Left, R.Top, XExtent, YExtent);
Result := True;
end;
end;
end;
end;
end;*)
{------------------------------------------------------------------------------
Method: SetWindowOrgEx
Params: DC - handle of device context
NewX - new x-coordinate of window origin
NewY - new y-coordinate of window origin
Point - record receiving original origin
Returns: Whether the call was successful
Sets the window origin of the device context by using the specified coordinates.
------------------------------------------------------------------------------}
function TCDWidgetSet.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean;
var
P: TPoint;
LazDC: TLazCanvas absolute DC;
begin
{$ifdef VerboseCDDrawing}
DebugLn(Format('[WinAPI SetWindowOrgEx] DC=%x NewX=%d NewY=%d',
[DC, NewX, NewY]));
{$endif}
Result := False;
if not IsValidDC(DC) then Exit;
GetWindowOrgEx(DC, @P);
if OldPoint <> nil then OldPoint^ := P;
LazDC.WindowOrg := Point(-NewX, -NewY);
Result := True;
end;
(*{------------------------------------------------------------------------------
Method: SetWindowPos
Params: HWnd - handle of window
HWndInsertAfter - placement-order handle
X - horizontal position
Y - vertical position
CX - width
CY - height
UFlags - window-positioning flags
Returns: If the function succeeds
Changes the size, position, and Z order of a child, pop-up, or top-level
window.
------------------------------------------------------------------------------}
function TQtWidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx,
cy: Integer; uFlags: UINT): Boolean;
var
DisableUpdates: boolean;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetWindowPos] Handle: ', dbghex(hWnd),
' hWndInsertAfter: ',dbghex(hWnd));
{$endif}
Result := hWnd <> 0;
if not Result then
exit;
DisableUpdates := (SWP_NOREDRAW and uFlags) <> 0;
if DisableUpdates then
TQtWidget(Hwnd).setUpdatesEnabled(False);
try
if (SWP_NOMOVE and uFlags) = 0 then
TQtWidget(Hwnd).move(X, Y);
if (SWP_NOSIZE and uFlags) = 0 then
TQtWidget(Hwnd).resize(CX, CY);
if (SWP_NOZORDER and uFlags) = 0 then
begin
case hWndInsertAfter of
HWND_TOP:
begin
TQtWidget(hWnd).raiseWidget;
if (SWP_NOACTIVATE and uFlags) = 0 then
TQtWidget(hWnd).Activate;
end;
HWND_BOTTOM: TQtWidget(hWnd).lowerWidget;
{TODO: HWND_TOPMOST ,HWND_NOTOPMOST}
end;
end;
finally
if DisableUpdates then
TQtWidget(Hwnd).setUpdatesEnabled(True);
end;
end;
{------------------------------------------------------------------------------
Method: SetWindowRgn
Params: hWnd - handle of the widget
hRgn - handle of the region
bRedraw - ?
Returns: 0 if the call failed, any other value if it was successful
Makes the region specifyed in hRgn be the only part of the window which is
visible.
------------------------------------------------------------------------------}
function TQtWidgetSet.SetWindowRgn(hWnd: HWND;
hRgn: HRGN; bRedraw: Boolean):longint;
var
w: TQtWidget;
r: TQtRegion;
begin
Result := 0;
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI SetWindowRgn] Handle: ', dbghex(hWnd));
{$endif}
// Basic checks
if (hWnd = 0) or (hRgn = 0) then Exit;
w := TQtWidget(hWnd);
r := TQtRegion(hRgn);
// Now set the mask in the widget
w.setMask(r.FHandle);
Result := 1;
end;
{------------------------------------------------------------------------------
function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;

67
lcl/interfaces/customdrawn/customdrawnwinapi_android.inc
View File

@ -2222,8 +2222,8 @@ begin
lHeight := javaEnvRef^^.GetLongField(javaEnvRef, javaActivityObject, javaField_lclheight);
{$ifdef VerboseCDText}
DebugLn(Format(':[WinAPI ExtTextOut] lWidth=%d lHeight=%d',
[lWidth, lHeight]));
DebugLn(Format(':[WinAPI ExtTextOut] lWidth=%d lHeight=%d DestCanvasSize=%d, %d',
[lWidth, lHeight, lDestCanvas.Width, lDestCanvas.Height]));
{$endif}
// ---------------------------
@ -2239,6 +2239,9 @@ begin
// Execute the copy, pixel by pixel with Alpha blending
// Simple AlphaBlend was showing redish areas in the emulator
// because misteriously it read the target area pixels as red
//
// Don't apply WindowOrg to the dest pos because it is applied
// on each pixel drawing and was set via SetWindowOrg already
lDestCanvas.AlphaBlendIgnoringDestPixels(lCanvas, X, Y, 0, 0, lWidth, lHeight);
// Release the helper objects
@ -2254,16 +2257,8 @@ begin
Result := True;
{ if ((Options and ETO_OPAQUE) <> 0) then
QtDC.fillRect(Rect^.Left, Rect^.Top, Rect^.Right - Rect^.Left, Rect^.Bottom - Rect^.Top);
if Str <> nil then
begin
if Count >= 0 then
WideStr := GetUtf8String(Copy(Str, 1, Count))
else
WideStr := GetUtf8String(Str);
if (Options and ETO_CLIPPED <> 0) then
QtDC.fillRect(Rect^.Left, Rect^.Top, Rect^.Right - Rect^.Left, Rect^.Bottom - Rect^.Top);}
{ if (Options and ETO_CLIPPED <> 0) then
begin
B := QtDC.getClipping;
if not B then
@ -2556,10 +2551,19 @@ end;*)
coordinates are relative to the control's left and top.
------------------------------------------------------------------------------}
function TCDWidgetSet.BackendGetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
var
lForm: TCDForm;
begin
(* if Handle = 0 then
Exit(False);
ARect := TQtWidget(handle).getClientBounds;*)
lForm := TCDForm(handle);
ARect.Left := 0;
ARect.Top := 0;
if lForm.Image = nil then Exit(False);
ARect.Right := lForm.Image.Width;
ARect.Bottom := lForm.Image.Height;
Result := True;
end;
@ -4388,18 +4392,14 @@ end;*)
parent
------------------------------------------------------------------------------}
function TCDWidgetSet.BackendGetWindowRelativePosition(Handle: HWND; var Left, Top: integer): boolean;
var
R: TRect;
begin
{$ifdef VerboseCDWinAPI}
WriteLn('[WinAPI BackendGetWindowRelativePosition]');
DebugLn('[WinAPI BackendGetWindowRelativePosition]');
{$endif}
{ if Handle = 0 then}
Exit(False);
{ R := TQtWidget(Handle).getFrameGeometry;
Left := R.Left;
Top := R.Top;
Result := True;}
Left := 0;
Top := 0;
Result := True;
end;
{------------------------------------------------------------------------------
@ -4410,22 +4410,23 @@ end;
Returns the current widget Width and Height
------------------------------------------------------------------------------}
function TCDWidgetSet.BackendGetWindowSize(Handle: hwnd; var Width, Height: integer): boolean;
var
lForm: TCDForm;
begin
{$ifdef VerboseCDWinAPI}
WriteLn('[WinAPI BackendGetWindowSize]');
DebugLn('[WinAPI BackendGetWindowSize]');
{$endif}
if Handle = 0 then Exit(False);
lForm := TCDForm(handle);
if lForm.Image = nil then Exit(False);
{ with TQtWidget(Handle).getSize do
begin
Height := cy;
Width := cx;
end;}
Width := lForm.Image.Width;
Height := lForm.Image.Height;
Result := True;
end;
(*
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: GradientFill
Params: DC - DeviceContext to perform on
Vertices - array of Points W/Color & Alpha
@ -4736,7 +4737,7 @@ end;*)
function TCDWidgetSet.BackendInvalidateRect(aHandle: HWND; Rect: pRect; bErase: Boolean): Boolean;
begin
{$ifdef VerboseCDWinAPI}
WriteLn('[TCDWidgetSet.InvalidateRect]');
DebugLn('[TCDWidgetSet.InvalidateRect]');
{$endif}
if AHandle = 0 then exit(False);

24
lcl/interfaces/customdrawn/customdrawnwinapih.inc
View File

@ -54,10 +54,10 @@ function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override;
(*function CreateCaret(Handle : HWND; Bitmap : hBitmap; Width, Height : Integer) : Boolean; override;
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;*)
function CreateCompatibleDC(DC: HDC): HDC; override;
(*function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;
//function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
(*function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
function CreatePatternBrush(ABitmap: HBITMAP): HBRUSH; override;*)
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
(*function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
@ -128,17 +128,17 @@ function GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollIn
function GetStockObject(Value: Integer): THandle; override;*)
function GetSysColor(nIndex: Integer): DWORD; override;
(*function GetSysColorBrush(nIndex: Integer): HBrush; override;
function GetSystemMetrics(nIndex: Integer): Integer; override;
function GetTextColor(DC: HDC) : TColorRef; Override;*)
function GetSystemMetrics(nIndex: Integer): Integer; override;*)
function GetTextColor(DC: HDC) : TColorRef; Override;
function GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize): Boolean; override;
function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean; override;
(*function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;
function GetViewPortOrgEx(DC: HDC; P: PPoint): Integer; override;
function GetWindowExtEx(DC: HDC; Size: PSize): Integer; override;
function GetWindowLong(Handle : hwnd; int: Integer): PtrInt; override;
function GetWindowLong(Handle : hwnd; int: Integer): PtrInt; override;*)
function GetWindowOrgEx(dc : hdc; P : PPoint): Integer; override;
function GetWindowRect(Handle: hwnd; var ARect: TRect): Integer; override;*)
//function GetWindowRect(Handle: hwnd; var ARect: TRect): Integer; override;
function GetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean; override;
function BackendGetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean;
function GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean; override;
@ -176,8 +176,8 @@ function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean; override;
function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean; override;
*)
function Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean; override;
(*function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
function RedrawWindow(Wnd: HWND; lprcUpdate: PRECT; hrgnUpdate: HRGN; flags: UINT): Boolean; override;
function RectVisible(dc : hdc; const ARect: TRect) : Boolean; override;
(*function RedrawWindow(Wnd: HWND; lprcUpdate: PRECT; hrgnUpdate: HRGN; flags: UINT): Boolean; override;
function ReleaseCapture : Boolean; override;
function ReleaseDC(hWnd: HWND; DC: HDC): Integer; override;
function RestoreDC(DC: HDC; SavedDC: Integer): Boolean; override;
@ -205,13 +205,13 @@ function SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean; override;
function SetParent(hWndChild: HWND; hWndParent: HWND): HWND; override;*)
function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;
(*function SetROP2(DC: HDC; Mode: Integer): Integer; override;
function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;
function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;*)
function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; override;
function SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean; override;
(*function SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean; override;
function SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean; override;
function SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; OldSize: PSize): Boolean; override;
function SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; OldSize: PSize): Boolean; override;*)
function SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; override;
function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
(*function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
X, Y, cx, cy: Integer; uFlags: UINT): Boolean; override;
function SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: Boolean):longint; override;
function ShowCaret(hWnd: HWND): Boolean; override;

41
lcl/lazcanvas.pas
View File

@ -23,6 +23,12 @@
Abstract:
Classes and functions for extending TFPImageCanvas to support more stretching
filters and to support all features from the LCL TCanvas
TLazCanvas also fixes various small problems and incompatibilities between
TFPImageCanvas versions, making the interface smoother for its users
Dont use anything from the LCL here as this unit should be kept strictly independent
only LCLProc for DebugLn is allowed, but only during debuging
}
unit lazcanvas;
@ -56,6 +62,7 @@ type
public
Brush: TFPCustomBrush;
Pen: TFPCustomPen;
Font: TFPCustomFont;
BaseWindowOrg: TPoint;
WindowOrg: TPoint;
Clipping: Boolean;
@ -68,6 +75,7 @@ type
TLazCanvas = class(TFPImageCanvas)
private
FAssignedBrush: TFPCustomBrush;
FAssignedFont: TFPCustomFont;
FAssignedPen: TFPCustomPen;
FBaseWindowOrg: TPoint;
{$if defined(ver2_4) or defined(ver2_5) or defined(ver2_6)}
@ -77,6 +85,7 @@ type
GraphicStateStack: TObjectStack; // TLazCanvasState
function GetAssignedBrush: TFPCustomBrush;
function GetAssignedPen: TFPCustomPen;
function GetAssignedFont: TFPCustomFont;
function GetWindowOrg: TPoint;
procedure SetWindowOrg(AValue: TPoint);
protected
@ -114,11 +123,13 @@ type
// This needed to be added because Pen/Brush.Assign raises exceptions
procedure AssignPenData(APen: TFPCustomPen);
procedure AssignBrushData(ABrush: TFPCustomBrush);
procedure AssignFontData(AFont: TFPCustomFont);
// These properties are utilized to implement LCLIntf.SelectObject
// to keep track of which brush handle was assigned to this canvas
// They are not utilized by TLazCanvas itself
property AssignedPen: TFPCustomPen read GetAssignedPen write FAssignedPen;
property AssignedBrush: TFPCustomBrush read GetAssignedBrush write FAssignedBrush;
property AssignedFont: TFPCustomFont read GetAssignedFont write FAssignedFont;
//
// SetWindowOrg operations will be relative to BaseWindowOrg,
// This is very useful for implementing the non-native wincontrol,
@ -160,6 +171,14 @@ begin
Result := FAssignedPen;
end;
function TLazCanvas.GetAssignedFont: TFPCustomFont;
begin
if FAssignedFont = nil then
Result := TFPEmptyFont.Create
else
Result := FAssignedFont;
end;
function TLazCanvas.GetWindowOrg: TPoint;
begin
Result := Point(FWindowOrg.X-FBaseWindowOrg.X, FWindowOrg.Y-FBaseWindowOrg.Y)
@ -251,8 +270,8 @@ var b : TRect;
begin
b := Bounds;
SortRect (b);
if clipping then
CheckRectClipping (ClipRect, B);
// if clipping then
// CheckRectClipping (ClipRect, B);
with b do
case Brush.style of
bsSolid : FillRectangleColor (self, left,top, right,bottom);
@ -397,6 +416,7 @@ begin
lState.Brush := Brush.CopyBrush;
lState.Pen := Pen.CopyPen;
lState.Font := Font.CopyFont;
lState.BaseWindowOrg := BaseWindowOrg;
lState.WindowOrg := WindowOrg;
lState.Clipping := Clipping;
@ -413,6 +433,7 @@ begin
AssignPenData(lState.Pen);
AssignBrushData(lState.Brush);
AssignFontData(lState.Font);
BaseWindowOrg := lState.BaseWindowOrg;
WindowOrg := lState.WindowOrg;
Clipping := lState.Clipping;
@ -511,8 +532,8 @@ begin
lDrawHeight := Min(Self.Height - ADestY, ASource.Height - ASourceY);
lDrawWidth := Min(lDrawWidth, ASourceWidth);
lDrawHeight := Min(lDrawHeight, ASourceHeight);
//DebugLn(Format('[TLazCanvas.AlphaBlend] lDrawWidth=%d lDrawHeight=%d',
// [lDrawWidth, lDrawHeight]));
//DebugLn(Format('[TLazCanvas.AlphaBlendIgnoringDestPixels] lDrawWidth=%d lDrawHeight=%d',
//[lDrawWidth, lDrawHeight]));
for y := 0 to lDrawHeight - 1 do
begin
for x := 0 to lDrawWidth - 1 do
@ -614,6 +635,18 @@ begin
Brush.Style := ABrush.Style;
end;
procedure TLazCanvas.AssignFontData(AFont: TFPCustomFont);
begin
if AFont = nil then Exit;
Font.FPColor := AFont.FPColor;
Font.Name := AFont.Name;
Font.Size := AFont.Size;
Font.Bold := AFont.Bold;
Font.Italic := AFont.Italic;
Font.Underline := AFont.Underline;
Font.StrikeTrough := AFont.StrikeTrough;
end;
{ TFPWindowsSharpInterpolation }
procedure TFPSharpInterpolation.Execute(x, y, w, h: integer);