clean up, added GetRGBValues

git-svn-id: trunk@6497 -

lcl/graphics.pp

@@ -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
 

lcl/include/font.inc

@@ -756,13 +756,13 @@ end;
  ------------------------------------------------------------------------------}
 procedure TFont.SetColor(Value : TColor);
 begin
-  if FColor <> Value
+  if FColor <> Value then begin
-  then begin
-    FColor := Value;
     {$IFDEF UseFPCanvas}
-    inherited SetFPColor(TColorToFPColor(FColor));
+    SetColor(Value,FPColorToTColor(Value));
-    {$ENDIF}
+    {$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
 

lcl/include/winapi.inc

@@ -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
 

lcl/include/winapih.inc

@@ -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
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -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);
+    GetRGBIntValues(BeginColor,R1,G1,B1);
-    G := GetGValue(BeginColor);
+    GetRGBIntValues(EndColor,R2,G2,B2);
-    B := GetBValue(BeginColor);
 
-    R := R + (Position*(GetRValue(EndColor) - R) div TotalSteps);
+    R1 := R1 + (Position*(R2 - R1) div TotalSteps);
-    G := G + (Position*(GetGValue(EndColor) - G) div TotalSteps);
+    G1 := G1 + (Position*(G2 - G1) div TotalSteps);
-    B := B + (Position*(GetBValue(EndColor) - B) 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