diff --git a/components/mbColorLib/BAxisColorPicker.pas b/components/mbColorLib/BAxisColorPicker.pas index 78d60439e..cde16d1b8 100644 --- a/components/mbColorLib/BAxisColorPicker.pas +++ b/components/mbColorLib/BAxisColorPicker.pas @@ -7,11 +7,7 @@ unit BAxisColorPicker; interface uses - {$IFDEF FPC} LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Controls, Graphics, Math, Forms, HTMLColors, mbColorPickerControl; @@ -28,10 +24,6 @@ type procedure CreateWnd; override; procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - (* - procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); - message CN_KEYDOWN; - *) 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; @@ -50,11 +42,13 @@ type property OnChange; end; + implementation uses mbUtils; + {TBAxisColorPicker} constructor TBAxisColorPicker.Create(AOwner: TComponent); @@ -62,12 +56,7 @@ begin inherited; FGradientWidth := 256; FGradientHeight := 256; - {$IFDEF DELPHI} - Width := 256; - Height := 256; - {$ELSE} SetInitialBounds(0, 0, 255, 255); - {$ENDIF} HintFormat := 'R: %r G: %g'#13'Hex: %hex'; FG := 0; FB := 255; @@ -116,35 +105,6 @@ begin Result := RGB(x, FBufferBmp.Height - 1 - y, FB); 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)); - inherited; -end; - -procedure TBAxisColorPicker.SetSelectedColor(c: TColor); -begin - if WebSafe then c := GetWebSafe(c); - FR := GetRValue(c); - FG := GetGValue(c); - FB := GetBValue(c); - FSelected := c; - FManual := false; - mxx := Round(FR*(Width/255)); - myy := Round((255-FG)*(Height/255)); - Invalidate; - if Assigned(FOnChange) then FOnChange(self); -end; - procedure TBAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState); var eraseKey: Boolean; @@ -204,20 +164,12 @@ end; procedure TBAxisColorPicker.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; @@ -225,23 +177,6 @@ begin SetFocus; end; -procedure TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - inherited; - {$IFDEF DELPHI} - ClipCursor(nil); - {$ENDIF} - if ssLeft in Shift then - begin - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; - if Assigned(FOnChange) then FOnChange(self); - end; -end; - procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; @@ -255,108 +190,40 @@ begin if Assigned(FOnChange) then FOnChange(self); end; end; -(* -procedure TBAxisColorPicker.CNKeyDown( - var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); -var - Shift: TShiftState; - FInherited: boolean; + +procedure TBAxisColorPicker.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 TBAxisColorPicker.SetRValue(r: integer); + +procedure TBAxisColorPicker.Paint; begin - Clamp(r, 0, 255); - FR := r; + 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)); + inherited; +end; + +procedure TBAxisColorPicker.SetBValue(b: integer); +begin + Clamp(b, 0, 255); + FB := b; SetSelectedColor(RGB(FR, FG, FB)); end; @@ -367,11 +234,26 @@ begin SetSelectedColor(RGB(FR, FG, FB)); end; -procedure TBAxisColorPicker.SetBValue(b: integer); +procedure TBAxisColorPicker.SetRValue(r: integer); begin - Clamp(b, 0, 255); - FB := b; + Clamp(r, 0, 255); + FR := r; SetSelectedColor(RGB(FR, FG, FB)); end; +procedure TBAxisColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FR := GetRValue(c); + FG := GetGValue(c); + FB := GetBValue(c); + FSelected := c; + FManual := false; + mxx := Round(FR*(Width/255)); + myy := Round((255-FG)*(Height/255)); + Invalidate; + if Assigned(FOnChange) then FOnChange(self); +end; + + end. diff --git a/components/mbColorLib/BColorPicker.pas b/components/mbColorLib/BColorPicker.pas index 6a5571b47..e67d9953f 100644 --- a/components/mbColorLib/BColorPicker.pas +++ b/components/mbColorLib/BColorPicker.pas @@ -7,13 +7,9 @@ unit BColorPicker; interface uses - {$IFDEF FPC} - LCLIntf, LCLType, //LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, - mbTrackBarPicker, HTMLColors; + HTMLColors, mbTrackBarPicker; type @@ -25,10 +21,10 @@ type function ArrowPosFromBlue(b: integer): integer; function BlueFromArrowPos(p: integer): integer; function GetSelectedColor: TColor; - procedure SetSelectedColor(c: TColor); - procedure SetRed(r: integer); - procedure SetGreen(g: integer); procedure SetBlue(b: integer); + procedure SetGreen(g: integer); + procedure SetRed(r: integer); + procedure SetSelectedColor(c: TColor); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; @@ -37,9 +33,9 @@ type public constructor Create(AOwner: TComponent); override; published - property Red: integer read FRed write SetRed default 128; - property Green: integer read FGreen write SetGreen default 128; property Blue: integer read FBlue write SetBlue default 255; + property Green: integer read FGreen write SetGreen default 128; + property Red: integer read FRed write SetRed default 128; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property Layout default lyVertical; end; @@ -70,50 +66,6 @@ begin FChange := true; end; -function TBColorPicker.GetGradientColor(AValue: Integer): TColor; -begin - Result := RGB(FRed, FGreen, AValue); -end; - -procedure TBColorPicker.SetRed(r: integer); -begin - Clamp(r, 0, 255); - if FRed <> r then - begin - FRed := r; - FManual := false; - CreateGradient; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - -procedure TBColorPicker.SetGreen(g: integer); -begin - Clamp(g, 0, 255); - if FGreen <> g then - begin - FGreen := g; - FManual := false; - CreateGradient; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - -procedure TBColorPicker.SetBlue(b: integer); -begin - Clamp(b, 0, 255); - if FBlue <> b then - begin - FBlue := b; - FArrowPos := ArrowPosFromBlue(b); - FManual := false; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - function TBColorPicker.ArrowPosFromBlue(b: integer): integer; var a: integer; @@ -138,43 +90,13 @@ var b: integer; begin if Layout = lyHorizontal then - b := Round(p/((Width - 12)/255)) + b := Round(p / (Width - 12) * 255) else - b := Round(255 - p/((Height - 12)/255)); + b := Round(255 - p / (Height - 12) * 255); Clamp(b, 0, 255); Result := b; end; -function TBColorPicker.GetSelectedColor: TColor; -begin - if not WebSafe then - Result := RGB(FRed, FGreen, FBlue) - else - Result := GetWebSafe(RGB(FRed, FGreen, FBlue)); -end; - -function TBColorPicker.GetSelectedValue: integer; -begin - Result := FBlue; -end; - -procedure TBColorPicker.SetSelectedColor(c: TColor); -begin - if WebSafe then c := GetWebSafe(c); - FChange := false; - SetRed(GetRValue(c)); - SetGreen(GetGValue(c)); - SetBlue(GetBValue(c)); - FManual := false; - FChange := true; - if Assigned(OnChange) then OnChange(Self); -end; - -function TBColorPicker.GetArrowPos: integer; -begin - Result := ArrowPosFromBlue(FBlue); -end; - procedure TBColorPicker.Execute(tbaAction: integer); begin case tbaAction of @@ -211,4 +133,78 @@ begin end; end; +function TBColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromBlue(FBlue); +end; + +function TBColorPicker.GetGradientColor(AValue: Integer): TColor; +begin + Result := RGB(FRed, FGreen, AValue); +end; + +function TBColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := RGB(FRed, FGreen, FBlue) + else + Result := GetWebSafe(RGB(FRed, FGreen, FBlue)); +end; + +function TBColorPicker.GetSelectedValue: integer; +begin + Result := FBlue; +end; + +procedure TBColorPicker.SetBlue(b: integer); +begin + Clamp(b, 0, 255); + if FBlue <> b then + begin + FBlue := b; + FArrowPos := ArrowPosFromBlue(b); + FManual := false; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TBColorPicker.SetGreen(g: integer); +begin + Clamp(g, 0, 255); + if FGreen <> g then + begin + FGreen := g; + FManual := false; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TBColorPicker.SetRed(r: integer); +begin + Clamp(r, 0, 255); + if FRed <> r then + begin + FRed := r; + FManual := false; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TBColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FChange := false; + SetRed(GetRValue(c)); + SetGreen(GetGValue(c)); + SetBlue(GetBValue(c)); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + end. diff --git a/components/mbColorLib/CColorPicker.pas b/components/mbColorLib/CColorPicker.pas index 0dca22c57..242cd9d44 100644 --- a/components/mbColorLib/CColorPicker.pas +++ b/components/mbColorLib/CColorPicker.pas @@ -7,11 +7,7 @@ unit CColorPicker; interface uses - {$IFDEF FPC} LCLIntf, LCLType, - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Controls, Graphics, Forms, RGBCMYKUtils, mbTrackBarPicker, HTMLColors; @@ -22,11 +18,11 @@ type function ArrowPosFromCyan(c: integer): integer; function CyanFromArrowPos(p: integer): integer; function GetSelectedColor: TColor; - procedure SetSelectedColor(clr: TColor); + procedure SetBlack(k: integer); procedure SetCyan(c: integer); procedure SetMagenta(m: integer); + procedure SetSelectedColor(clr: TColor); procedure SetYellow(y: integer); - procedure SetBlack(k: integer); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; @@ -35,14 +31,15 @@ type public constructor Create(AOwner: TComponent); override; published + property Black: integer read FBlack write SetBlack default 0; property Cyan: integer read FCyan write SetCyan default 255; property Magenta: integer read FMagenta write SetMagenta default 0; property Yellow: integer read FYellow write SetYellow default 0; - property Black: integer read FBlack write SetBlack default 0; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property Layout default lyVertical; end; + implementation uses @@ -68,11 +65,96 @@ begin FChange := true; end; +function TCColorPicker.ArrowPosFromCyan(c: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*c); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + c := 255 - c; + a := Round(((Height - 12)/255)*c); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TCColorPicker.CyanFromArrowPos(p: integer): integer; +var + c: integer; +begin + if Layout = lyHorizontal then + c := Round(p/((Width - 12)/255)) + else + c := Round(255 - p/((Height - 12)/255)); + Clamp(c, 0, 255); + Result := c; +end; + +procedure TCColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: + SetCyan(FCyan); + TBA_MouseMove: + FCyan := CyanFromArrowPos(FArrowPos); + TBA_MouseDown: + FCyan := CyanFromArrowPos(FArrowPos); + TBA_MouseUp: + FCyan := CyanFromArrowPos(FArrowPos); + TBA_WheelUp: + SetCyan(FCyan + Increment); + TBA_WheelDown: + SetCyan(FCyan - Increment); + TBA_VKRight: + SetCyan(FCyan + Increment); + TBA_VKCtrlRight: + SetCyan(255); + TBA_VKLeft: + SetCyan(FCyan - Increment); + TBA_VKCtrlLeft: + SetCyan(0); + TBA_VKUp: + SetCyan(FCyan + Increment); + TBA_VKCtrlUp: + SetCyan(255); + TBA_VKDown: + SetCyan(FCyan - Increment); + TBA_VKCtrlDown: + SetCyan(0); + else + inherited; + end; +end; + +function TCColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromCyan(FCyan); +end; + function TCColorPicker.GetGradientColor(AValue: Integer): TColor; begin Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack); end; +procedure TCColorPicker.SetBlack(k: integer); +begin + Clamp(k, 0, 255); + if FBlack <> k then + begin + FBlack := k; + FManual := false; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + procedure TCColorPicker.SetCyan(C: integer); begin Clamp(c, 0, 255); @@ -112,50 +194,6 @@ begin end; end; -procedure TCColorPicker.SetBlack(k: integer); -begin - Clamp(k, 0, 255); - if FBlack <> k then - begin - FBlack := k; - FManual := false; - CreateGradient; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - -function TCColorPicker.ArrowPosFromCyan(c: integer): integer; -var - a: integer; -begin - if Layout = lyHorizontal then - begin - a := Round(((Width - 12)/255)*c); - if a > Width - FLimit then a := Width - FLimit; - end - else - begin - c := 255 - c; - a := Round(((Height - 12)/255)*c); - if a > Height - FLimit then a := Height - FLimit; - end; - if a < 0 then a := 0; - Result := a; -end; - -function TCColorPicker.CyanFromArrowPos(p: integer): integer; -var - c: integer; -begin - if Layout = lyHorizontal then - c := Round(p/((Width - 12)/255)) - else - c := Round(255 - p/((Height - 12)/255)); - Clamp(c, 0, 255); - Result := c; -end; - function TCColorPicker.GetSelectedColor: TColor; begin Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack); @@ -187,45 +225,4 @@ begin FChange := true; end; -function TCColorPicker.GetArrowPos: integer; -begin - Result := ArrowPosFromCyan(FCyan); -end; - -procedure TCColorPicker.Execute(tbaAction: integer); -begin - case tbaAction of - TBA_Resize: - SetCyan(FCyan); - TBA_MouseMove: - FCyan := CyanFromArrowPos(FArrowPos); - TBA_MouseDown: - FCyan := CyanFromArrowPos(FArrowPos); - TBA_MouseUp: - FCyan := CyanFromArrowPos(FArrowPos); - TBA_WheelUp: - SetCyan(FCyan + Increment); - TBA_WheelDown: - SetCyan(FCyan - Increment); - TBA_VKRight: - SetCyan(FCyan + Increment); - TBA_VKCtrlRight: - SetCyan(255); - TBA_VKLeft: - SetCyan(FCyan - Increment); - TBA_VKCtrlLeft: - SetCyan(0); - TBA_VKUp: - SetCyan(FCyan + Increment); - TBA_VKCtrlUp: - SetCyan(255); - TBA_VKDown: - SetCyan(FCyan - Increment); - TBA_VKCtrlDown: - SetCyan(0); - else - inherited; - end; -end; - end. diff --git a/components/mbColorLib/CIEAColorPicker.pas b/components/mbColorLib/CIEAColorPicker.pas index 4919705b3..17fd7d7ea 100644 --- a/components/mbColorLib/CIEAColorPicker.pas +++ b/components/mbColorLib/CIEAColorPicker.pas @@ -7,11 +7,7 @@ unit CIEAColorPicker; interface uses - {$IFDEF FPC} LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Controls, Graphics, Math, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; @@ -28,13 +24,9 @@ type procedure CreateWnd; override; procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - (* - procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); - message CN_KEYDOWN; - *) 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; @@ -56,25 +48,14 @@ implementation uses mbUtils; - {TCIEAColorPicker} constructor TCIEAColorPicker.Create(AOwner: TComponent); begin inherited; - { - FBmp := TBitmap.Create; - FBmp.PixelFormat := pf32bit; - FBmp.SetSize(256, 256); - } FGradientWidth := 256; FGradientHeight := 256; - {$IFDEF DELPHI} - Width := 256; - Height := 256; - {$ELSE} SetInitialBounds(0, 0, 256, 256); - {$ENDIF} HintFormat := 'L: %cieL B: %cieB'#13'Hex: %hex'; FSelected := clFuchsia; FL := 100; @@ -88,25 +69,18 @@ begin MarkerStyle := msCircle; end; -procedure TCIEAColorPicker.CreateWnd; -begin - inherited; - CreateGradient; -end; - -// In the original code: for L ... for B ... LabToRGB(Round(100-L*100/255), FA, B-128); -// --> x is B, y is L -function TCIEAColorPicker.GetGradientColor2D(x, y: Integer): TColor; -begin - Result := LabToRGB(Round(100 - y*100/255), FA, x - 128); -end; - procedure TCIEAColorPicker.CorrectCoords(var x, y: integer); begin Clamp(x, 0, Width - 1); Clamp(y, 0, Height - 1); end; +procedure TCIEAColorPicker.CreateWnd; +begin + inherited; + CreateGradient; +end; + procedure TCIEAColorPicker.DrawMarker(x, y: integer); var c: TColor; @@ -124,91 +98,11 @@ begin InternalDrawMarker(x, y, c); end; -procedure TCIEAColorPicker.SetSelectedColor(c: TColor); +// In the original code: for L ... for B ... LabToRGB(Round(100-L*100/255), FA, B-128); +// --> x is B, y is L +function TCIEAColorPicker.GetGradientColor2D(x, y: Integer): TColor; begin - if WebSafe then c := GetWebSafe(c); - FL := Round(GetCIELValue(c)); - FA := Round(GetCIEAValue(c)); - FB := Round(GetCIEBValue(c)); - FSelected := c; - FManual := false; - mxx := Round((FB + 128) * Width / 255); - myy := Round((100 - FL) * 255 / 100 * Height / 255); - Invalidate; - if Assigned(FOnChange) then - FOnChange(Self); -end; - -procedure TCIEAColorPicker.Paint; -begin - Canvas.StretchDraw(ClientRect, FBufferBmp); - CorrectCoords(mxx, myy); - DrawMarker(mxx, myy); -end; - -procedure TCIEAColorPicker.Resize; -begin - FManual := false; - mxx := Round((FB + 128) * Width / 255); - myy := Round(((100 - FL) * 255 / 100) * Height / 255); - inherited; -end; - -procedure TCIEAColorPicker.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; - if Assigned(FOnChange) then - FOnChange(Self); - end; - SetFocus; -end; - -procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - inherited; - {$IFDEF DELPHI} - ClipCursor(nil); - {$ENDIF} - if ssLeft in Shift then - begin - mxx := x; - myy := y; - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; - if Assigned(FOnChange) then - FOnChange(Self); - end; -end; - -procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - 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; + Result := LabToRGB(Round(100 - y*100/255), FA, x - 128); end; procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState); @@ -272,11 +166,65 @@ begin inherited; end; -procedure TCIEAColorPicker.SetLValue(l: integer); +procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - Clamp(L, 0, 100); - FL := L; - SetSelectedColor(LabToRGB(FL, FA, FB)); + inherited; + mxx := x; + myy := y; + if Button = mbLeft then + begin + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); + end; + SetFocus; +end; + +procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + 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; +end; + +procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + 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; +end; + +procedure TCIEAColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBufferBmp); + CorrectCoords(mxx, myy); + DrawMarker(mxx, myy); +end; + +procedure TCIEAColorPicker.Resize; +begin + FManual := false; + mxx := Round((FB + 128) * Width / 255); + myy := Round(((100 - FL) * 255 / 100) * Height / 255); + inherited; end; procedure TCIEAColorPicker.SetAValue(a: integer); @@ -293,4 +241,26 @@ begin SetSelectedColor(LabToRGB(FL, FA, FB)); end; +procedure TCIEAColorPicker.SetLValue(l: integer); +begin + Clamp(L, 0, 100); + FL := L; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIEAColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FL := Round(GetCIELValue(c)); + FA := Round(GetCIEAValue(c)); + FB := Round(GetCIEBValue(c)); + FSelected := c; + FManual := false; + mxx := Round((FB + 128) * Width / 255); + myy := Round((100 - FL) * 255 / 100 * Height / 255); + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); +end; + end. diff --git a/components/mbColorLib/CIEBColorPicker.pas b/components/mbColorLib/CIEBColorPicker.pas index ad66b030d..9713c58d5 100644 --- a/components/mbColorLib/CIEBColorPicker.pas +++ b/components/mbColorLib/CIEBColorPicker.pas @@ -7,11 +7,7 @@ unit CIEBColorPicker; interface uses - {$IFDEF FPC} LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Controls, Graphics, Math, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; @@ -31,12 +27,9 @@ type procedure CreateWnd; override; procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - (* - procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); - message CN_KEYDOWN;*) 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; @@ -44,11 +37,11 @@ type public constructor Create(AOwner: TComponent); override; published - property SelectedColor default clLime; - property LValue: integer read FL write SetLValue default 100; property AValue: integer read FA write SetAValue default -128; property BValue: integer read FB write SetBValue default 127; + property LValue: integer read FL write SetLValue default 100; property MarkerStyle default msCircle; + property SelectedColor default clLime; property OnChange; end; @@ -58,7 +51,6 @@ implementation uses mbUtils; - {TCIEBColorPicker} constructor TCIEBColorPicker.Create(AOwner: TComponent); @@ -66,12 +58,7 @@ begin inherited; FGradientWidth := 256; FGradientHeight := 256; - {$IFDEF DELPHI} - Width := 256; - Height := 256; - {$ELSE} SetInitialBounds(0, 0, 256, 256); - {$ENDIF} HintFormat := 'L: %cieL A: %cieA'#13'Hex: %hex'; FSelected := clLime; FL := 100; @@ -85,25 +72,18 @@ begin MarkerStyle := msCircle; end; -procedure TCIEBColorPicker.CreateWnd; -begin - inherited; - CreateGradient; -end; - -{ In the original code: for L ... for A ... LabToRGB(Round(100-L*100/244), A-128, FB) - --> x is A, y is L} -function TCIEBColorPicker.GetGradientColor2D(x, y: Integer): TColor; -begin - Result := LabToRGB(Round(100 - y*100/255), x - 128, FB); -end; - procedure TCIEBColorPicker.CorrectCoords(var x, y: integer); begin Clamp(x, 0, Width - 1); Clamp(y, 0, Height - 1); end; +procedure TCIEBColorPicker.CreateWnd; +begin + inherited; + CreateGradient; +end; + procedure TCIEBColorPicker.DrawMarker(x, y: integer); var c: TColor; @@ -121,89 +101,11 @@ begin InternalDrawMarker(x, y, c); end; -procedure TCIEBColorPicker.SetSelectedColor(c: TColor); +{ In the original code: for L ... for A ... LabToRGB(Round(100-L*100/244), A-128, FB) + --> x is A, y is L} +function TCIEBColorPicker.GetGradientColor2D(x, y: Integer): TColor; begin - if WebSafe then c := GetWebSafe(c); - FL := Round(GetCIELValue(c)); - FA := Round(GetCIEAValue(c)); - FB := Round(GetCIEBValue(c)); - FSelected := c; - FManual := false; - mxx := Round((FA + 128) * Width / 255); - myy := Round((100 - FL) * 255 / 100* Height / 255); - Invalidate; - if Assigned(FOnChange) then - FOnChange(Self); -end; - -procedure TCIEBColorPicker.Paint; -begin - Canvas.StretchDraw(ClientRect, FBufferBmp); - CorrectCoords(mxx, myy); - DrawMarker(mxx, myy); -end; - -procedure TCIEBColorPicker.Resize; -begin - FManual := false; - mxx := Round((FA + 128) * (Width / 255)); - myy := Round(((100 - FL) * 255 / 100) * (Height / 255)); - inherited; -end; - -procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -var - R: TRect; -begin - inherited; - mxx := x; - myy := y; - if Button = mbLeft then - begin - R := ClientRect; - R.TopLeft := ClientToScreen(R.TopLeft); - R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} - ClipCursor(@R); - {$ENDIF} - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; - end; - SetFocus; -end; - -procedure TCIEBColorPicker.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 TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - 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; + Result := LabToRGB(Round(100 - y*100/255), x - 128, FB); end; procedure TCIEBColorPicker.KeyDown(var Key: Word; Shift: TShiftState); @@ -267,11 +169,74 @@ begin inherited; end; -procedure TCIEBColorPicker.SetLValue(L: integer); +procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + R: TRect; begin - Clamp(L, 0, 100); - FL := L; - SetSelectedColor(LabToRGB(FL, FA, FB)); + inherited; + mxx := x; + myy := y; + if Button = mbLeft then + begin + R := ClientRect; + R.TopLeft := ClientToScreen(R.TopLeft); + R.BottomRight := ClientToScreen(R.BottomRight); + {$IFDEF DELPHI} + ClipCursor(@R); + {$ENDIF} + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + end; + SetFocus; +end; + +procedure TCIEBColorPicker.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 TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + 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; +end; + +procedure TCIEBColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBufferBmp); + CorrectCoords(mxx, myy); + DrawMarker(mxx, myy); +end; + +procedure TCIEBColorPicker.Resize; +begin + FManual := false; + mxx := Round((FA + 128) * (Width / 255)); + myy := Round(((100 - FL) * 255 / 100) * (Height / 255)); + inherited; end; procedure TCIEBColorPicker.SetAValue(a: integer); @@ -288,4 +253,26 @@ begin SetSelectedColor(LabToRGB(FL, FA, FB)); end; +procedure TCIEBColorPicker.SetLValue(L: integer); +begin + Clamp(L, 0, 100); + FL := L; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIEBColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FL := Round(GetCIELValue(c)); + FA := Round(GetCIEAValue(c)); + FB := Round(GetCIEBValue(c)); + FSelected := c; + FManual := false; + mxx := Round((FA + 128) * Width / 255); + myy := Round((100 - FL) * 255 / 100* Height / 255); + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); +end; + end. diff --git a/components/mbColorLib/CIELColorPicker.pas b/components/mbColorLib/CIELColorPicker.pas index 4119f166e..f870fb63a 100644 --- a/components/mbColorLib/CIELColorPicker.pas +++ b/components/mbColorLib/CIELColorPicker.pas @@ -7,11 +7,7 @@ unit CIELColorPicker; interface uses - {$IFDEF FPC} LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Controls, Graphics, Math, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; @@ -28,10 +24,6 @@ type procedure CreateWnd; override; procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - (* - procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); - message CN_KEYDOWN; - *) 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; @@ -42,11 +34,11 @@ type public constructor Create(AOwner: TComponent); override; published - property SelectedColor default clAqua; - property LValue: integer read FL write SetLValue default 100; property AValue: integer read FA write SetAValue default -128; property BValue: integer read FB write SetBValue default 127; + property LValue: integer read FL write SetLValue default 100; property MarkerStyle default msCircle; + property SelectedColor default clAqua; property OnChange; end; @@ -63,12 +55,7 @@ begin inherited; FGradientWidth := 256; FGradientHeight := 256; - {$IFDEF DELPHI} - Width := 256; - Height := 256; - {$ELSE} SetInitialBounds(0, 0, 256, 256); - {$ENDIF} HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex'; FSelected := clAqua; FL := 100; @@ -83,24 +70,18 @@ begin SetSelectedColor(clAqua); end; -procedure TCIELColorPicker.CreateWnd; -begin - inherited; - CreateGradient; -end; - -{ Original code: for A ... for B ---> LabToRGB(FL, A - 128, B - 128) } -function TCIELColorPicker.GetGradientColor2D(x, y: Integer): TColor; -begin - Result := LabToRGB(FL, y - 128, x - 128); -end; - procedure TCIELColorPicker.CorrectCoords(var x, y: integer); begin Clamp(x, 0, Width - 1); clamp(y, 0, Height - 1); end; +procedure TCIELColorPicker.CreateWnd; +begin + inherited; + CreateGradient; +end; + procedure TCIELColorPicker.DrawMarker(x, y: integer); var c: TColor; @@ -118,89 +99,10 @@ begin InternalDrawMarker(x, y, c); end; -procedure TCIELColorPicker.SetSelectedColor(c: TColor); +{ Original code: for A ... for B ---> LabToRGB(FL, A - 128, B - 128) } +function TCIELColorPicker.GetGradientColor2D(x, y: Integer): TColor; begin - if WebSafe then c := GetWebSafe(c); - FL := Round(GetCIELValue(c)); - FA := Round(GetCIEAValue(c)); - FB := Round(GetCIEBValue(c)); - FSelected := c; - FManual := false; - mxx := Round((FA + 128) * Width / 255); - myy := Round((255 - (FB + 128)) * Height / 255); - Invalidate; - if Assigned(FOnChange) then - FOnChange(Self); -end; - -procedure TCIELColorPicker.Paint; -begin - Canvas.StretchDraw(ClientRect, FBufferBmp); - CorrectCoords(mxx, myy); - DrawMarker(mxx, myy); -end; - -procedure TCIELColorPicker.Resize; -begin - FManual := false; - mxx := Round((FA + 128) * Width / 255); - myy := Round((255 - (FB + 128)) * Height / 255); - inherited; -end; - -procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -var - R: TRect; -begin - inherited; - mxx := x; - myy := y; - if Button = mbLeft then - begin - R := ClientRect; - R.TopLeft := ClientToScreen(R.TopLeft); - R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} - ClipCursor(@R); - {$ENDIF} - FSelected := GetColorAtPoint(x, y); - FManual := true; - Invalidate; - end; - SetFocus; -end; - -procedure TCIELColorPicker.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 TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - 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; + Result := LabToRGB(FL, y - 128, x - 128); end; procedure TCIELColorPicker.KeyDown(var Key: Word; Shift: TShiftState); @@ -263,11 +165,63 @@ begin inherited; end; -procedure TCIELColorPicker.SetLValue(l: integer); +procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - Clamp(L, 0, 100); - FL := L; - SetSelectedColor(LabToRGB(FL, FA, FB)); + inherited; + mxx := x; + myy := y; + if Button = mbLeft then + begin + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; + end; + SetFocus; +end; + +procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + 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; +end; + +procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + 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; +end; + +procedure TCIELColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBufferBmp); + CorrectCoords(mxx, myy); + DrawMarker(mxx, myy); +end; + +procedure TCIELColorPicker.Resize; +begin + FManual := false; + mxx := Round((FA + 128) * Width / 255); + myy := Round((255 - (FB + 128)) * Height / 255); + inherited; end; procedure TCIELColorPicker.SetAValue(a: integer); @@ -284,4 +238,27 @@ begin SetSelectedColor(LabToRGB(FL, FA, FB)); end; +procedure TCIELColorPicker.SetLValue(l: integer); +begin + Clamp(L, 0, 100); + FL := L; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIELColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FL := Round(GetCIELValue(c)); + FA := Round(GetCIEAValue(c)); + FB := Round(GetCIEBValue(c)); + FSelected := c; + FManual := false; + mxx := Round((FA + 128) * Width / 255); + myy := Round((255 - (FB + 128)) * Height / 255); + Invalidate; + if Assigned(FOnChange) then + FOnChange(Self); +end; + + end. diff --git a/components/mbColorLib/RGBCIEUtils.pas b/components/mbColorLib/RGBCIEUtils.pas index fc3a18b34..0be427da9 100644 --- a/components/mbColorLib/RGBCIEUtils.pas +++ b/components/mbColorLib/RGBCIEUtils.pas @@ -3,9 +3,7 @@ unit RGBCIEUtils; interface uses - SysUtils, - {$IFDEF FPC}LCLIntf,{$ELSE}Windows,{$ENDIF} - Graphics, Math; + SysUtils, LCLIntf, Graphics, Math; const {// Observer= 2°, Illuminant= D65 - Daylignt @@ -290,23 +288,23 @@ end; function GetCIEAValue(c: TColor): double; var - d: double; + d: double; begin - XYZToLab(RGBToXYZ(c), d, Result, d); + XYZToLab(RGBToXYZ(c), d, Result, d); end; function GetCIEBValue(c: TColor): double; var - d: double; + d: double; begin - XYZToLab(RGBToXYZ(c), d, d, Result); + XYZToLab(RGBToXYZ(c), d, d, Result); end; function GetCIECValue(c: TColor): double; var - d: double; + d: double; begin - RGBToLCH(c, d, Result, d); + RGBToLCH(c, d, Result, d); end; function GetCIEHValue(c: TColor): double; diff --git a/components/mbColorLib/RGBCMYKUtils.pas b/components/mbColorLib/RGBCMYKUtils.pas index 71eedb93a..99a42a740 100644 --- a/components/mbColorLib/RGBCMYKUtils.pas +++ b/components/mbColorLib/RGBCMYKUtils.pas @@ -8,8 +8,7 @@ interface {$DEFINE CMYK_FORMULA_2} // Result agrees with OpenOffice uses - {$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF} - Graphics, Math; + LCLIntf, Graphics, Math; function CMYtoColor(C, M, Y: integer): TColor; procedure RGBtoCMY(clr: TColor; var C, M, Y: integer); diff --git a/components/mbColorLib/RGBHSLUtils.pas b/components/mbColorLib/RGBHSLUtils.pas index b561687f5..5bc9e2cb2 100644 --- a/components/mbColorLib/RGBHSLUtils.pas +++ b/components/mbColorLib/RGBHSLUtils.pas @@ -7,12 +7,7 @@ unit RGBHSLUtils; interface uses - {$IFDEF FPC} - LCLIntf, LCLType, - {$ELSE} - Windows, - {$ENDIF} - Graphics, Math, Scanlines; + LCLIntf, LCLType, Graphics, Math, Scanlines; var //set these variables to your needs, e.g. 360, 255, 255 MaxHue: integer = 359; @@ -36,6 +31,7 @@ function HSLToRGBTriple(H, S, L : integer) : TRGBTriple; function HSLToRGBQuad(H, S, L: integer): TRGBQuad; procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer); + implementation uses diff --git a/components/mbColorLib/RGBHSVUtils.pas b/components/mbColorLib/RGBHSVUtils.pas index 8bba05980..6c0fce8d1 100644 --- a/components/mbColorLib/RGBHSVUtils.pas +++ b/components/mbColorLib/RGBHSVUtils.pas @@ -7,12 +7,8 @@ unit RGBHSVUtils; interface uses - {$IFDEF FPC} - LCLIntf, LCLType, - {$ELSE} - Windows, - {$ENDIF} - SysUtils, Classes, Graphics, Math, Scanlines; + LCLIntf, LCLType, SysUtils, Classes, Graphics, Math, + Scanlines; procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double); procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer); diff --git a/components/mbColorLib/SColorPicker.pas b/components/mbColorLib/SColorPicker.pas index dd152b8a6..23c16fe23 100644 --- a/components/mbColorLib/SColorPicker.pas +++ b/components/mbColorLib/SColorPicker.pas @@ -7,11 +7,7 @@ unit SColorPicker; interface uses - {$IFDEF FPC} LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} SysUtils, Classes, Controls, Graphics, Forms, RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines; @@ -21,18 +17,18 @@ type FVal, FHue, FSat: Double; FMaxVal, FMaxHue, FMaxSat: Integer; function ArrowPosFromSat(s: integer): integer; - function SatFromArrowPos(p: integer): integer; function GetHue: Integer; function GetSat: Integer; - function GetVal: Integer; function GetSelectedColor: TColor; - procedure SetSelectedColor(c: TColor); + function GetVal: Integer; + function SatFromArrowPos(p: integer): integer; procedure SetHue(h: integer); - procedure SetSat(s: integer); - procedure SetValue(v: integer); procedure SetMaxHue(h: Integer); procedure SetMaxSat(s: Integer); procedure SetMaxVal(v: Integer); + procedure SetSat(s: integer); + procedure SetValue(v: integer); + procedure SetSelectedColor(c: TColor); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; @@ -75,6 +71,25 @@ begin FChange := true; end; +function TSColorPicker.ArrowPosFromSat(s: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(s / FMaxSat * (Width - 12)); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + s := FMaxSat - s; + a := Round(s / FMaxSat * (Height - 12)); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + (* procedure TSColorPicker.CreateSGradient; var @@ -121,162 +136,6 @@ begin end; *) -function TSColorPicker.GetGradientColor(AValue: Integer): TColor; -begin - Result := HSVtoColor(FHue, AValue/FMaxSat, FVal); -end; - -procedure TSColorPicker.SetValue(v: integer); -begin - Clamp(v, 0, FMaxVal); - if GetVal() <> v then - begin - FVal := v / FMaxVal; - FManual := false; - CreateGradient; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - -procedure TSColorPicker.SetHue(h: integer); -begin - Clamp(h, 0, FMaxHue); - if GetHue() <> h then - begin - FHue := h / FMaxHue; - CreateGradient; - FManual := false; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - -procedure TSColorPicker.SetSat(s: integer); -begin - Clamp(s, 0, FMaxSat); - if GetSat() <> s then - begin - FSat := s / FMaxSat; - FManual := false; - FArrowPos := ArrowPosFromSat(s); - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - -function TSColorPicker.ArrowPosFromSat(s: integer): integer; -var - a: integer; -begin - if Layout = lyHorizontal then - begin - a := Round(s / FMaxSat * (Width - 12)); - if a > Width - FLimit then a := Width - FLimit; - end - else - begin - s := FMaxSat - s; - a := Round(s / FMaxSat * (Height - 12)); - if a > Height - FLimit then a := Height - FLimit; - end; - if a < 0 then a := 0; - Result := a; -end; - -function TSColorPicker.SatFromArrowPos(p: integer): integer; -var - r: integer; -begin - if Layout = lyHorizontal then - r := Round(p / (Width - 12) * FMaxSat) - else - r := Round(FMaxSat - p / (Height - 12) * FMaxSat); - Clamp(r, 0, FMaxSat); - Result := r; -end; - -function TSColorPicker.GetHue: Integer; -begin - Result := round(FHue * FMaxHue); -end; - -function TSColorPicker.GetSat: Integer; -begin - Result := round(FSat * FMaxSat); -end; - -function TSColorPicker.GetVal: Integer; -begin - Result := round(FVal * FMaxVal); -end; - -procedure TSColorPicker.SetMaxHue(h: Integer); -begin - if h = FMaxHue then - exit; - FMaxHue := h; - CreateGradient; - if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure TSColorPicker.SetMaxSat(s: Integer); -begin - if s = FMaxSat then - exit; - FMaxSat := s; - FGradientWidth := FMaxSat + 1; - CreateGradient; - if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure TSColorPicker.SetMaxVal(v: Integer); -begin - if v = FMaxVal then - exit; - FMaxVal := v; - CreateGradient; - if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -function TSColorPicker.GetSelectedColor: TColor; -begin - Result := HSVToColor(FHue, FSat, FVal); - if WebSafe then - Result := GetWebSafe(Result); -end; - -function TSColorPicker.GetSelectedValue: integer; -begin - Result := GetSat(); -end; - -procedure TSColorPicker.SetSelectedColor(c: TColor); -var - h, s, v: integer; -begin - if WebSafe then c := GetWebSafe(c); - RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); - FChange := false; - SetHue(h); - SetSat(s); - SetValue(v); - FManual := false; - FChange := true; - if Assigned(OnChange) then OnChange(Self); -end; - -function TSColorPicker.GetArrowPos: integer; -begin - if FMaxSat = 0 then - Result := inherited GetArrowPos - else - Result := ArrowPosFromSat(GetSat()); -end; - procedure TSColorPicker.Execute(tbaAction: integer); begin case tbaAction of @@ -313,4 +172,142 @@ begin end; end; +function TSColorPicker.GetArrowPos: integer; +begin + if FMaxSat = 0 then + Result := inherited GetArrowPos + else + Result := ArrowPosFromSat(GetSat()); +end; + +function TSColorPicker.GetGradientColor(AValue: Integer): TColor; +begin + Result := HSVtoColor(FHue, AValue/FMaxSat, FVal); +end; + +function TSColorPicker.GetHue: Integer; +begin + Result := round(FHue * FMaxHue); +end; + +function TSColorPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function TSColorPicker.GetSelectedColor: TColor; +begin + Result := HSVToColor(FHue, FSat, FVal); + if WebSafe then + Result := GetWebSafe(Result); +end; + +function TSColorPicker.GetSelectedValue: integer; +begin + Result := GetSat(); +end; + +function TSColorPicker.GetVal: Integer; +begin + Result := round(FVal * FMaxVal); +end; + +function TSColorPicker.SatFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p / (Width - 12) * FMaxSat) + else + r := Round(FMaxSat - p / (Height - 12) * FMaxSat); + Clamp(r, 0, FMaxSat); + Result := r; +end; + +procedure TSColorPicker.SetMaxHue(h: Integer); +begin + if h = FMaxHue then + exit; + FMaxHue := h; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +procedure TSColorPicker.SetMaxSat(s: Integer); +begin + if s = FMaxSat then + exit; + FMaxSat := s; + FGradientWidth := FMaxSat + 1; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +procedure TSColorPicker.SetMaxVal(v: Integer); +begin + if v = FMaxVal then + exit; + FMaxVal := v; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +procedure TSColorPicker.SetHue(h: integer); +begin + Clamp(h, 0, FMaxHue); + if GetHue() <> h then + begin + FHue := h / FMaxHue; + CreateGradient; + FManual := false; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TSColorPicker.SetSat(s: integer); +begin + Clamp(s, 0, FMaxSat); + if GetSat() <> s then + begin + FSat := s / FMaxSat; + FManual := false; + FArrowPos := ArrowPosFromSat(s); + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TSColorPicker.SetSelectedColor(c: TColor); +var + h, s, v: integer; +begin + if WebSafe then c := GetWebSafe(c); + RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); + FChange := false; + SetHue(h); + SetSat(s); + SetValue(v); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +procedure TSColorPicker.SetValue(v: integer); +begin + Clamp(v, 0, FMaxVal); + if GetVal() <> v then + begin + FVal := v / FMaxVal; + FManual := false; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + + end. diff --git a/components/mbColorLib/Scanlines.pas b/components/mbColorLib/Scanlines.pas index 93941c845..ba7434632 100644 --- a/components/mbColorLib/Scanlines.pas +++ b/components/mbColorLib/Scanlines.pas @@ -7,12 +7,7 @@ unit Scanlines; interface uses - {$IFDEF FPC} - LCLIntf, LCLType, - {$ELSE} - Windows, - {$ENDIF} - Graphics; + LCLIntf, LCLType, Graphics; type TRGBTripleArray = array [0..65535] of TRGBTriple; @@ -27,6 +22,7 @@ function RGBToRGBQuad(c: TColor): TRGBQuad; overload; function RGBQuadToRGB(q: TRGBQuad): TColor; function RGBTripleToColor(RGBTriple : TRGBTriple) : TColor; + implementation function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; diff --git a/components/mbColorLib/ScreenWin.pas b/components/mbColorLib/ScreenWin.pas index 5a6ab4dd0..04ada8bf5 100644 --- a/components/mbColorLib/ScreenWin.pas +++ b/components/mbColorLib/ScreenWin.pas @@ -7,12 +7,8 @@ unit ScreenWin; interface uses - {$IFDEF FPC} - LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} - SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls, + LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, + ExtCtrls, StdCtrls, PalUtils; const @@ -47,12 +43,7 @@ var implementation -{$IFDEF DELPHI} - {$R *.dfm} -{$ELSE} - {$R *.lfm} -{$ENDIF} - +{$R *.lfm} {$R PickCursor.res} function ColorToHex(Color: TColor): string; @@ -74,28 +65,36 @@ begin c.Free; end; end; -(* -{$ELSE} -var - bmp: TBitmap; - screenDC: HDC; -begin - bmp := TBitmap.Create; - screenDC := GetDC(0); - bmp.LoadFromDevice(screenDC); - Result := bmp.Canvas.Pixels[X, Y]; - ReleaseDC(0, screenDC); - bmp.Free; -end; -{$ENDIF} -*) -procedure TScreenForm.FormShow(Sender: TObject); + +{ TScreenForm } + +procedure TScreenForm.CMHintShow(var Message: TCMHintShow); begin - Width := Screen.Width; - Height := Screen.Height; - Left := 0; - Top := 0; + with TCMHintShow(Message) do + if not ShowHint then + Message.Result := 1 + else + with HintInfo^ do + begin + Result := 0; + ReshowTimeout := 1; + HideTimeout := 5000; + HintPos := Point(HintPos.X + 16, HintPos.y - 16); + HintStr := FormatHint(FHintFormat, SelectedColor); + end; + inherited; +end; + +procedure TScreenForm.EndSelection(x, y: integer; ok: boolean); +begin + if ok then + SelectedColor := GetDesktopColor(x, y) + else + SelectedColor := clNone; + Close; + if Assigned(FOnSelColorChange) then + FOnSelColorChange(Self); end; procedure TScreenForm.FormCreate(Sender: TObject); @@ -118,23 +117,6 @@ begin FOnKeyDown(Self, Key, Shift); end; -procedure TScreenForm.EndSelection(x, y: integer; ok: boolean); -begin - if ok then - SelectedColor := GetDesktopColor(x, y) - else - SelectedColor := clNone; - Close; - if Assigned(FOnSelColorChange) then - FOnSelColorChange(Self); -end; - -procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - EndSelection(x, y, true); -end; - procedure TScreenForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin @@ -143,21 +125,18 @@ begin Application.ProcessMessages; end; -procedure TScreenForm.CMHintShow(var Message: TCMHintShow); +procedure TScreenForm.FormMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); begin - with TCMHintShow(Message) do - if not ShowHint then - Message.Result := 1 - else - with HintInfo^ do - begin - Result := 0; - ReshowTimeout := 1; - HideTimeout := 5000; - HintPos := Point(HintPos.X + 16, HintPos.y - 16); - HintStr := FormatHint(FHintFormat, SelectedColor); - end; - inherited; + EndSelection(x, y, true); +end; + +procedure TScreenForm.FormShow(Sender: TObject); +begin + Width := Screen.Width; + Height := Screen.Height; + Left := 0; + Top := 0; end; end. diff --git a/components/mbColorLib/SelPropUtils.pas b/components/mbColorLib/SelPropUtils.pas index 7639a2a1e..914bf9c82 100644 --- a/components/mbColorLib/SelPropUtils.pas +++ b/components/mbColorLib/SelPropUtils.pas @@ -7,12 +7,7 @@ unit SelPropUtils; interface uses - {$IFDEF FPC} - LCLIntf, LCLType, - {$ELSE} - Windows, - {$ENDIF} - Classes, Graphics; + LCLIntf, LCLType, Classes, Graphics; procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor); procedure DrawSelCrossCirc(x, y: integer; Canvas: TCanvas; Color: TColor);