You've already forked lazarus-ccr
mbColorLib: Delphi support removed. Change version number to 2.1 (standard even/odd numbering scheme).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5549 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -7,12 +7,7 @@ unit GAxisColorPicker;
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF FPC}
|
||||
LCLType, LCLIntf, LMessages,
|
||||
{$ELSE}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
SysUtils, Classes, Controls, Graphics, Math, Forms,
|
||||
LCLType, LCLIntf, LMessages, SysUtils, Classes, Controls, Graphics, Math, Forms,
|
||||
HTMLColors, mbColorPickerControl;
|
||||
|
||||
type
|
||||
@@ -29,12 +24,8 @@ type
|
||||
procedure DrawMarker(x, y: integer);
|
||||
function GetGradientColor2D(x, y: Integer): TColor; override;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
(*
|
||||
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
|
||||
message CN_KEYDOWN;
|
||||
*)
|
||||
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;
|
||||
@@ -50,6 +41,7 @@ type
|
||||
property OnChange;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@@ -62,12 +54,7 @@ begin
|
||||
inherited;
|
||||
FGradientWidth := 256;
|
||||
FGradientHeight := 256;
|
||||
{$IFDEF DELPHI}
|
||||
Width := 256;
|
||||
Height := 256;
|
||||
{$ELSE}
|
||||
SetInitialBounds(0, 0, 256, 256);
|
||||
{$ENDIF}
|
||||
HintFormat := 'R: %r B: %b'#13'Hex: %hex';
|
||||
FG := 255;
|
||||
FB := 0;
|
||||
@@ -93,11 +80,6 @@ begin
|
||||
CreateGradient;
|
||||
end;
|
||||
|
||||
function TGAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
|
||||
begin
|
||||
Result := RGB(FBufferBmp.Height - 1 - y, FG, x);
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.DrawMarker(x, y: integer);
|
||||
var
|
||||
c: TColor;
|
||||
@@ -115,34 +97,9 @@ begin
|
||||
InternalDrawMarker(x, y, c);
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.SetSelectedColor(c: TColor);
|
||||
function TGAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
|
||||
begin
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
FR := GetRValue(c);
|
||||
FG := GetGValue(c);
|
||||
FB := GetBValue(c);
|
||||
FSelected := c;
|
||||
FManual := false;
|
||||
myy := Round((255 - FR) * Height / 255);
|
||||
mxx := Round(FB * Width / 255);
|
||||
Invalidate;
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.Paint;
|
||||
begin
|
||||
Canvas.StretchDraw(ClientRect, FBufferBmp);
|
||||
CorrectCoords(mxx, myy);
|
||||
DrawMarker(mxx, myy);
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.Resize;
|
||||
begin
|
||||
FManual := false;
|
||||
myy := Round((255 - FR) * Height / 255);
|
||||
mxx := Round(FB * Width / 255);
|
||||
inherited;
|
||||
Result := RGB(FBufferBmp.Height - 1 - y, FG, x);
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
@@ -207,20 +164,12 @@ begin
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.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}
|
||||
FSelected := GetColorAtPoint(x, y);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
@@ -228,24 +177,6 @@ begin
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if ssLeft in Shift then
|
||||
begin
|
||||
{$IFDEF DELPHI}
|
||||
ClipCursor(nil);
|
||||
{$ENDIF}
|
||||
mxx := X;
|
||||
myy := Y;
|
||||
FSelected := GetColorAtPoint(X, Y);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
@@ -260,108 +191,41 @@ begin
|
||||
FOnChange(Self);
|
||||
end;
|
||||
end;
|
||||
(*
|
||||
procedure TGAxisColorPicker.CNKeyDown(
|
||||
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
|
||||
var
|
||||
Shift: TShiftState;
|
||||
FInherited: boolean;
|
||||
|
||||
procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
FInherited := false;
|
||||
Shift := KeyDataToShiftState(Message.KeyData);
|
||||
if not (ssCtrl in Shift) then
|
||||
case Message.CharCode of
|
||||
VK_LEFT:
|
||||
begin
|
||||
mxx := dx - 1;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_RIGHT:
|
||||
begin
|
||||
mxx := dx + 1;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_UP:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy - 1;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy + 1;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
FInherited := true;
|
||||
inherited;
|
||||
end;
|
||||
end
|
||||
else
|
||||
case Message.CharCode of
|
||||
VK_LEFT:
|
||||
begin
|
||||
mxx := dx - 10;
|
||||
myy := dy;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_RIGHT:
|
||||
begin
|
||||
mxx := dx + 10;
|
||||
myy := dy;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_UP:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy - 10;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy + 10;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
FInherited := true;
|
||||
inherited;
|
||||
end;
|
||||
inherited;
|
||||
if ssLeft in Shift then
|
||||
begin
|
||||
mxx := X;
|
||||
myy := Y;
|
||||
FSelected := GetColorAtPoint(X, Y);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
if not FInherited then
|
||||
if Assigned(OnKeyDown) then
|
||||
OnKeyDown(Self, Message.CharCode, Shift);
|
||||
end;
|
||||
*)
|
||||
procedure TGAxisColorPicker.SetRValue(r: integer);
|
||||
|
||||
procedure TGAxisColorPicker.Paint;
|
||||
begin
|
||||
Clamp(r, 0, 255);
|
||||
FR := r;
|
||||
Canvas.StretchDraw(ClientRect, FBufferBmp);
|
||||
CorrectCoords(mxx, myy);
|
||||
DrawMarker(mxx, myy);
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.Resize;
|
||||
begin
|
||||
FManual := false;
|
||||
myy := Round((255 - FR) * Height / 255);
|
||||
mxx := Round(FB * Width / 255);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.SetBValue(b: integer);
|
||||
begin
|
||||
Clamp(b, 0, 255);
|
||||
FB := b;
|
||||
SetSelectedColor(RGB(FR, FG, FB));
|
||||
end;
|
||||
|
||||
@@ -372,11 +236,26 @@ begin
|
||||
SetSelectedColor(RGB(FR, FG, FB));
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.SetBValue(b: integer);
|
||||
procedure TGAxisColorPicker.SetRValue(r: integer);
|
||||
begin
|
||||
Clamp(b, 0, 255);
|
||||
FB := b;
|
||||
Clamp(r, 0, 255);
|
||||
FR := r;
|
||||
SetSelectedColor(RGB(FR, FG, FB));
|
||||
end;
|
||||
|
||||
procedure TGAxisColorPicker.SetSelectedColor(c: TColor);
|
||||
begin
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
FR := GetRValue(c);
|
||||
FG := GetGValue(c);
|
||||
FB := GetBValue(c);
|
||||
FSelected := c;
|
||||
FManual := false;
|
||||
myy := Round((255 - FR) * Height / 255);
|
||||
mxx := Round(FB * Width / 255);
|
||||
Invalidate;
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user