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

lcl: correct declaration of TRIVERTEX, add TTriVertex, TGradientRect types, fix Qt and Gtk versions of GradientFill

Browse Source 
git-svn-id: trunk@24458 -
This commit is contained in:
paul 2010-04-06 07:10:10 +00:00
parent 903275fc98
commit 82492703f2
4 changed files with 58 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -6590,7 +6590,6 @@ function TGtkWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
var var
DevCtx: TGtkDeviceContext absolute DC; DevCtx: TGtkDeviceContext absolute DC;
function DoFillTriangle : Boolean; function DoFillTriangle : Boolean;
begin begin
Result := (Mode and GRADIENT_FILL_TRIANGLE) = GRADIENT_FILL_TRIANGLE; Result := (Mode and GRADIENT_FILL_TRIANGLE) = GRADIENT_FILL_TRIANGLE;
@ -6615,7 +6614,8 @@ var
G1 := G1 + (Position*(G2 - G1) div TotalSteps); G1 := G1 + (Position*(G2 - G1) div TotalSteps);
B1 := B1 + (Position*(B2 - B1) div TotalSteps); B1 := B1 + (Position*(B2 - B1) div TotalSteps);
With NewBrush do begin with NewBrush do
begin
lbStyle := BS_SOLID; lbStyle := BS_SOLID;
lbColor := RGB(R1,G1,B1); lbColor := RGB(R1,G1,B1);
end; end;
@ -6654,47 +6654,56 @@ var
function FillRectMesh(Mesh : tagGradientRect) : Boolean; function FillRectMesh(Mesh : tagGradientRect) : Boolean;
var var
TL,BR : tagTRIVERTEX; TL, BR: tagTRIVERTEX;
StartColor, EndColor : TColorRef; StartColor, EndColor: TColorRef;
I, Swap : Longint; I, Swap: Longint;
SwapColors : Boolean; SwapColors: Boolean;
UseBrush : hBrush; UseBrush: hBrush;
Steps, MaxSteps : Longint; Steps, MaxSteps: Int64;
begin
with Mesh do
begin begin
With Mesh do begin
Result := (UpperLeft < NumVertices) and (UpperLeft >= 0) and Result := (UpperLeft < NumVertices) and (UpperLeft >= 0) and
(LowerRight < NumVertices) and (LowerRight >= 0); (LowerRight < NumVertices) and (LowerRight >= 0);
If (LowerRight = UpperLeft) or not Result then if (LowerRight = UpperLeft) or not Result then
exit; exit;
TL := Vertices[UpperLeft]; TL := Vertices[UpperLeft];
BR := Vertices[LowerRight]; BR := Vertices[LowerRight];
SwapColors := (BR.Y < TL.Y) and (BR.X < TL.X); SwapColors := (BR.Y < TL.Y) and (BR.X < TL.X);
If BR.X < TL.X then begin if BR.X < TL.X then
begin
Swap := BR.X; Swap := BR.X;
BR.X := TL.X; BR.X := TL.X;
TL.X := Swap; TL.X := Swap;
end; end;
If BR.Y < TL.Y then begin if BR.Y < TL.Y then
begin
Swap := BR.Y; Swap := BR.Y;
BR.Y := TL.Y; BR.Y := TL.Y;
TL.Y := Swap; TL.Y := Swap;
end; end;
StartColor := RGB(TL.Red, TL.Green, TL.Blue); StartColor := RGB(TL.Red shr 8, TL.Green shr 8, TL.Blue shr 8);
EndColor := RGB(BR.Red, BR.Green, BR.Blue); EndColor := RGB(BR.Red shr 8, BR.Green shr 8, BR.Blue shr 8);
If SwapColors then begin if SwapColors then
begin
Swap := StartColor; Swap := StartColor;
StartColor := EndColor; StartColor := EndColor;
EndColor := Swap; EndColor := Swap;
end; end;
UseBrush := 0; UseBrush := 0;
MaxSteps := GetDeviceCaps(DC, BITSPIXEL); MaxSteps := GetDeviceCaps(DC, BITSPIXEL);
If MaxSteps >= 4 then if MaxSteps >= 32 then
MaxSteps := Floor(Power(2, MaxSteps)) MaxSteps := $FFFFFFFF
else
if MaxSteps >= 4 then
MaxSteps := 1 shl MaxSteps
else else
MaxSteps := 256; MaxSteps := 256;
If DoFillVRect then begin if DoFillVRect then
begin
Steps := Min(BR.Y - TL.Y, MaxSteps); Steps := Min(BR.Y - TL.Y, MaxSteps);
for I := 0 to Steps - 1 do begin for I := 0 to Steps - 1 do
begin
GetGradientBrush(StartColor, EndColor, I, Steps, UseBrush); GetGradientBrush(StartColor, EndColor, I, Steps, UseBrush);
LCLIntf.FillRect(DC, Rect(TL.X, TL.Y + I, BR.X, TL.Y + I + 1), LCLIntf.FillRect(DC, Rect(TL.X, TL.Y + I, BR.X, TL.Y + I + 1),
UseBrush) UseBrush)
@ -6702,7 +6711,8 @@ var
end end
else begin else begin
Steps := Min(BR.X - TL.X, MaxSteps); Steps := Min(BR.X - TL.X, MaxSteps);
for I := 0 to Steps - 1 do begin for I := 0 to Steps - 1 do
begin
GetGradientBrush(StartColor, EndColor, I, Steps, UseBrush); GetGradientBrush(StartColor, EndColor, I, Steps, UseBrush);
LCLIntf.FillRect(DC, Rect(TL.X + I, TL.Y, TL.X + I + 1, BR.Y), LCLIntf.FillRect(DC, Rect(TL.X + I, TL.Y, TL.X + I + 1, BR.Y),
UseBrush); UseBrush);
@ -6722,26 +6732,30 @@ begin
//Currently Alpha blending is ignored... Ideas anyone? //Currently Alpha blending is ignored... Ideas anyone?
Result := (Meshes <> nil) and (NumMeshes >= 1) and (NumVertices >= 2) Result := (Meshes <> nil) and (NumMeshes >= 1) and (NumVertices >= 2)
and (Vertices <> nil); and (Vertices <> nil);
If Result and DoFillTriangle then if Result and DoFillTriangle then
Result := NumVertices >= 3; Result := NumVertices >= 3;
If Result then begin if Result then
begin
Result := False; Result := False;
//Sanity Checks For Vertices Size vs. Count //Sanity Checks For Vertices Size vs. Count
If MemSize(Vertices) < PtrInt(SizeOf(tagTRIVERTEX)*NumVertices) then if MemSize(Vertices) < PtrInt(SizeOf(tagTRIVERTEX)*NumVertices) then
exit; exit;
//Sanity Checks For Meshes Size vs. Count //Sanity Checks For Meshes Size vs. Count
If MemSize(Meshes) < PtrInt(MeshSize[DoFillTriangle]*NumMeshes) then if MemSize(Meshes) < PtrInt(MeshSize[DoFillTriangle]*NumMeshes) then
exit; exit;
For I := 0 to NumMeshes - 1 do begin for I := 0 to NumMeshes - 1 do
If DoFillTriangle then begin begin
If Not FillTriMesh(PGradientTriangle(Meshes)[I]) then if DoFillTriangle then
begin
If not FillTriMesh(PGradientTriangle(Meshes)[I]) then
exit; exit;
end end
else begin else
If not FillRectMesh(PGradientRect(Meshes)[I]) then begin
if not FillRectMesh(PGradientRect(Meshes)[I]) then
exit; exit;
end; end;
end; end;

2
lcl/interfaces/qt/qtobject.inc
View File

@ -483,8 +483,6 @@ begin
end; end;
function TQtWidgetSet.IsValidHandle(AHandle: HWND): Boolean; function TQtWidgetSet.IsValidHandle(AHandle: HWND): Boolean;
var
i: integer;
begin begin
if (AHandle = 0) then if (AHandle = 0) then
Exit(False); Exit(False);

11
lcl/interfaces/qt/qtwinapi.inc
View File

@ -3668,7 +3668,7 @@ function TQtWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
I, Swap : Longint; I, Swap : Longint;
SwapColors : Boolean; SwapColors : Boolean;
UseBrush : hBrush; UseBrush : hBrush;
Steps, MaxSteps : Longint; Steps, MaxSteps: Int64;
begin begin
with Mesh do with Mesh do
begin begin
@ -3691,8 +3691,8 @@ function TQtWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
BR.Y := TL.Y; BR.Y := TL.Y;
TL.Y := Swap; TL.Y := Swap;
end; end;
StartColor := RGB(TL.Red, TL.Green, TL.Blue); StartColor := RGB(TL.Red shr 8, TL.Green shr 8, TL.Blue shr 8);
EndColor := RGB(BR.Red, BR.Green, BR.Blue); EndColor := RGB(BR.Red shr 8, BR.Green shr 8, BR.Blue shr 8);
if SwapColors then if SwapColors then
begin begin
Swap := StartColor; Swap := StartColor;
@ -3701,8 +3701,11 @@ function TQtWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
end; end;
UseBrush := 0; UseBrush := 0;
MaxSteps := GetDeviceCaps(DC, BITSPIXEL); MaxSteps := GetDeviceCaps(DC, BITSPIXEL);
if MaxSteps >= 32 then
MaxSteps := $FFFFFFFF
else
if MaxSteps >= 4 then if MaxSteps >= 4 then
MaxSteps := Floor(Power(2, MaxSteps)) MaxSteps := 1 shl MaxSteps
else else
MaxSteps := 256; MaxSteps := 256;
if DoFillVRect then if DoFillVRect then

11
lcl/lcltype.pp
View File

@ -1106,12 +1106,13 @@ type
tagTRIVERTEX = record tagTRIVERTEX = record
x: Longint; x: Longint;
y: Longint; y: Longint;
Red: Shortint; Red: Word;
Green: Shortint; Green: Word;
Blue: Shortint; Blue: Word;
Alpha: Shortint; Alpha: Word;
end; end;
TRIVERTEX = tagTRIVERTEX; TRIVERTEX = tagTRIVERTEX;
TTriVertex = TRIVERTEX;
PGradientTriangle = ^tagGradientTriangle; PGradientTriangle = ^tagGradientTriangle;
tagGRADIENTTRIANGLE = record tagGRADIENTTRIANGLE = record
@ -1120,6 +1121,7 @@ type
Vertex3: Longint; Vertex3: Longint;
end; end;
GRADIENTTRIANGLE = tagGRADIENTTRIANGLE; GRADIENTTRIANGLE = tagGRADIENTTRIANGLE;
TGradientTriangle = GRADIENTTRIANGLE;
PGradientRect = ^tagGradientRect; PGradientRect = ^tagGradientRect;
tagGRADIENTRECT = record tagGRADIENTRECT = record
@ -1127,6 +1129,7 @@ type
LowerRight: Longint; LowerRight: Longint;
end; end;
GRADIENTRECT = tagGRADIENTRECT; GRADIENTRECT = tagGRADIENTRECT;
TGradientRect = GRADIENTRECT;
{ ********************************** } { ********************************** }
{ B I T M A P S T U F F } { B I T M A P S T U F F }