pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: Fix endless change loops between RGB ColorPicker and RGB AxisColorPicker. Add axispickers demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5563 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-24 12:47:07 +00:00
parent 83f00a7a0b
commit 054fd3f9f6
21 changed files with 596 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
components/mbColorLib/BAxisColorPicker.pas
View File

@ -7,8 +7,7 @@ unit BAxisColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Math, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics,
HTMLColors, mbColorPickerControl;
type
@ -23,22 +22,22 @@ type
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetColorAtPoint(x, y: Integer): TColor; override;
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
published
property SelectedColor default clBlue;
property RValue: integer read FR write SetRValue default 0;
property GValue: integer read FG write SetGValue default 0;
property BValue: integer read FB write SetBValue default 255;
property Red: integer read FR write SetRValue default 0;
property Green: integer read FG write SetGValue default 0;
property Blue: integer read FB write SetBValue default 255;
property MarkerStyle default msCircle;
property OnChange;
end;
@ -176,13 +175,14 @@ procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SetFocus;
end;
@ -194,7 +194,9 @@ begin
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
@ -208,7 +210,9 @@ begin
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
@ -218,24 +222,27 @@ end;
procedure TBAxisColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TBAxisColorPicker.Resize;
begin
FManual := false;
mxx := round(FR * (Width / 255));
myy := round((255 - FG) * (Height / 255));
mxx := round(FR * Width / 255);
myy := round((255 - FG) * Height / 255);
inherited;
end;
procedure TBAxisColorPicker.SetBValue(b: integer);
begin
Clamp(b, 0, 255);
if b <> FB then
begin
FB := b;
CreateGradient;
SetSelectedColor(RGB(FR, FG, FB));
end;
end;
procedure TBAxisColorPicker.SetGValue(g: integer);
begin
@ -252,13 +259,20 @@ begin
end;
procedure TBAxisColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
if b <> FB then
CreateGradient;
FR := r;
FG := g;
FB := b;
FSelected := c;
FManual := false;
FManual := true;
mxx := Round(FR * Width / 255); // RED is on x
myy := Round((255 - FG) * Height / 255); // GREEN is on y
Invalidate;

12
components/mbColorLib/BColorPicker.pas
View File

@ -72,13 +72,12 @@ var
begin
if Layout = lyHorizontal then
begin
a := Round(((Width - 12)/255)*b);
a := Round((Width - 12) * b / 255);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
b := 255 - b;
a := Round(((Height - 12)/255)*b);
a := Round((Height - 12) * (255 - b) / 255 );
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@ -90,9 +89,9 @@ var
b: integer;
begin
if Layout = lyHorizontal then
b := Round(p / (Width - 12) * 255)
b := Round(p * 255 / (Width - 12))
else
b := Round(255 - p / (Height - 12) * 255);
b := Round(255 - p * 255 / (Height - 12));
Clamp(b, 0, 255);
Result := b;
end;
@ -138,6 +137,7 @@ begin
Result := ArrowPosFromBlue(FBlue);
end;
// Note: AValue is restricted to the range 0..255 by the size of the trackbar.
function TBColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := RGB(FRed, FGreen, AValue);
@ -198,6 +198,8 @@ end;
procedure TBColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
FChange := false;
SetRed(GetRValue(c));
SetGreen(GetGValue(c));

50
components/mbColorLib/GAxisColorPicker.pas
View File

@ -7,7 +7,7 @@ unit GAxisColorPicker;
interface
uses
LCLType, LCLIntf, LMessages, SysUtils, Classes, Controls, Graphics, Math, Forms,
LCLType, LCLIntf, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, mbColorPickerControl;
type
@ -22,7 +22,6 @@ type
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetColorAtPoint(x, y: Integer): TColor; override;
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@ -33,11 +32,12 @@ type
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
published
property SelectedColor default clLime;
property RValue: integer read FR write SetRValue default 0;
property GValue: integer read FG write SetGValue default 255;
property BValue: integer read FB write SetBValue default 0;
property Red: integer read FR write SetRValue default 0;
property Green: integer read FG write SetGValue default 255;
property Blue: integer read FB write SetBValue default 0;
property MarkerStyle default msCircle;
property OnChange;
end;
@ -177,13 +177,14 @@ end;
procedure TGAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SetFocus;
end;
@ -195,11 +196,12 @@ begin
begin
mxx := X;
myy := Y;
FSelected := GetColorAtPoint(X, Y);
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
@ -210,18 +212,18 @@ begin
begin
mxx := X;
myy := Y;
FSelected := GetColorAtPoint(X, Y);
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(FOnChange) then FOnChange(Self);
end;
end;
procedure TGAxisColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
@ -243,9 +245,13 @@ end;
procedure TGAxisColorPicker.SetGValue(g: integer);
begin
Clamp(g, 0, 255);
if FG = g then
begin
FG := g;
CreateGradient;
SetSelectedColor(RGB(FR, FG, FB));
end;
end;
procedure TGAxisColorPicker.SetRValue(r: integer);
begin
@ -255,18 +261,24 @@ begin
end;
procedure TGAxisColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
if g <> FG then
CreateGradient;
FR := r;
FG := g;
FB := b;
FSelected := c;
FManual := false;
mxx := Round(FB * Width / 255); // BLUE is x
myy := Round((255 - FR) * Height / 255); // RED is y
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(FOnChange) then FOnChange(Self);
end;
end.

12
components/mbColorLib/GColorPicker.pas
View File

@ -67,13 +67,12 @@ var
begin
if Layout = lyHorizontal then
begin
a := Round(((Width - 12)/255)*g);
a := Round((Width - 12) / 255 * g);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
g := 255 - g;
a := Round(((Height - 12)/255)*g);
a := Round((Height - 12) * (255 - g) / 255);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@ -121,6 +120,7 @@ begin
Result := ArrowPosFromGreen(FGreen);
end;
// Note: AValue is restricted to the range 0..255 by the size of the trackbar.
function TGColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := RGB(FRed, AValue, FBlue);
@ -144,9 +144,9 @@ var
g: integer;
begin
if Layout = lyHorizontal then
g := Round(p/((Width - 12)/255))
g := Round(p * 255 / (Width - 12))
else
g := Round(255 - p/((Height - 12)/255));
g := Round(255 - p * 255 / (Height - 12));
Clamp(g, 0, 255);
Result := g;
end;
@ -193,6 +193,8 @@ end;
procedure TGColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
FChange := false;
SetRed(GetRValue(c));
SetBlue(GetBValue(c));

2
components/mbColorLib/HRingPicker.pas
View File

@ -19,7 +19,7 @@ type
FSelectedColor: TColor;
FManual: boolean;
mx, my, mdx, mdy: integer;
FChange: boolean;
//FChange: boolean;
FRadius: integer;
FDoChange: boolean;
FDragging: Boolean;

7
components/mbColorLib/HSLColorPicker.pas
View File

@ -14,7 +14,7 @@ uses
type
THSLColorPicker = class(TmbBasicPicker)
private
FOnChange: TNotifyEvent;
//FOnChange: TNotifyEvent;
FHSPicker: THSColorPicker;
FLPicker: TLColorPicker;
FSelectedColor: TColor;
@ -93,7 +93,7 @@ type
property TabOrder;
property Color;
property ParentColor default true;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChange; //: TNotifyEvent read FOnChange write FOnChange;
property OnMouseMove;
end;
@ -170,8 +170,7 @@ begin
FRValue := GetRValue(FLPicker.SelectedColor);
FGValue := GetGValue(FLPicker.SelectedColor);
FBValue := GetBValue(FLPicker.SelectedColor);
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

10
components/mbColorLib/HSLRingPicker.pas
View File

@ -14,7 +14,7 @@ uses
type
THSLRingPicker = class(TmbBasicPicker)
private
FOnChange: TNotifyEvent;
//FOnChange: TNotifyEvent;
FRingPicker: THRingPicker;
FSLPicker: TSLColorPicker;
FSelectedColor: TColor;
@ -90,10 +90,7 @@ type
property TabOrder;
property Color;
property ParentColor default true;
{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
property ParentBackground default true;
{$ENDIF} {$ENDIF}
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChange; //: TNotifyEvent read FOnChange write FOnChange;
property OnMouseMove;
end;
@ -169,8 +166,7 @@ begin
FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor);
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
procedure THSLRingPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

2
components/mbColorLib/HSVColorPicker.pas
View File

@ -20,7 +20,7 @@ type
FShowSatCirc: boolean;
FShowHueLine: boolean;
FShowSelCirc: boolean;
FChange: boolean;
//FChange: boolean;
FDoChange: boolean;
function RadHue(New: integer): integer;
function GetHue: Integer;

8
components/mbColorLib/HexaColorPicker.pas
View File

@ -46,7 +46,8 @@ type
mX, mY: integer;
FHintFormat: string;
FUnderCursor: TColor;
FOnChange, FOnIntensityChange: TNotifyEvent;
//FOnChange,
FOnIntensityChange: TNotifyEvent;
FCurrentColor: TColor;
FSelectedIndex: Integer;
FColorCombRect, FBWCombRect, FSliderRect, FCustomColorRect: TRect;
@ -137,7 +138,7 @@ type
property DragMode;
property DragKind;
property Constraints;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChange; //: TNotifyEvent read FOnChange write FOnChange;
property OnIntensityChange: TNotifyEvent read FOnIntensityChange write FOnIntensityChange;
property OnDblClick;
property OnContextPopup;
@ -1281,8 +1282,7 @@ procedure THexaColorPicker.SelectColor(Color: TColor);
begin
SelectAvailableColor(Color);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
procedure THexaColorPicker.SetIntensity(v: integer);

45
components/mbColorLib/RAxisColorPicker.pas
View File

@ -5,7 +5,7 @@ unit RAxisColorPicker;
interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, mbColorPickerControl;
type
@ -20,7 +20,6 @@ type
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetColorAtPoint(x, y: Integer): TColor; override;
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
@ -31,6 +30,7 @@ type
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
published
property SelectedColor default clRed;
property Red: integer read FR write SetRValue default 255;
@ -174,23 +174,18 @@ begin
end;
procedure TRAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
ClipCursor(@R);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SetFocus;
end;
@ -202,7 +197,9 @@ begin
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
@ -217,7 +214,9 @@ begin
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
@ -227,15 +226,14 @@ end;
procedure TRAxisColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBmp);
CorrectCoords(mxx, myy);
DrawMarker(mxx, myy);
end;
procedure TRAxisColorPicker.Resize;
begin
FManual := false;
myy := Round((255 - FG) * Height / 255);
mxx := Round(FB * Width / 255);
myy := Round((255 - FG) * Height / 255);
inherited;
end;
@ -256,20 +254,31 @@ end;
procedure TRAxisColorPicker.SetRValue(r: integer);
begin
Clamp(r, 0, 255);
if FR <> r then
begin
FR := r;
CreateGradient;
SetSelectedColor(RGBtoColor(FR, FG, FB));
end;
end;
procedure TRAxisColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
if r <> FR then
CreateGradient;
FR := r;
FG := g;
FB := b;
FSelected := c;
FManual := false;
myy := Round((255 - FG) * Height / 255); // GREEN on y
mxx := Round(FB * Width / 255); // BLUE on x
myy := Round((255 - FG) * Height / 255); // GREEN on y
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;

8
components/mbColorLib/RColorPicker.pas
View File

@ -73,8 +73,7 @@ begin
end
else
begin
r := 255 - r;
a := Round((Height - 12) / 255 * r);
a := Round((Height - 12) * (255 - r) / 255);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@ -122,6 +121,7 @@ begin
Result := ArrowPosFromRed(FRed);
end;
// Note: AValue is restricted to the range 0..255 by the size of the trackbar.
function TRColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := RGB(AValue, FGreen, FBlue);
@ -194,13 +194,15 @@ end;
procedure TRColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
FChange := false;
SetGreen(GetGValue(c));
SetBlue(GetBValue(c));
SetRed(GetRValue(c));
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
if Assigned(OnChange) then OnChange(self);
end;
end.

2
components/mbColorLib/SLColorPicker.pas
View File

@ -14,7 +14,7 @@ type
private
FHue, FSat, FLum: Double;
FMaxHue, FMaxSat, FMaxLum: integer;
FChange: boolean;
//FChange: boolean;
procedure DrawMarker(x, y: integer);
procedure SelectionChanged(x, y: integer);
procedure UpdateCoords;

7
components/mbColorLib/SLHColorPicker.pas
View File

@ -12,7 +12,7 @@ uses
type
TSLHColorPicker = class(TmbBasicPicker)
private
FOnChange: TNotifyEvent;
//FOnChange: TNotifyEvent;
FSLPicker: TSLColorPicker;
FHPicker: THColorPicker;
FSelectedColor: TColor;
@ -83,7 +83,7 @@ type
property TabOrder;
property Color;
property ParentColor default true;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChange; //: TNotifyEvent read FOnChange write FOnChange;
property OnMouseMove;
end;
@ -176,8 +176,7 @@ begin
FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor);
if Assigned(FOnChange) then
FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
procedure TSLHColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

78
components/mbColorLib/examples/axispickers/axispickers.lpi Normal file
View File

@ -0,0 +1,78 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="axispickers"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="mbColorLibLaz"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="axispickers.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="axispickers"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/mbColorLib/examples/axispickers/axispickers.lpr Normal file
View File

@ -0,0 +1,21 @@
program axispickers;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

152
components/mbColorLib/examples/axispickers/main.lfm Normal file
View File

@ -0,0 +1,152 @@
object Form1: TForm1
Left = 280
Height = 450
Top = 130
Width = 516
Caption = 'AxisPickers'
ClientHeight = 450
ClientWidth = 516
OnCreate = FormCreate
LCLVersion = '1.7'
object PageControl1: TPageControl
Left = 4
Height = 442
Top = 4
Width = 508
ActivePage = PgRED
Align = alClient
BorderSpacing.Around = 4
TabIndex = 0
TabOrder = 0
object PgRED: TTabSheet
Caption = 'Picker based on RED'
ClientHeight = 414
ClientWidth = 500
object PanelRED: TPanel
Left = 0
Height = 414
Top = 0
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 414
ClientWidth = 500
TabOrder = 0
OnPaint = PanelREDPaint
object RColorPicker1: TRColorPicker
Left = 24
Height = 390
Top = 0
Width = 22
HintFormat = 'Red: %value (selected)'
Align = alLeft
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
TabOrder = 0
OnChange = RColorPicker1Change
SelectedColor = 8421631
end
object RAxisColorPicker1: TRAxisColorPicker
Left = 76
Height = 378
Top = 6
Width = 418
HintFormat = 'G: %g B: %b'#13'Hex: %hex'
Anchors = [akTop, akLeft, akRight]
Align = alClient
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
BorderSpacing.Around = 6
TabOrder = 1
OnChange = RAxisColorPicker1Change
end
end
end
object PgGREEN: TTabSheet
Caption = 'Picker based on GREEN'
ClientHeight = 414
ClientWidth = 500
object PanelGREEN: TPanel
Left = 0
Height = 414
Top = 0
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 414
ClientWidth = 500
TabOrder = 0
OnPaint = PanelGREENPaint
object GColorPicker1: TGColorPicker
Left = 24
Height = 390
Top = 0
Width = 22
HintFormat = 'Green: %value (selected)'
Align = alLeft
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
TabOrder = 0
OnChange = GColorPicker1Change
SelectedColor = 8454016
end
object GAxisColorPicker1: TGAxisColorPicker
Left = 76
Height = 378
Top = 6
Width = 418
HintFormat = 'R: %r B: %b'#13'Hex: %hex'
Align = alClient
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
BorderSpacing.Around = 6
TabOrder = 1
OnChange = GAxisColorPicker1Change
end
end
end
object PgBLUE: TTabSheet
Caption = 'Picker based on BLUE'
ClientHeight = 414
ClientWidth = 500
object PanelBLUE: TPanel
Left = 0
Height = 414
Top = 0
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 414
ClientWidth = 500
TabOrder = 0
OnPaint = PanelBLUEPaint
object BColorPicker1: TBColorPicker
Left = 24
Height = 390
Top = 0
Width = 22
HintFormat = 'Blue: %value (selected)'
Align = alLeft
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
TabOrder = 0
OnChange = BColorPicker1Change
SelectedColor = 16744576
end
object BAxisColorPicker1: TBAxisColorPicker
Left = 76
Height = 378
Top = 6
Width = 418
HintFormat = 'R: %r G: %g'#13'Hex: %hex'
Align = alClient
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
BorderSpacing.Around = 6
TabOrder = 1
OnChange = BAxisColorPicker1Change
end
end
end
end
end

201
components/mbColorLib/examples/axispickers/main.pas Normal file
View File

@ -0,0 +1,201 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, ComCtrls, RAxisColorPicker, RColorPicker, GColorPicker,
GAxisColorPicker, BColorPicker, BAxisColorPicker;
type
{ TForm1 }
TForm1 = class(TForm)
PageControl1: TPageControl;
RAxisColorPicker1: TRAxisColorPicker;
BAxisColorPicker1: TBAxisColorPicker;
GAxisColorPicker1: TGAxisColorPicker;
RColorPicker1: TRColorPicker;
BColorPicker1: TBColorPicker;
GColorPicker1: TGColorPicker;
PanelBLUE: TPanel;
PanelGREEN: TPanel;
PanelRED: TPanel;
PgRED: TTabSheet;
PgGREEN: TTabSheet;
PgBLUE: TTabSheet;
procedure BAxisColorPicker1Change(Sender: TObject);
procedure BColorPicker1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GAxisColorPicker1Change(Sender: TObject);
procedure GColorPicker1Change(Sender: TObject);
procedure PanelBLUEPaint(Sender: TObject);
procedure PanelGREENPaint(Sender: TObject);
procedure PanelREDPaint(Sender: TObject);
procedure RAxisColorPicker1Change(Sender: TObject);
procedure RColorPicker1Change(Sender: TObject);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
Types, GraphUtil;
{ TForm1 }
procedure TForm1.BAxisColorPicker1Change(Sender: TObject);
begin
BColorPicker1.SelectedColor := BAxisColorPicker1.SelectedColor;
end;
procedure TForm1.BColorPicker1Change(Sender: TObject);
begin
BAxisColorPicker1.SelectedColor := BColorPicker1.SelectedColor;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
RAxisColorPicker1.SelectedColor := clRed;
GAxisColorPicker1.SelectedColor := clGreen;
BAxisColorPicker1.SelectedColor := clBlue;
end;
procedure TForm1.GAxisColorPicker1Change(Sender: TObject);
begin
GColorPicker1.SelectedColor := GAxisColorPicker1.SelectedColor;
end;
procedure TForm1.GColorPicker1Change(Sender: TObject);
begin
GAxisColorPicker1.SelectedColor := GColorPicker1.SelectedColor;
end;
// On BlueAxisPicker, x is RED, y is GREEN
procedure TForm1.PanelBLUEPaint(Sender: TObject);
var
x, y: Integer;
Rr, Rg, Rb: TSize;
begin
PanelBLUE.Canvas.Font.Assign(PanelRED.Font);
Rr := PanelBLUE.Canvas.TextExtent('red');
Rg := PanelBLUE.Canvas.TextExtent('green');
Rb := PanelBLUE.Canvas.TextExtent('blue');
x := BAxisColorPicker1.Left + (BAxisColorPicker1.Width - Rr.CX) div 2;
y := BAxisColorPicker1.Top + BAxisColorPicker1.Height + 4;
PanelBLUE.Canvas.TextOut(x, y, 'red');
x := x + Rr.CX div 2;
y := y + Rr.CY div 2;
DrawArrow(PanelBLUE.Canvas, sdRight, Point(x + 16, y), 16, atArrows);
PanelBLUE.Canvas.Font.Orientation := 900;
x := BColorPicker1.Left - Rb.CY - 4;
y := BColorPicker1.Top + (BColorPicker1.Height + Rb.CX) div 2;
PanelBLUE.Canvas.TextOut(x, y, 'blue');
x := x + Rb.CY * 3 div 4;
y := y - Rb.CX - 16;
DrawArrow(PanelBLUE.Canvas, sdUp, Point(x, y + 8), 16, atArrows);
x := BAxisColorPicker1.Left - Rg.CY - 4;
y := BAxisColorPicker1.Top + (BAxisColorPicker1.Height + Rg.CX) div 2;
PanelBLUE.Canvas.TextOut(x, y, 'green');
x := x + Rg.CY * 3 div 4;
y := y - Rg.CX - 16;
DrawArrow(PanelBLUE.Canvas, sdUp, Point(x, y + 8), 16, atArrows);
end;
// on GreenAxisPicker, x is BLUE, y is RED
procedure TForm1.PanelGREENPaint(Sender: TObject);
var
x, y: Integer;
Rr, Rg, Rb: TSize;
begin
PanelGREEN.Canvas.Font.Assign(PanelGREEN.Font);
Rr := PanelGREEN.Canvas.TextExtent('red');
Rg := PanelGREEN.Canvas.TextExtent('green');
Rb := PanelGREEN.Canvas.TextExtent('blue');
x := GAxisColorPicker1.Left + (GAxisColorPicker1.Width - Rb.CX) div 2;
y := GAxisColorPicker1.Top + GAxisColorPicker1.Height + 4;
PanelGREEN.Canvas.TextOut(x, y, 'blue');
x := x + Rb.CX div 2;
y := y + Rb.CY div 2;
DrawArrow(PanelGREEN.Canvas, sdRight, Point(x + 16, y), 16, atArrows); //Solid);
PanelGREEN.Canvas.Font.Orientation := 900;
x := GColorPicker1.Left - Rg.CY - 4;
y := GColorPicker1.Top + (GColorPicker1.Height + Rg.CX) div 2;
PanelGREEN.Canvas.TextOut(x, y, 'green');
x := x + Rg.CY * 3 div 4;
y := y - Rg.CX - 16;
DrawArrow(PanelGREEN.Canvas, sdUp, Point(x, y + 8), 16, atArrows);
x := GAxisColorPicker1.Left - Rr.CY - 4;
y := GAxisColorPicker1.Top + (GAxisColorPicker1.Height + Rr.CX) div 2;
PanelGREEN.Canvas.TextOut(x, y, 'red');
x := x + Rr.CY * 3 div 4;
y := y - Rr.CX - 16;
DrawArrow(PanelGREEN.Canvas, sdUp, Point(x, y + 8), 16, atArrows);
end;
procedure TForm1.PanelREDPaint(Sender: TObject);
var
x, y: Integer;
Rr, Rg, Rb: TSize;
begin
PanelRED.Canvas.Font.Assign(PanelRED.Font);
Rr := PanelRED.Canvas.TextExtent('red');
Rg := PanelRED.Canvas.TextExtent('green');
Rb := PanelRED.Canvas.TextExtent('blue');
x := RAxisColorPicker1.Left + (RAxisColorPicker1.Width - Rb.CX) div 2;
y := RAxisColorPicker1.Top + RAxisColorPicker1.Height + 4;
PanelRED.Canvas.TextOut(x, y, 'blue');
x := x + Rb.CX div 2;
y := y + Rb.CY div 2;
DrawArrow(PanelRED.Canvas, sdRight, Point(x + 16, y), 16, atArrows); //Solid);
PanelRED.Canvas.Font.Orientation := 900;
x := RColorPicker1.Left - Rr.CY - 4;
y := RColorPicker1.Top + (RColorPicker1.Height + Rr.CX) div 2;
PanelRED.Canvas.TextOut(x, y, 'red');
x := x + Rr.CY * 3 div 4;
y := y - Rr.CX - 16;
DrawArrow(PanelRED.Canvas, sdUp, Point(x, y + 8), 16, atArrows);
x := RAxisColorPicker1.Left - Rg.CY - 4;
y := RAxisColorPicker1.Top + (RAxisColorPicker1.Height + Rg.CX) div 2;
PanelRED.Canvas.TextOut(x, y, 'green');
x := x + Rg.CY * 3 div 4;
y := y - Rg.CX - 16;
DrawArrow(PanelRED.Canvas, sdUp, Point(x, y + 8), 16, atArrows);
end;
procedure TForm1.RAxisColorPicker1Change(Sender: TObject);
begin
RColorPicker1.SelectedColor := RAxisColorPicker1.SelectedColor;
end;
procedure TForm1.RColorPicker1Change(Sender: TObject);
begin
RAXisColorPicker1.SelectedColor := RColorPicker1.SelectedColor;
end;
end.

3
components/mbColorLib/mbBasicPicker.pas
View File

@ -15,9 +15,11 @@ type
TmbBasicPicker = class(TCustomControl)
private
FOnChange: TNotifyEvent;
FOnGetHintStr: TGetHintStrEvent;
protected
FBufferBmp: TBitmap;
FChange: Boolean;
FGradientWidth: Integer;
FGradientHeight: Integer;
FHintShown: Boolean;
@ -34,6 +36,7 @@ type
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
property ColorUnderCursor: TColor read GetColorUnderCursor;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnGetHintStr: TGetHintStrEvent read FOnGetHintStr write FOnGetHintStr;
public
constructor Create(AOwner: TComponent); override;

1
components/mbColorLib/mbColorPickerControl.pas
View File

@ -59,6 +59,7 @@ type
published
property Anchors;
property Align;
property BorderSpacing;
property ShowHint;
property ParentShowHint;
property Visible;

3
components/mbColorLib/mbColorTree.pas
View File

@ -7,7 +7,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, ComCtrls, Graphics, Themes,
GraphUtil, ImgList, Forms,
HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils;
HTMLColors;
type
TmbColor = record
@ -384,7 +384,6 @@ const
var
b: TBitmap;
BR, TR: TRect;
i, fx: integer;
s: string;
h: Integer;
begin

16
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -49,7 +49,6 @@ type
FPlacement: TSliderPlacement;
FSelIndicator: TSelIndicator;
FWebSafe: boolean;
FOnChange: TNotifyEvent;
procedure CalcPickRect;
procedure DrawMarker(p: integer);
procedure SetBevelInner(Value: TBevelCut);
@ -115,6 +114,7 @@ type
property ParentShowHint default true;
property Anchors;
property Align;
property BorderSpacing;
property Visible;
property Enabled;
property PopupMenu;
@ -123,7 +123,7 @@ type
property DragMode;
property DragKind;
property Constraints;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChange;
property OnContextPopup;
property OnGetHintStr;
property OnMouseDown;
@ -369,7 +369,7 @@ begin
Execute(TBA_WheelDown);
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
end;
@ -598,7 +598,7 @@ begin
Execute(TBA_VKCtrlUp);
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
VK_LEFT:
if FLayout = lyVertical then
@ -612,7 +612,7 @@ begin
Execute(TBA_VKCtrlLeft);
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
VK_RIGHT:
if FLayout = lyVertical then
@ -626,7 +626,7 @@ begin
Execute(TBA_VKCtrlRight);
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end;
VK_DOWN:
if FLayout = lyHorizontal then
@ -640,7 +640,7 @@ begin
Execute(TBA_VKCtrlDown);
FManual := true;
FChange := true;
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
end
else
eraseKey := false;
@ -732,7 +732,7 @@ begin
DrawMarker(FArrowPos);
if FDoChange then
begin
if Assigned(FOnChange) then FOnChange(Self);
if Assigned(OnChange) then OnChange(Self);
FDoChange := false;
end;
end;