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

graphtype: Adds a debug routine; customdrawnws: Starts implementing StretchDraw and TBitmap support, not yet working

Browse Source 
git-svn-id: trunk@33968 -
This commit is contained in:
sekelsenmat 2011-12-05 10:30:39 +00:00
parent bacb77214e
commit eb931b330d
4 changed files with 117 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/graphtype.pp
View File

@ -285,6 +285,7 @@ function CopyImageData(AWidth, AHeight, ARowStride: Integer; ABPP: Word;
ASource: Pointer; const ARect: TRect; ASourceOrder: TRawImageLineOrder; ASource: Pointer; const ARect: TRect; ASourceOrder: TRawImageLineOrder;
ADestinationOrder: TRawImageLineOrder; ADestinationEnd: TRawImageLineEnd; ADestinationOrder: TRawImageLineOrder; ADestinationEnd: TRawImageLineEnd;
out ADestination: Pointer; out ASize: PtrUInt): Boolean; out ADestination: Pointer; out ASize: PtrUInt): Boolean;
function RawImageQueryFlagsToString(AFlags: TRawImageQueryFlags): string;
var var
MissingBits: array[0..15] of array[0..7] of word; MissingBits: array[0..15] of array[0..7] of word;
@ -294,7 +295,6 @@ implementation
uses uses
Math; Math;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: CopyImageData Function: CopyImageData
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -455,6 +455,18 @@ begin
Result := True; Result := True;
end; end;
function RawImageQueryFlagsToString(AFlags: TRawImageQueryFlags): string;
begin
Result := '';
if riqfMono in AFlags then Result := Result + 'riqfMono ';
if riqfGrey in AFlags then Result := Result + 'riqfGrey ';
if riqfRGB in AFlags then Result := Result + 'riqfRGB ';
if riqfAlpha in AFlags then Result := Result + 'riqfAlpha ';
if riqfMask in AFlags then Result := Result + 'riqfMask ';
if riqfPalette in AFlags then Result := Result + 'riqfPalette ';
if riqfUpdate in AFlags then Result := Result + 'riqfUpdate ';
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: GetBytesPerLine Function: GetBytesPerLine
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -1042,7 +1054,6 @@ begin
Result := True; Result := True;
end; end;
{ TRawImage } { TRawImage }
function TRawImage.IsMasked(ATestPixels: Boolean): Boolean; function TRawImage.IsMasked(ATestPixels: Boolean): Boolean;

35
lcl/interfaces/customdrawn/customdrawnlclintf.inc
View File

@ -1,4 +1,4 @@
{%MainUnit customdrawnint.pp} {%MainUnit customdrawnint.pas}
{****************************************************************************** {******************************************************************************
All CustomDrawn interface support routines All CustomDrawn interface support routines
Initial Revision : Sat Jan 17 19:00:00 2004 Initial Revision : Sat Jan 17 19:00:00 2004
@ -422,10 +422,15 @@ var
lRawImage: TRawImage; lRawImage: TRawImage;
lBitmap: TCDBitmap; lBitmap: TCDBitmap;
begin begin
{$ifdef VerboseCDBitmap}
DebugLn(Format(':>[TCDWidgetSet.RawImage_CreateBitmaps] ARawImage.Description=%s', [ARawImage.Description.AsString]));
{$endif}
Result := False; Result := False;
ABitmap := 0; ABitmap := 0;
AMask := 0; AMask := 0;
// Copy the data
if ARawImage.DataSize > 0 then if ARawImage.DataSize > 0 then
begin begin
NewData := GetMem(ARawImage.DataSize); NewData := GetMem(ARawImage.DataSize);
@ -437,14 +442,15 @@ begin
// this is only a rough implementation, there is no check against bitsperpixel // this is only a rough implementation, there is no check against bitsperpixel
lBitmap := TCDBitmap.Create; lBitmap := TCDBitmap.Create;
ABitmap := HBITMAP(lBitmap); ABitmap := HBITMAP(lBitmap);
lRawImage := ARawImage; System.Move(ARawImage, lRawImage, SizeOf(TRawImage));
lRawImage.Data := NewData; lRawImage.Data := NewData;
lBitmap.Image := TLazIntfImage.Create(lRawImage, True); lBitmap.Image := TLazIntfImage.Create(lRawImage, True);
Result := ABitmap <> 0; Result := ABitmap <> 0;
if ASkipMask then Exit; // Currently we dont support the Mask
if not ASkipMask then
AMask := 0; begin
AMask := 0;
{ if (ARawImage.Mask <> nil) and (ARawImage.MaskSize > 0) then { if (ARawImage.Mask <> nil) and (ARawImage.MaskSize > 0) then
begin begin
@ -455,6 +461,11 @@ begin
NewData := nil; NewData := nil;
AMask := HBitmap(TQtImage.Create(NewData, Desc.Width, Desc.Height, QImageFormat_Mono, True));} AMask := HBitmap(TQtImage.Create(NewData, Desc.Width, Desc.Height, QImageFormat_Mono, True));}
end;
{$ifdef VerboseCDBitmap}
DebugLn(Format(':<[TCDWidgetSet.RawImage_CreateBitmaps] out ABitmap=%x AMask=%x', [ABitmap, AMask]));
{$endif}
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -470,6 +481,10 @@ var
CDBitmap: TCDBitmap; CDBitmap: TCDBitmap;
lRawImage: TRawImage; lRawImage: TRawImage;
begin begin
{$ifdef VerboseCDBitmap}
DebugLn(Format('[TCDWidgetSet.RawImage_DescriptionFromBitmap] ABitmap=%x', [ABitmap]));
{$endif}
Result := IsValidBitmap(ABitmap); Result := IsValidBitmap(ABitmap);
if not Result then if not Result then
begin begin
@ -512,6 +527,10 @@ function TCDWidgetSet.RawImage_FromBitmap(out ARawImage: TRawImage; ABitmap, AMa
var var
CDBitmap: TCDBitmap; CDBitmap: TCDBitmap;
begin begin
{$ifdef VerboseCDBitmap}
DebugLn(Format('[TCDWidgetSet.RawImage_FromBitmap] ABitmap=%x', [ABitmap]));
{$endif}
Result := IsValidBitmap(ABitmap); Result := IsValidBitmap(ABitmap);
if not Result then if not Result then
begin begin
@ -719,10 +738,14 @@ end;*)
Params: AFlags: Params: AFlags:
ADesc: ADesc:
Returns: Returns:
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TCDWidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean; function TCDWidgetSet.RawImage_QueryDescription(AFlags: TRawImageQueryFlags; var ADesc: TRawImageDescription): Boolean;
begin begin
{$ifdef VerboseCDBitmap}
DebugLn(Format('[TCDWidgetSet.RawImage_QueryDescription] AFlags=%s', [RawImageQueryFlagsToString(AFlags)]));
{$endif}
// The default implementation is good enough, don't change this without a very good reason
Result := inherited RawImage_QueryDescription(AFlags, ADesc); Result := inherited RawImage_QueryDescription(AFlags, ADesc);
end; end;

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

@ -69,7 +69,7 @@ end;*)
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TCDWidgetSet.BeginPaint(Handle: hWnd; Var PS : TPaintStruct): hdc; function TCDWidgetSet.BeginPaint(Handle: hWnd; Var PS : TPaintStruct): hdc;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn('Trace:> [WinAPI BeginPaint] Handle=', dbghex(Handle)); DebugLn('Trace:> [WinAPI BeginPaint] Handle=', dbghex(Handle));
{$endif} {$endif}
Result := 0; Result := 0;
@ -109,22 +109,22 @@ begin
WriteLn('Trace:< [WinAPI BeginPaint] Result=', dbghex(Result)); WriteLn('Trace:< [WinAPI BeginPaint] Result=', dbghex(Result));
{$endif}*) {$endif}*)
end; end;
(*
function TQtWidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; function TCDWidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseCDDrawing}
WriteLn('Trace:> [TQtWidgetSet.BitBlt]'); WriteLn('Trace:> [TCDWidgetSet.BitBlt]');
{$endif} {$endif}
Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width,
Height, ROP); Height, ROP);
{$ifdef VerboseQtWinAPI} {$ifdef VerboseCDDrawing}
WriteLn('Trace:< [TQtWidgetSet.BitBlt]'); WriteLn('Trace:< [TCDWidgetSet.BitBlt]');
{$endif} {$endif}
end; end;
function TQtWidgetSet.CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; (*function TQtWidgetSet.CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer;
begin begin
{$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION} {$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
WriteLn('***** [WinAPI TQtWidgetSet.CallNextHookEx] missing implementation '); WriteLn('***** [WinAPI TQtWidgetSet.CallNextHookEx] missing implementation ');
@ -394,7 +394,7 @@ function TCDWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
var var
lBrush: TFPCustomBrush; lBrush: TFPCustomBrush;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[TCDWidgetSet.CreateBrushIndirect] Style: %d, Color: %8x', DebugLn(Format(':>[TCDWidgetSet.CreateBrushIndirect] Style: %d, Color: %8x',
[LogBrush.lbStyle, LogBrush.lbColor])); [LogBrush.lbStyle, LogBrush.lbColor]));
{$endif} {$endif}
@ -468,7 +468,7 @@ begin
DebugLn('TQtWidgetSet.CreateBrushIndirect: Failed'); DebugLn('TQtWidgetSet.CreateBrushIndirect: Failed');
end;*) end;*)
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[WinAPI CreateBrushIndirect] Result: ', dbghex(Result)); DebugLn(':<[WinAPI CreateBrushIndirect] Result: ', dbghex(Result));
{$endif} {$endif}
end; end;
@ -485,16 +485,19 @@ end;*)
Returns: handle to a memory device context Returns: handle to a memory device context
Creates a memory device context (DC) compatible with the specified device. Creates a memory device context (DC) compatible with the specified device.
This is utilized for example for creating a Canvas for a Bitmap, by later using
SelectObject to select the bitmap
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TCDWidgetSet.CreateCompatibleDC(DC: HDC): HDC; function TCDWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
WriteLn('[WinAPI CreateCompatibleDC] DC: ', dbghex(DC)); DebugLn('[WinAPI CreateCompatibleDC] DC: ', dbghex(DC));
{$endif} {$endif}
Result := 0;//HDC(TQtDeviceContext.Create(nil, True)); Result := HDC(TLazCanvas.Create(nil));
end; end;
(*
{------------------------------------------------------------------------------ (*{------------------------------------------------------------------------------
Function: CreateEllipticRgn Function: CreateEllipticRgn
Params: p1 - X position of the top-left corner Params: p1 - X position of the top-left corner
p2 - Y position of the top-left corner p2 - Y position of the top-left corner
@ -666,7 +669,7 @@ function TCDWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
var var
lPen: TFPCustomPen; lPen: TFPCustomPen;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[TCDWidgetSet.CreatePenIndirect] Style: %d, Color: %8x', DebugLn(Format(':>[TCDWidgetSet.CreatePenIndirect] Style: %d, Color: %8x',
[LogPen.lopnStyle, LogPen.lopnColor])); [LogPen.lopnStyle, LogPen.lopnColor]));
{$endif} {$endif}
@ -791,11 +794,11 @@ var
aObject: TObject; aObject: TObject;
// APaintEngine: QPaintEngineH; // APaintEngine: QPaintEngineH;
// APainter: QPainterH; // APainter: QPainterH;
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
ObjType: string; ObjType: string;
{$endif} {$endif}
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn('Trace:> [WinAPI DeleteObject] GDIObject: ', dbghex(GDIObject)); DebugLn('Trace:> [WinAPI DeleteObject] GDIObject: ', dbghex(GDIObject));
ObjType := 'Unidentifyed'; ObjType := 'Unidentifyed';
{$endif} {$endif}
@ -816,7 +819,7 @@ begin
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
if aObject is TFPCustomFont then if aObject is TFPCustomFont then
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
ObjType := 'Font'; ObjType := 'Font';
{$endif} {$endif}
end end
@ -825,7 +828,7 @@ begin
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
else if aObject is TFPCustomBrush then else if aObject is TFPCustomBrush then
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
ObjType := 'Brush'; ObjType := 'Brush';
{$endif} {$endif}
end end
@ -863,7 +866,7 @@ begin
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
else if aObject is TFPCustomPen then else if aObject is TFPCustomPen then
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseCDDrawing}
ObjType := 'Pen'; ObjType := 'Pen';
{$endif} {$endif}
end; end;
@ -1487,13 +1490,13 @@ var
LazDC: TLazCanvas absolute DC; LazDC: TLazCanvas absolute DC;
R: TRect; R: TRect;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[WinAPI Ellipse] DC=%s', [dbghex(DC)])); DebugLn(Format(':>[WinAPI Ellipse] DC=%s', [dbghex(DC)]));
{$endif} {$endif}
if not IsValidDC(DC) then if not IsValidDC(DC) then
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[WinAPI Rectangle] Invalid DC!'); DebugLn(':<[WinAPI Rectangle] Invalid DC!');
{$endif} {$endif}
Exit(False); Exit(False);
@ -2239,7 +2242,7 @@ var
begin begin
Result := False; Result := False;
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn('[WinAPI FillRect Rect=', dbgs(Rect),' Brush=', dbghex(Brush)); DebugLn('[WinAPI FillRect Rect=', dbgs(Rect),' Brush=', dbghex(Brush));
{$endif} {$endif}
@ -2745,7 +2748,7 @@ var
lWinControl: TWinControl; lWinControl: TWinControl;
lFormHandle: TCDForm; lFormHandle: TCDForm;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':>[WinAPI GetDC] hWnd: ', dbghex(hWnd)); DebugLn(':>[WinAPI GetDC] hWnd: ', dbghex(hWnd));
{$endif} {$endif}
@ -2781,7 +2784,7 @@ begin
// to receive something which can be drawn to anyway // to receive something which can be drawn to anyway
if Result = 0 then Result := HDC(CDWidgetset.ScreenDC); if Result = 0 then Result := HDC(CDWidgetset.ScreenDC);
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[WinAPI GetDC] Result: ', dbghex(Result)); DebugLn(':<[WinAPI GetDC] Result: ', dbghex(Result));
{$endif} {$endif}
end; end;
@ -4655,7 +4658,7 @@ var
lControlHandle: TCDWinControl; lControlHandle: TCDWinControl;
lControl: TWinControl; lControl: TWinControl;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
WriteLn('[WinAPI InvalidateRect]'); WriteLn('[WinAPI InvalidateRect]');
{$endif} {$endif}
if AHandle = 0 then exit(False); if AHandle = 0 then exit(False);
@ -4728,7 +4731,7 @@ var
PenPos, LastPos: TPoint; PenPos, LastPos: TPoint;
LazDC: TLazCanvas absolute DC; LazDC: TLazCanvas absolute DC;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format('[TCDWidgetSet.LineTo] DC=%x X=%d Y=%d', [DC, X, Y])); DebugLn(Format('[TCDWidgetSet.LineTo] DC=%x X=%d Y=%d', [DC, X, Y]));
{$endif} {$endif}
@ -4804,7 +4807,7 @@ function TCDWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolea
var var
LazDC: TLazCanvas absolute DC; LazDC: TLazCanvas absolute DC;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn('[WinAPI MoveToEx]', DebugLn('[WinAPI MoveToEx]',
' DC:', dbghex(DC), ' DC:', dbghex(DC),
' X:', dbgs(X), ' X:', dbgs(X),
@ -4863,7 +4866,7 @@ end;*)
function TCDWidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; function TCDWidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer;
Filled, Continuous: Boolean): Boolean; Filled, Continuous: Boolean): Boolean;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
WriteLn('[WinAPI PolyBezier] DC: ', dbghex(DC)); WriteLn('[WinAPI PolyBezier] DC: ', dbghex(DC));
{$endif} {$endif}
Result := inherited PolyBezier(DC, Points, NumPts, Filled, Continuous); Result := inherited PolyBezier(DC, Points, NumPts, Filled, Continuous);
@ -4881,7 +4884,7 @@ var
lPoints: array of TPoint; lPoints: array of TPoint;
i: Integer; i: Integer;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[WinAPI Polygon] DC=%s', [dbghex(DC)])); DebugLn(Format(':>[WinAPI Polygon] DC=%s', [dbghex(DC)]));
{$endif} {$endif}
@ -4890,7 +4893,7 @@ begin
SetLength(lPoints, NumPts); SetLength(lPoints, NumPts);
for i := 0 to NumPts-1 do for i := 0 to NumPts-1 do
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
LCLProc.DbgOut(Format(' P=%d,%d', [Points[i].X, Points[i].Y])); LCLProc.DbgOut(Format(' P=%d,%d', [Points[i].X, Points[i].Y]));
{$endif} {$endif}
lPoints[i] := Points[i]; lPoints[i] := Points[i];
@ -4899,7 +4902,7 @@ begin
LazDC.Polygon(lPoints); LazDC.Polygon(lPoints);
Result := True; Result := True;
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(''); DebugLn('');
{$endif} {$endif}
end; end;
@ -4915,7 +4918,7 @@ var
lPoints: array of TPoint; lPoints: array of TPoint;
i: Integer; i: Integer;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[WinAPI Polygon] DC=%s', [dbghex(DC)])); DebugLn(Format(':>[WinAPI Polygon] DC=%s', [dbghex(DC)]));
{$endif} {$endif}
@ -4965,13 +4968,13 @@ function TCDWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var var
LazDC: TLazCanvas absolute DC; LazDC: TLazCanvas absolute DC;
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[WinAPI Rectangle] DC=%s', [dbghex(DC)])); DebugLn(Format(':>[WinAPI Rectangle] DC=%s', [dbghex(DC)]));
{$endif} {$endif}
if not IsValidDC(DC) then if not IsValidDC(DC) then
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[WinAPI Rectangle] Invalid DC!'); DebugLn(':<[WinAPI Rectangle] Invalid DC!');
{$endif} {$endif}
Exit(False); Exit(False);
@ -5310,11 +5313,11 @@ var
lPen: TFPCustomPen absolute AObject; lPen: TFPCustomPen absolute AObject;
lBrush: TFPCustomBrush absolute AObject; lBrush: TFPCustomBrush absolute AObject;
lOrigBrush: TFPCustomBrush; lOrigBrush: TFPCustomBrush;
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
ObjType: string; ObjType: string;
{$endif} {$endif}
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(Format(':>[TCDWidgetSet.SelectObject] DC=%s GDIObj=%s', DebugLn(Format(':>[TCDWidgetSet.SelectObject] DC=%s GDIObj=%s',
[dbghex(DC), dbghex(GDIObj)])); [dbghex(DC), dbghex(GDIObj)]));
{$endif} {$endif}
@ -5323,7 +5326,7 @@ begin
if not IsValidDC(DC) then if not IsValidDC(DC) then
begin begin
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[TCDWidgetSet.SelectObject] Invalid DC'); DebugLn(':<[TCDWidgetSet.SelectObject] Invalid DC');
{$endif} {$endif}
@ -5332,7 +5335,7 @@ begin
if not IsValidGDIObject(GDIObj) then if not IsValidGDIObject(GDIObj) then
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[TCDWidgetSet.SelectObject] Invalid GDI Object'); DebugLn(':<[TCDWidgetSet.SelectObject] Invalid GDI Object');
{$endif} {$endif}
@ -5353,7 +5356,7 @@ begin
end end
else*) if aObject is TFPCustomPen then else*) if aObject is TFPCustomPen then
begin begin
{$ifdef VerboseCDWinAPI}ObjType := 'Pen';{$endif} {$ifdef VerboseCDDrawing}ObjType := 'Pen';{$endif}
Result := HGDIOBJ(TLazCanvas(DC).AssignedPen); Result := HGDIOBJ(TLazCanvas(DC).AssignedPen);
TLazCanvas(DC).AssignPenData(lPen); // := doesn't work and Assign() raises exceptions TLazCanvas(DC).AssignPenData(lPen); // := doesn't work and Assign() raises exceptions
@ -5361,30 +5364,27 @@ begin
end end
else if aObject is TFPCustomBrush then else if aObject is TFPCustomBrush then
begin begin
{$ifdef VerboseCDWinAPI}ObjType := 'Brush';{$endif} {$ifdef VerboseCDDrawing}ObjType := 'Brush';{$endif}
Result := HGDIOBJ(TLazCanvas(DC).AssignedBrush); Result := HGDIOBJ(TLazCanvas(DC).AssignedBrush);
TLazCanvas(DC).AssignBrushData(lBrush); // := doesn't work and Assign() raises exceptions TLazCanvas(DC).AssignBrushData(lBrush); // := doesn't work and Assign() raises exceptions
TLazCanvas(DC).AssignedBrush := lBrush; TLazCanvas(DC).AssignedBrush := lBrush;
end(* end
else if aObject is TQtImage then else if aObject is TCDBitmap then
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseCDDrawing}ObjType := 'Bitmap';{$endif}
ObjType := 'Image';
{$endif}
Result := HGDIOBJ(TQtDeviceContext(DC).vImage); Result := HGDIOBJ(TLazCanvas(DC).Image);
// TODO: is this also saved in qpainter_save? TLazCanvas(DC).Image := TCDBitmap(aObject).Image;
TQtDeviceContext(DC).setImage(TQtImage(aObject)); end; (*else
end else
if AObject is TQtRegion then if AObject is TQtRegion then
begin begin
Result := HGDIOBJ(TQtDeviceContext(DC).getClipRegion); Result := HGDIOBJ(TQtDeviceContext(DC).getClipRegion);
SelectClipRGN(DC, HRGN(GDIObj)); SelectClipRGN(DC, HRGN(GDIObj));
end*); end*);
{$ifdef VerboseCDWinAPI} {$ifdef VerboseCDDrawing}
DebugLn(':<[TCDWidgetSet.SelectObject] Result=', dbghex(Result), ' ObjectType=', ObjType); DebugLn(':<[TCDWidgetSet.SelectObject] Result=', dbghex(Result), ' ObjectType=', ObjType);
{$endif} {$endif}
end; end;
@ -6230,7 +6230,7 @@ begin
end; end;
Result := True; Result := True;
end; end;
end; end;*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: StretchBlt Function: StretchBlt
@ -6250,7 +6250,7 @@ end;
destination device context. destination device context.
If SrcDC contains a mask the pixmap will be copied with this transparency. If SrcDC contains a mask the pixmap will be copied with this transparency.
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TQtWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; function TCDWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean;
begin begin
Result := StretchMaskBlt(DestDC,X,Y,Width,Height, Result := StretchMaskBlt(DestDC,X,Y,Width,Height,
@ -6278,32 +6278,30 @@ end;
Sizing is done according to the stretching mode currently set in the Sizing is done according to the stretching mode currently set in the
destination device context. destination device context.
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TQtWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; function TCDWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
XMask, YMask: Integer; Rop: DWORD): Boolean; XMask, YMask: Integer; Rop: DWORD): Boolean;
var var
SrcQDC: TQtDeviceContext absolute SrcDC; SrcLazDC: TLazCanvas absolute SrcDC;
DstQDC: TQtDeviceContext absolute DestDC; DstLazDC: TLazCanvas absolute DestDC;
SrcRect, DstRect, MaskRect: TRect; SrcRect, DstRect, MaskRect: TRect;
Image, TmpImage, QMask, TmpMask: QImageH;
TmpPixmap: QPixmapH;
SrcMatrix: QTransformH;
dx, dy: integer;
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseCDDrawing}
WriteLn('[WinAPI StretchMaskBlt]', DebugLn('[WinAPI StretchMaskBlt]' +
' DestDC:', dbghex(DestDC), ' DestDC:' + dbghex(DestDC) +
' SrcDC:', dbghex(SrcDC), ' SrcDC:' + dbghex(SrcDC) +
' Image:', dbghex(PtrInt(Image)), // ' Image:', dbghex(PtrInt(Image)),
' X:', dbgs(X), ' Y:', dbgs(Y), ' X:' + dbgs(X) + ' Y:' + dbgs(Y) +
' W:', dbgs(Width), ' H:', dbgs(Height), ' W:' + dbgs(Width) + ' H:', dbgs(Height) +
' XSrc:', dbgs(XSrc), ' YSrc:', dbgs(YSrc), ' XSrc:' + dbgs(XSrc) + ' YSrc:' + dbgs(YSrc) +
' WSrc:', dbgs(SrcWidth), ' HSrc:', dbgs(SrcHeight)); ' WSrc:' + dbgs(SrcWidth) + ' HSrc:' + dbgs(SrcHeight));
{$endif} {$endif}
Result := False; Result := False;
SrcMatrix := QPainter_transform(SrcQDC.Widget); DstLazDC.AlphaBlend(SrcLazDC, X, Y, XSrc, YSrc, SrcWidth, SrcHeight);
(* SrcMatrix := QPainter_transform(SrcQDC.Widget);
if SrcQDC.vImage = nil then if SrcQDC.vImage = nil then
begin begin
if SrcQDC.Parent <> nil then if SrcQDC.Parent <> nil then
@ -6388,12 +6386,12 @@ begin
DstQDC.drawImage(@DstRect, Image, @SrcRect, QMask, @MaskRect); DstQDC.drawImage(@DstRect, Image, @SrcRect, QMask, @MaskRect);
if SrcQDC.vImage = nil then if SrcQDC.vImage = nil then
QImage_destroy(Image); QImage_destroy(Image); *)
Result := True; Result := True;
end; end;
{------------------------------------------------------------------------------ (*{------------------------------------------------------------------------------
Function: SystemParametersInfo Function: SystemParametersInfo
Params: uiAction: System-wide parameter to be retrieved or set Params: uiAction: System-wide parameter to be retrieved or set
uiParam: Depends on the system parameter being queried or set uiParam: Depends on the system parameter being queried or set

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

@ -31,9 +31,9 @@ function Arc(DC: HDC; Left,Top,Right,Bottom,angle1,angle2 : Integer): Boolean; o
(*function AngleChord(DC: HDC; x1, y1, x2, y2, angle1, angle2: Integer): Boolean; override;*) (*function AngleChord(DC: HDC; x1, y1, x2, y2, angle1, angle2: Integer): Boolean; override;*)
function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override; function BeginPaint(Handle: hWnd; Var PS : TPaintStruct) : hdc; override;
(*function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; override; function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean; override;
function CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; override; (*function CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; override;
function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override; function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;
function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override; function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override;
@ -214,13 +214,13 @@ function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
function SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: Boolean):longint; override; function SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: Boolean):longint; override;
function ShowCaret(hWnd: HWND): Boolean; override; function ShowCaret(hWnd: HWND): Boolean; override;
function ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean; override; function ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean; override;
function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override; function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;*)
function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer; function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; function StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
XMask, YMask: Integer; Rop: DWORD): Boolean; override; XMask, YMask: Integer; Rop: DWORD): Boolean; override;
function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;*) (*function SystemParametersInfo(uiAction: DWord; uiParam: DWord; pvParam: Pointer; fWinIni: DWord): LongBool; override;*)
function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override; function TextOut(DC: HDC; X,Y : Integer; Str : Pchar; Count: Integer) : Boolean; override;
(*function UpdateWindow(Handle: HWND): Boolean; override; (*function UpdateWindow(Handle: HWND): Boolean; override;