You've already forked lazarus-ccr
mbColorLib: Apply standard code formatting
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5503 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -9,188 +9,186 @@ interface
|
||||
{$I mxs.inc}
|
||||
|
||||
uses
|
||||
{$IFDEF FPC}
|
||||
LCLIntf, LCLType, LMessages,
|
||||
{$ELSE}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
SysUtils, Classes, Controls, Graphics, StdCtrls, Forms,
|
||||
{$IFDEF DELPHI_7_UP} Themes, {$ENDIF} HTMLColors, RGBHSLUtils, Math,
|
||||
RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, mbBasicPicker;
|
||||
{$IFDEF FPC}
|
||||
LCLIntf, LCLType, LMessages,
|
||||
{$ELSE}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
SysUtils, Classes, Controls, Graphics, StdCtrls, Forms,
|
||||
{$IFDEF DELPHI_7_UP} Themes, {$ENDIF} HTMLColors, RGBHSLUtils, Math,
|
||||
RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, mbBasicPicker;
|
||||
|
||||
const
|
||||
CustomCell = -2;
|
||||
NoCell = -1;
|
||||
CustomCell = -2;
|
||||
NoCell = -1;
|
||||
|
||||
type
|
||||
TMarker = (smArrow, smRect);
|
||||
TMarker = (smArrow, smRect);
|
||||
|
||||
TCombEntry = record
|
||||
Position: TPoint;
|
||||
Color: COLORREF;
|
||||
TabIndex: integer;
|
||||
end;
|
||||
TCombEntry = record
|
||||
Position: TPoint;
|
||||
Color: COLORREF;
|
||||
TabIndex: integer;
|
||||
end;
|
||||
|
||||
TCombArray = array of TCombEntry;
|
||||
TCombArray = array of TCombEntry;
|
||||
|
||||
TFloatPoint = record
|
||||
X, Y: Extended;
|
||||
end;
|
||||
TFloatPoint = record
|
||||
X, Y: Extended;
|
||||
end;
|
||||
|
||||
TRGBrec = record
|
||||
Red, Green, Blue: Single;
|
||||
end;
|
||||
TRGBrec = record
|
||||
Red, Green, Blue: Single;
|
||||
end;
|
||||
|
||||
TSelectionMode = (smNone, smColor, smBW, smRamp);
|
||||
TSelectionMode = (smNone, smColor, smBW, smRamp);
|
||||
|
||||
THexaColorPicker = class(TmbBasicPicker)
|
||||
private
|
||||
FIncrement: integer;
|
||||
FSelectedCombIndex: integer;
|
||||
mX, mY: integer;
|
||||
FHintFormat: string;
|
||||
FUnderCursor: TColor;
|
||||
FOnChange, FOnIntensityChange: TNotifyEvent;
|
||||
FCurrentColor: TColor;
|
||||
FSelectedIndex: Integer;
|
||||
FColorCombRect, FBWCombRect, FSliderRect, FCustomColorRect: TRect;
|
||||
FCombSize, FLevels: Integer;
|
||||
FBWCombs, FColorCombs: TCombArray;
|
||||
FCombCorners: array[0..5] of TFloatPoint;
|
||||
FCenterColor: TRGBrec;
|
||||
FCenterIntensity: Single;
|
||||
FSliderWidth: integer;
|
||||
FCustomIndex: Integer; // If FSelectedIndex contains CustomCell then this index shows
|
||||
THexaColorPicker = class(TmbBasicPicker)
|
||||
private
|
||||
FIncrement: integer;
|
||||
FSelectedCombIndex: integer;
|
||||
mX, mY: integer;
|
||||
FHintFormat: string;
|
||||
FUnderCursor: TColor;
|
||||
FOnChange, FOnIntensityChange: TNotifyEvent;
|
||||
FCurrentColor: TColor;
|
||||
FSelectedIndex: Integer;
|
||||
FColorCombRect, FBWCombRect, FSliderRect, FCustomColorRect: TRect;
|
||||
FCombSize, FLevels: Integer;
|
||||
FBWCombs, FColorCombs: TCombArray;
|
||||
FCombCorners: array[0..5] of TFloatPoint;
|
||||
FCenterColor: TRGBrec;
|
||||
FCenterIntensity: Single;
|
||||
FSliderWidth: integer;
|
||||
FCustomIndex: Integer; // If FSelectedIndex contains CustomCell then this index shows
|
||||
// which index in the custom area has been selected.
|
||||
// Positive values indicate the color comb and negative values
|
||||
// indicate the B&W combs (complement). This value is offset with
|
||||
// 1 to use index 0 to show no selection.
|
||||
FRadius: Integer;
|
||||
FSelectionMode: TSelectionMode;
|
||||
FSliderVisible: boolean;
|
||||
FMarker: TMarker;
|
||||
FNewArrowStyle: boolean;
|
||||
FIntensityText: string;
|
||||
FRadius: Integer;
|
||||
FSelectionMode: TSelectionMode;
|
||||
FSliderVisible: boolean;
|
||||
FMarker: TMarker;
|
||||
FNewArrowStyle: boolean;
|
||||
FIntensityText: string;
|
||||
|
||||
procedure SetNewArrowStyle(Value: boolean);
|
||||
procedure SetMarker(Value: TMarker);
|
||||
procedure SetSliderVisible(Value: boolean);
|
||||
procedure SetRadius(r: integer);
|
||||
procedure SetSliderWidth(w: integer);
|
||||
procedure SetIntensity(v: integer);
|
||||
procedure ChangeIntensity(increase: boolean);
|
||||
procedure SelectColor(Color: TColor);
|
||||
procedure Initialize;
|
||||
procedure DrawAll;
|
||||
procedure SetSelectedColor(const Value: TColor);
|
||||
procedure DrawCombControls;
|
||||
procedure DrawComb(Canvas: TCanvas; X, Y, Size: Integer);
|
||||
procedure HandleCustomColors(var Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF});
|
||||
procedure CalculateCombLayout;
|
||||
procedure EndSelection;
|
||||
procedure EnumerateCombs;
|
||||
function SelectAvailableColor(Color: TColor): boolean;
|
||||
function GetIntensity: integer;
|
||||
function HandleBWArea(const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean;
|
||||
function HandleColorComb(const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean;
|
||||
function HandleSlider(const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean;
|
||||
function PtInComb(Comb: TCombEntry; P: TPoint; Scale: Integer): Boolean;
|
||||
function FindBWArea(X, Y: Integer): Integer;
|
||||
function FindColorArea(X, Y: Integer): Integer;
|
||||
function GetNextCombIndex(i: integer): integer;
|
||||
function GetPreviousCombIndex(i: integer): integer;
|
||||
protected
|
||||
procedure CreateWnd; override;
|
||||
procedure Paint; override;
|
||||
procedure Resize; override;
|
||||
procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
{$IFDEF DELPHI}
|
||||
procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
|
||||
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
||||
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
|
||||
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
||||
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
|
||||
{$ELSE}
|
||||
procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
|
||||
procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
|
||||
procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
|
||||
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
|
||||
procedure WMMouseMove(var Message: TLMMouseMove); message LM_MOUSEMOVE;
|
||||
{$ENDIF}
|
||||
procedure SetNewArrowStyle(Value: boolean);
|
||||
procedure SetMarker(Value: TMarker);
|
||||
procedure SetSliderVisible(Value: boolean);
|
||||
procedure SetRadius(r: integer);
|
||||
procedure SetSliderWidth(w: integer);
|
||||
procedure SetIntensity(v: integer);
|
||||
procedure ChangeIntensity(increase: boolean);
|
||||
procedure SelectColor(Color: TColor);
|
||||
procedure Initialize;
|
||||
procedure DrawAll;
|
||||
procedure SetSelectedColor(const Value: TColor);
|
||||
procedure DrawCombControls;
|
||||
procedure DrawComb(Canvas: TCanvas; X, Y, Size: Integer);
|
||||
procedure HandleCustomColors(var Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF});
|
||||
procedure CalculateCombLayout;
|
||||
procedure EndSelection;
|
||||
procedure EnumerateCombs;
|
||||
function SelectAvailableColor(Color: TColor): boolean;
|
||||
function GetIntensity: integer;
|
||||
function HandleBWArea(const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean;
|
||||
function HandleColorComb(const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean;
|
||||
function HandleSlider(const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean;
|
||||
function PtInComb(Comb: TCombEntry; P: TPoint; Scale: Integer): Boolean;
|
||||
function FindBWArea(X, Y: Integer): Integer;
|
||||
function FindColorArea(X, Y: Integer): Integer;
|
||||
function GetNextCombIndex(i: integer): integer;
|
||||
function GetPreviousCombIndex(i: integer): integer;
|
||||
protected
|
||||
procedure CreateWnd; override;
|
||||
procedure Paint; override;
|
||||
procedure Resize; override;
|
||||
procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||||
{$IFDEF DELPHI}
|
||||
procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
|
||||
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
||||
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
|
||||
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
|
||||
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
|
||||
{$ELSE}
|
||||
procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
|
||||
procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
|
||||
procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
|
||||
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
|
||||
procedure WMMouseMove(var Message: TLMMouseMove); message LM_MOUSEMOVE;
|
||||
{$ENDIF}
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure SelectCombIndex(i: integer);
|
||||
function GetSelectedCombIndex: integer;
|
||||
function GetColorUnderCursor: TColor;
|
||||
function GetHexColorUnderCursor: string;
|
||||
function GetColorAtPoint(X, Y: integer): TColor;
|
||||
function GetHexColorAtPoint(X, Y: integer): string;
|
||||
property ColorUnderCursor: TColor read GetColorUnderCursor;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property HintFormat: string read FHintFormat write FHintFormat;
|
||||
property SelectedColor: TColor read FCurrentColor write SetSelectedColor default clBlack;
|
||||
property Intensity: integer read GetIntensity write SetIntensity default 100;
|
||||
property IntensityIncrement: integer read FIncrement write FIncrement default 1;
|
||||
property SliderVisible: boolean read FSliderVisible write SetSliderVisible default true;
|
||||
property SliderMarker: TMarker read FMarker write SetMarker default smArrow;
|
||||
property NewArrowStyle: boolean read FNewArrowStyle write SetNewArrowStyle default false;
|
||||
property IntensityText: string read FIntensityText write FIntensityText;
|
||||
property ShowHint default true;
|
||||
property TabStop default true;
|
||||
property Visible;
|
||||
property Enabled;
|
||||
property PopupMenu;
|
||||
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
|
||||
property ParentBackground default true;
|
||||
{$ENDIF}{$ENDIF}
|
||||
property TabOrder;
|
||||
property Color;
|
||||
property ParentColor;
|
||||
property SliderWidth: integer read FSliderWidth write SetSliderWidth default 12;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property DragKind;
|
||||
property Constraints;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnIntensityChange: TNotifyEvent read FOnIntensityChange write FOnIntensityChange;
|
||||
property OnDblClick;
|
||||
property OnContextPopup;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelUp;
|
||||
property OnMouseWheelDown;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnResize;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
procedure SelectCombIndex(i: integer);
|
||||
function GetSelectedCombIndex: integer;
|
||||
function GetColorUnderCursor: TColor;
|
||||
function GetHexColorUnderCursor: string;
|
||||
function GetColorAtPoint(X, Y: integer): TColor;
|
||||
function GetHexColorAtPoint(X, Y: integer): string;
|
||||
property ColorUnderCursor: TColor read GetColorUnderCursor;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property HintFormat: string read FHintFormat write FHintFormat;
|
||||
property SelectedColor: TColor read FCurrentColor write SetSelectedColor default clBlack;
|
||||
property Intensity: integer read GetIntensity write SetIntensity default 100;
|
||||
property IntensityIncrement: integer read FIncrement write FIncrement default 1;
|
||||
property SliderVisible: boolean read FSliderVisible write SetSliderVisible default true;
|
||||
property SliderMarker: TMarker read FMarker write SetMarker default smArrow;
|
||||
property NewArrowStyle: boolean read FNewArrowStyle write SetNewArrowStyle default false;
|
||||
property IntensityText: string read FIntensityText write FIntensityText;
|
||||
property ShowHint default true;
|
||||
property TabStop default true;
|
||||
property Visible;
|
||||
property Enabled;
|
||||
property PopupMenu;
|
||||
{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
|
||||
property ParentBackground default true;
|
||||
{$ENDIF}{$ENDIF}
|
||||
property TabOrder;
|
||||
property Color;
|
||||
property ParentColor;
|
||||
property SliderWidth: integer read FSliderWidth write SetSliderWidth default 12;
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property DragKind;
|
||||
property Constraints;
|
||||
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnIntensityChange: TNotifyEvent read FOnIntensityChange write FOnIntensityChange;
|
||||
property OnDblClick;
|
||||
property OnContextPopup;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelUp;
|
||||
property OnMouseWheelDown;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnResize;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
const
|
||||
DefCenterColor: TRGBrec =(Red: 1; Green: 1; Blue: 1); // White
|
||||
DefColors: array[0..5] of TRGBrec = (
|
||||
(Red: 1; Green: 0; Blue: 1), // Magenta
|
||||
(Red: 1; Green: 0; Blue: 0), // Red
|
||||
(Red: 1; Green: 1; Blue: 0), // Yellow
|
||||
(Red: 0; Green: 1; Blue: 0), // Green
|
||||
(Red: 0; Green: 1; Blue: 1), // Cyan
|
||||
(Red: 0; Green: 0; Blue: 1) // Blue
|
||||
);
|
||||
DefCenter: TFloatPoint = (X: 0; Y: 0);
|
||||
const
|
||||
DefCenterColor: TRGBrec =(Red: 1; Green: 1; Blue: 1); // White
|
||||
DefColors: array[0..5] of TRGBrec = (
|
||||
(Red: 1; Green: 0; Blue: 1), // Magenta
|
||||
(Red: 1; Green: 0; Blue: 0), // Red
|
||||
(Red: 1; Green: 1; Blue: 0), // Yellow
|
||||
(Red: 0; Green: 1; Blue: 0), // Green
|
||||
(Red: 0; Green: 1; Blue: 1), // Cyan
|
||||
(Red: 0; Green: 0; Blue: 1) // Blue
|
||||
);
|
||||
DefCenter: TFloatPoint = (X: 0; Y: 0);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
Reference in New Issue
Block a user