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

clean up, added GetRGBValues

Browse Source 
git-svn-id: trunk@6497 -
This commit is contained in:
mattias 2005-01-07 18:40:10 +00:00
parent 7fc8c7bc73
commit 8bf0d5935f
5 changed files with 66 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/graphics.pp
View File

@ -494,9 +494,10 @@ type
procedure DoDeAllocateResources; override;
procedure DoCopyProps(From: TFPCanvasHelper); override;
procedure SetFlags(Index: integer; AValue: boolean); override;
procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
procedure SetName(AValue: string); override;
procedure SetSize(AValue: integer); override;
procedure SetFPColor(AValue: TFPColor); override;
procedure SetFPColor(const AValue: TFPColor); override;
{$ELSE}
procedure SetName(const AValue: string);
procedure SetSize(AValue: Integer);
@ -1874,6 +1875,9 @@ end.
{ =============================================================================
$Log$
Revision 1.167 2005/01/07 18:40:10 mattias
clean up, added GetRGBValues
Revision 1.166 2005/01/07 17:40:59 mattias
fixed TTabSheet.SetPageControl

32
lcl/include/font.inc
View File

@ -756,13 +756,13 @@ end;
------------------------------------------------------------------------------}
procedure TFont.SetColor(Value : TColor);
begin
if FColor <> Value
then begin
FColor := Value;
if FColor <> Value then begin
{$IFDEF UseFPCanvas}
inherited SetFPColor(TColorToFPColor(FColor));
{$ENDIF}
SetColor(Value,FPColorToTColor(Value));
{$ELSE}
FColor := Value;
Changed;
{$ENDIF}
end;
end;
@ -856,6 +856,25 @@ begin
8: SetStyleFlag(fsStrikeOut,AValue);
end;
end;
{------------------------------------------------------------------------------
procedure TFont.SetFPColor(const AValue: TFPColor);
Set FPColor and Color
------------------------------------------------------------------------------}
procedure TFont.SetFPColor(const AValue: TFPColor);
begin
if FPColor=AValue then exit;
SetColor(FPColorToTColor(AValue),AValue);
end;
procedure TFont.SetColor(const NewColor: TColor; const NewFPColor: TFPColor);
begin
if (NewColor=Color) and (NewFPColor=FPColor) then exit;
FColor:=NewColor;
inherited SetFPColor(NewFPColor);
Changed;
end;
{$ENDIF}
{------------------------------------------------------------------------------
@ -1074,6 +1093,9 @@ end;
{ =============================================================================
$Log$
Revision 1.25 2005/01/07 18:40:10 mattias
clean up, added GetRGBValues
Revision 1.24 2005/01/07 17:40:59 mattias
fixed TTabSheet.SetPageControl

18
lcl/include/winapi.inc
View File

@ -984,6 +984,21 @@ begin
Result := (RGB shr 16) and $ff;
end;
procedure GetRGBValues(RGB : DWORD; var R, G, B: Byte);
begin
R := RGB and $ff;
G := (RGB shr 8) and $ff;
B := (RGB shr 16) and $ff;
end;
procedure GetRGBIntValues(RGB : DWORD; var R, G, B: integer);
begin
R := RGB and $ff;
G := (RGB shr 8) and $ff;
B := (RGB shr 16) and $ff;
end;
{------------------------------------------------------------------------------
Function: GetScrollRange
Params: Handle, nBar, lpMinPos, lpMaxPos
@ -1300,6 +1315,9 @@ end;
{ =============================================================================
$Log$
Revision 1.115 2005/01/07 18:40:10 mattias
clean up, added GetRGBValues
Revision 1.114 2004/08/10 22:09:03 mattias
fixed uninitialised LogFont

5
lcl/include/winapih.inc
View File

@ -284,6 +284,8 @@ function UnionRect(var DestRect: TRect; const SrcRect1, SrcRect2: TRect): Boolea
function GetRValue(RGB : DWORD) : BYTE;
function GetGValue(RGB : DWORD) : BYTE;
function GetBValue(RGB : DWORD) : BYTE;
procedure GetRGBValues(RGB : DWORD; var R, G, B: Byte);
procedure GetRGBIntValues(RGB : DWORD; var R, G, B: integer);
function RGB(R, G, B : Byte) : TColorRef;
@ -295,6 +297,9 @@ function RGB(R, G, B : Byte) : TColorRef;
{ =============================================================================
$Log$
Revision 1.102 2005/01/07 18:40:10 mattias
clean up, added GetRGBValues
Revision 1.101 2005/01/01 20:17:30 mattias
implemented gtk GetTextExtentPoint for UTF8

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

@ -5668,20 +5668,20 @@ function TGtkWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices :
Procedure GetGradientBrush(BeginColor, EndColor : TColorRef; Position,
TotalSteps : Longint; var GradientBrush : hBrush);
var
R, G, B : Byte;
R1, G1, B1 : Integer;
R2, G2, B2 : Integer;
NewBrush : TLogBrush;
begin
R := GetRValue(BeginColor);
G := GetGValue(BeginColor);
B := GetBValue(BeginColor);
GetRGBIntValues(BeginColor,R1,G1,B1);
GetRGBIntValues(EndColor,R2,G2,B2);
R := R + (Position*(GetRValue(EndColor) - R) div TotalSteps);
G := G + (Position*(GetGValue(EndColor) - G) div TotalSteps);
B := B + (Position*(GetBValue(EndColor) - B) div TotalSteps);
R1 := R1 + (Position*(R2 - R1) div TotalSteps);
G1 := G1 + (Position*(G2 - G1) div TotalSteps);
B1 := B1 + (Position*(B2 - B1) div TotalSteps);
With NewBrush do begin
lbStyle := BS_SOLID;
lbColor := RGB(R,G,B);
lbColor := RGB(R1,G1,B1);
end;
If GradientBrush <> 0 then
@ -8826,6 +8826,9 @@ end;
{ =============================================================================
$Log$
Revision 1.383 2005/01/07 18:40:10 mattias
clean up, added GetRGBValues
Revision 1.382 2005/01/01 20:17:32 mattias
implemented gtk GetTextExtentPoint for UTF8