mbColorLib: Less hints and warnings.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8129 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-10-27 17:26:55 +00:00
parent 83b7ffa66d
commit abdec8801e
19 changed files with 61 additions and 45 deletions

View File

@@ -17,8 +17,6 @@ type
FShowSatCirc: boolean; FShowSatCirc: boolean;
FShowHueLine: boolean; FShowHueLine: boolean;
FShowSelCirc: boolean; FShowSelCirc: boolean;
procedure SetRelHue(H: Double);
procedure SetRelSat(S: Double);
procedure SetSatCircColor(c: TColor); procedure SetSatCircColor(c: TColor);
procedure SetHueLineColor(c: TColor); procedure SetHueLineColor(c: TColor);
procedure DrawSatCirc; procedure DrawSatCirc;
@@ -35,6 +33,8 @@ type
procedure Paint; override; procedure Paint; override;
procedure Resize; override; procedure Resize; override;
procedure SelectColor(x, y: integer); override; procedure SelectColor(x, y: integer); override;
procedure SetRelHue(H: Double); override;
procedure SetRelSat(S: Double); override;
procedure SetSelectedColor(c: TColor); override; procedure SetSelectedColor(c: TColor); override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;

View File

@@ -53,7 +53,7 @@ type
implementation implementation
uses uses
Math, mbUtils, PalUtils; Math, mbUtils;
{ THSColorPicker } { THSColorPicker }

View File

@@ -314,8 +314,6 @@ begin
end; end;
procedure THSLColorPicker.HSPickerChange(Sender: TObject); procedure THSLColorPicker.HSPickerChange(Sender: TObject);
var
c: TColor;
begin begin
FLVPicker.Lock; // Lock the LVPicker to generate OnChange events here. FLVPicker.Lock; // Lock the LVPicker to generate OnChange events here.
try try

View File

@@ -18,7 +18,7 @@ type
FSLPicker: TSLColorPicker; FSLPicker: TSLColorPicker;
FSelectedColor: TColor; FSelectedColor: TColor;
// FRValue, FGValue, FBValue: integer; // FRValue, FGValue, FBValue: integer;
FRingHint, FSLHint: string; FRingHint: string;
FSLMenu, FRingMenu: TPopupMenu; FSLMenu, FRingMenu: TPopupMenu;
FSLCursor, FRingCursor: TCursor; FSLCursor, FRingCursor: TCursor;
PBack: TBitmap; PBack: TBitmap;
@@ -33,7 +33,7 @@ type
function GetRed: Integer; function GetRed: Integer;
function GetGreen: Integer; function GetGreen: Integer;
function GetBlue: Integer; function GetBlue: Integer;
function GetLVHint(AMode: TBrightnessMode): String; function GetLVHint({%H-}AMode: TBrightnessMode): String;
procedure SetBrightnessMode(AMode: TBrightnessMode); procedure SetBrightnessMode(AMode: TBrightnessMode);
procedure SetHue(H: integer); procedure SetHue(H: integer);
procedure SetSat(S: integer); procedure SetSat(S: integer);

View File

@@ -1,5 +1,8 @@
unit HTMLColors; unit HTMLColors;
{$IF FPC_FullVersion >= 30200}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$IFEND}
interface interface
uses uses

View File

@@ -9,7 +9,7 @@ interface
//{$I mxs.inc} //{$I mxs.inc}
uses uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, StdCtrls, LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics,
Forms, Themes, Math, Forms, Themes, Math,
HTMLColors, mbBasicPicker; HTMLColors, mbBasicPicker;

View File

@@ -22,7 +22,7 @@ type
function LumFromArrowPos(p: integer): Double; function LumFromArrowPos(p: integer): Double;
function ValFromArrowPos(p: Integer): Double; function ValFromArrowPos(p: Integer): Double;
function GetHint(AMode: TBrightnessMode): String; function GetHint(AMode: TBrightnessMode): String;
procedure SetHint(AMode: TBrightnessMode; AText: String); procedure SetHint(AMode: TBrightnessMode; AText: String); reintroduce;
protected protected
procedure Execute(tbaAction: integer); override; procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override; function GetArrowPos: integer; override;

View File

@@ -65,7 +65,7 @@ function ReadPhotoshopAct(PalFile: TFileName): string;
implementation implementation
uses uses
Math, mbColorConv; mbColorConv;
function ReplaceFlags(s: string; flags: array of string; value: integer): string; function ReplaceFlags(s: string; flags: array of string; value: integer): string;
var var
@@ -239,7 +239,7 @@ var
Scolor: string; Scolor: string;
Faktor: double; Faktor: double;
a: RGBArray; a: RGBArray;
b: array of RGBArray; b: array of RGBArray = nil;
begin begin
Result := ''; Result := '';
Span := 300; Span := 300;
@@ -683,13 +683,22 @@ end;
function ReadPhotoshopAco(PalFile: TFileName): AcoColors; function ReadPhotoshopAco(PalFile: TFileName): AcoColors;
var var
f: file; f: file;
ver, num, space, w, x, y, z, dummy: Word;
i: integer; i: integer;
v0Length: byte; ver: word = 0;
v0Name: string; num: word = 0;
v2Length: Word; space: word = 0;
v2Name: WideString; w: word = 0;
x: word = 0;
y: word = 0;
z: word = 0;
dummy: Word = 0;
v0Length: byte = 0;
v0Name: string = '';
v2Length: Word = 0;
v2Name: WideString = '';
begin begin
Result := Default(AcoColors);
if not FileExists(PalFile) then if not FileExists(PalFile) then
begin begin
SetLength(Result.Colors, 0); SetLength(Result.Colors, 0);
@@ -744,7 +753,7 @@ begin
SetLength(v0Name, v0Length); SetLength(v0Name, v0Length);
if v0Length > 0 then if v0Length > 0 then
BlockRead(f, PChar(v0Name)^, v0Length); BlockRead(f, PChar(v0Name)^, v0Length);
Result.Names[i] := v0Name; Result.Names[i] := UTF8Decode(v0Name);
end; end;
2: begin 2: begin
BlockRead(f, dummy, sizeof(dummy)); BlockRead(f, dummy, sizeof(dummy));
@@ -753,7 +762,7 @@ begin
SetLength(v2Name, v2Length - 1); SetLength(v2Name, v2Length - 1);
if v2Length > 0 then if v2Length > 0 then
begin begin
BlockRead(f, PWideChar(v2Name)^, 2*(v2Length - 1)); BlockRead(f, PWideChar(v2Name)^, (Int64(v2Length) - 1)*2);
ExchangeChars(v2Name); ExchangeChars(v2Name);
end; end;
Result.Names[i] := v2Name; Result.Names[i] := v2Name;
@@ -767,7 +776,9 @@ end;
function ReadPhotoshopAct(PalFile: TFileName): string; function ReadPhotoshopAct(PalFile: TFileName): string;
var var
f: file; f: file;
r, g, b: byte; r: byte = 0;
g: byte = 0;
b: byte = 0;
s: TStringList; s: TStringList;
i: integer; i: integer;
begin begin

View File

@@ -1,5 +1,7 @@
unit RGBCMYKUtils; unit RGBCMYKUtils;
{$IF FPC_Fullversion >= 30200}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$IFEND}
interface interface
// Activate only one of these defines - see comments below // Activate only one of these defines - see comments below

View File

@@ -4,6 +4,10 @@ unit RGBHSVUtils;
{$MODE DELPHI} {$MODE DELPHI}
{$ENDIF} {$ENDIF}
{$IF FPC_FullVersion >= 30200}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$IFEND}
interface interface
uses uses

View File

@@ -13,7 +13,7 @@ type
private private
FHint: array[TBrightnessMode] of string; FHint: array[TBrightnessMode] of string;
function GetHint(AMode: TBrightnessMode): String; function GetHint(AMode: TBrightnessMode): String;
procedure SetHint(AMode: TBrightnessMode; AText: String); procedure SetHint(AMode: TBrightnessMode; AText: String); reintroduce;
protected protected
procedure CorrectCoords(var x, y: integer); procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override; procedure CreateWnd; override;

View File

@@ -8,7 +8,7 @@ interface
uses uses
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
ExtCtrls, StdCtrls, ExtCtrls,
PalUtils; PalUtils;
const const

View File

@@ -60,6 +60,9 @@
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Linking> <Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>

View File

@@ -9,7 +9,7 @@ object Form1: TForm1
Font.Color = clWindowText Font.Color = clWindowText
OnCreate = FormCreate OnCreate = FormCreate
ShowHint = True ShowHint = True
LCLVersion = '2.2.0.1' LCLVersion = '2.3.0.0'
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 6 Left = 6
Height = 404 Height = 404
@@ -52,7 +52,7 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbMarker AnchorSideTop.Control = CbMarker
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 111 Left = 109
Height = 15 Height = 15
Top = 355 Top = 355
Width = 40 Width = 40
@@ -82,7 +82,7 @@ object Form1: TForm1
Left = 4 Left = 4
Height = 19 Height = 19
Top = 353 Top = 353
Width = 83 Width = 81
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'SliderVisible' Caption = 'SliderVisible'
Checked = True Checked = True
@@ -93,7 +93,7 @@ object Form1: TForm1
object CbMarker: TComboBox object CbMarker: TComboBox
AnchorSideLeft.Control = Label4 AnchorSideLeft.Control = Label4
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
Left = 159 Left = 157
Height = 23 Height = 23
Top = 351 Top = 351
Width = 103 Width = 103
@@ -115,10 +115,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CbMarker AnchorSideTop.Control = CbMarker
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 286 Left = 284
Height = 20 Height = 20
Top = 352 Top = 352
Width = 101 Width = 99
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Left = 24 BorderSpacing.Left = 24
Caption = 'NewArrowStyle' Caption = 'NewArrowStyle'
@@ -1398,7 +1398,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 19 Height = 19
Top = 210 Top = 210
Width = 83 Width = 81
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'SwatchStyle' Caption = 'SwatchStyle'
OnClick = CbSwatchStyleClick OnClick = CbSwatchStyleClick
@@ -1423,7 +1423,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 19 Height = 19
Top = 328 Top = 328
Width = 66 Width = 64
BorderSpacing.Top = 12 BorderSpacing.Top = 12
Caption = 'WebSafe' Caption = 'WebSafe'
OnClick = CbWebSsafeClick OnClick = CbWebSsafeClick
@@ -1436,7 +1436,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 19 Height = 19
Top = 351 Top = 351
Width = 78 Width = 76
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'Show hints' Caption = 'Show hints'
Checked = True Checked = True
@@ -1451,7 +1451,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 19 Height = 19
Top = 374 Top = 374
Width = 62 Width = 60
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'Enabled' Caption = 'Enabled'
Checked = True Checked = True

View File

@@ -1,5 +1,5 @@
unit main; unit main;
{$WARN 5024 off : Parameter "$1" not used}
interface interface

View File

@@ -6,8 +6,8 @@ interface
uses uses
SysUtils, LCLIntf, LCLType, Classes, Controls, StdCtrls, SysUtils, LCLIntf, LCLType, Classes, Controls, StdCtrls,
Graphics, GraphUtil, Forms, Themes, Graphics, Forms, Themes,
HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, PalUtils; HTMLColors, {RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils,} PalUtils;
type type
TmbColor = record TmbColor = record

View File

@@ -692,7 +692,7 @@ begin
FNames.Clear; FNames.Clear;
if a.HasNames then if a.HasNames then
for i := 0 to Length(a.Names) - 1 do for i := 0 to Length(a.Names) - 1 do
FNames.Add(a.Names[i]); FNames.Add(UTF8Encode(a.Names[i]));
end end
else if SameText(ExtractFileExt(FileName), '.act') then else if SameText(ExtractFileExt(FileName), '.act') then
begin begin

View File

@@ -907,18 +907,9 @@ end;
procedure TmbHSLVTrackbarPicker.SetBrightnessMode(AMode: TBrightnessMode); procedure TmbHSLVTrackbarPicker.SetBrightnessMode(AMode: TBrightnessMode);
var var
c: TColor; c: TColor;
S, L, V: Double;
begin begin
c := HSLVtoColor(FHue, FSat, FLum, FVal); c := HSLVtoColor(FHue, FSat, FLum, FVal);
FBrightnessMode := AMode; FBrightnessMode := AMode;
(*
ColorToHSLV(c, FHue, S, L, V);
SetRelSat(S);
case AMode of
bmLuminance: SetRelLum(L);
bmValue : SetRelVal(V);
end;
*)
ColorToHSLV(c, FHue, FSat, FLum, FVal); ColorToHSLV(c, FHue, FSat, FLum, FVal);
CreateGradient; CreateGradient;
Invalidate; Invalidate;

View File

@@ -2,6 +2,10 @@ unit mbColorConv;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$IF FPC_FullVersion >= 30200}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$IFEND}
interface interface
uses uses