unit GraphicComponents;

interface

uses
	SysUtils, Windows, Messages, Classes, Graphics, Controls,
	Forms, Dialogs, Grids, StdCtrls, Themes;

type
	TOnChanged = procedure(sender: TObject) of object;
	TWrapStyle = (wrHorVer, wrVerHor);

	TOnDrawStyle = procedure (aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect) of object;
	TStyleGrid = class(TCustomGrid)
	private
		FCount,
		FSelected: integer;
		FOnChanged: TOnChanged;
		FWrapStyle: TWrapStyle;
		PreventSizing: Boolean;
		FOnDrawStyle: TOnDrawStyle;

	protected
		function IsValidIndex(anIndex: integer): boolean;
		function CalcIndex(aCol, aRow: longint): integer;
		function CalcRow(anIndex: integer): longint;
		function CalcCol(anIndex: integer): longint;
		procedure UpdateCellSizes(DoRepaint: Boolean);

		procedure DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect); virtual;
		procedure DrawCell(aCol, aRow: Longint; aRect: TRect; aState: TGridDrawState);
			override;
		function SelectCell(aCol, aRow: Longint): Boolean; override;
		procedure WMSize(var Message: TWMSize); message WM_SIZE;

		procedure SetSelected(anIndex: integer);
		function GetColCount: integer;
		procedure SetColCount(aColCount: integer);
		procedure SetCount(aCount: integer);
		procedure SetWrapStyle(aWrapStyle: TWrapStyle);

		procedure MouseDown(aButton: TMouseButton; aShift: TShiftState; aX, aY: Integer);
			override;

		procedure CMEnabledChanged(var aMsg: TMessage); message CM_ENABLEDCHANGED;
	public
		property Selected: integer read FSelected write SetSelected;

		function IsUnselected: Boolean;
		procedure Unselect;

		procedure InvalidateStyle(aStyleIndex: Integer);
		constructor Create(anOwner: TComponent); override;
	published
		property Align;
		property BorderStyle;
		property Ctl3D;
		property ParentCtl3D;
		property Enabled;
		property Color;
		property ParentColor;
    property ParentBackground;

		property PopupMenu;
		property WrapStyle: TWrapStyle read FWrapStyle write SetWrapStyle;
		property Count: Integer read FCount write SetCount;
		property ColCount: Integer read GetColCount write SetColCount;
		property OnDrawStyle: TOnDrawStyle read FOnDrawStyle write FOnDrawStyle;
		property OnChanged: TOnChanged read FOnChanged write FOnChanged;

		property OnClick;
		property OnDblClick;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDrag;
		property OnEnter;
		property OnExit;
		property OnKeyDown;
		property OnKeyPress;
		property OnKeyUp;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnStartDrag;
	end;


	TBrushStyleGrid = class(TStyleGrid)
	protected
		FTransparency: Byte;
		FBackColor: TColor;
		FHatchColor: TColor;

		procedure DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect); override;

		procedure SetStyle(aStyle: TBrushStyle);
		function GetStyle: TBrushStyle;

		procedure SetBackColor(aValue: TColor);
		procedure SetHatchColor(aValue: TColor);
		procedure SetTransparency(aValue: Byte);

		property Count;
	public
		constructor Create(anOwner: TComponent); override;

	published
		property Style: TBrushStyle read GetStyle write SetStyle;
    property Transparency: Byte read FTransparency write SetTransparency;
		property BackColor: TColor read FBackColor write SetBackColor;
		property HatchColor: TColor read FHatchColor write SetHatchColor;
	end;

{	TPenStyle }

	TPenStyleGrid = class(TStyleGrid)
	protected
		FPenColor: TColor;

		procedure SetStyle(aStyle: TPenStyle);
		function GetStyle: TPenStyle;
		procedure DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect); override;

		procedure SetPenColor(aValue: TColor);
		property Count;
	public
		constructor Create(anOwner: TComponent); override;
		procedure Loaded; override;
		property PenColor: TColor read FPenColor write SetPenColor;
		property Style: TPenStyle read GetStyle write SetStyle;
	end;

{	TColorSelector }

	TColorPalette = class(TStyleGrid)
	private
		FPalette: TList;

		function GetColorCount: Integer;
		procedure SetColorCount(aValue: Integer);
		function GetColor(anIndex: Integer): TColor;
		procedure SetColor(anIndex: Integer; aValue: TColor);
		function GetSelectedColor: TColor;
	protected
		procedure DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect); override;

		property Count;
	public
		constructor Create(anOwner: TComponent); override;
		destructor Destroy; override;

		function IndexOfColor(aColor: TColor): Integer;

		property Colors[anIndex: Integer]: TColor read GetColor write SetColor;
		property SelectedColor: TColor read GetSelectedColor;
	published
		property ColorCount: Integer read GetColorCount write SetColorCount;
	end;

{	TBatternBitsGrid }

	TPatternBits = array [0..7] of byte;

	TPatternBitsGrid = class(TCustomGrid)
	private
		FSetBitColor: TColor;
		FClearBitColor: TColor;
		FPatternBits: TPatternBits;
		FOnChanged: TOnChanged;
		PreventSizing: Boolean;
		PaintBit: boolean;
		PaintMode: boolean;

		procedure WMSize(var Message: TWMSize); message WM_SIZE;
		procedure UpdateCellSizes(doRepaint: Boolean);
		function GetBit(x, y: integer): boolean;
		procedure SetBit(x, y: integer; bit: boolean);
		property Bits[x, y: integer]: boolean read GetBit write SetBit;

	protected
		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 SetPatternBits(const aBits: TPatternBits);
		procedure SetSetBitColor(color: TColor);
		procedure SetClearBitColor(color: TColor);

		procedure DrawCell(
				aCol,
				aRow: Longint;
				aRect: TRect;
				aState: TGridDrawState); override;

	public
		constructor Create(anOwner: TComponent); override;
		property PatternBits: TPatternBits read FPatternBits write SetPatternBits;

	published

		property OnChanged: TOnChanged read FOnChanged write FOnChanged;
		property SetBitColor: TColor read FSetBitColor write SetSetBitColor;
		property ClearBitColor: TColor read FClearBitColor write SetClearBitColor;
	end;

{	TColorPicker }

	TCustomColors = array [0..15] of TColor;

	TColorPicker = class(TCustomControl)
	private
		FCustomColors: TCustomColors;
		FColor: TColor;
		Pressed: boolean;
		FOnChanged: TOnChanged;

		function GetCustomColor(Index: Integer): TColor;
		procedure SetCustomColor(Index: Integer; const Value: TColor);
	protected
		procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
			X, Y: Integer); override;
		procedure Paint; override;

		procedure SetColor(aColor: TColor);
	public
		constructor Create(anOwner: TComponent); override;
		property CustomColors[Index: Integer]: TColor read GetCustomColor write SetCustomColor;
	published
		property Color: TColor read FColor write SetColor;
		property OnChanged: TOnChanged read FOnChanged write FOnChanged;
	end;

	TFloatEdit = class(TCustomEdit)
	private
		FValue: Double;
		FMinValue,
		FMaxValue: Double;
		FPrecision: Integer;
		FStrictCheck: Boolean;
		FTruncZeros: Boolean;
		FISSigned: boolean;

		function GetValue: Double;
		function CheckValue (NewValue: Double): Double;
		procedure SetPrecision(v: Integer);
		procedure SetValue (NewValue: Double);

	protected
		procedure CMExit(var Message: TCMExit); message CM_EXIT;

		function IsValidChar(Key: Char): Boolean; virtual;
		procedure KeyPress(var Key: Char); override;

	public
		constructor Create(Owner: TComponent); override;
	published
		property StrictCheck: Boolean read FStrictCheck write FStrictCheck default false;
		property TruncZeros: Boolean read FTruncZeros write FTruncZeros;

		property AutoSelect;
		property AutoSize;
		property Color;
		property Ctl3D;
		property DragCursor;
		property DragMode;
		property Enabled;
		property Font;
		property MaxLength;
		property MaxValue: Double read FMaxValue write FMaxValue;
		property MinValue: Double read FMinValue write FMinValue;
		property ParentColor;
		property ParentCtl3D;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property Precision: Integer read FPrecision write SetPrecision default 2 ;
		property ReadOnly;
		property ShowHint;
		property IsSigned: boolean read FISSigned write FISSigned default true;
		property TabOrder;
		property TabStop;
		property Value: Double read GetValue write SetValue;
		property Visible;
		property OnChange;
		property OnClick;
		property OnDblClick;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDrag;
		property OnEnter;
		property OnExit;
		property OnKeyDown;
		property OnKeyPress;
		property OnKeyUp;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
	end;



implementation
uses
	InSysUtils, ExtCtrls, GraphicUtils;

{	TStyleGrid }

constructor TStyleGrid.Create(anOwner: TComponent);
begin
	inherited Create(anOwner);
	FixedRows := 0;
	FixedCols := 0;

	DefaultDrawing := False;
	Options := [];

	FWrapStyle := wrHorVer;
	FCount := 1;
	FSelected := 0;
	RowCount := 1;
	ColCount := 1;
	PreventSizing := False;
	ScrollBars := ssNone;
	FOnChanged := nil;
end;

procedure TStyleGrid.CMEnabledChanged(var aMsg: TMessage);
begin
	inherited;
	Invalidate;
end;

function TStyleGrid.IsValidIndex(anIndex: integer): boolean;
begin
	result := (anIndex >= 0) and (anIndex < Count);
end;

function TStyleGrid.CalcIndex(aCol, aRow: longint): integer;
begin
	if FWrapStyle = wrHorVer then
		result := aRow * ColCount + aCol
	else
		result := aCol * RowCount + aRow;
end;

function TStyleGrid.CalcRow(anIndex: integer): longint;
begin
	if FWrapStyle = wrHorVer then
		if ColCount > 0 then
			Result := anIndex div ColCount
		else
			Result := 0
	else
		if ColCount > 0 then
			Result := anIndex mod ColCount
		else
			Result := 0
end;

function TStyleGrid.CalcCol(anIndex: integer): longint;
begin
	if FWrapStyle = wrHorVer then
		if ColCount > 0 then
			Result := anIndex mod ColCount
		else
			Result := 0
	else
		if ColCount > 0 then
			Result := anIndex div ColCount
		else
			Result := 0
end;

procedure TStyleGrid.InvalidateStyle(aStyleIndex: Integer);
begin
	InvalidateCell(CalcCol(aStyleIndex), CalcRow(aStyleIndex));
end;
	
function TStyleGrid.SelectCell(aCol, aRow: Longint): Boolean;
var
	i: integer;
begin
	i := CalcIndex(aCol, aRow);
	if IsValidIndex(i) then begin
		FSelected := i;
		if Assigned(FOnChanged) then
			FOnChanged(Self);
		Result := True;
	end
	else
		Result := False;
end;

procedure TStyleGrid.SetSelected(anIndex: integer);
begin
	if FSelected <> anIndex then begin
		if IsValidIndex(anIndex) then begin
			FSelected := anIndex;
			Col := CalcCol(anIndex);
			Row := CalcRow(anIndex);
		end
		else begin
			FSelected := -1;
			InvalidateCell(Col, Row);
		end;
		if Assigned(FOnChanged) then
			FOnChanged(Self);
	end;
end;

function TStyleGrid.GetColCount: integer;
begin
	Result := inherited ColCount;
end;

procedure TStyleGrid.SetColCount(aColCount: integer);
begin
	if aColCount <= FCount then begin
		inherited ColCount := aColCount;
		if aColCount = 0 then begin
			RowCount := 0;
			Unselect;
		end
		else
			RowCount := (FCount - 1) div aColCount + 1;
		UpdateCellSizes(False);
	end;
end;

procedure TStyleGrid.SetCount(aCount: integer);
begin
	FCount := aCount;
	if ColCount > FCount then
		ColCount := FCount
	else begin
		if ColCount = 0 then begin
			RowCount := 0;
			Unselect
		end
		else
			RowCount := (FCount - 1) div ColCount + 1;
		UpdateCellSizes(False);
	end;
end;

function TStyleGrid.IsUnselected: Boolean;
begin
	Result := FSelected = -1;
end;

procedure TStyleGrid.Unselect;
begin
	SetSelected(-1);
end;

procedure TStyleGrid.SetWrapStyle(aWrapStyle: TWrapStyle);
begin
	FWrapStyle := aWrapStyle;
	Invalidate;
end;

procedure TStyleGrid.MouseDown(aButton: TMouseButton; aShift: TShiftState;
	aX, aY: Integer);
begin
	if aButton = mbRight then begin
		inherited MouseDown(mbLeft, aShift, aX, aY);
		inherited MouseUp(mbLeft, aShift, aX, aY);
	end
	else
		inherited MouseDown(aButton, aShift, aX, aY);
end;

procedure TStyleGrid.DrawCell(
		aCol,
		aRow: Longint;
		aRect: TRect;
		aState: TGridDrawState);


	function UseParentBackGround: Boolean;
  begin
  	Result := ThemeServices.ThemesEnabled and
    	Assigned(Parent) and ParentBackground;
  end;


var
	index: integer;
begin
	index := CalcIndex(aCol, aRow);
	Canvas.Pen.Style := psSolid;
	if IsValidIndex(index) then begin
		if not Enabled then begin
			Frame3D(Canvas, aRect, clBtnFace, clBtnFace, 1);
			Frame3D(Canvas, aRect, clBtnShadow, clBtnHighlight, 1);
			Frame3D(Canvas, aRect, clBtnHighlight, clBtnShadow, 1);
		  if UseParentBackGround then
		  	Canvas.Brush.Style := bsClear
      else
				Canvas.Brush.Color := clBtnFace;
			Canvas.FillRect(aRect);
			Exit;
		end;
		if index = FSelected then begin
			Frame3D(Canvas, aRect, clBlack, clBlack, 1);
			Frame3D(Canvas, aRect, clWhite, clWhite, 1);
			Frame3D(Canvas, aRect, clBlack, clBlack, 1);
		end
		else begin
			Frame3D(Canvas, aRect, clBtnFace, clBtnFace, 1);
			Frame3D(Canvas, aRect, clBtnShadow, clBtnHighlight, 1);
			Frame3D(Canvas, aRect, clBlack, clBtnFace, 1);
		end;
		Canvas.Font.Assign(ValidParentForm(Self).Font);
		DrawStyle(Canvas, Index, aRect);
		InflateRect(aRect, 2, 2);
		if (index = FSelected) and (gdFocused in aState) then begin
			Canvas.Pen.Color := clBlack;
			SetBkColor(Canvas.Handle, ColorToRGB(clWhite));
			SetTextColor(Canvas.Handle, ColorToRGB(clBlack));
			Canvas.DrawFocusRect(aRect);
		end;
	end
	else begin
		Canvas.Brush.Color := clWindow;
		Canvas.FillRect(aRect);
	end;
	BrushAttrsEx(bsSolid, clWindow, clWindow, 0).AssignToCanvas(Canvas);
end;

procedure TStyleGrid.WMSize(var Message: TWMSize);
begin
	inherited;
	if not PreventSizing then
		UpdateCellSizes(False);
end;

procedure TStyleGrid.UpdateCellSizes(DoRepaint: Boolean);
begin
	if ColCount > 0 then begin
		DefaultColWidth := Width div ColCount;
		DefaultRowHeight := Height div RowCount;
	end
	else begin
		DefaultColWidth := Width;
		DefaultRowHeight := Height;
	end;
	PreventSizing := True;
{		BoundsRect := Bounds(Left, Top,
			DefaultColWidth * ColCount + 1,
			DefaultRowHeight * RowCount + 1);}
	PreventSizing := False;

	if DoRepaint then Invalidate;
end;

procedure TStyleGrid.DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect);
begin
	if Assigned(FOnDrawStyle) then
		FOnDrawStyle(aCanvas, aStyleIndex, aRect);
end;

{ TBrushStyleGrid }

const
	BrushStyles: array [0..7] of TBrushStyle = (
		bsClear,
		bsSolid,
		bsHorizontal,
		bsVertical,
		bsFDiagonal,
		bsBDiagonal,
		bsCross,
		bsDiagCross);

constructor TBrushStyleGrid.Create(anOwner: TComponent);
begin
	inherited Create(anOwner);
	Count := high(BrushStyles) + 1;
	FBackColor := clWhite;
	FHatchColor := clBlack; 
end;

function TBrushStyleGrid.GetStyle: TBrushStyle;
begin
	result := BrushStyles[FSelected];
end;

procedure TBrushStyleGrid.SetStyle(aStyle: TBrushStyle);
	var
		i: integer;
begin
	for i := low(BrushStyles) to high(BrushStyles) do
		if aStyle = BrushStyles[i] then begin
			Selected := i;
			break;
		end;
end;

procedure TBrushStyleGrid.SetBackColor(aValue: TColor);
begin
	if FBackColor <> aValue then begin
		FBackColor := aValue;
		Invalidate;
	end;
end;

procedure TBrushStyleGrid.SetHatchColor(aValue: TColor);
begin
	if FHatchColor <> aValue then begin
		FHatchColor := aValue;
		Invalidate;
	end;
end;

procedure TBrushStyleGrid.SetTransparency(aValue: Byte);
begin
	if aValue <> FTransparency then begin
		FTransparency := aValue;
		Invalidate;
	end;
end;

procedure TBrushStyleGrid.DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect);
var
	aStyle: TBrushStyle;
	aDevPoints: TDevPoints;
begin
	aStyle := BrushStyles[aStyleIndex];
	if aStyle = bsClear then begin
		BrushAttrsEx(bsSolid, clWindow, clWindow, 0).AssignToCanvas(aCanvas);
		aCanvas.FillRect(aRect);
		aCanvas.Font.Assign(ValidParentform(Self).Font);
		DrawText(aCanvas.Handle, 'Нет', -1, aRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
	end
	else begin
		aDevPoints := GetDevPoints;
		try
			aRect.Right := aRect.Right + 1;
			aRect.Bottom := aRect.Bottom + 1;

			aDevPoints.BeginUpdate;
			aDevPoints.NewRectSegment(aRect, True);
			aDevPoints.EndUpdate;

			aDevPoints.Paint(aCanvas, ClearPen,
				BrushAttrsEx(aStyle, FBackColor, FHatchColor, FTransparency), 0, 0, False);
		finally
			aDevPoints.Free;
		end;
	end;
end;


{ TPenStyleGrid }

const
	PenStyles: array [0..5] of TPenStyle = (
		psClear,
		psDash,
		psDot,
		psDashDot,
		psDashDotDot,
		psSolid);

constructor TPenStyleGrid.Create(anOwner: TComponent);
begin
	inherited Create(anOwner);
	Count := high(PenStyles) + 1;
end;

function TPenStyleGrid.GetStyle: TPenStyle;
begin
	result := PenStyles[FSelected]
end;

procedure TPenStyleGrid.Loaded;
begin
	inherited Loaded;
	Count := High(PenStyles) + 1;
end;

procedure TPenStyleGrid.SetStyle(aStyle: TPenStyle);
	var
		i: integer;
begin
	if aStyle = psInsideFrame then
		aStyle := psSolid;
	for i := low(PenStyles) to high(PenStyles) do
		if aStyle = PenStyles[i] then begin
			Selected := i;
			break;
		end;
end;

procedure TPenStyleGrid.SetPenColor(aValue: TColor);
begin
	FPenColor := aValue;
	Invalidate;
end;

procedure TPenStyleGrid.DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect);

	procedure ShowText(aText: PChar; aColor: TColor);
	begin
		aCanvas.Font.Assign(ValidParentform(Self).Font);
		aCanvas.Font.Color := aColor;
		DrawText(aCanvas.Handle, aText, -1, aRect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
	end;

var
	aStyle: TPenStyle;
	y: integer;
begin
	aStyle := PenStyles[aStyleIndex];
	aCanvas.Brush.Color := clWindow;
	aCanvas.FillRect(aRect);
	SetBkColor(aCanvas.Handle, ColorToRGB(clWindow));

	case aStyle of
		psClear:
			ShowText('Нет', clWindowText);
		psSolid:
			ShowText('Сплошная', FPenColor);
		else begin
			aCanvas.Pen.Color := FPenColor;
			aCanvas.Pen.Style := aStyle;

			y := (aRect.top + aRect.bottom) div 2;
			aCanvas.MoveTo(aRect.left + 4, y);
			aCanvas.LineTo(aRect.right - 4, y);
			aCanvas.Pen.Style := psSolid;
		end;
	end;
end;

{	TPatternBitsGrid }

constructor TPatternBitsGrid.Create(anOwner: TComponent);
begin
	inherited Create(anOwner);
	FillChar(FPatternBits, sizeof(FPatternBits), 0);
	FSetBitColor := clBlack;
	FClearBitColor := clWhite;
	FOnChanged := nil;
	FixedCols := 0;
	FixedRows := 0;
	RowCount := 8;
	ColCount := 8;
	PaintMode := False;
	PaintBit := False;
	Options := Options - [goRangeSelect];
end;

procedure TPatternBitsGrid.WMSize(var Message: TWMSize);
begin
	inherited;
	if not PreventSizing then
		UpdateCellSizes(False);
end;

procedure TPatternBitsGrid.UpdateCellSizes(doRepaint: Boolean);
begin
	DefaultColWidth := (Width - 1 - ColCount) div ColCount;
	DefaultRowHeight := (Height - 1 - RowCount) div RowCount;
	PreventSizing := True;
	BoundsRect := Bounds(Left, Top,
			(DefaultColWidth + 1) * ColCount + 1,
			(DefaultRowHeight + 1) * RowCount + 1);
	PreventSizing := False;

	if DoRepaint then Invalidate;
end;

function IntInRange(v, v1, v2: integer): boolean;
begin
	result := (v >= v1) and (v <= v2);
end;

function TPatternBitsGrid.GetBit(x, y: integer): boolean;
	var
		mask: byte;
begin
	if IntInRange(x, 0, 7) and IntInRange(y, 0, 7) then begin
		mask := 128 shr x;
		result := (FPatternBits[y] and mask) <> 0
	end
	else
		result := False;
end;

procedure TPatternBitsGrid.SetBit(x, y: integer; bit: boolean);
	var
		mask: byte;
begin
	if IntInRange(x, 0, 7) and IntInRange(y, 0, 7) then
		if bit <> Bits[x,y] then begin
			mask := 128 shr x;
			if bit then
				FPatternBits[y] := FPatternBits[y] or mask
			else
				FPatternBits[y] := FPatternBits[y] and not mask;
			InvalidateCell(x, y);
			if Assigned(FOnChanged) then FOnChanged(self);
		end;
end;

procedure TPatternBitsGrid.SetPatternBits(const aBits: TPatternBits);
begin
	FPatternBits := aBits;
	Invalidate;
end;

procedure TPatternBitsGrid.SetSetBitColor(color: TColor);
begin
	FSetBitColor := color;
	Invalidate;
end;

procedure TPatternBitsGrid.SetClearBitColor(color: TColor);
begin
	FClearBitColor := color;
	Invalidate;
end;

procedure TPatternBitsGrid.DrawCell(
		aCol,
		aRow: Longint;
		aRect: TRect;
		aState: TGridDrawState);
begin
	if Bits[aCol, aRow] then
		Canvas.Brush.Color := FSetBitColor
	else
		Canvas.Brush.Color := FClearBitColor;
	Canvas.FillRect(aRect);
end;

procedure TPatternBitsGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
	X, Y: Integer);
	var
		coord: TGridCoord;
begin
	inherited MouseDown(button, shift, x, y);
	if button = mbLeft then begin
		coord := MouseCoord(x, y);
		PaintMode := True;
		PaintBit := not Bits[coord.x, coord.y];
		if IntInRange(coord.x, 0, 7) and IntInRange(coord.y, 0, 7) then
			Bits[coord.x, coord.y] := PaintBit;
	end;
end;

procedure TPatternBitsGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
	var
		coord: TGridCoord;
begin
	inherited MouseMove(shift, x, y);
	if PaintMode then begin
		coord := MouseCoord(x, y);
		if IntInRange(coord.x, 0, 7) and IntInRange(coord.y, 0, 7) then
			Bits[coord.x, coord.y] := PaintBit;
	end;
end;

procedure TPatternBitsGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
	X, Y: Integer);
begin
	inherited MouseUp(button, shift, x, y);
	if button = mbLeft then
		PaintMode := False;
end;

const
	DefaultColors: TCustomColors = (
		clBlack,
		clWhite,

		clGray,
		clSilver,

		clMaroon,
		clRed,

		clGreen,
		clLime,

		clNavy,
		clBlue,

		clPurple,
		clFuchsia,

		clOlive,
		clYellow,

		clTeal,
		clAqua);


{	TColorPicker }

constructor TColorPicker.Create(anOwner: TComponent);
begin
	inherited Create(anOwner);
	FColor := clBlack;
  FCustomColors := DefaultColors;
	Pressed := False;
	FOnChanged := nil;
end;

function TColorPicker.GetCustomColor(Index: Integer): TColor;
begin
	Result := FCustomColors[Index];
end;

procedure TColorPicker.SetCustomColor(Index: Integer; const Value: TColor);
begin
	FCustomColors[Index] := Value;
end;

procedure TColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
	X, Y: Integer);
var
	ColorDialog: TColorDialog;
	i: Integer;

begin
	Pressed := True;
	Invalidate;
	Update;
	ColorDialog := TColorDialog.Create(Self);
	try
		for i := 0 to Length(FCustomColors) - 1 do
			ColorDialog.CustomColors.Add('Color'+Chr(Ord('A') + i) + '=' + IntToHex(ColorToRGB(FCustomColors[i]), 6));
			
		ColorDialog.Color := Color;
		if ColorDialog.Execute and (FColor <> ColorDialog.Color) then begin
			FColor := ColorDialog.Color;
			if Assigned(FOnChanged) then FOnChanged(self);
		end;
		Pressed := False;
		Invalidate;
	finally
		ColorDialog.Free;
	end;
end;

procedure TColorPicker.Paint;
	var
		r: TRect;
begin
	r := ClientRect;
	if Pressed then
		Frame3d(Canvas, r, clBtnShadow, clBtnHighlight, 1)
	else
		Frame3d(Canvas, r, clBtnHighlight, clBtnShadow, 1);
	Frame3d(Canvas, r, clBtnFace, clBtnFace, 1);
	Canvas.Brush.Color := FColor;
	Canvas.FillRect(r);
end;

procedure TColorPicker.SetColor(aColor: TColor);
begin
	FColor := AColor;
	Invalidate;
end;


{	TColorSelector }


constructor TColorPalette.Create(anOwner: TComponent);
var
	i: Integer;
begin
	inherited Create(anOwner);
	FPalette := TList.Create;
	for i := Low(DefaultColors) to High(DefaultColors) do
		FPalette.Add(Pointer(DefaultColors[i]));
	Count := FPalette.Count;
end;

destructor TColorPalette.Destroy;
begin
	FPalette.Free;
  inherited Destroy;
end;

function TColorPalette.GetColorCount: Integer;
begin
	Result := Count;
end;

procedure TColorPalette.SetColorCount(aValue: Integer);
var
	i: Integer;
begin
	FPalette.Count := aValue;
	for i := FCount to aValue - 1 do
		FPalette[i] := Pointer(clWhite);
	Count := aValue;
end;

function TColorPalette.GetColor(anIndex: Integer): TColor;
begin
	Result := TColor(FPalette[anIndex]);
end;

procedure TColorPalette.SetColor(anIndex: Integer; aValue: TColor);
begin
	FPalette[anIndex] := Pointer(aValue);
  Invalidate;
end;

function TColorPalette.GetSelectedColor: TColor;
begin
	if IsUnselected then
		Result := clWhite
	else
		Result := TColor(FPalette[Selected]);
end;

procedure TColorPalette.DrawStyle(aCanvas: TCanvas; aStyleIndex: Integer; aRect: TRect);
begin
  Canvas.Brush.Style := bsSolid;
	Canvas.Brush.Color := TColor(FPalette[aStyleIndex]);
	Canvas.FillRect(aRect);
end;


function TColorPalette.IndexOfColor(aColor: TColor): Integer;
begin
	Result := FPalette.IndexOf(Pointer(aColor));
end;

constructor TFloatEdit.Create(Owner: TComponent);
begin
	inherited Create(Owner);
	Precision := 2;
	IsSigned := true;
	StrictCheck := false;
end;

procedure TFloatEdit.CMExit(var Message: TCMExit);
begin
	inherited;
	if StrictCheck then
	try
		StringToFloat(Text);
	except
		SetFocus;
		if Trim(Text) = '' then
			raise EConvertError.Create('Ошибка: Введите число')
		else
			raise EConvertError.CreateFmt('Ошибка: не могу преобразовать строку "%s" в число', [Text]);
	end;

	if CheckValue(Value) <> Value then
		SetValue (Value);
end;

function TFloatEdit.GetValue: Double;
begin
	try
		if Modified then
			Result := StringToFloat(Text)
		else
			Result := FValue
	except
		Result := FMinValue;
	end;
end;

procedure TFloatEdit.SetPrecision(v: Integer);
begin
	FPrecision := v;
end;

procedure TFloatEdit.SetValue(NewValue: Double);
begin
	FValue := NewValue;
	if FTruncZeros then
		Text := Format('%.'+IntToStr(Precision)+'g', [CheckValue (NewValue)])
	else
		Text := Format('%.'+IntToStr(Precision)+'f', [CheckValue (NewValue)]);
	Modified := False;
end;

function TFloatEdit.CheckValue(NewValue: Double): Double;
begin
	Result := NewValue;
	if (FMaxValue <> FMinValue) then
	begin
		if NewValue < FMinValue then
			Result := FMinValue
		else if NewValue > FMaxValue then
			Result := FMaxValue;
	end;
end;

function TFloatEdit.IsValidChar(Key: Char): Boolean;
var aValue: string;
begin
	Result := false;

	if Key in ['0'..'9', ^H, ^M, #27] then
		Result := true
	else begin

		aValue := Text;
		Delete(aValue, SelStart+1, SelLength);
		if (Key in ['+', '-']) then
			Result := not StrictCheck or (IsSigned and (SelStart = 0) and ((aValue ='') or not (aValue[1] in ['+', '-'])))
		else if Key in [',', '.'] then
			Result := (Precision <> 0) and (not StrictCheck or (Pos('.', aValue) = 0) and (Pos(',', aValue) = 0));
	end;
end;

procedure TFloatEdit.KeyPress(var Key: Char);
begin
	if not IsValidChar(Key) then
	begin
		Key := #0;
		MessageBeep(0)
	end;
	if Key <> #0 then inherited KeyPress(Key);
end;


end.

