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

customdrawnws: Implements more skeletons for winapi canvas routines and fixes the color channels in Cocoa

Browse Source 
git-svn-id: trunk@33717 -
This commit is contained in:
sekelsenmat 2011-11-23 08:27:08 +00:00
parent 6293824469
commit 0748370917
4 changed files with 55 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/interfaces/customdrawn/cocoaprivate.pas
View File

@ -673,6 +673,8 @@ var
lWidth, lHeight: Integer; lWidth, lHeight: Integer;
lBitmap, lMask: HBITMAP; lBitmap, lMask: HBITMAP;
lRawImage: TRawImage; lRawImage: TRawImage;
AImage: TLazIntfImage;
ACanvas: TLazCanvas;
begin begin
if not Assigned(Context) then Context:=TCocoaContext.Create; if not Assigned(Context) then Context:=TCocoaContext.Create;
@ -685,7 +687,7 @@ begin
FillChar(struct, SizeOf(TPaintStruct), 0); FillChar(struct, SizeOf(TPaintStruct), 0);
UpdateControlLazImageAndCanvas(TCocoaCustomControl(Owner).Image, UpdateControlLazImageAndCanvas(TCocoaCustomControl(Owner).Image,
TCocoaCustomControl(Owner).Canvas, lWidth, lHeight); TCocoaCustomControl(Owner).Canvas, lWidth, lHeight, clfRGB24);
struct.hdc := HDC(TCocoaCustomControl(Owner).Canvas); struct.hdc := HDC(TCocoaCustomControl(Owner).Canvas);

14
lcl/interfaces/customdrawn/customdrawnproc.pas
View File

@ -13,7 +13,11 @@ uses
// //
GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc; GraphType, Controls, LCLMessageGlue, WSControls, LCLType, LCLProc;
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage; var ACanvas: TLazCanvas; AWidth, AHeight: Integer); type
TUpdateLazImageFormat = (clfRGB24, clfBGR24, clfBGRA32);
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; AWidth, AHeight: Integer; AFormat: TUpdateLazImageFormat);
function DateTimeToMilliseconds(aDateTime: TDateTime): Int64; function DateTimeToMilliseconds(aDateTime: TDateTime): Int64;
function IsValidDC(ADC: HDC): Boolean; function IsValidDC(ADC: HDC): Boolean;
function IsValidGDIObject(AGDIObj: HGDIOBJ): Boolean; function IsValidGDIObject(AGDIObj: HGDIOBJ): Boolean;
@ -21,7 +25,7 @@ function IsValidGDIObject(AGDIObj: HGDIOBJ): Boolean;
implementation implementation
procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage; procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; AWidth, AHeight: Integer); var ACanvas: TLazCanvas; AWidth, AHeight: Integer; AFormat: TUpdateLazImageFormat);
var var
lRawImage: TRawImage; lRawImage: TRawImage;
begin begin
@ -35,7 +39,11 @@ begin
if (AImage <> nil) then AImage.Free; if (AImage <> nil) then AImage.Free;
lRawImage.Init; lRawImage.Init;
lRawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight); case AFormat of
clfRGB24: lRawImage.Description.Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight);
clfBGR24: lRawImage.Description.Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight);
clfBGRA32: lRawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight);
end;
lRawImage.CreateData(True); lRawImage.CreateData(True);
AImage := TLazIntfImage.Create(AWidth, AHeight); AImage := TLazIntfImage.Create(AWidth, AHeight);

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

@ -784,7 +784,7 @@ begin
if not IsValidDC(hDC) then exit; if not IsValidDC(hDC) then exit;
TQtDeviceContext(hDC).Free; TQtDeviceContext(hDC).Free;
end; end;*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: DeleteObject Function: DeleteObject
@ -792,31 +792,29 @@ end;
Returns: Nothing Returns: Nothing
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TQtWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean; function TCDWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
var var
aObject: TObject; aObject: TObject;
APaintEngine: QPaintEngineH; // APaintEngine: QPaintEngineH;
APainter: QPainterH; // APainter: QPainterH;
{$ifdef VerboseQtWinAPI} {$ifdef VerboseWinAPI}
ObjType: string; ObjType: string;
{$endif} {$endif}
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseWinAPI}
WriteLn('Trace:> [WinAPI DeleteObject] GDIObject: ', dbghex(GDIObject)); DebugLn('Trace:> [WinAPI DeleteObject] GDIObject: ', dbghex(GDIObject));
ObjType := 'Unidentifyed'; ObjType := 'Unidentifyed';
{$endif} {$endif}
Result := False; Result := False;
if GDIObject = 0 then if GDIObject = 0 then Exit(True);
Exit(True);
if not IsValidGDIObject(GDIObject) then if not IsValidGDIObject(GDIObject) then Exit;
Exit;
aObject := TObject(GDIObject); aObject := TObject(GDIObject);
if (aObject is TQtResource) and TQtResource(aObject).FShared then (* if (aObject is TQtResource) and TQtResource(aObject).FShared then
Exit(True); Exit(True);
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -889,16 +887,16 @@ begin
begin begin
//WriteLn('Delete object: ', PtrUInt(AObject)); //WriteLn('Delete object: ', PtrUInt(AObject));
FreeThenNil(AObject); FreeThenNil(AObject);
end; end;*)
Result := True; Result := True;
{$ifdef VerboseQtWinAPI} {$ifdef VerboseWinAPI}
WriteLn('Trace:< [WinAPI DeleteObject] Result=', dbgs(Result), ' ObjectType=', ObjType); DebugLn('Trace:< [WinAPI DeleteObject] Result=', dbgs(Result), ' ObjectType=', ObjType);
{$endif} {$endif}
end; end;
function TQtWidgetSet.DestroyCaret(Handle: HWND): Boolean; (*function TQtWidgetSet.DestroyCaret(Handle: HWND): Boolean;
begin begin
Result := (Handle <> 0) and QtCaret.DestroyCaret; Result := (Handle <> 0) and QtCaret.DestroyCaret;
end; end;
@ -4710,7 +4708,7 @@ var
begin begin
ACritSec:=System.PRTLCriticalSection(CritSection); ACritSec:=System.PRTLCriticalSection(CritSection);
System.LeaveCriticalsection(ACritSec^); System.LeaveCriticalsection(ACritSec^);
end; end;*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: LineTo Function: LineTo
@ -4719,28 +4717,29 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TQtWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean; function TCDWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
var var
PenPos, LastPos: TPoint; PenPos, LastPos: TPoint;
LazDC: TLazCanvas absolute DC;
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseWinAPI}
WriteLn('[WinAPI LineTo]'); DebugLn('[TCDWidgetSet.LineTo]');
{$endif} {$endif}
Result := False; Result := False;
if not IsValidDC(DC) then Exit; if not IsValidDC(DC) then Exit;
TQtDeviceContext(DC).getPenPos(@PenPos); (* TQtDeviceContext(DC).getPenPos(@PenPos);
LastPos := Point(X, Y); LastPos := Point(X, Y);
if TQtDeviceContext(DC).pen.getCosmetic then if TQtDeviceContext(DC).pen.getCosmetic then
LastPos := TQtDeviceContext(DC).GetLineLastPixelPos(PenPos, LastPos); LastPos := TQtDeviceContext(DC).GetLineLastPixelPos(PenPos, LastPos);
TQtDeviceContext(DC).drawLine(PenPos.X, PenPos.Y, LastPos.X, LastPos.Y); TQtDeviceContext(DC).drawLine(PenPos.X, PenPos.Y, LastPos.X, LastPos.Y);
MoveToEx(DC, X, Y, nil); MoveToEx(DC, X, Y, nil);*)
Result := True; Result := True;
end; end;
(*
function TQtWidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; function TQtWidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL;
var var
P: PPoint; P: PPoint;
@ -4782,19 +4781,19 @@ begin
TitleStr := GetUtf8String(lpCaption); TitleStr := GetUtf8String(lpCaption);
OkStr := GetUtf8String('Ok'); OkStr := GetUtf8String('Ok');
Result := QMessageBox_information(TQtWidget(hWnd).Widget, @Str, @TitleStr, @OkStr); Result := QMessageBox_information(TQtWidget(hWnd).Widget, @Str, @TitleStr, @OkStr);
end; end;*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: MoveToEx Function: MoveToEx
Params: none Params: none
Returns: Nothing Returns: Nothing
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TQtWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; function TCDWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
var
LazDC: TLazCanvas absolute DC;
begin begin
{$ifdef VerboseQtWinAPI} {$ifdef VerboseWinAPI}
WriteLn('[WinAPI MoveToEx]', DebugLn('[WinAPI MoveToEx]',
' DC:', dbghex(DC), ' DC:', dbghex(DC),
' X:', dbgs(X), ' X:', dbgs(X),
' Y:', dbgs(Y)); ' Y:', dbgs(Y));
@ -4804,14 +4803,14 @@ begin
if not IsValidDC(DC) then Exit; if not IsValidDC(DC) then Exit;
if (OldPoint <> nil) then TQtDeviceContext(DC).getPenPos(OldPoint); if (OldPoint <> nil) then OldPoint^ := LazDC.PenPos;
TQtDeviceContext(DC).setPenPos(X, Y); LazDC.PenPos := Types.Point(X, Y);
Result := True; Result := True;
end; end;
function TQtWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer; (*function TQtWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
var var
QtRgn: QRegionH; QtRgn: QRegionH;
begin begin
@ -4937,8 +4936,6 @@ function TCDWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var var
LazDC: TLazCanvas absolute DC; LazDC: TLazCanvas absolute DC;
begin begin
if DC = 0 then Exit;
{$ifdef VerboseWinAPI} {$ifdef VerboseWinAPI}
DebugLn(Format(':>[WinAPI Rectangle] DC=%s', [dbghex(DC)])); DebugLn(Format(':>[WinAPI Rectangle] DC=%s', [dbghex(DC)]));
{$endif} {$endif}
@ -4955,11 +4952,12 @@ begin
DebugLn(Format('::[WinAPI Rectangle] DC.Width=%d DC.Height=%d', [LazDC.Width, LazDC.Height])); DebugLn(Format('::[WinAPI Rectangle] DC.Width=%d DC.Height=%d', [LazDC.Width, LazDC.Height]));
{$endif} {$endif}
LazDC.Rectangle(X1, Y1, X2, Y2); // ToDo: Normalize the rectangle, or improve TLazCanvas so that it accepts invalid coordinates
{ R := NormalizeRect(Rect(X1, Y1, X2, Y2)); { R := NormalizeRect(Rect(X1, Y1, X2, Y2));
if IsRectEmpty(R) then Exit(True); if IsRectEmpty(R) then Exit(True);}
LazDC.Rectangle(X1, Y1, X2, Y2);
TQtDeviceContext(DC).drawRect(R.Left, R.Top, R.Right - R.Left - 1, R.Bottom - R.Top - 1);}
Result := True; Result := True;
end; end;
(* (*

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

@ -64,9 +64,9 @@ function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): H
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override; function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
procedure DeleteCriticalSection(var CritSection: TCriticalSection); override; procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
function DeleteDC(hDC: HDC): Boolean; override; function DeleteDC(hDC: HDC): Boolean; override;*)
function DeleteObject(GDIObject: HGDIOBJ): Boolean; override; function DeleteObject(GDIObject: HGDIOBJ): Boolean; override;
function DestroyCaret(Handle : HWND): Boolean; override; (*function DestroyCaret(Handle : HWND): Boolean; override;
function DestroyIcon(Handle: HICON): Boolean; override; function DestroyIcon(Handle: HICON): Boolean; override;
function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; override; function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; override;
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override; function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
@ -155,14 +155,14 @@ function IsWindowEnabled(Handle: HWND): boolean; override;
function IsWindowVisible(Handle: HWND): boolean; override; function IsWindowVisible(Handle: HWND): boolean; override;
function IsZoomed(Handle: HWND): boolean; override; function IsZoomed(Handle: HWND): boolean; override;
procedure LeaveCriticalSection(var CritSection: TCriticalSection); override; procedure LeaveCriticalSection(var CritSection: TCriticalSection); override;*)
function LineTo(DC: HDC; X, Y: Integer): Boolean; override; function LineTo(DC: HDC; X, Y: Integer): Boolean; override;
function LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; override; (*function LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; override;
function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; override; function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; override;*)
function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override; function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; override;
function OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer; override; (*function OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer; override;
function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; override; function PeekMessage(var lpMsg : TMsg; Handle : HWND; wMsgFilterMin, wMsgFilterMax,wRemoveMsg : UINT): Boolean; override;
function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuous: boolean): boolean; override; function PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer; Filled, Continuous: boolean): boolean; override;