mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 12:03:51 +02:00
added InvertColor and RGBColor to graphics.pp from Tom Gregorovic
git-svn-id: trunk@9892 -
This commit is contained in:
parent
2f8dd510a5
commit
16b454e50e
@ -233,11 +233,16 @@ uses
|
||||
|
||||
var
|
||||
Identifiers: array[#0..#255] of ByteBool;
|
||||
{$IFNDEF SYN_LAZARUS}
|
||||
mHashTable: array[#0..#255] of Integer;
|
||||
{$ENDIF}
|
||||
|
||||
procedure MakeIdentTable;
|
||||
var
|
||||
I, J: Char;
|
||||
I: Char;
|
||||
{$IFNDEF SYN_LAZARUS}
|
||||
J: Char;
|
||||
{$ENDIF}
|
||||
idents:string;
|
||||
begin
|
||||
idents:='_0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-?!';
|
||||
@ -248,11 +253,13 @@ begin
|
||||
// case I in ['_', '0'..'9', 'a'..'z', 'A'..'Z','-','?','!'] of true: Identifiers[I] := True;
|
||||
// else Identifiers[I] := False;
|
||||
// end;
|
||||
{$IFNDEF SYN_LAZARUS}
|
||||
J := UpCase(I);
|
||||
Case I in ['_', 'a'..'z', 'A'..'Z'] of
|
||||
True: mHashTable[I] := Ord(J) - 64
|
||||
else mHashTable[I] := 0;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -98,24 +98,6 @@ var
|
||||
BGBlue: Integer;
|
||||
TokenStart: Integer;
|
||||
|
||||
function InvertColor(AColor: TColor): TColor;
|
||||
var Red, Green, Blue: integer;
|
||||
begin
|
||||
Red:=(AColor shr 16) and $ff;
|
||||
Green:=(AColor shr 8) and $ff;
|
||||
Blue:=AColor and $ff;
|
||||
if Abs($80-Red)+Abs($80-Green)+Abs($80-Blue)<$140 then begin
|
||||
Red:=Red+$a0;
|
||||
Green:=Green+$a0;
|
||||
Blue:=Blue+$a0;
|
||||
end else begin
|
||||
Red:=$ff-Red;
|
||||
Green:=$ff-Green;
|
||||
Blue:=$ff-Blue;
|
||||
end;
|
||||
Result:=((Red and $ff) shl 16)+((Green and $ff) shl 8)+(Blue and $ff);
|
||||
end;
|
||||
|
||||
procedure SetFontColor(NewColor: TColor);
|
||||
var
|
||||
FGRed: Integer;
|
||||
|
@ -5930,6 +5930,8 @@ begin
|
||||
TCustomLabel, 'Caption', TStringMultilinePropertyEditor);
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('AnsiString'),
|
||||
TCustomStaticText, 'Caption', TStringMultilinePropertyEditor);
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('AnsiString'),
|
||||
TCustomCheckBox, 'Caption', TStringMultilinePropertyEditor);
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TTranslateString'),
|
||||
TControl, 'Hint', TStringMultilinePropertyEditor);
|
||||
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('longint'),
|
||||
|
@ -1302,10 +1302,12 @@ function ColorToRGB(Color: TColor): TColor;
|
||||
function ColorToString(Color: TColor): AnsiString;
|
||||
function StringToColor(const S: shortstring): TColor;
|
||||
procedure GetColorValues(Proc: TGetColorStringProc);
|
||||
function InvertColor(AColor: TColor): TColor;
|
||||
|
||||
Function Blue(rgb: TColor): BYTE;
|
||||
Function Green(rgb: TColor): BYTE;
|
||||
Function Red(rgb: TColor): BYTE;
|
||||
function RGBToColor(R, G, B: Byte): TColor;
|
||||
procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
|
||||
function FPColorToTColor(const FPColor: TFPColor): TColor;
|
||||
function TColorToFPColor(const c: TColor): TFPColor;
|
||||
@ -1639,6 +1641,30 @@ begin
|
||||
for I := Low(Colors) to High(Colors) do Proc(Colors[I].Name);
|
||||
end;
|
||||
|
||||
function InvertColor(AColor: TColor): TColor;
|
||||
var
|
||||
R, G, B: Integer;
|
||||
begin
|
||||
R := AColor and $ff;
|
||||
G := (AColor shr 8) and $ff;
|
||||
B := (AColor shr 16) and $ff;
|
||||
|
||||
if Abs($80 - R) + Abs($80 - G) + Abs($80 - B) < $140 then
|
||||
begin
|
||||
Inc(R, $a0);
|
||||
Inc(G, $a0);
|
||||
Inc(B, $a0);
|
||||
end
|
||||
else
|
||||
begin
|
||||
R := $ff - R;
|
||||
G := $ff - G;
|
||||
B := $ff - B;
|
||||
end;
|
||||
|
||||
Result := ((B and $ff) shl 16) or ((G and $ff) shl 8) or (R and $ff);
|
||||
end;
|
||||
|
||||
Function Blue(rgb: TColor): BYTE;
|
||||
begin
|
||||
Result := (rgb shr 16) and $000000ff;
|
||||
@ -1654,6 +1680,11 @@ begin
|
||||
Result := rgb and $000000ff;
|
||||
end;
|
||||
|
||||
function RGBToColor(R, G, B: Byte): TColor;
|
||||
begin
|
||||
Result := (B shl 16) or (G shl 8) or R;
|
||||
end;
|
||||
|
||||
procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
|
||||
begin
|
||||
Red := rgb and $000000ff;
|
||||
|
Loading…
Reference in New Issue
Block a user