From 5d7f9b43bf84fe1cf237367092cf6d09e1ca5d76 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 8 Dec 2016 23:14:26 +0000 Subject: [PATCH] mbColorLib: Initial commit (still some issues) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5452 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/BAxisColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/BAxisColorPicker.pas | 381 ++++ components/mbColorLib/BColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/BColorPicker.pas | 264 +++ components/mbColorLib/CColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/CColorPicker.pas | 286 +++ components/mbColorLib/CIEAColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/CIEAColorPicker.pas | 381 ++++ components/mbColorLib/CIEBColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/CIEBColorPicker.pas | 381 ++++ components/mbColorLib/CIELColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/CIELColorPicker.pas | 383 +++++ components/mbColorLib/Demo/Demo.ico | Bin 0 -> 137040 bytes components/mbColorLib/Demo/Demo.lpi | 82 + components/mbColorLib/Demo/Demo.lpr | 17 + components/mbColorLib/Demo/MXS Website.url | 4 + components/mbColorLib/Demo/clr.ico | Bin 0 -> 3262 bytes components/mbColorLib/Demo/main.lfm | 1125 ++++++++++++ components/mbColorLib/Demo/main.pas | 381 ++++ components/mbColorLib/Demo/mxico.res | Bin 0 -> 25228 bytes components/mbColorLib/GAxisColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/GAxisColorPicker.pas | 380 ++++ components/mbColorLib/GColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/GColorPicker.pas | 264 +++ components/mbColorLib/HColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/HColorPicker.pas | 264 +++ components/mbColorLib/HRingPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/HRingPicker.pas | 511 ++++++ components/mbColorLib/HSColorPicker.dcr | Bin 0 -> 1860 bytes components/mbColorLib/HSColorPicker.pas | 377 ++++ components/mbColorLib/HSLColorPicker.dcr | Bin 0 -> 1860 bytes components/mbColorLib/HSLColorPicker.pas | 399 +++++ components/mbColorLib/HSLRingPicker.dcr | Bin 0 -> 1860 bytes components/mbColorLib/HSLRingPicker.pas | 405 +++++ components/mbColorLib/HSVColorPicker.dcr | Bin 0 -> 1860 bytes components/mbColorLib/HSVColorPicker.pas | 622 +++++++ components/mbColorLib/HTMLColors.pas | 346 ++++ components/mbColorLib/HexaColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/HexaColorPicker.pas | 1531 +++++++++++++++++ components/mbColorLib/KColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/KColorPicker.pas | 290 ++++ components/mbColorLib/LColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/LColorPicker.pas | 270 +++ components/mbColorLib/MColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/MColorPicker.pas | 290 ++++ .../mbColorLib/OfficeMoreColorsDialog.dfm | 204 +++ .../mbColorLib/OfficeMoreColorsDialog.lfm | 204 +++ .../mbColorLib/OfficeMoreColorsDialog.pas | 340 ++++ components/mbColorLib/PalUtils.pas | 706 ++++++++ components/mbColorLib/PickCursor.res | Bin 0 -> 448 bytes components/mbColorLib/RAxisColorPicker.dcr | Bin 0 -> 1864 bytes components/mbColorLib/RAxisColorPicker.pas | 382 ++++ components/mbColorLib/RColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/RColorPicker.pas | 268 +++ components/mbColorLib/RGBCIEUtils.pas | 323 ++++ components/mbColorLib/RGBCMYKUtils.pas | 76 + components/mbColorLib/RGBHSLUtils.pas | 276 +++ components/mbColorLib/RGBHSVUtils.pas | 179 ++ components/mbColorLib/Readme.rtf | Bin 0 -> 3211 bytes components/mbColorLib/SColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/SColorPicker.pas | 267 +++ components/mbColorLib/SLColorPicker.dcr | Bin 0 -> 1860 bytes components/mbColorLib/SLColorPicker.pas | 416 +++++ components/mbColorLib/SLHColorPicker.dcr | Bin 0 -> 1860 bytes components/mbColorLib/SLHColorPicker.pas | 379 ++++ components/mbColorLib/Scanlines.pas | 72 + components/mbColorLib/ScreenWin.dfm | 26 + components/mbColorLib/ScreenWin.lfm | 20 + components/mbColorLib/ScreenWin.pas | 162 ++ components/mbColorLib/SelPropUtils.pas | 80 + components/mbColorLib/VColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/VColorPicker.pas | 270 +++ components/mbColorLib/XPLibIntegration.txt | 3 + components/mbColorLib/YColorPicker.dcr | Bin 0 -> 1856 bytes components/mbColorLib/YColorPicker.pas | 290 ++++ components/mbColorLib/clean.bat | 13 + components/mbColorLib/clear history.bat | 4 + components/mbColorLib/mbColorLibD10.dpk | 110 ++ components/mbColorLib/mbColorLibD5.dpk | 109 ++ components/mbColorLib/mbColorLibD7.dpk | 110 ++ components/mbColorLib/mbColorLibD9.dpk | 111 ++ components/mbColorLib/mbColorList.dcr | Bin 0 -> 1856 bytes components/mbColorLib/mbColorList.pas | 447 +++++ components/mbColorLib/mbColorPalette.dcr | Bin 0 -> 1860 bytes components/mbColorLib/mbColorPalette.pas | 1190 +++++++++++++ .../mbColorLib/mbColorPickerControl.pas | 288 ++++ components/mbColorLib/mbColorPreview.dcr | Bin 0 -> 1860 bytes components/mbColorLib/mbColorPreview.pas | 251 +++ components/mbColorLib/mbColorTree.dcr | Bin 0 -> 1856 bytes components/mbColorLib/mbColorTree.pas | 686 ++++++++ components/mbColorLib/mbDeskPickerButton.dcr | Bin 0 -> 1868 bytes components/mbColorLib/mbDeskPickerButton.pas | 113 ++ components/mbColorLib/mbOfficeColorDialog.dcr | Bin 0 -> 1872 bytes components/mbColorLib/mbOfficeColorDialog.pas | 84 + components/mbColorLib/mbTrackBarPicker.pas | 843 +++++++++ components/mbColorLib/mbcolorliblaz.lpk | 234 +++ components/mbColorLib/mxs.inc | 44 + 97 files changed, 19214 insertions(+) create mode 100644 components/mbColorLib/BAxisColorPicker.dcr create mode 100644 components/mbColorLib/BAxisColorPicker.pas create mode 100644 components/mbColorLib/BColorPicker.dcr create mode 100644 components/mbColorLib/BColorPicker.pas create mode 100644 components/mbColorLib/CColorPicker.dcr create mode 100644 components/mbColorLib/CColorPicker.pas create mode 100644 components/mbColorLib/CIEAColorPicker.dcr create mode 100644 components/mbColorLib/CIEAColorPicker.pas create mode 100644 components/mbColorLib/CIEBColorPicker.dcr create mode 100644 components/mbColorLib/CIEBColorPicker.pas create mode 100644 components/mbColorLib/CIELColorPicker.dcr create mode 100644 components/mbColorLib/CIELColorPicker.pas create mode 100644 components/mbColorLib/Demo/Demo.ico create mode 100644 components/mbColorLib/Demo/Demo.lpi create mode 100644 components/mbColorLib/Demo/Demo.lpr create mode 100644 components/mbColorLib/Demo/MXS Website.url create mode 100644 components/mbColorLib/Demo/clr.ico create mode 100644 components/mbColorLib/Demo/main.lfm create mode 100644 components/mbColorLib/Demo/main.pas create mode 100644 components/mbColorLib/Demo/mxico.res create mode 100644 components/mbColorLib/GAxisColorPicker.dcr create mode 100644 components/mbColorLib/GAxisColorPicker.pas create mode 100644 components/mbColorLib/GColorPicker.dcr create mode 100644 components/mbColorLib/GColorPicker.pas create mode 100644 components/mbColorLib/HColorPicker.dcr create mode 100644 components/mbColorLib/HColorPicker.pas create mode 100644 components/mbColorLib/HRingPicker.dcr create mode 100644 components/mbColorLib/HRingPicker.pas create mode 100644 components/mbColorLib/HSColorPicker.dcr create mode 100644 components/mbColorLib/HSColorPicker.pas create mode 100644 components/mbColorLib/HSLColorPicker.dcr create mode 100644 components/mbColorLib/HSLColorPicker.pas create mode 100644 components/mbColorLib/HSLRingPicker.dcr create mode 100644 components/mbColorLib/HSLRingPicker.pas create mode 100644 components/mbColorLib/HSVColorPicker.dcr create mode 100644 components/mbColorLib/HSVColorPicker.pas create mode 100644 components/mbColorLib/HTMLColors.pas create mode 100644 components/mbColorLib/HexaColorPicker.dcr create mode 100644 components/mbColorLib/HexaColorPicker.pas create mode 100644 components/mbColorLib/KColorPicker.dcr create mode 100644 components/mbColorLib/KColorPicker.pas create mode 100644 components/mbColorLib/LColorPicker.dcr create mode 100644 components/mbColorLib/LColorPicker.pas create mode 100644 components/mbColorLib/MColorPicker.dcr create mode 100644 components/mbColorLib/MColorPicker.pas create mode 100644 components/mbColorLib/OfficeMoreColorsDialog.dfm create mode 100644 components/mbColorLib/OfficeMoreColorsDialog.lfm create mode 100644 components/mbColorLib/OfficeMoreColorsDialog.pas create mode 100644 components/mbColorLib/PalUtils.pas create mode 100644 components/mbColorLib/PickCursor.res create mode 100644 components/mbColorLib/RAxisColorPicker.dcr create mode 100644 components/mbColorLib/RAxisColorPicker.pas create mode 100644 components/mbColorLib/RColorPicker.dcr create mode 100644 components/mbColorLib/RColorPicker.pas create mode 100644 components/mbColorLib/RGBCIEUtils.pas create mode 100644 components/mbColorLib/RGBCMYKUtils.pas create mode 100644 components/mbColorLib/RGBHSLUtils.pas create mode 100644 components/mbColorLib/RGBHSVUtils.pas create mode 100644 components/mbColorLib/Readme.rtf create mode 100644 components/mbColorLib/SColorPicker.dcr create mode 100644 components/mbColorLib/SColorPicker.pas create mode 100644 components/mbColorLib/SLColorPicker.dcr create mode 100644 components/mbColorLib/SLColorPicker.pas create mode 100644 components/mbColorLib/SLHColorPicker.dcr create mode 100644 components/mbColorLib/SLHColorPicker.pas create mode 100644 components/mbColorLib/Scanlines.pas create mode 100644 components/mbColorLib/ScreenWin.dfm create mode 100644 components/mbColorLib/ScreenWin.lfm create mode 100644 components/mbColorLib/ScreenWin.pas create mode 100644 components/mbColorLib/SelPropUtils.pas create mode 100644 components/mbColorLib/VColorPicker.dcr create mode 100644 components/mbColorLib/VColorPicker.pas create mode 100644 components/mbColorLib/XPLibIntegration.txt create mode 100644 components/mbColorLib/YColorPicker.dcr create mode 100644 components/mbColorLib/YColorPicker.pas create mode 100644 components/mbColorLib/clean.bat create mode 100644 components/mbColorLib/clear history.bat create mode 100644 components/mbColorLib/mbColorLibD10.dpk create mode 100644 components/mbColorLib/mbColorLibD5.dpk create mode 100644 components/mbColorLib/mbColorLibD7.dpk create mode 100644 components/mbColorLib/mbColorLibD9.dpk create mode 100644 components/mbColorLib/mbColorList.dcr create mode 100644 components/mbColorLib/mbColorList.pas create mode 100644 components/mbColorLib/mbColorPalette.dcr create mode 100644 components/mbColorLib/mbColorPalette.pas create mode 100644 components/mbColorLib/mbColorPickerControl.pas create mode 100644 components/mbColorLib/mbColorPreview.dcr create mode 100644 components/mbColorLib/mbColorPreview.pas create mode 100644 components/mbColorLib/mbColorTree.dcr create mode 100644 components/mbColorLib/mbColorTree.pas create mode 100644 components/mbColorLib/mbDeskPickerButton.dcr create mode 100644 components/mbColorLib/mbDeskPickerButton.pas create mode 100644 components/mbColorLib/mbOfficeColorDialog.dcr create mode 100644 components/mbColorLib/mbOfficeColorDialog.pas create mode 100644 components/mbColorLib/mbTrackBarPicker.pas create mode 100644 components/mbColorLib/mbcolorliblaz.lpk create mode 100644 components/mbColorLib/mxs.inc diff --git a/components/mbColorLib/BAxisColorPicker.dcr b/components/mbColorLib/BAxisColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..a209c7ea604925723cfe488dcd62fb8c886c7881 GIT binary patch literal 1864 zcmb`|G3fTh0mt!Fk|MYyPNgK^c%wryCssQ2NkLH|!7-Wh48<i>0+VgkoXSGoKJg0qs|Bo{<3=9*)#t;}ThL3Tm$<^j6xVl_@KL3>A0e`Bvf1iJS#rq#~Ex1-(71xGq$93R3ab37> zTu(>pNE2xz1=8ig>wNYeGD0TEjC=R^_B-yqhOCeZ*&sXQfSiyEazma@u9KVOHn|{o z`SKIqc$GXNPslTJ$roSn);r`Cxgu}KJMw{iB45Zi^3y4GN|Vy26qGK1dz%mcNEuNk zlo_SupMU56o0Ju$qHHKT%7JpCTqrln)2Vf8liH>h)GmL1p6~w6{a2_H>WsfWVEvN1 zpsuJDbwk}z57ZO&LcLL+j?z&k%0>y4i}HEvWxiSY&o><3@{hmp=I>DjszNDLgX&NN zYC9^=U7(5g+`9cYjMOX>YUzZAGhS8`_R`pq*$J+Ku*fdY#^+ zx9J7FOYhTP=p*`sKBJfPH~NCUqF3|{eMdjgPxK4@Mt?e^&S)~)jDpc+^cgRV5o5xb zF-pc8W5HN4D#nJfV;mSK#)WZXJe^r*HkoZ^!R#{o%opZ}IbqJ2CG(BBV6K=IbHm&* z56lzu!n`q`&Z@JTtTwA)byW zn_aNG>^}R2Jz`JTGj_>-V=ve%cE#SXckBcE#J;d^?5A_+943d&AvjzPpX0(2aU>iW ehvc|%6dV Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure TBAxisColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + FR := GetRValue(FSelected); + FG := GetGValue(FSelected); + FB := GetBValue(FSelected); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function TBAxisColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +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)); + CreateRGBGradient; + Invalidate; +end; + +procedure TBAxisColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBmp); + 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.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 TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +end; + +procedure TBAxisColorPicker.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; + end; +end; + +procedure TBAxisColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TBAxisColorPicker.SetRValue(r: integer); +begin + if r > 255 then r := 255; + if r < 0 then r := 0; + FR := r; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +procedure TBAxisColorPicker.SetGValue(g: integer); +begin + if g > 255 then g := 255; + if g < 0 then g := 0; + FG := g; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +procedure TBAxisColorPicker.SetBValue(b: integer); +begin + if b > 255 then b := 255; + if b < 0 then b := 0; + FB := b; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +function TBAxisColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure TBAxisColorPicker.WebSafeChanged; +begin + inherited; + CreateRGBGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/BColorPicker.dcr b/components/mbColorLib/BColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..4838dac931a1f0e61ed9224e2281a6ed490eea98 GIT binary patch literal 1856 zcmchSp-O~N5JpEq5iDvFK`?H#2u4v1vVtN8yL}(vJb({iGuSs+?c03;yT#@M7_NiY z|8l*|?sqXboPn9)euw`zGu!h{DYuWm>V4Jh&@U-1+qE6riCx&a_my4RnQvn|^*Pu6 z#?IOh9{I5S(@Woz+00#A>$!(_ZvF>WK+^LWn;_}&?1H4nGXhDE=Kv%mE zrat;S21$vyAr0kox%+SflJdUxxUW{-f@GejR!u;%z*AIo)B;cWwL6f^^Aw3cxCcq- zsU`m45hTUqgU2)V(dQ{hnn<`lgCq<##~DbPNVvX$Bn&pkSCBN3aD4+w7;KIoAZa4u L`U#RS_~+vn;TsX! literal 0 HcmV?d00001 diff --git a/components/mbColorLib/BColorPicker.pas b/components/mbColorLib/BColorPicker.pas new file mode 100644 index 000000000..85b1cac27 --- /dev/null +++ b/components/mbColorLib/BColorPicker.pas @@ -0,0 +1,264 @@ +unit BColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + mbTrackBarPicker, HTMLColors, Scanlines; + +type + TBColorPicker = class(TmbTrackBarPicker) + private + FRed, FGreen, FBlue: integer; + FBmp: TBitmap; + + function ArrowPosFromBlue(b: integer): integer; + function BlueFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateBGradient; + procedure SetRed(r: integer); + procedure SetGreen(g: integer); + procedure SetBlue(b: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Red: integer read FRed write SetRed default 122; + property Green: integer read FGreen write SetGreen default 122; + property Blue: integer read FBlue write SetBlue default 255; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Layout default lyVertical; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R BColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TBColorPicker]); +end; + +{TBColorPicker} + +constructor TBColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(12, 256); + Width := 22; + Height := 268; + Layout := lyVertical; + FRed := 122; + FGreen := 122; + FBlue := 255; + FArrowPos := ArrowPosFromBlue(255); + FChange := false; + SetBlue(255); + HintFormat := 'Blue: %value'; + FManual := false; + FChange := true; +end; + +destructor TBColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TBColorPicker.CreateWnd; +begin + inherited; + CreateBGradient; +end; + +procedure TBColorPicker.CreateBGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FBmp.width := 256; + FBmp.height := 12; + for i := 0 to 255 do + for j := 0 to 11 do + begin + row := FBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBtoRGBQuad(FRed, FGreen, i) + else + row[i] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, FGreen, i))); + end; + end + else + begin + FBmp.width := 12; + FBmp.height := 256; + for i := 0 to 255 do + begin + row := FBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBtoRGBQuad(FRed, FGreen, 255-i) + else + row[j] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, FGreen, 255-i))); + end; + end; +end; + +procedure TBColorPicker.SetRed(r: integer); +begin + if r < 0 then r := 0; + if r > 255 then r := 255; + if FRed <> r then + begin + FRed := r; + FManual := false; + CreateBGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TBColorPicker.SetGreen(g: integer); +begin + if g > 255 then g := 255; + if g < 0 then g := 0; + if FGreen <> g then + begin + FGreen := g; + FManual := false; + CreateBGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TBColorPicker.SetBlue(b: integer); +begin + if b > 255 then b := 255; + if b < 0 then b := 0; + if FBlue <> b then + begin + FBlue := b; + FArrowPos := ArrowPosFromBlue(b); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TBColorPicker.ArrowPosFromBlue(b: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*b); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + b := 255 - b; + a := Round(((Height - 12)/255)*b); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TBColorPicker.BlueFromArrowPos(p: integer): integer; +var + b: integer; +begin + if Layout = lyHorizontal then + b := Round(p/((Width - 12)/255)) + else + b := Round(255 - p/((Height - 12)/255)); + if b < 0 then b := 0; + if b > 255 then b := 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 + TBA_Resize: SetBlue(FBlue); + TBA_Paint: Canvas.StretchDraw(FPickRect, FBmp); + TBA_MouseMove: FBlue := BlueFromArrowPos(FArrowPos); + TBA_MouseDown: FBlue := BlueFromArrowPos(FArrowPos); + TBA_MouseUp: FBlue := BlueFromArrowPos(FArrowPos); + TBA_WheelUp: SetBlue(FBlue + Increment); + TBA_WheelDown: SetBlue(FBlue - Increment); + TBA_VKRight: SetBlue(FBlue + Increment); + TBA_VKCtrlRight: SetBlue(255); + TBA_VKLeft: SetBlue(FBlue - Increment); + TBA_VKCtrlLeft: SetBlue(0); + TBA_VKUp: SetBlue(FBlue + Increment); + TBA_VKCtrlUp: SetBlue(255); + TBA_VKDown: SetBlue(FBlue - Increment); + TBA_VKCtrlDown: SetBlue(0); + TBA_RedoBMP: CreateBGradient; + end; +end; + +end. diff --git a/components/mbColorLib/CColorPicker.dcr b/components/mbColorLib/CColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..3a42f9d2676a71a4c2d8d6da39f160871bfe0a6c GIT binary patch literal 1856 zcmcJOF$%&!5Jg7|5o|;d#LCjb!qQ$WL_ra+-~l{^y$7)O0QMfh-rhm_!Ip z;Rl_(fuAM&vb(TmW*u)x+hd`w6|;elK-rcy^k-&M?}g26>~9krc}}ZeZ&&llT@S6S zORr>hbXTL6cK#j7pMMGuRKf*tM^v%iaP?&3Pe6U$@=6?`5`3r-d7fwp;A2O+%p7`*fRi; W*wX`%*wX=#*wX}&zj{LX*Mm=FZ~PDd literal 0 HcmV?d00001 diff --git a/components/mbColorLib/CColorPicker.pas b/components/mbColorLib/CColorPicker.pas new file mode 100644 index 000000000..058f8d2ce --- /dev/null +++ b/components/mbColorLib/CColorPicker.pas @@ -0,0 +1,286 @@ +unit CColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TCColorPicker = class(TmbTrackBarPicker) + private + FCyan, FMagenta, FYellow, FBlack: integer; + FCBmp: TBitmap; + + function ArrowPosFromCyan(c: integer): integer; + function CyanFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateCGradient; + procedure SetCyan(c: integer); + procedure SetMagenta(m: integer); + procedure SetYellow(y: integer); + procedure SetBlack(k: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + 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; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R CColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TCColorPicker]); +end; + +{TCColorPicker} + +constructor TCColorPicker.Create(AOwner: TComponent); +begin + inherited; + FCBmp := TBitmap.Create; + FCBmp.PixelFormat := pf32bit; + FCBmp.SetSize(12, 255); + Width := 22; + Height := 267; + Layout := lyVertical; + FCyan := 255; + FMagenta := 0; + FYellow := 0; + FBlack := 0; + FArrowPos := ArrowPosFromCyan(255); + FChange := false; + SetCyan(255); + HintFormat := 'Cyan: %value'; + FManual := false; + FChange := true; +end; + +destructor TCColorPicker.Destroy; +begin + FCBmp.Free; + inherited Destroy; +end; + +procedure TCColorPicker.CreateWnd; +begin + inherited; + CreateCGradient; +end; + +procedure TCColorPicker.CreateCGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FCBmp = nil then + begin + FCBmp := TBitmap.Create; + FCBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FCBmp.width := 255; + FCBmp.height := 12; + for i := 0 to 254 do + for j := 0 to 11 do + begin + row := FCBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(CMYKtoTColor(i, FMagenta, FYellow, FBlack)) + else + row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(i, FMagenta, FYellow, FBlack))); + end; + end + else + begin + FCBmp.width := 12; + FCBmp.height := 255; + for i := 0 to 254 do + begin + row := FCBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBtoRGBQuad(CMYKtoTColor(255-i, FMagenta, FYellow, FBlack)) + else + row[j] := RGBtoRGBQuad(GetWebSafe(CMYKtoTColor(255-i, FMagenta, FYellow, FBlack))); + end; + end; +end; + +procedure TCColorPicker.SetCyan(C: integer); +begin + if C < 0 then C := 0; + if C > 255 then C := 255; + if FCyan <> c then + begin + FCyan := c; + FArrowPos := ArrowPosFromCyan(c); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TCColorPicker.SetMagenta(m: integer); +begin + if m > 255 then m := 255; + if m < 0 then m := 0; + if FMagenta <> m then + begin + FMagenta := m; + FManual := false; + CreateCGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TCColorPicker.SetYellow(y: integer); +begin + if y > 255 then y := 255; + if y < 0 then y := 0; + if FYellow <> y then + begin + FYellow := y; + FManual := false; + CreateCGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TCColorPicker.SetBlack(k: integer); +begin + if k > 255 then k := 255; + if k < 0 then k := 0; + if FBlack <> k then + begin + FBlack := k; + FManual := false; + CreateCGradient; + Invalidate; + if FChange then + if 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 + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +function TCColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) + else + Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); +end; + +function TCColorPicker.GetSelectedValue: integer; +begin + Result := FCyan; +end; + +procedure TCColorPicker.SetSelectedColor(c: TColor); +var + cy, m, y, k: integer; +begin + if WebSafe then c := GetWebSafe(c); + ColorToCMYK(c, cy, m, y, k); + FChange := false; + SetMagenta(m); + SetYellow(y); + SetBlack(k); + SetCyan(cy); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +function TCColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromCyan(FCyan); +end; + +procedure TCColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetCyan(FCyan); + TBA_Paint: Canvas.StretchDraw(FPickRect, FCBmp); + 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); + TBA_RedoBMP: CreateCGradient; + end; +end; + +end. diff --git a/components/mbColorLib/CIEAColorPicker.dcr b/components/mbColorLib/CIEAColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..9d7676fc538090068e62bfc1edf5d0ef220fa942 GIT binary patch literal 1864 zcmb`G4NO*57{`A&HOfF%rezwGD=jU|xl*$wGNzzQ#;|%__HN1wW@BN_`7J4mXo?n0 z{D==h$ViAR-kA^v&hiUmN;(DeV=8{P7f^BFzw_SvqB7fZtGoYm@408^{_gYq&vO8R zOh|T^VTY@sD~vKTQYWGbC7duq%yR}X#{BL9~P8L*DA%W%wMYAn+nBt$TCB(sB=+mHFZSm4XT_Md$Qi(oM%!4gYL zA=%Ev#pumA(uhrB`lrm9O5#M8gt2TGD+aPMkX1cc)tOXS4QniY0bg25gLIFqqN;ee zglSpKTFs&bERQGENm?Wsqgg+cjs3~&OI83`K4jxj4s5cN3r2ac+2$N1uAI4rB(G<6 z3K_G>j3d`U!8o?ONntQs`%&~1#Sc^LbRNjbIh~qX9~@i(-&@)SKiHf)=I&vIi?#V= zr}K3ZMKjnIgKHu`jiGE9<%6gQqGJ2D%egrXPUq2tgu0rVrj(R3P-SVC&1vBCS~gUY zUqW#PK>-s`UDlhzq?q*_Bgxbh@CR+2ObhCaW_xr;V*w z*>RlRd#QHuM?Q7woJ``}3>sp%6wTEzt`%jpB*xz8i@Q6GJ~TpOMMY~!$PH+MW}73* zTiAP^+FI%>Ia|V|Z2nqB^8#+hb89lK6KIRWorSR9fmeL0(yPi38$T z6K79xrJCk4ZWYqD&MZc=&`0P!G!}*T)bYc*a87Qw3JT=s*A6i>FQ;ByY@_)qt;f)B z$c6Gy8d{7J&=eGfLeLO2ytn%J-$Srd@^Y?-7NHh&4jo37=sT2&R-$?6V>Agxpb_Xr zJf(HIQ&9&_tAW^RL?=--+JU}78E7e*iDFPR3PrD?XHb`a=6E3n)rKx3Q{AuVN0f`! zphOgpCZqADF7yKG_HP`6x{1!B8nhD?p$%xcW%!3yO2(yN^!NjC49bm8p#5k&%17yz z;h!KU8i$6VK;&~T%Iovpx(vjq6 Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure TCIEAColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + FL := Round(GetCIELValue(FSelected)); + FA := Round(GetCIEAValue(FSelected)); + FB := Round(GetCIEBValue(FSelected)); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function TCIEAColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +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)); + CreateLABGradient; + Invalidate; +end; + +procedure TCIEAColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBmp); + 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 + 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 TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +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; + end; +end; + +procedure TCIEAColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TCIEAColorPicker.SetLValue(l: integer); +begin + if l > 100 then l := 100; + if l < 0 then l := 0; + FL := l; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIEAColorPicker.SetAValue(a: integer); +begin + if a > 127 then a := 127; + if a < -128 then a := -128; + FA := a; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIEAColorPicker.SetBValue(b: integer); +begin + if b > 127 then b := 127; + if b < -128 then b := -128; + FB := b; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +function TCIEAColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure TCIEAColorPicker.WebSafeChanged; +begin + inherited; + CreateLABGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/CIEBColorPicker.dcr b/components/mbColorLib/CIEBColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..c1b7ec9b76069add1533d78956ced650794709d4 GIT binary patch literal 1864 zcmb`Hdr(wm7{-67IYx>_Gw7H%Miezflf0mo7pP=4QM`;S4w@;*$f)22HK7m@R!lSq z)=WYXj1g2=Aq;Va8MGi3G)*PYNh{KXq=`Wh-#!ip&HS@=&b#~VH)nt6`JU%}7ofi? zk+xFHr(U(4VUpSr>A)O3@Zv3|s84UEtMXx{+VNnT+Vy$-yAdz;>eBvYuv+xg%SKzl zDaEvZp{?5QQ_uguE{4M}7z)ndq#du1648a1d(+jKPOrgOcoRIq0JC5|EP`ba0vjNz zO$lzG?o~7w7y^S7tpoiX=T*qPFwaBq%VwK6S6C=vZ~6I znu*ISoEG2^NXJkJhgkRoQXms7VAVM)ab=!2%)pdwN-0dit26I7;^EfKU}*TO(Qfkl zxCSsFlNcLQ!=E%VfY$O!v(0(Im-JWEyh61#pY#c%Xsg3{D)zj!o1nmi&rLZNW>!o_w5Wb z^HMtGKoOL|W%vo|bxs(p(_&nWL%2hIW4%kXJ3(VuI^C3aEWhFsb2ssB9G+&zrZXUy zj#em#tMD^4K#R_aR;>h)@KLLa4qF|*uf6)qz26&}8V`O~-fcxBi%iTn@awFuBj6$Pgo#4;XE zVE0*eRTEoBL^C16V!>N*euksE;38DQS=AJMIqgfyI*Q^so{pt}ta37bWN#gb4~Y{Z zgjIsSFh%I5qjaBd!VRc~Yw*KpE(UQvnz9s1Em+S`aE;tMWHzg@CRx}fgbTsKTw(Cj zoO^H=Zo{v(-16qeda4q*oJD0Z<(DX}<>Y(M!Oh%XY097Imha+Rif8Xj?5xG7W#7ldzw zA`P`)*eQIV8Q$+-oFPaEVn*_j3gkEBp&CJ&gnL4*a9tCo&UjKorATXhstr7JPMb^r G@%?YMey556 literal 0 HcmV?d00001 diff --git a/components/mbColorLib/CIEBColorPicker.pas b/components/mbColorLib/CIEBColorPicker.pas new file mode 100644 index 000000000..bed88b022 --- /dev/null +++ b/components/mbColorLib/CIEBColorPicker.pas @@ -0,0 +1,381 @@ +unit CIEBColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, Forms, + HTMLColors, SelPropUtils, mbColorPickerControl, RGBCIEUtils, Scanlines; + +type + TCIEBColorPicker = class(TmbColorPickerControl) + private + FSelected: TColor; + FBmp: TBitmap; + FOnChange: TNotifyEvent; + FL, FA, FB: integer; + FManual: boolean; + dx, dy, mxx, myy: integer; + + procedure SetLValue(l: integer); + procedure SetAValue(a: integer); + procedure SetBValue(b: integer); + protected + function GetSelectedColor: TColor; override; + procedure WebSafeChanged; override; + procedure SetSelectedColor(c: TColor); 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure DrawMarker(x, y: integer); + procedure Paint; override; + procedure CreateLABGradient; + procedure Resize; override; + procedure CreateWnd; override; + procedure CorrectCoords(var x, y: integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + 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 MarkerStyle default msCircle; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R CIEBColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TCIEBColorPicker]); +end; + +{TCIEBColorPicker} + +constructor TCIEBColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(256, 256); + Width := 256; + Height := 256; + HintFormat := 'L: %cieL A: %cieA'#13'Hex: %hex'; + FSelected := clLime; + FL := 100; + FA := -128; + FB := 127; + FManual := false; + dx := 0; + dy := 0; + mxx := 0; + myy := 0; + MarkerStyle := msCircle; +end; + +destructor TCIEBColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TCIEBColorPicker.CreateWnd; +begin + inherited; + CreateLABGradient; +end; + +procedure TCIEBColorPicker.CreateLABGradient; +var + l, a: integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.Width := 256; + FBmp.Height := 256; + end; + + for l := 255 downto 0 do + begin + row := FBmp.Scanline[l]; + for a := 0 to 255 do + if not WebSafe then + row[a] := RGBtoRGBQuad(LabToRGB(Round(100 - l*100/255), a-128, FB)) + else + row[a] := RGBtoRGBQuad(GetWebSafe(LabToRGB(Round(100 - l*100/255), a-128, FB))); + end; +end; + +procedure TCIEBColorPicker.CorrectCoords(var x, y: integer); +begin + if x < 0 then x := 0; + if y < 0 then y := 0; + if x > Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure TCIEBColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + FL := Round(GetCIELValue(FSelected)); + FA := Round(GetCIEAValue(FSelected)); + FB := Round(GetCIEBValue(FSelected)); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function TCIEBColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +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)); + CreateLABGradient; + Invalidate; +end; + +procedure TCIEBColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBmp); + 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; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +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; + end; +end; + +procedure TCIEBColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TCIEBColorPicker.SetLValue(l: integer); +begin + if l > 100 then l := 100; + if l < 0 then l := 0; + FL := l; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIEBColorPicker.SetAValue(a: integer); +begin + if a > 127 then a := 127; + if a < -128 then a := -128; + FA := a; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIEBColorPicker.SetBValue(b: integer); +begin + if b > 127 then b := 127; + if b < -128 then b := -128; + FB := b; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +function TCIEBColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure TCIEBColorPicker.WebSafeChanged; +begin + inherited; + CreateLABGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/CIELColorPicker.dcr b/components/mbColorLib/CIELColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..8f399a7fcf545e2a842c13f5f7a58fb1e96b373e GIT binary patch literal 1864 zcmb`Ie@vBC7{?!&irMaR+KgCjwAEI!OexA=;W;&GSxir4p1zv&ZQ#@k8_xyle=&OuEKf9fH(+y9F8L_hC~L-=xV`W<~CHp708DZ5DOuX!U4d1AGr_|C8h8HO}9E zYEn{QRMfg@(_YhT4yGI0;7_;-zd{k5h9eLOLI2LtXe1y&$;=+>&~;s1jVhI@Q{PD| zwne{YEgmIpO7VOPt8JVLG$ncqJ;)Kk~!#ZkobOmTMvpqbkI;m=*`VXorxp9S?h18@| z6G!cK>XcQr?$CUsz^+2xEhHktaM0E5rAg0EnV?e5Q>$~@x{4lf@gBtu6zll;GM5S{ zNvGrhrQwtHU)JmdsE3yqx?X#HnG!q!c2M}=?^%mC!>K=Ix;Vll~2}j zPVXl>j5BH*XBVPqw?)oTtlvZY9`g569gT4x#F&ZcCANe8dJfzou7ZPQ#Gm8PaS~!V zvW-M#|5@j?5mB@W31-G-!ZjTGii=yQ51~60wwl@2OIQctdcMBJ_6j1(*l~_;()cch z$gS-B#K!SM)W{NKDIYB(ayjY#lzqybmGlO{Dl@Bl2{aPa%;&dQQ^DF&*5&a3tC@PP@B9z2cAZ)QO~K3aTBS(L}(RF>>x zSqLk9Z5;c-I>muNM`Ffsb}ZMOXqmu}3MQJE+{1H5UTDU(o>#QEl`=h-nJLVQW=;t1 zACKU;3hRV8Ay23fS_PBkv^60;h|yZ6^@tXS62{~*J_S`YlS6PB$(br_5)y<0p;EXn znE&Rq+c`?fmLR!E3KETML3~Dx=S^XYkSJUbss*D3@@PE6oH}dWkKlOQI8Wri^B3Ze BY>)r| literal 0 HcmV?d00001 diff --git a/components/mbColorLib/CIELColorPicker.pas b/components/mbColorLib/CIELColorPicker.pas new file mode 100644 index 000000000..bb98c0cc9 --- /dev/null +++ b/components/mbColorLib/CIELColorPicker.pas @@ -0,0 +1,383 @@ +unit CIELColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, Forms, + HTMLColors, SelPropUtils, mbColorPickerControl, RGBCIEUtils, Scanlines; + +type + TCIELColorPicker = class(TmbColorPickerControl) + private + FSelected: TColor; + FBmp: TBitmap; + FOnChange: TNotifyEvent; + FL, FA, FB: integer; + FManual: boolean; + dx, dy, mxx, myy: integer; + + procedure SetLValue(l: integer); + procedure SetAValue(a: integer); + procedure SetBValue(b: integer); + protected + function GetSelectedColor: TColor; override; + procedure WebSafeChanged; override; + procedure SetSelectedColor(c: TColor); 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure DrawMarker(x, y: integer); + procedure Paint; override; + procedure CreateLABGradient; + procedure Resize; override; + procedure CreateWnd; override; + procedure CorrectCoords(var x, y: integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + 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 MarkerStyle default msCircle; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R CIELColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TCIELColorPicker]); +end; + +{TCIELColorPicker} + +constructor TCIELColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(256, 256); + Width := 256; + Height := 256; + HintFormat := 'A: %cieA B: %cieB'#13'Hex: %hex'; + FSelected := clAqua; + FL := 100; + FA := -128; + FB := 127; + FManual := false; + dx := 0; + dy := 0; + mxx := 0; + myy := 0; + MarkerStyle := msCircle; +end; + +destructor TCIELColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TCIELColorPicker.CreateWnd; +begin + inherited; + CreateLABGradient; +end; + +procedure TCIELColorPicker.CreateLABGradient; +var + a, b: integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.Width := 256; + FBmp.Height := 256; + end; + + for a := 0 to 255 do + for b := 255 downto 0 do + begin + row := FBmp.Scanline[255 - b]; + if not WebSafe then + row[a] := RGBToRGBQuad(LabToRGB(FL, a - 128, b - 128)) +// FBmp.Canvas.Pixels[a, 255 - b] := LabToRGB(FL, a - 128, b - 128) + else + row[a] := RGBToRGBQuad(GetWebSafe(LabToRGB(FL, a - 128, b - 128))); +// FBmp.Canvas.Pixels[a, 255 - b] := GetWebSafe(LabToRGB(FL, a - 128, b - 128)); + end; +end; + +procedure TCIELColorPicker.CorrectCoords(var x, y: integer); +begin + if x < 0 then x := 0; + if y < 0 then y := 0; + if x > Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure TCIELColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + FL := Round(GetCIELValue(FSelected)); + FA := Round(GetCIEAValue(FSelected)); + FB := Round(GetCIEBValue(FSelected)); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function TCIELColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +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)); + CreateLABGradient; + Invalidate; +end; + +procedure TCIELColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBmp); + 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; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +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; + end; +end; + +procedure TCIELColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TCIELColorPicker.SetLValue(l: integer); +begin + if l > 100 then l := 100; + if l < 0 then l := 0; + FL := l; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIELColorPicker.SetAValue(a: integer); +begin + if a > 127 then a := 127; + if a < -128 then a := -128; + FA := a; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +procedure TCIELColorPicker.SetBValue(b: integer); +begin + if b > 127 then b := 127; + if b < -128 then b := -128; + FB := b; + SetSelectedColor(LabToRGB(FL, FA, FB)); +end; + +function TCIELColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure TCIELColorPicker.WebSafeChanged; +begin + inherited; + CreateLABGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/Demo/Demo.ico b/components/mbColorLib/Demo/Demo.ico new file mode 100644 index 0000000000000000000000000000000000000000..0341321b5d952e1662a3d9444a73cf9f42a7db37 GIT binary patch literal 137040 zcmXV11ymH@_upNX?(Rmq1f;tg1O*8J5$Q%sVwXk)X#uIFK~f~8LAtwP>F%!GKi~8F z&pC5u?!1{dciz44#^=5P0Du5Az<(PMzyMf}2LP;}&!N!&(d-yNfNBB&AS?U-v^)Ud z`V$D?=l>sF`~m<-U3z|!;s0rZ=X*gQ0KxO|zy55&0KhI02=G-`TLl-33hTLRTs2ii zz5iPO+cExowW)jY^E=~9)D-33_$(a0M}^W{O+yZxcf7^ac(o(rz~2a$OqQ0TBp4g~ zYmz|S8g96H>?G_4HQgwfjB#-UO&N;=}*&M99jA|))TbitYLr2yi5gvqA6iICRYHE8veV~DP4&szzkxu%D<6`e?i zrnAMX^2@_TDtEomoflmfp^M5(_VGeQdJwda6jVJJ481|}yuHgl@KFC>RXMtot1qNl zv}d|RxDK|tbYw@}Gj{KC014f!yDXub;s4d2 z;~e2fFvCk-IJRp&iD=F$HLB;|(|1LhC+wS_(-#4ompF~lep%6enbB>G2lxKFl7$Ta zf*%uHJ*Zvvw2*@hZQZfs2mfy5ELALb<*{gQZ;`M>fNfR)aNvsF=98syjB#G;HFIY2{R~??Jrxnvua1s4Fpe; zk%6)-@!pTJoPrt34G7DkaqWeBQDJRZE^+N5DnNY1*rm<-Rd$uSeQE7%E*phmStvV}p4O;ZCUD>2_FgQzW85RIdvy zK12fqz$9N@9ABer??PhzXqWlQw%19`xKCNiSm5dfprjf@4!OJ;LEvm$m4hd2{9L}$ zAP6hF^3A}!$DSuvqiY#2RZy@XX~V-@vMc$3fiv8|B?!Ep0qyYte(x5|`L0Avpu`xf zxIv&~iNS~&8WQM??eRds9KkQm7e2Zs97I4N7l{!xGW%Ad{b3e+TBNrB(0Wzb+|8se^tbdbMk%!Rc?lvmA}c=EtPYr4mNW^$sETrrp0Pf z4=R;%)*Rcb%UCwxAnli8#(tp!P-Jlzv$>gUOkhR%gJH!nBIm3WPV$QGQ*smSjxZC{ zHX~Fliv_A0dj0aa&X&F>K$IdFT8Z*##&#Q^je#0)_%etf_jg4ofz1LijbiE5@Ao*B zYaii#a4i;;wyD)4)qfPgd?5QJX@dl1z5eS4uiS^fq+bHVb_~3T%t(Bau`bznzvSWK zpe<1kHLP#^s(c-6P;Sww11Wvm++HdkX4d_^s~qu}-iFn+6f%(nJAl)M2H$5BVZw(2 z)mLGpY4Z<{t1Rg(uyN7)d+!7QmOwmU1y4m31e0>gQ6(7;r2uy=9mz5P0%O0$1LNf* zhcKG6nL{XS)ZuQHZXK&tA!%?Wfm=3LD_QA~hN;y%)sAQT0A#UX7$am}j_hte5(<<(LQHSFPvllYL@*7~%m z?!Ib<|5;>tGFMgh>-0}afaZXx*$7{zh^d-tMPyl5Tp!90(Cq;`5sKIcr+Mvbx zPCGR2bApd}z4>1Wz7^S``ZUq;z~0 zCF5K7{T72#U}8aJ`6a6c9p9ln|L&W9t=>eaL08Fb#u%5Vpj%feo^;GArCGPrNv3oFJ=%-@0y+E4{{pu0C;7X#y zFQzTHtX%IddUN39xp4=&yKgNvQL`}Gi+4iJ*f69qTa4pBZ@W>2iX!;b5rn+I@I9qX zb_WRG_e1aSz_@aoG8W@t0Yb}7?&xP3W&?_FBQXH4Kzs?o*~rBWH@S#El;SiowtAsr z|7olQK@j~YlH&M8j>$F&zCmg5EL~@4XB+h~oswK$oLLl{%lEB$jBqoWNS+wJV_34q z@9n&*4fWVy=c&?pC+*#7_DkCX2eDV?!;<&S=;rg3^(WfpHaldz_M-m!?+4KJ^dgkD z<+(d{NKSJUteGPHQCKd`?&OiqIWA_=}~li{?EU zVNxGOAIqxINFF7ZmcMp-^PUQ%GTk=+tdv_^w&Jh|c2Rn@YO5=lBSI;pxr^I8kX>_@ z2LG1f+x&$Oqg50lQ!r)&t@EqMVJor}Sc}vVSg!#wMypB(zblFbd~H|g9K~S3abEIk z4s@-X4H-1UmxILJVSQl){d(6-p$3=HgU~fbu03IE5c^0VxtEURa|X#X`~<>a`yO2N zWQP8UwHW77Tpf;eL0>VY*lt;wk6)j9YHk_+rf3ZpyU=^<@8*t&vGN5WZpD0iFqiX% zpVE3$kg%H-WQY3NjEjK?LphZUeihcPzyfF1!w8zC1{AdbGm1%dE9BUt6=lUR-^{j4 zU~gnj$5gHzW3dFImB@TE?d*H%z9MFSY=R%Vu&4S(cKLE|d>1D2f3v|eLsUij76vy- z8%tN)^dH_C=?_6v*K$&Az^5rSY&$a zB*u~|nj)Bn100V*6^~)xadN}x_L&G+RSImHd{FRhu`9<9wzahnaz7e96Duw^d9!5tQt)vrFVc2>m)^%H zj5z#>kQvybw(Xa`<*ZqIHPmRRD?rDMM*B{as)|Ak1bdr} z*{U45#wAun_iYi|7il{Eeuqu+m-PCj+@`Fitc@1v4wDH)7@3O}Y&5opDIfqFUbBt3 zF4R)RqRkL)KgU?lfWY*rVY+KyRYAzadmfFT*B1whYuPbP5Llcxp+Nv@wq0+@gYB#d zHmvHiz`}zy>!m>+*^nXtjYt21!!H(`J$Sj1;Q8-U{dHX;&DCR$(?w-c=ldR*5~ls- zx~^T)L$A;5)I&xT6`i-V3+WS;3ATO_aKu6P}lS_Uqfgj+r7wI@*eRU!~$>avi`Qqh7Fd<2kjM z$umcvO8!Pot*5V0IeljognuJV#Otz>mP^tQ*%rVSV}jF!s)C(a0Oz=IMiwq%*V|g~ z3m@^?AX`%!4%<$_jA)kAw5gL<)D*vE-kWVfV*c(&Nj;X;7$|8=GbbgTfDKHf+twW@ zfpG&mX93k$p7w#$^Y6H}Nc>-9tH5j^5X;fUj8Ji^uwQHX@;+t6P`? z^l}kwfO6cn-(w%*ba=kADuf^QHE1k-e?U_2v35j0V&wz#i1ZRRN-U25SjPIQetgV}~O<60r zJm_)4o}IhI(!O;%7d2fi9p~)p#+^Koj*YW4i^E}WoC$1ZE3*;YY}CGx>Sh!+mB!va zOU}Ovh=)o*3xUU(+O{R;_+~ojJJfUIEVjTAzSG}RCxXNjFWan10;#@T(P1H*E7YV+ zO|#!1C@ls@KXSDW=cAMw4MyBdmAz9@UH*hClCa-uyOnaU^*u)=(m!;GJ4AG~pS?qb z1JgrWegbW&SxmMSSd@N^$X6qPQzs}IrC+jO>dwIDRY9W~PtubyglFl>YuV5yBVN#HkzNAA4XH-RC*C@yPRGc&m&czPp0J*EuT^w!3`{0{A|-gk-cc%WO}q*Xq{ zKmjrKn!G!n_!14~*o<)-(Da&hilUSI7Xe!vfJG~K=M=gV9U7eb;lV>?O$N)GFXz-D z^pvLL(f-%8NE$5PU3kvX+WKH|Xd%CauVz#4qP)IuoNa0?78BVQ7N?rzs2 zVD3DW3wG9~W=MqQf_ZS$+sBOu_c7UX87f}L65Wc>9gDIAL8nff*eQO<_(~6{yl8gs znB)_ED8@Ipo7Su{(uz|Vk^aU@xjy-am3F{tRVqg@<$)o5OXX!aP+oHGjjfqFSFwi)=mYw?=0}7`v6?Bu4BX4PKY4ZvD0T0g1}ei z9X7woWbL*ztBkKSPrm~C_Ig9JUHV_p!8)X&zdu2yfbIGEAjET0Qg*X~TNt9HDv>i+6^cA}zQQ~ez-T<2`O_v76By_GEcdP_UbhBeu| z*YeRIPxoKmy5+;Vc))z>X{*&oUg(HnKq-La4Pt=wwk^EFA|h!ho-l+--hhtp8JB4~~6 zA!ym7DUPZOO2qF3mWF~pFrxXR#O{2uy7VSQJg(cbbCz1?v`AW?I2bv%#Z7SWt^?e`O7-Jp`x zo%?;cH7Xl@Ey2R#-%5wq>`AUC%$4nzlufDuX$f++x>z7g#m2Q4mPD>z80pkM?Ps8~ z8`e(!O`>So${OXx2R5fE=@C3VB=kzvL(WxHD3!xrNpWq&Mac%TY{G>dk{ialcW%Bgj0b2qZZ z-dz7Vl+OH#J8RX+XFr+z$3+h`w`dHn+4up+uh}8;Zj=XluRKT&W&BB>O5wu%*QFaa zqM!(3G*BS;v>Xw}#56$4(92*40{)_hoox@%s6MmefpMI2FLf23k%-&+{syV*WAh@6 z9+E`WT3i&p{_KGCGgi6v9;VfGe>F%4d}M6RaznnK?PQ~Goj>r{bVq%>3nI0}8%n-+ ze-TE&N#c%b8%mi>`fV6E0X{q`AFF<{!3YhGW)EEm0*mO~C5303eNo%LnILvoSJ%Dm zCw(G}Sta{*pX48&J)eO7g4kLis~;d-`lI`Pejv89a++Pg>3VajX@KY7#%obTl`laj zy@Sh`t>@{IgZVS|k#wK%B5dv@dn(Eh8~jL zb1}eGy0%udlKA{-D(>!tm6+hBIA|Q(*uoo>>%!qoma%!A_ITBQUUsGr>g7`>1zhgR zX1D8EkSOASVmb6z=j`P_v3-RF4X1l&&l9_1IqyS*XsUlFLu5rCLSMi?UrOPBYzv7E z!>(+2zdx8vBma_6?2gI5=_RiY!;t#duV8UqVq3c<@b%0QL2eIIiI!69cQB2H3B*r^ z>B^6gnN2a=W%rCZ`3h@InkX>S48LH*8<;-)^Yg7y+Ct^p!L7t}AY(lQ=c$WNCIG#j zTO!YVv}Hg1!J;D}B)`?FKc2>jY-8wIPX6-gzpcD;7=)(FL-1OYL|;i#v{7pXIWT^T z`&$!dYVXs8)F45;Zwh~i;_?m;4xX?oYx@(B5_K>-TE9z%77+cxLiA*_pcwUX8I;`_ zf-m(1Bq2*y3+PV>(V*Ub1#E4^(Bdsz01^d8u(caUzjAsalytV4?UN0@L2t$vlLsYe z;1ab5us^00i9YGp>h#=eWeoH2?!CqKxV7>x)>-#a}wRbb>)^v-G4<< z7m3g2cw=PR^!Tn88B{sN*&o|_m)rCX1GmrW<>qf28_qq}qzBFgDI1fsx6jMX6e_q9kjI?V^!fRy({4p6P#ZwE4&>|>#3X@uWJHjAjcJc9n~gu@%Pmppc;P< zp1zVMf}bdI&P;>{+*5=k$%K_UUesiFD6KfYCfClZ=f5{;!&nmONdgn_svn%zh0LWE zo<0$8=PbK?2p$!CvfVQLLuO{GRw*gwZeqXWd*OR}5xaWm3URYTUApmc{xY^`k`A9H zr-Qzd@drv*`pH>?A8GAQiOZ?s-)47)|&)BGA>^?U>@n%%WeB$T`6pj}4y_S_RR6 zo>Z)zaC}#rCmk+lz*jAxnj%Knvlpr!rCZmO$y7#BB9+LyH&1ZfdhzD^wIKdXrv}GH z;mLOJCG&{r7hXkX330DvbyCTPo@dX%_tjMt=cE|{e!STb=@?%T*xl$mZ4!TKKCoze zNu*kci@h;ulpCij5_k9luA*=8%4fNP_7Q0Nl1{JQx;uh_5mQwO;GJ{I_l!H|e5+K( zybIgNDfSm|x$*Wo`Lxz*#g@I~c0288hA;Ad`45BS*+4yPdjCaBkHr{1r11*B%6DV5 zr4WEml2|kxzEv*+w68UoxM6!ml>4E;^gBSt52^}{3YRn;mi;qFKW2wjV>cBwZ_);7 zrDS0WD$^jsLeeZfLBTMB-iH|Lk>mO*w5;Z37r6cXo*Uc9e(@Cs-?+$#?LEdUkb@s>4t(D!s+AMBTqE(t!?X|B@ieA5; z>M$%P)7ly)?cX`8_e<%xF~7-J^XYx?(A>FR=^E*u7(CWF`X^RsBCot7 zN=GFC;-*JZ($an_L=CqKhlU{)_t(U?59XEq_r4`bx4908DC5!fvTO;%=Lp0HC$%?Q z9P6&Q9+vHaMMOBaXaXzn;z<`LA(ao2l{xu$<)?{<+^U^5`=&sq#*hv^6~aQM$#>#^ zI=8E(VlQ1GbtL0@$3yjF!({^dEKq60@aDbmNGtrR;fw#0MNNBvPQcHrgD=}I_3a|a zr+SubOgnG3j7FSmY5p7H908!S(#{uby+VdsDjPNVPFX!FQN0K31{$sR8W90lMpoNK zDu*>sGbS#>KRMz^$K}_|Bb)gCX-RRcv9-KuWftXbm!~HX`rR*Vi^tv=FpBOhe?d z?yl$3z6*(bV8(J~(rcNvGShXK+m?~WyVPhN%fyVl{n&QVHgnRD%TZI36Z&N=>p&6(6`;8!}A2eu1nUK<{6h>Tj&Nz4z zW|-b!gq?%S3f_@cIs?tN7I1~JIIcT(F2MbAbzT6qS`N@3hzQ<@H9)RM8O52u>-_aF zG;~mDE%+eRnQw;LcD_^b*hOl?+r!5{w{yYCrWtWPgJx#3`y^5RQxt{Q?3!UWW?RmD zcJ-u%DA4RFY>FPg>#NOs^l#Tv>idIz;{Wb|on^ptbX}qLExaIVHJIBX{!r*)0(DjS zKdN;7_aqmeLcju?X6%n!4G*MYtL&l(+bfa9sGNLv)<1Xs7cOMaGv>4_%09d!`j~6P z6g;jfdemF6-?TB>Om=O0{~*_bC{Ljej$I9q+mDS15^CLo7y}EohznYi%9zDM;`GAq z#y>h!sg2Y?2}BQ_#`K!Pr?DcbqXs^Gl_BL2UioW3&1uh*^;(}{5`4;iti99eV_J}{ zT@*Bd*_6BBf+py4lkPKZUZD56=fT7D7Sk~6w`+tP^&Thy%@DRHOVuH}R#V?zo`Tfg zk7dKmT*2^`yp(2F**J|4Z75;eHNukRp2N4hM7+|!OkRM_|wEe z8u{oE1QrO6{z_?n_=ghGH(-^BZ@PA&&MNnzAIy47CcPNjjF9h)9h=b*rV)Y)lELCl{(>c0C=9Klpk7+`v0%`zA*D`A7zD{Y=ibc;fM7rYfZ~nf{ zO9*b|J$8As$E(9xQbQ)7mH4Fdi1S0|9{H17d!@2gf!iO1* z(zYL+fg4`I!JTg0dl7m8B|X_#0SV56O=Wa zX&?^Sj+rmLW_n}9R7$*Oq)NPgFhMCPTq8n_n1QE#=ZYmUWIclq9`tplXDci$EMC(N zn8pP4bM;Q1yB48vyQ*9vH4Jb{0I<)R=e>?{e-eCpl}|o6V)U=IOfw|ZdVd6kkMq7) z5E7hhu9`?NMSPB>zINaCsQ;fkMT$}1p7YV%};DhMCv z)-y1h+PUcwp3n1>tKqVzD98U%=vj~l7IvMv)gNZwrp99F`c&Bsdc$uXQpp$;!6enU z<~@7%&eOI+@tUGwK{)_2qKP`JL8ct>r3E;^dfWldmPC?V6jjkD-&I@Ex3-MBu0sp| z4!a_qifpz_Sv91Wd|Z%UZalj;ZcMREgv$oDRVLXuOTELtRX{ZN2UT;u4!+#NW7___ zy&YII13RIG=N#$^YZ?PQFv8zCxSgZVnbd`}_!19d6DWbjv2a%?3x2pZjoU^SE|RF0 z_T`-FUt^UcW~@5!v3$+;Nc#AGS%EFqxSm3%&3T8;G#*s4j3lqxldJ5O2g)+OML8la zcOmFk#`UGR$IaKp851B|w}!PW?{?d2^)IwCmG?L+U-l~DSE7kGMvh^wN12stE_!L# z7nsa_iL{|}%^es%lBxjdb5z}0xHmz5q->c!w(h_NQlxe)FlE^pzi5#$)fv=4=M5pL zM3mJ-u8te_4_vPdJu(CCEVHfVTts=E+QU9OxBAdW+OVU;BusBo>Qhk+VC@cDr!(vR{Ym^ZxMsuUJY$NrmsxBE-om=iui*i$%s3HlOH&5+XWvS}N^zQ?bJ`AnJF+Tv_0|?hUtREz%E^=-q>UMbLY4T;9gs9k-6`lqcSz8o+>8^Hxr*K=s5mxp}}NXEXA? zYgt+tGQQ^ek7H24-Rvy&wE;OU7!u&s}4%?|0U4ieNAYQ;OO;n%jph1}Rj!$fu{jej(!-_=d*NT?hg7BG&l#mRUGCPGNh|FyC0)Mmt|r0lpjIB0w$i=zXj2AsDv zH0fpBejMQn%RQ%byef)uL{^~6bZK5w9yj>6MUw)q!n$<+qHQ1h?!wIcMz2)(&1HFm zgu2t|`T~1dUf$nJbFm)c*u1|x1$>{A!Jv}0QH1@8VBjKi7lW01UEwLo7bwqW$a^%8 z+X|sg=Ahyjfw5VSi>4^P9q7U|{*APCo*P*VbEy*nL?(5TF0!v+rG~k(T`< zE?n#(-&~Ae7SFDD9_0`m=lOmmX;@o{m90n`A@sR9?_#7ly}lK_1N~UNkmj}DtF$8N z`8M7ojv2vZiZ90k5J3Ow&}!3fYH0&gCTt809!B{5t${KQt~JcF(FRBO8kQjrK7V1) zY(P)Fq?*}^`1EvEDpP`7LQlUQ72NQ#>CXOebc3Y44+@7Wp=V+F(fV&g&2M%}@fH09 zij*e>P2GB_VWV+*k`GGfalX z>8C0s#NLk_zkZ^VeT%_t8{5$tu0&LSptvD-oqhFS(|lhkGiHnHI`8Cyqv|=5>~Io= z?eYb6Xhyz&1i9Xol4EzHkv%H05v7uoFWE983tU(408D~9HL)24VFk{(w@cR~g0kh2 z(gGZ-XKb0;JCwi3o)Mj-m~_txBlcmPsE2&V15R>u(ET!Z(?eca_UyO;dTHw;xzMyTv~Jt!$^O9L zl^wb0+T*2;3=zwZ7^+xLag=~f97QJAIuU5g+3YhbtQu2V{SGVCGBUHewa^^G_QOP( z-X|j7!cnc;S~9mZ2+M7!g-&_6!(|D&UwEu?Ki*f%^$e<+y6rq1dS`i^jsrR< z`{aY0`Pz4|WiMu28d`%gtpV?9gY*Z=TXkNeoC*sGf$?P?PvqC-WkZzRa^d~%3U!MLM+*1LnVe1M@k2&Z`~k}vIZ;Rh6C*DlbRWF1KO0h%SE6C> zdKklj`u({Onmic6{c?^fs6#!k%>TMyWIfH9+z%PE4Pq}#9exf1NO#9^V8W}M$#K^b zl403ZPF>!o+kZsV0w^V*lDj*rx3SXM-bmaCt6HBDnYo8kY>SjI73;&>Md6B2k?h8o zPQ8CNlRM`J1tw>8Q@Q%YF;p7Ya;0px7Bzu*;uTTDs3wf?y6vESnbNS`1z-4b#V7S{#8#KEOLN6W2{NRDO4^flg3+~c6 z&di`|KGW?dO8twHENbrc(56;D(s%Y`MlR_)%VCEXFaXarSpn1TE^Og-f6y z^N8$+Perz}sq`%JU*!}5+I~`^>B5CI*!lw>S9Jy)B+x4hq=>#YNYUxo!f+MPlmNC! zBxY=@DGfq!k#iiJI&=tGux+k4rnq>8Q;PVzet@4HJZ;{}d-dru3KcyA(}UbwCfR%N zz7qbFauRn>M2RP{B}^gXSszU!vFqKH2$9a21!d=04wSX5K|c!4azSfxh=%}K0Dm*S znkoMjZo=(H06~W7SRH+o(S}845K6MS-wiLc((+XDKy;|x_^j38ZFaL8 zpX0j=HRV+l9)C9TYZeczLTWWZhLJQNHyZ#G8VSW8ldd zLQiFfpg`jGq-AY^2l;BRpSP2C$WmDT7oD*K&$8W!42ZGxm7z4wVt_Zgu~Amzfno_? zp3b4))U;;b-!AN%EIc#sCaYNkA!h-a05faa5}hSC5=G{m=r(c0Q;uaYWHos{alB6rjObuG7{{*lcMW{JqfpnUxu> z5f>SHOc>@cz=oaV9RD8@JF6`bm z49;%zq<1vtazgorfDav*ot&wt+5P4^mcZ?lGdHLxaD3Dhy?o;?ZEbM7NF~zImi1SF z>qIS@vWX528&BOO+}1`<*Crd#L1J6^6m*3_;E5CNpLw%wnTQNX>L+7?;t8PWqD0Ee z+;p?{ntn$J={yCJjrN4c+dhpAcFjdyPQ=i?6r3SAr%h13{HpVXE@#ASh*K!pD zZem0$HrPT5h(6aj%Im|lB^607f1R2nll8XzepjZJH!g~1iFRoyo_25EIN0CTd(p}` zhpg#5i1F3ceHkH!XqanDz`o-Ggsy*-~}6++?dS;T!m1eMMMKCuGykZtq%e>vjgmYL>|LN}usGIV81#Hpu= z7qP6s-%F6YzG@_@|HInH(}Q0(`K{4r3|*vq^tL~*D#NCKjhaI}xmJ7V->km)9gs!& zsuOdPyi}6Ezn5e6mIHif$m7i z9Rg~SHPI7mLosEF5Z+#h4+=8Msb~bTDj!hofi{9{?(VQ!v|6A33Zi(h{=j4L*v+fy%1j+KsqfHEK5x& zcTji2KyzJm3+ypD+Oa2DyHYQx#x#T!X%}H%774@JCOEQ1T(WY-#A9r|DpCPhoZG?u zj-Q_Ea-YMI;T{K-t*6s|_?_D{o@n2DNqs6;@ukPZ&uRCC1JJb=XREb^&fbN-B}{-VH% zdp)O*0h`;sOVm1epg3{(*LIYn+c%pHWO|C%wMNqWpLYDJjq!EzS!DSRAklhqGd3q7Hk87icpF(SynT~?%wBPzcs=Q-KeE=*<hsy<7@z zM>F{-1V>V}%CX=o>cRVurESI?e?c6i%xrf>Y|lVMJ31ftpzX+=>}#=4`0pMcp4EAW zN%-j&SoSFTH187<^t@6$kM9d>c`wOCaQ_S&h#(h8do8|eyPQFU$zQCH{npqNKhJ*# zkA-HAo-jG@iLcTv<(T|y|EkVc0L3|DnTM1*7Y*K*ILtTr|mfx(s_A^X|zK#6LgKVIWEQ7O4$V{r*U| zMg@hAnzhmXw6B)o)WkV&JqZ}n($#xqvLDOrV7pXDC5^Okej|b{q|rMSPlkMopB$5GDJs<3zoe-?ozQh;F}Od-FtZFzIml9{Gnos zUcun(q=*kKRh11Jw&{R#}QyLEAj$@vr7>N+yJT<)!F~} zRv%I74I=_!K&bdMujnBsdv;CJl#5KMYn@{lzM)k`zE4%^pUuyy!bopB2|9D~fBt~q z>@tcZS^#&nIwvHsQ;x3`lOQs8V*T-(94+GeBOph&xZ8sN^VG}?n%^M$ZX$pk5o;fM z-)nsFMN%hO6tmd&@fbEq*?g6;lMvm+NdgQ-5R|^bG1_~6v4L*X?ngRmZoRtg9 zpbli9Bwb~WKR^g*%HD)nIS1Y+=#e3HY@>#Gq^XDhC3t%Q_2kDxm0$&jGM*{FSGyXX zZgk~JC--&eP*en;WG8jNoV9dbW}k^Pe|l6+xx6L1U3NM>PTbK5pj@_`$Oy4W2^i5j zcsXy`8H@MroE32Qyh_Ol?o_G92>2#^>Xz28m3Lpawi?sGCIfA2ZkCj^1u>voO!0sG zC6aGEXx2^)HFlBrvyrwz7O?>ORbq}-se=Q_%Mh1pwsZGV0=Hv-rY>#mkD7Nd`2+9G z6r^WddmyW~GPWg8YWst`Wcu55BSX;7@{wR&QGTL4Q@{dK*~`e%Pao9<2!0`D3{q)h z`?t=Wd>~Rk_l^QQG559J7(G;;v_5EGnUuN(^8Z5U^=w@WfX1lKVK9H;XF%dszjXUA za=`ZlxqAWnjDH^-h`4`IynHG{R=w|nO6Plx`-6$Sif=i}#0f$Z z)ItP>1IjK)PKcv9S4pS7pdv(T3qgJK^@0@${|A>D07oAo4y363k9vwbiXfh^(_{jGj4Gry3 z6#1Yj^7fM>==I;X&lcgeA~oCGLdnU3fjc<2SvXG&UOn#^lywijRtLy~;VEcc{cEY~ zZXI9-&{&?jJy%xeFF*-)oGvi6pMW7uimI+mk=m6xsMSvnvb(-JvnQA(jnMDB+$v2&r3e(Z`T2h^*DAseP@ls6JoW5y1Qj zd`*VAt7TvW2AG%4AM@U!5VcEL(nDWXVm-$ZM%1nq=&+11w0Swfb^yJkABTrO3m=V+ zfWuh{|0lEi^@@*u@5>OIZgbVwGS3BxO3~ArhxQEf`0EV;;EqN}2}R^9^fUCF+U-&j z&@()I+<)hU586RdRR-yLoL(gnEwKS@39k@QrFm}M!-uH;B<*kb3CmF5!e&d2h~oGG zLi!4_EB>2F&Jt&bzPoRAUw)EP9uW&)>R61;jxmO6JnK85dl=UD#>?dAJjsYO(odL+ zfxz0S)1(f;7X~1y_OVb0ssL_pgp;Q4Tend!S<1OVRnE)e1(SPIPSxZ~QD9dwKPVf( zW8BKB$$bhC2hhdVeW3vrOawjNqx5=9EdQXfiO9H8RhGVexrv9kYsa)jDe@Sz`69=K zlq)KNY|B-1i*_g_MFMQ!v0tIuF5jb4-*QT-uxcn4ZP!ae>m5k2P&F{g)I-OJ+*kB--}34p@j0t*@nRg|&fck}=w0dQ(yvlsHER5%1r{0I?UZ1%B_ z_7SBGY0BAh9L3>*A0p8F&29&=Xb_c9Rx_!)f zE`v1<;c9*bU#bI0K#Es#Z8@(_Ub6s%KWj4pH2Ss6NK^a!UZLb{Ghk89qB9WVoGzHh zhGz*JL~+`5n)NQ#bv>B`-UAk>15xYq=sFHlUN z-^aJz!7=|Q{7ZC!dW?89hE0&7CHyK}3{-rFmm4pO1=JjI2rw;C9fPC0gPjdIlZQEz zf92)mFp64$U<3?A&<~}hmv`^vN8EK#K~+CS6y-R>kKr3$F7y7Sd3qjXo4GAND zo86-!dc#`j1)s-t%o?*W1I%^pE_DS0c@G2owkXqX#lv&D=9?*{jpLhQv`IK|X#(~J zDJ5EAx4K5I&jU|S1eH+~1R2P&>}oSY_az^&sgyoTtt>^g?Ht*HE~&5%;{oj8ckkX6 z%L}&OKD*`YvrxyEezFWuw?7@W1L%og*#J~1BlW;hFlO_`TqFEM3D!G0N9`qZOSH{l zc6COKqTTlPS4~wfV@gLue_m;|vnbSYb@oI;*hUbrbL=5J$tsA-NSn$8oTBVI!2WFt zPzPf@WO9J{SN3lsv`LLLSOHrg_`c4toaq$H=bL5kSe!@zJ30di7A3@q$A=mds;0~a z974^T$Fj~Nt5F3^VX7APnc_oZ4Y|?%HhSpj+4vkg8tlf5A1>lX^xwTi`9b5!Y)`x} z)Exg32kS)I4e0ZJSkJr%4@MQ!g^Zi8v%)m9nr|O-C6P4C0_@Mqi(2R~Le;-*;I?pT zb`$lR0;bk8RneBWLC<<*Uu#VKtvfoMMyc}O`gy@2aAnYiD>H;uR{8>{%OV^98Dt#} zGzdIpa2(W|#6?Z$UwRq|*-v}Gf3opyjx?ia8j8=kwrVvpw~BI{~w){aLFM z&Mq*NwqNFl)MDuL-GsK#3bn=J(s9fqB{dfDuBKG-rCKiA?>i4h^j@EdNJ07kvs!E_V zCC1J3viN-9?cW3JF*acF8_o-BKLmZ(%Wld;R7qeeR$-MQ!ylt>VAuz6yEV`{4%~-# zDN6MmoyoQ9>01VjjKPYY{SS(@yJvF(ImEs*}t{}H56TTl0~L?Rg{%g>1SN=Rj1wtXR|bkzFD7HJ9YyH zgeeufwB2z6Iu1iAh;l&t*)I(!l@81(2k8YF%bYZyvZVgD`Jy2mLA`YS#dhwI7P}tJ zpBDplsm#EqFU^=H$>Jqnew`LCkB6c0r-W|PHwW_ z(w&0FG+;%p%mfUn#VUJ2++j5q++U{l6Htv4K4HhuiLRq6leK8Y6;{CZNWaSyrf06+ zBNzO>X-&g+;T*-mgY0q+T__?pJc+8TTlb|W@UZ5zp$2ng)@2#jvn?=fdbHD6hz?Kk zK)N~k$)B(g2)m<}?eK0K2cM$m1RRhreUt>UZ=J#On`a>FT0e<2_mMNL;wV?@fQ_D* zNwg3-hnPwCI=(XPFA}O_S2ONax>A6j0Mlb;=PtuBv-qkV3usDe{Ry^48?u>dKa7TrEbqQ*aW4ElmGJR zWI;rS=6A}Xvx*E^8VElCYo6Zc1APK4RuQ;J0=7|3r6CE9%1pEu2@9h_fS(ka%w1Ps zT8i4h?N~u$2D%0Y2KFC+r+#Xh^v@M3Yvj5E+hbaDqMGyznLgEWlgk#oc29;bZ`tR^ zlOrw;leq=C4P^;~r6As~lHTBtwm!PCOb*Kg0$v?RM|`jQ>5N?=5cF7GQni~(J+E5M z_+ADJ8A~q%G=bcw;tFVSoqC%|`{K_%RdH3PlTXCpys&DwMgc!E?z*D3AGn3&Ie&^m z(anqYdb4;a)YKXjnk`(QXA~i@By0us< z`HVw6&X+yh)1O{I%==bS#&t-NbRu5#u1Iprhntzsi&Q+4FPyE0tWNS8#pB++DLe{f z`BsfX>-O%VUr^Nw`Ds`o92Az2Fi@BWHy@oh>1x zBJ0k`Oei4{3fV;VxHHPg9@(5PS=qacGs?=|BqJHwd))l_{q_0xGajGk`}KaVcU%E* z+`C7kSx7ew@Ho?DmAwRBjcF{&9sC^bX1GxvqbMoQ=JPVAqc`!NnpPkW?)2Z}Sp2OJ zp}*-E&nMQBSpYWQAF<#hbMuXLk6g7nzPGw-R+Xd@D~Mi$Tukeqg?5`n5G-)o!ajYc-HcH;?E_GLNM?bQo+LnN~9dy9^V_^kRu4LlT4al z@384O4DrnwXBDD=H)K##b`0^`mkFEf#cEzi%T^eW4RgzyN(WcXa9-{&Uxe0+`3@ED z!}I6)Hwm;;m{U3he&(+EHdY1m=4+?X*qW2Qw}9r08)nqv&+F1Zwync`YYp#0 zfn>7)g-_Ic2Tf43Z(^%I5lflg^oQ2ccC$S;OQ91qwG`Ojhx0$>!V4W!u6M#{Rnq5? zImDaJkt$i^xgBbh9yThJr6l@*FV^R9;c1EB^Me)Plm&Tp!bplIOmeNhUlyAKPRSFc}GC_faEXevYhh>gn$ATwb` z{ZS9KTs9Di4Kv-BcYz-{h^f{dwm)tW7EcN@$g`r8y!Z9NgA#NNOI)P-D8hLAXCg$I zbo?fmfhNM}5?@LR=`z&DBGYyF;XY2jkS8^L3Kqo4V}9dvAq?6mJIi2tGyL{}YHn zJIn=(DBE=J2HSKceU$^5Q5iBZJiH#B`WfL23(dhKwGPtj{>&!}D$m6K6cJ_%S7b%` zoWN(-1W3F+(s!&8xb!uOoAjxK{ipjD&2{``o`tLac|Hy4gkMdbGtJ~hK?VNQ-wb;d zvy0$T|LzuPN%Pc4QK_B$A@*=Da`g4%sw9#d+#v(6t;H&mF=}<;FNXjpGN#XNohl=Q zivZkM)7i&V29(98sK*2DR}`fA-Mrpvynveq#d+uqSmU2VYp zDdpdUY>-Gj-H?g0Lqy$*#7&TjDRtZ1gR)GRQI_g+J1xt0@VnwuR@U~53%$;znzviz zgEAS%eO-*{Fu^lBZ7LfP;0$!=Pa;9yx#xkRJXCjLN)*^G8>vTxUNjaAP3T@j98D9q z{AVbzK>t1-Y2)~D_7Zie;}l0q)jLWeXaGnsp`O<42%EkO%*pQTG&(^g~(0cE$7b ze%5L;VXLxrJj7g!p(1DS!ju9j0q~2H2lD6N4a|5PI)_oRKWK2=_q` z*E>tQQc65LXjMyvGnNnJ_`_K=n9B!VuRfy@X=M6RP99 z!D`riZe%QANaAtd9aR1Lg)Z5fyb*L||4Q+9q{($sI{=(aCcX8^TFn4%45d2MGU*sF zI@VR^2#1~(A(OFYj+HwB_FDrjp+-U%gVkAXgsH4ug_034#yb(!sY$t*eQoVf#~rsLvu70blOd z+*nVguvR>j>@o~=SCd@Q(N`tc0H)ZuFSf6_FOq#~!!(ZOfjpw2P_g#ozeQxE(f|&FvZsmYK{da4FMEZ$t&C6jNV7!$Shg?ylCx8}qBJ)XN zHyCq{5eKxGGxw!Hkrqwu{%S;G*X{r7hv$m=+tdS`QNXJ<{K19CHhPpfVy2SV^F!+1 zfU{G`&&_L!KKjmlMD=S3@|REQvi+ihle2U9%}EkLfRpw^cQri(?B60)>HA{jB%&d= z%6FUE`gVBR+sSd7vHCb1aH}!dokt{#NodAvqMzm$;tH%1e6A^mE>R72S{rS_)~mMP z=RWO;;nFI3T~XsHDu3BcZss{11y8`h41l(4J3hK^U7g7ztldX=k_K{fy>{gIB1eKIC`@;J@H`whan+#$a^Bvnp${)m=O1>CGyVvZHz$#B&G zEYuRmM3lIkI;m%&6iJ2{PE%WwQxX+?RRa0hf)xRKt0E}yluqNBBW=xcCc-u(H7N#S z1!x=*Q7{N^1F^m3!3(F(-HN+G1y5ZK!rK+7U%`JEO#oOR(9w! z2qsA7nj;sB@3ZOF3|u{lj*yt=2`w+>0GUY)(OaV?tT)IFg?K_0b0mi!?^vM&m^-dE zt%R@sBct}}l9%7Wbj76*F2dR2&T$QKGF~8KRe9I01Dg?0$(u$kEA#R250Au^-V^%? z^eDU(13d7zImNdZ*TTTq%I_zr3!|@Z6dB=&9pHP(0iB{P$sd!iKk|qrhL2*ju z`%luZo`)=vv|pulNyYT&9iMHo+FjCHS#3@AzxnsZ2Skm+4fVwSnvU2S0fj#Rg_KXM zWCLmQ|LEZk^B86vHgt7O_~pB9&x~)ID^J4mzrGr%5sOF$rz)akH&_3=%d1=drsumq zHk|Tal}$KAjfgJoBfqvb!BWe`t=h$$ASSAoCxzjEqNy{Xoer|dJf^S)TuTkj zW19V#<^wEAgB#a^OQ*}~6bu1msoqEX9Z$SZ^igz*2-jA17enHX#SB$keKWqT9Om5R zn%mA_nIhgSC)yHI4rQ@ufAIxkwwW6eC{&nwY4bKoc`meWE;fM?R6_yWUYt^F@9RQE zs8GVWslH)vC>~DbgMno zEj))4agm!rFX16SjO9J&>%#*i9|C!3d#keL?wUy5FOi>1mcY;IKiT3e@c7@8Cl0l- zeST*!mQbWzRQJK!AL1`W1hPa@7;I>J=rS;Q)l|s+Em1xzLWpl+ZE*ROG=~|5$M0|6 zEON2FzDvB-(E_05;EUW_3=~^qEHwp`hA|q_A=$D-jJ5Ftb$Q4YsN(aa(Rw+!5Do;; zmPRNaXL4D>_h6UMPVQW9(ys!SN%$a3CIH3lbEu@3atx1h(6HU$86I_o-W2xz+h@NxjQCEhm%R>#V(yP|X{(i< z%JDt~QxssJ6rsz*Wkk0?@dkIRALilSbl~XsBI}L83Ec-hu)QFP#Cc+AaIey z=z8{C>Gd*dj(FoDIKD{!?yr-wkL)x*eXPFHY-16a_I$dl)*BK`IGAk*)e?e=cx6Uz z4U^BhA70`uo=ty~1(bQOYvxXhGs)nmbSaW5b^)NYRt^&0^->Us=&-#b%!D$&MSYVA zDVkMN+rG8$r)F<$ptdT)Um{Y_i&N4B0zR?D+9N+5unl>F>$E`QiBJ;>7|Zlc_nDD- zcDCFG?qaD20sVdc`!Vfa+re=xvHA5Z=P;t1W5Y?oCekDSV&)LwKhaaFbE{^OJk4wE=Me14anoXF`oT(3Cz-6!hTEvkr=r zJs5-=H_Bc}+_?GIQ<~Kzywc^)mZNP8DPzk}XAuK3gn z^|~>nz^6?6C=dP0isH(%SrX&Xdyo$6!GWKXZelj45V{1)hkSoU&tO2vC*bdg8A&Tu z8bseK@|EvxO;F?GjBH<^PJmB^#6xkA3;%okDPtn?TI-yK_$l!=fKRVkcmYP^dx59d zwM)IWs*02?=5HeYiw?X4=A(u8)q(F-+=q{W>yo)7)J`_;9TI}suXVM-ZT}y0d!>5T z=c;dt_WYzQ8lhEW>e(T(ANEyqvmSrFxOU>Df5ELy5j~`7RNWIPuZ`lyr|V8j{W;-b z_-YdkJoCve?9Xy4;|83`nht)Ax*zz06#zMI8{XjCW7)WaC-oAoGCvpGu7g-zj8+nIFwiihXeT$4h16mBT$!+^ zTT7%q?N|V}N2-OqWFh!05!jsoPK++-ab5>By`MYu>gvj=K$$}rk_1IH2_6I?G=@)w zH~#iKTS_&h^k!ri$e@Y@}UmP~v>C&#}JfA&eK-%obvFKbvSvXk~c zN^*pq>zP6!DsS|9mwOz3Gze>T{h4$h92saShsFb!bBHl^+py6oL6vs z=C>^hv+K;PExX-cZUelH+<7>My1n(So8im{0lxix|90dgl}1`wh9qQl)X!p^hRc-@b$c?OMu1251lq{yU(_|};*3yC_^x_U~R2YkbT676&k zL$+rv+6Rmpl-SarMkO)=cEtI?H(_6EVg*66?qm+{hdM{xR25Uze7|NrYWnu;5-qpV z=bH~Uc!4o@O4HA#$G-G4(EMn$JrhC+U4#WFfOJ5*RohE8!zs$2sDr0BJV}sThW8)nL=)3Fe!p<}27JE49I1Q)gi?XE+HFHU_nid1l!ZE? z69<%%IxM<1lg@vpFfh}xhll_23{x!n9mf;f8!paLA%C;lNyMFOD-n2ynkY*#M=~(> zlge{7bvH{9NjXC-2R>-hL5$zqOY+b&ZyeAo9w6>G&}5E^1Rm_e;5``k&zKfX+Vl29 zx6-9EWNe-weqf>=5>;2?k}!s`c4%2c7CH1ttfy@@WmksJzEAp|g^%>Lov0;^^Bzm` z4eR>_l$}XP^S*URq7+=@m~^*hn|@Uw68xlgJA^>RITK9n`fEmJ7%B2IraH{TNAE4E z7ektUKE0iy9Zc}xpO_?brFLl`KYd7jPltMMC zjp%Zwb%wT4_S-uXTZPq&%)PYt9RF_0N&T1Y77z_Y@FK5w!_gZ7`R54V*_pMIh#;U2 zR4RRwGwzd-JOebl=0_63M!s0$4-T-n+xg@^?a;$#5<=P`z#t``Bz&MZQY;bD@*Tx( z1o=R!5^#BI?mYNh-MEmk=~%~O7rNX(cO>>tl##?_MqgaXj_^K+pW@CL^d3+RU1$oT zT(y=K#+kbL5S%6=%1-DV0TybvVqRn_c&M4gy?_^~Stv7?jyKqn15vzJb$H>BWLJ6{ zr6EmX9$c)>4eEKh8{KvTel&$EzmlMWn_m;-3n-ff5Erii3+35&U_L`yA+`qJH@XVD zuoO76i{;#sAoUnjC)u5!gPz?34aCEQ=7z5NBCiu@qF{=a@D)dQIPJV*v|>DA4i+4D^dGz&x^%F3;QFy} zrTcnT@t1`cn8<*o=Z=lMHEEHKAX_p9%9}=d46KxKWuSHe&eI-hcF8WNuE!QRmpU5W zDEUU^N*zO=v+{=k&m+ojUL}zANSq{;5lb=5lylA|g*U9BaIsxd;!! zNO6&99wD9(%Rm%a%<&z^#2*|{e}#KOO}YkeZnphW55Z-vZyKvHJRVXJ0V6G_*dC^Q`M(hh@`6;lm~noWm-s(Qz#z!m|9 z?^hm-9=)E4O$N)M+AeKrt0bP zSG-S%M+WTo0MHUa^Z>TZP*m7V#`oLO9KHO3fv$)ETsE^lqy5CHtqfKO`$ihaD=W@u zUmNljZ0vN8#rS|K;A7mw>ow)BEme&@|E*$DX)9!G{!OLs2;WjvSpIA}o({qAS_d}& zLG5#BeV%3RQuuMW%KLcO(76_vLUwhN61a%}mfv~cViWJEik~eL*grDqt8T*>P{NA{ z^@mVlVj{+16=s1_##0h0IT%1=A{ihG=1fp3t2P9g@XXblE$2qO81?(xsw@|Bf73!; z7e{m?;p#$gb&cos4E$0^&1gH=L-}-7qbRv5MbCM`WCg;4;dt}WM{4%&}wSe-~xOSidB2D=p86iSV# zQC<8R5GOV!Atu8^8`TFelOP7udto)}I~OY_T2(ep%N#`{??DM2*xXa@SbE&k+X#Wd zYJ$VER+!C8Jbg_C8Xn1PN<6q;IKqUwWXNM>eR1|P5V2Es&9BFY1F*mNl0z%nL4je2 z3pDD&s?%CS^0PceOIN|r4eczXptaf9wyY$pW_XgUVc9r*HR3nixlWoHc?>poAfve6 z^sqegVfZARD}r|wQg~8BfQhf{ygBH1p*!Wky#I&Ir=TAFW@lKffA#yAAGU!{cuNY) z*@J$dfMN=#tQHixWp`FF9N~+J7 z+bwsH%lTuH9Imv=bqR4pKpQ&Q5p?JII$L0uPEt$vcTezND#P+L>;7u6^FQNjy+a#Z zO1ky+JD-V|c0EK)qI4^ks)qS2Re&$Rx$ZBlhwIDBKnfEyp=K&whKx6I`5Rcbc=X`B zHg(xb3f&G_-V%IxRx%Cau(?NMgl*!eYv&N;4el=}jfBVo=o-liXVWqjn#>whvo4ue z1Bpo@aB&q%mG{K$x69>|{}z>Lfj!!A0YH~Z?UT*08c8TJQ#ayutr@8unWs6Du@P9y z3zJPW4vHae8qATHBAB(nQ+JI=)2UL_4S)Y*NIfb>x{&|l9U9EQ?jBC3GGuyn&*c;ED_etN92TKO^5QD<#{Tp{AQ1#f9dMdEUDd; z2;!@;>hzdi$tfl%tWhW5z0{+9-p)xJI zZVj*#ty$kN5F8@*lsHYsGf8F~KnrF28%QRE2VKV7&bx}`Nd}#6dKH{U8eH3;WTHF{ zhey@tE8d3(-OJzo`3tXBYmhTfXxlb`taPQpI_C-TdoXzaWS0m?2HZ(BK6dcSKiXYc&Uof zyc*^zn%9l^uVI5%*iOQ%au;4EYB|;H(s4afK7C&=Ub%KnN^Kjqblxz7EU`PG`-1rT zqj9{H>PbrirlWQY>Q;Hv>MUrSUKqIdbOY+NLg)VqlaMQIvDQj4L$hM{# zt@?=i@cq5XoyDeLh$OtL0l3FOEsFf=Cs0l5A=KFb6nJwit5l>wE`Rc<#&mjV0Iyj? z9)LL60*+6<7-5a+_kp$>vtN%-$`Kh}xTNredOQikxd5Y|vcx}8CK|O^4F2KQ?@*Q? zt@l3~N$FXcO%Mfp>}B}QGo16v&ye52XZQnZbrC?78r8H~N|`8y0-}*u;6w^-=9|uk zbLZy~jcJ~rcuKAB0aR4fCL<(q15})XZ>UO>8A10>$ZKBlFJuTNiF5Jl6nDl<`h+IV z3SR?CfZ^&wfo~ht!^sWW?K8@%se}tm-@FSNvb-VA8!Kdrh{4MCL6>~);lQeI|pV-cKW%W2YA+7 zmD;d$3f0I`<7v}a^_0Yr+8nsff*XN4vZbR2KWK$n9Zq|(g;lp3ZU5w$M*XlubLB-) z857B4Bm9b?o2P=R_CBym+$x10CYnsG;k8b!(gAco@BBGEe(rb#~L1oCK%LEu+aQ$4c-SPi++tM7jGeOezy!HS0*WS52k^GZL z#eBipy-UWnNj|fZu#P!-j5dp4CQwvkw1RTT7|u`PVfopt5X!fRG$qc`5ofD}zK_>o zOn<`j>1(KNseX2orLh6y+-Odo+?i;KIA<){DcpTb&1VI8FoHORo-|Bnq7m}NbyV}A zLW@rAN$X^#v;nupq6`>K>K1_|7V9{TD>^k#o9`S#)5uj_Qs|QBox4?6*8wPwG(OsQ zXs-MZbq_w0TG?X+K>FZc{eyYP$I3dMtZlqj8i4nQF>b2ar z-0BdvL67^9+vBhBG3Zauut5{7a{JL)Nd(m9tWT1Yf`ACLVsn1(lh=6ex8b#K=4I+@ z+WO0J<+Dw^s7e;A33#Rrr$DVv%xNOmwCqY zpAb5E?68585kKz4UNoW6pltq!M!u-*mW}_}PphZs!(YTpZ7C~^#Cq?lRI~~k?%SB? z+8ry`i`StGXbyGe43F&UtCrCwv=Lr8;KKRK3k0{HSWK|)b3_BeN{Q%z^*->|Ll7)S zPmXW@q((vCvW5VKq_+MZ>souQ*T}=P5K>b zSjDY`Ht+N$tiucur>*SIkbTMlQo$PdOm_nHbbH7S9zkJx`B%cr%k=m~YrYF+-a-#y zf-e!kZ#of|E~ae{R08ofA~zpj+4U_4?hG>qVAU~&Bs3S;Lel3*3H%T8Ll2ew1BE;y zy#!t+PtL_<&Cr%SnGN}%?lwOYpAo1+>cGI+eGys}GQu2*k|F(b9%CN-Z_)(}$7o5u zrO-WLfPFHyk)5njTyH5+{x&+JdU~q$X=oaa(W{1?RA{iTITSYfTjCe3u*CuEo6B#y z(im|8yw!D+^yjTfIPJ^Ozi+@9^EFUUqSi0p{&Pg65HVIqz`*;fyRyZp)jwBs?j|nU z;=r9V1df>`xZcG^oc7UlHk#9_gv}dqh49)b`GTcCciU1~GbP=31WPwmB~p5*Hvk&s z_Ydg5<^Rr?v$DIlL~r&@ecHWh$uL*koy8oko((o4xe@kEO@zlkG6`MpWMw`9MG!wDfK!2~&Co;hOeDRj5qQ|rw115i|NQ2a571IK+VUIcRq z*+2ia{0!?$OuVqU@S01A>baQwQJL1aOpB-CB~G1U(tWHbNMB9p7U7pZ2Ro1i_Fo}B zg&?%P8TY-t((g$W(&2o|?Hm2${`fr#0-yoeBDefpZ-wwhto^JPdO3cp{V}s>(!TQ1ba>S}~@7Wjx_iD%O;KxclTbp30aBi^tO#b#GSSb!5KKerVSe8U+ z$lFd`{{3sY0Iz~2^NW$%yZq_?&Ue|dPd4JJVlAO2v?yOvJLm{kzm_1~AX`-1+$4odMO43Ee+p(2<$wXRWzyID%kt<@LUll-5XSs|bXOLeovkU0hJutSou z+U&Y^8MC`qU*)!f$pB5P^f`HAM8d)sr}f?vd4bL>V3X{7+qv@uJmMZ1CB1G4a)jgb zqf3_smi)2v#CRc{k_8%Ts#3L4NN~&_{CY!N3Sk_4&V|sjBrcjR&tlU@RNmYpv>9US zEnGr)c1Az9nf75D7xJktnMJ}fIo+3^;v-?!lYB2EDrV7)BUq`F-%`tvX{bnN23thf z3Qa>fOfqAWo~|ota`)t`4g#B<;Aj@fC&D7!`P%$Q{~cYJ6i^JbZ%|1((`&Ui`-l#w z$N5?*VqQ&KM8a0QS*L|$N*P}W9O}P#%go!LOzKD(GylPJfK{H}Ei{n0i7q2z6wv_- zC2xzhyznsr|E{4Bb|Q}cy!|D6^sHWAkX}lP0$>f!WB`8QlQ*c-cps|p0iUh`+1MFW z-<7w}ijO=+cki3lVB2kvwg=BI)ar<7rG$oS3$^rhFBpC)#XjFx2;}ffo{(ocSFI4A z2COjPW|}*G=&MH!n4k7oXIQdH0zw}8{JN;NG~bJv4rx7SWjk$PB3B#bb#?FCKPjCj zhQm%E3fgY&!&kY2sGe{pfx9=t^F*mSuPB)bgk^%=*`a`9&0S7s)2ZQnVphNo2i%Ht z0iFcx4Rj8gm&MB@dkHeM1abJ z4Fl)9n7{T=KH&7~XB|xk62Inw`?}U*W5W}6TIf^+dZ+IOXv3obp7*mUN(-0&mN4wH zVeN0Jx}iWI+Usnse7senGocaId5`>+rHTa$ohtR1Mq)ZuR8Bs&$SQ=15USn*^#T!= zsu8MjyuTlWrpUJz*7`ix!&qToKxs}50=we|^Ec!7+&lB<|KwTJ;pAiGUYK>NAD29R zO-!J~A&Tq^gN^XaJ91|3@%yg#v5D6lMnLi08=6GHH3QZO;_X#PBcZi{Zv%$K%%byD z4EmPqE%G*xu67yPeD=&WV8uGHczuvUh~+VOg(1SEW+7kBZ3$Wx6oUsXG6+qbkbSS+ zei^7Y9kBBVxc{J3>k8MB)|oFA+5?jI)|P3o1jIYX~^}TyJ zzD!?^_}~ZICFC}*bMfPo&g2RX>SPc)=c)-XV}h&TTEfu!{9Ad#;#($ZYf0oxS9{=v zbfX`2oO&u*J3r`>^uA-DUEoCU+EEcc>o&*njWNE^ni<32U)IZMbL7-u7oLV0vLBA+)5N{)(EBRoPTr%4YJa|Xr5E@*ds`rJ)*?H zDB9l{>0GWpvC3R!k5f7LR*tBj&tZ7U*0*{oZW*(7IcB%~`VnZMs_*UMa|t%*?>-)2 zPNvRtvi61x>$yNL#7vtF9%NJWhNHaM_@MX2EjMrPNd^ZnZKgx&`8?E6b_1>o4mdWl zN@omwIqs<>g(W*4Tt9sLwZu%#=Pv@&n{T|^NRbY@B3k@)p-<LGW!$V;%dDlyAR7DO%0Gtq&B@2FGx&*+ZZqOx-=mxHDqe^PERR995orNCKY z3b^iky*UIhfV4;{YI0k{(+ub~iG+MHJWXys=#Q)0OVe}}yxrNh6#iM`)eL*W z(a*fGUa9J~5$!?az`^!wzP%qru{)8r93i_VS=eu4JKYd>H6jNHELwK^_)Q#Xn@-ce! zEgRJ#846{Odl$HoT*7uquTJnZdkKntOQN%7{xuT?r?)=f!laQb7R69-mq|5atbz4} zhe`VPdnNwsTmtcd22H%p{k2tmekqag3tjQyA|xQJd3TQeZFok_V#cs9SwKpuIcCN3gBH#fJ;4^Mk(#Q|P9@M4aj zxU3Y?nS;Wq)xyRg*Vmmii>usg=!Gc{|3{Y`kpXFu1Cp+fB=D|k7hdoF50rre96-sE zX7Xe|v*0#Nmp}drK9(7OzNdUiBn-ozz%G4>8v4GxdE5SwvtlPVi>Kn%!C^wU{3mi9 zr<=yX_(4ajyutpT6IM?Gl-G7sJYSNb3(sF1ejKDU=d-Z-{=yILL!h|}p?{f>s-PTgl$+|PJ<Hp zGd@}>o{ug6hPkSqIIGS-7xu$Q%Rc%Q#`}7c9gmGIS=J6QS>4nD`H>NGvIFZx;Kc0x zrDug&6C;5}rFg#NpOwLnHXFmG-sXg8pFM0t(7#u1h|^3o#IBwOYK)#O=`7&)<>R!1 z%3yGNwpS&n33H%n_8(|>D8+icoq#D}X6;q-wPw)WIn;hwnYaBiIAtibc!cKNU1a9~ zTg1l7JR$611d>wqQRtH|GB2L~l_Zkx%dd0h1rm2)Ulf-K^iBs_MAJCvlF7%Tl`=Z& z{T~cJBnAq7($y=@8h@7i|04@;_reR7V+XbTu|shs7Q{u|@Q+pZ7rtU9SFWD)aB)f% z?rlMj%_sBeIxY0^Ds&^)6#JY0&^=QZ z7O-(JaCdp@Fr199@6+CeMEddfj@dKvu^$dhmw`o8u1uZP+J1@k5Xa{vltUAKd*=j< zsO%{Hb5B7f4ksoGF4t*(rl>3)aEL=A@R!1Gmqp^5HVD&NNYM@aCa z1D`C@bGZd7zdP36A4VN9)x23wZ$MBs~s79C1HIBV;xD`L$ z90dWpj#5*4Ku`l4aEd;k z0lo*yu9mi$ez>Gvl0(6C#EXCacn;j0X5FYxFP5IG1b;LA$$K4Y2f-Ur4M@E)hy&Cd z&<2WX)Zi}qDSms85ogS0?7a*1QYxS-nhHkBphrJ)z4fVj>8(4ZTzi%I!BzoOH<^VQ zHc@vrkO!;~>#CWLDwaq7H*RlRdTF@?84UWmk|dPZkIG{J`>7Kt?nAC?y{5$J@Q}Pn z$5k&DHvT=y>9BfQ^FpdQ>5p?)zD}0Z8;qFcAFTGqS@_?+BHjd#4=*caEg*%z+fe2fCWM+gQWJv?KgjPk1Sx}s(Em8zBMlx+mp zo-)*ks21VDujoq0q>?|xI`YwKR%lvRXB1N9x|-?lxu{nz>lPAGDAUqD&#f{MqxnfO8G1`O z5SO;UcU^3f?y>w@oABe6%r~Ds&YW=3?b9#u^@qFWOk3|1WNKgK-Zth+3*QogfTe}_ zDtlGI!;jwY{lYiOy?MSk6AXN>N_Z#s*7@X2;DZwRFnY%de@bR8|VLvmM3CM3{{^TYusrFqsa_pa)gj*#LGBB%%* zLEtUy$nPy3cNj`g93?(j`n(3Cf2t7sU%`=I?1%q&%5JpS-UWTelA~(16RONo7#7+l zt*~?Qm6d*X4p1Y6NhWlM=d;EccSrqB3`i|kLdbSSN4Ov+rUP7@q5U?Z^OXJYXA-#N z#PD`O&o=AXAR_PWUxP*E`kuh;&=TT)(7-5bB3EcN9rfOW_e!@UUtxdz7dkqD=t%Tf zR%-|)CAzE3*<{0VqViPJeLFsdSX=t36*SvCW`!|gZ;e}T-2)O zD(KhBO`bdmU&?*0%zjA{f?I=P9fUQr;5~mStWEffXu>HR;)?k1a_&t$b7nl;z94h1 zre{B+eN89Ls9|`Nq_FtZ^$w+>)`}ji3yh1u-$?*o(`~tC%NsjBuU?5jO)MtB0JMhJldPj967$$RJqAI51~}#SFQ+H?O5>zGzuc$mX5=%r2qB z_Jd$4xF3Vib#bC8XLL&zAV9KnllwoeP^Ps@0?PNgPPc9Q#hIluxS#WMjWZJhHEJ9w z{&ZP&%D#*oVU)fChYs@^KPD^KgYRNVLGrExzd1>EiptrzavQ}%G(VVn{{5PL1v+#V z&DX{@Bw{|lds&K&-k+_egewvL?8$Kg%s}zKtjE()MTDS+FKbwxCtw6Bd0y}LZ|F?; z593aE?hwsmuTXkV-1s6%GL#dTBHWDeArJ40YFJ>_KT)3WhV3z%`8*a;YH4g_oqXs# zMtWBW>7v@e5h>Ow1jkxlLblBI#!F8o&KrWC8pyxWhTj3ADYo0clz%?-UM*>*o?N@(4?=R7R zEl=2?a4AiA8kA;xCAPPs-a`L`2$~A1yYl^a#dAM6zVdR-->A4x~3xl74FbH4ag!x zLH2{v9CPqGQ|KmpJsY-HXUmD?A+ODT>WzTu~$Yf>YvtY^tu@VDV+u0R2mRkJEOKg8YcoZgjnBeR7MNBf&-}2TIEBk#%t(3hl zmH1zw=^_g0H)ZYG56@*U(?*Wf4PfV&JsVo3^eZKH+QqvpwS;=Ikl^9b{hIgc5JJ@L zS1FIeZfnC8s4VZVstOAs8ThrW^WN{ZhA-{ZSIlhqlf=4rMo<-gbFvE1|M7bmd}%KO zVK9v+|2COecfw3&=L+XcNEIZ@OFOOLk%;EaxT1~^&>9&^Sz9VCY3GCCkd8mr{pl`c zML$(@b1fTP_(PjIxR&&&qw~4OL=_t4q>|v>XUu}hn3L6b2Wo}3k{I5Q`OlifbMx1y z8BYU+r%K)hNEs|kdR?mS$wjNsk1}5-ygPV|#nDinV(~50PWQI{{P*KBD+030&_+`U zcVya+D*P-QbiZ#Uw-M7rbtFaGhq^!ID3K_(#YY@7gpK2HDaGJde6v#}CRNO_#nv zPWXdezfE~3w;XvanFUI}{F;`uI}4Z0hG_GXQGU;*9UxDPLW0m@LR8{HeAFp14rDox zC6dA{{v$Kt^5bNb{~hhArFb~_^1J9_ZAwep)oP@8iDPVF_38Z*C3e8n00?>c>2i?m zK>o4H>w{JwbQ)8TXGjK|Zq*b=Avi?71q_4MLLvdUIgqFG8E6Wh!DX|Q3}6u9NY zj_u{y=Q{c&f>!b@QTuLausrVm{re+ImwWgJYdzPl&3t6?omT>3tPbF0VTU@>2hXE~ zJhM9|QHt!M&!<`xciZplIbTopwp_6kErm0j%&La&tc;+Nm@zLbl~OdtV(P2R?!^yu z!{3EJiwzAr%SAYB+`V=PMX)5eDJZ4C&A8>B<8z*vw7Y@0N}g*E$)#J<*~sGuJFiI@ zT|7;?1P3*ar3LBk`pz!NjldpaQwYlUez#XLBPN7z!Gg!vdso`idL8gy!Xorr;8 zm3)b3z5)H%-SSWkZq3za`7?8>a>R>Du%V_ym!P2jaC+a_k z+;bZ;3ntOk4^wpS9JqoZuO@*1w0cJL0-vSuO%15We4!S6wqyD9tdT26zn>1?2LV7g zMKv6vI#W5sGaJpW)_Vn;Sf2~m8*b7|ijs_u6F)9Niqi`MpFNI(lqb|MH;KEhlRi&V z_j~*~kE>Vqv9jnVch&qXS3pJZ6@c<)OfYAmRjllT>FBBe5kSg#Ue+#7LsBGMZ91|H zIqLC@u)lAx{qoM)yLI^VBrJt(sdW3-+b((o1jmQ1on6sjoX&DCHfc=#~fF?g@5=)&pK&J}q>inKNB(kVm4 z^D(o)_a9^0#-hpk7fC))+GL zjg?8X`eiOr!ax0A`a9k@3|POrVEiyBU${NfrKe*9l{I=El9jgLDgFtQNmdD1MJrcd z9~XKDlIU=NP!RP-Y+BwsfK60>d&KFHOf~M122Be}e}Qi`yn4`!mEZX zh3}~i&S5d64Cd|@056VanX~6N|I;Jk&?&*ER`X;T)TU<3$EL=h4}WkYVn&BUMO9pW zNXszmxb2&d0_O|bu7a@79bxKf2?qVG&8XYLE9{)wx3`1EjQWIu*%Ya~;KDz@Jo4Ti zJ|8Q2wW*jF>_XjnJ<-i7R4>beg?$Wm=9hx+EroxBP4=zJ`sbDioTUt;Z4mbCmAC>p zFXZWyF~Wh%B9~)z>JtPR%1o_^={MO(v>pnIN@J(ZpxC6s>E*?E$x2X;{h)Wg+fU;l zpvC~{DqmwqY647Vq^f*sd?Ko;%-=;n*5Ezrjt3>;%pdL?{&%xKJCw~+iS8s&5=bud|+HJVlHKgDCwWYy1e z_VcfIbbXgfE9?~IqLnhaI%K1j;){G=Ux9;oeoA##M|V;l&A)p|>$yjwO(n`F`Eix* z*A?X#>^Gf~UhsvE7t93||XksJOlwh@#FV5lbo;_%=>XTji%rq=-) zulYQE7rr$pyIPHE7w!Ck?g>TM8SI5o2p{=m5V5 z&--4b8pw(%)5iv_&hy(1%G7a=h8ZMo-A40@2Rvra1iS`S1LhkOTMLwU3pFTXYuqNTDp(D#`F7n^-3b;yxe z!+-O)b?}NAIg{#A*1>KS$KtgvqV= z@DO@AQa3@Ts;rwvWD%I9Y{_Qr<@vJWE{YU)F{uy$w)?FzD|u(M%Co2qe7jF z4eJ@R3zs7U&`X#!Uwlh3Frs!kDO-GfD(s6f_5xKd{-}o2(eM?x@2ed_k6ZNA0)`4j z4wD~0TV~#R1WD)k^irVO^G7*nCqG>W6Mf6s`P|TPa=ZIIK+bd-`8(h=Zcyqxq`2gl z$)CUV$Y!3v!IkD8%DZ^0(s^sW;qwE=!@gvORI?NiR#)L%;!Db7W=+2Y_!Zl#20 zAttzg$+d+B0T=pqb&s77)c4Xe10QtIr{%MZ$h^Xx1@IKvY+vm?Q!rR-V@6)lYIAgF z2|_&Rm_T0#DTrrwv_iw4-1tG|K8LOFEZ7V8Dq!p^q(hkA3)^$(?kb{b#{gooZp+G2N7)dZxzt&&u;qOlKh}ST?wcxx0R)8B2Ef zSioTVr_@pK+V1N_t`xW@Htv3+u-EyP!HrAVFN8O}g$J694y`)dgmq2gOYTltgXBC? zmA*6Cfz9S8`E1O8UZ+7(ec&`J3J_0F?`f0RJf1H$qG4oLDdH*~lEdy$<8}CJnQ$LV zx>fuTvaP@!ap&HHY>1f#m$cB>=jLRUYEDQAhdn4%8PzAenA?2+LZtF%G}RvxjTQED zmAhdzsN_;} zBIro`G$%}LGn3BAxdR{LmeO!dYNLDouREn8P!=WmX~*%CqyJXIiIT-wCz-|n?6P(E ze20+|DW9x%7kfhf$KF-IMX`N=qR} zF`nJ+GtU2ehIr@`Tm{=M%C$jFcDE5PyY2#vA>IYsnKQ?HGd}?I3M<16(89u6Ju>6{*R+$cp z&go$tU7}XZ>onHsGAkq)y&9UNy4|54~A$&^4W#@qSUVNo$s+F7I>M=~3TvO^z(6prHNK zW5jc<#{NFbFCTAvGS%fpzph($T&Qg}VX*Ds`n6KbR=>a8@WipZH=oKsf7fw``lIA6 z$CQtY>L2L5-1@J^$Fz*oUVjP>3a?^wNYy+p{!FKRa$P*j_uE$|(SE|@yD~N3mJru- zZJ{JLyF~Euu&8y{cc$ofUiWBHYoFWU=i`qX6&svp`+SL9mAU4puPUw$vMMog(#;R$ z67R&^F_0S{XWqB0cADH(>k@J&i??}{IxBkdj1OL=f*LMLEx&b!-jikz>c^iMX#JPV z>iZFm+F9K8ykFzEC}PJ+8MWY)s%4tr?xc6I-HFEO7K@c;JDMNpqA^6K@~H>=ryZzQ zeDHwRPCK7fJ3XZHgY;9g9-EerNJ@+TbpC3kVNulvb(k~dWuW5TH%sC^I1GI*SE+MV zMf<3YAxYbGb?PX&o8NSsU80$y?8sJQb<3F7yL<9fm4ukbgCZO|SGFjv{ItxF_X&UB zKOWn+?M$W7sZkrEFP4Ze=1?~Hv}ey!e!J$D?KDv$3yN^UqH+*4yzu!a?!n5Hn57t$OV;N*%1EmwIR16|JW;N{XT;JMU0A^w+goPxova zT_?QG+ow;PIaN$|UZHJMY_k5f!7oO-zpEs3Ym-aHhzON=#ZQ#%VC?7bKQX4l!3koG zas!uCS#$4Yuv76(jjFnKO?q&-OL26e#wZTA&IsQVd-Bp89d(yX~0_a1fJa=v}JZ&>EZ)sY*y31>MFUo zb7KXA1yipat?;bI{hj?&Yq=h}r$0qTuAf%DRn_}_jCHv*T=`PkfG7LL-kI|$qMz}d z9sw)#E(ENfyk+p@-r;AoGK?Q>TRY9=UKyj9vrpK<%R1$jehd#C zqS1NHu~TuaWHznYU+SL zbdzytl$h9RT=9i7E)G~x=j7;)NAJvysr^>Qc?-~ShY%>6YY);DcM2x{PiYn zG%rS-sw?+*RprX7nxH-z=ro<3E5f0qNHhYsqf%kE6-x_Ru;zpG<^mObGq9*Z9K zS$c2b0lN|*lkaXH?$~8;7ulB&GkQl&9@Ri)&YaPE2JOG9U(xLRyFTj=^jWl`Nk;3C z2gW`b`x+?d$;GE!=um9lym_Dc7*){p(ELzLqukwVEjE_AUS6zseVjolpS|I63q~wF z7kglX#UgKG^WyRu%iWA-pG(G2%#i7On{BIk&wHeP(-g_*>q}n5JCxowTPAiuh9s6F}@N9L}YvazJaN75g<>piEt+aAaqfvc)m8&d_Reo{r?q+qrQ8RarJ%7=?=`6$Xz3We{ zUv*(%+I9U>d$;V}`cyVi#%I|uMNJh0&lS(-rqn*O^j*A-nwej>T2)FYeqYoDa*ZntTJO(X~p;Pc0>9Po?Rw&La}zTmXR-e z?A`BXOWn(yPkyQRDsg7i7;_!De$~~Edd6-y(vfSbQ+BO)hDrm;`?B#BPE;*(dTjZm zX_CteRC|uks9e`$@!iIEjgN_&z1}%nZf5i8^VGUT%=}>9Qr<{a_3nAvBJo+NnQ{mV zRNKh3zOrK6^q`V`mwPT$FJ*Fevtpfd!{5c%NqhgOgWmHQ1}{wXG$(ZJZn3`4;g+>W zo*CTg_Wp$Kot*VHnY`@psA@jq#GIB(j_XXkG^b+eagPE#i`Q(sdsSRn&rj}8FQs^;MLtWje;v55 zRFF-#V=~1CZk^Kpx=oXS_A(0Z55?9zK6-5jvkuc@D}B&u8W1{XUsOP=8WgihedXWL zZ+m1kl}(O)J~MWQY{cp_b0=D>ynZ-s<*W$bGauXD942%4W>jQqWm!|(`bM#ly|t>W zZT(Va$@#cub%(C55IL8cveVMeR6GL>03u4`sh~gFsk+YC)-Y4`Iu6&+pQJpC(_!v zMIXI?J;bqUMCF#nw%@C&yv1r=53QMZ!UsM!u6-qbnoqG$bV#y<5{THSoEEXglP)&}3#+ z*}=sh=^fg7VS;h>YO*m$qF3s6IF!`&^~C)$FU&hukSi{y6{H+Ja zT1KLla_GeyIpv{Ej(t!(He=CW5i-@3k0i!4joCaot}=V)L%R$ZxXyA@lVVTj6z^~?+A95I*-n-v$H**Q;79O}ztYyYMU*#+P!e=&EVO}bu)a>AElNJA3ra1aspTWgX zSe+{N^6BkRCAomq)h-9p%Vmfzfz$T&8Y-Kg&N#Kq!OSi;T3+0!*rvwCy!P>>ppEi1~$DJo8IA^qv|mKI(HV#d_Ly!9X;>vrf*9=b)VFE_W&6R8+-bWq-sCk z9kpsiRy+~9+<)&gA8&810k6hRf04!58~rW;Eq0H7S$W`olbF#}qa>3p^{Qm3#|)`# zIXt#z>7lwZYlbXvJ0ESm%(1xphJ#Nwh+`UzS&VmRMi1?$cxuaQg(m*96fdosJ!HhP z-Y0bq&VQ-YTrtKwJfL5(PFrJr5-6O#PJq!25MhsMkN?b7pX}SCT7t zHb?I+uV!l3-}YSza~Jc#gY6s1n0gKly;Sb*vGAk^q71GIy6aLW>LKwfi*gr>Yv_gd2LVXinImkuVv*@EmJz*mRoqR;;9BtTAA-2ZhLn? zC)FLYrvB@Wt7Z2UJR<7+9hVzD8*uHEJ`bu zGCJNlYGJ_P&W7@HZ`yw-eps`@CcD&jQQd82?o3x|=^Jg{b7P4Uz1<$Qc)DTv8{b3g z_bzT+JYM7dD48%Nlg1@)ML&$cR?E7xOvcz^r#5fiJUv2m`tJ#jarI+TdfZ)b6c#qE z-ZF8Ud#&QkOP?s;?dtY>EmVq^mvd5#saWE4aNkR7W;CjJRz^dnpR7q|nd29$O*HQ{ z(Ink-ctg>aSC`%$t23mX^NNrzpH$WF+-_X*^vhm)<+S{l&pX{ow=-5SPdlWl9o1c@ z?zSnyX4f@pfv#+qo3&rt`P~Uik~v@!-l(IR z>xEran%2CScK3aP_v#Y5W}WrsUFc(U?C$&*ZL3C<$yj}<*3H?F_56u$NtO1uN!_AZ zr?joS?NHlPl^)@vYL}iae{g8j-8#KuhD=vP`|y z7iL4$yU!cBQ&j52SaGkY`8%6Ec=O(H=vBD}Q+HhHcBkaSxAV)TE;`oJLZ*Fh&nM#> zr@FP&464v8vG0SK`t>WeFw8J0E!R20CH1y$>0%FFz3Q9XwPe%;UAypd_HxGEi(U2= zMSL(gpl3emV_WkBe^-uIzm!sYg+a^G8G|Rbee*!ZFsSx0jbh>r4~s2s739DETqT+G zsEZ9sX4IB3JUd$EV|-|>o8=+c0h;?0E+1IB^L1Rt4w-j`^0kWh&}_MX^neeMJ>K{2 zQ|#PJWf}b0Nu0&&EQ5wM!RILcLYDt2@~8jhKS+Tk@m=)4EVns;bIJbh1 z7=yG~SMZ%O>Zk*%$~uu-ADA!Df4-sU^)LtXEE_M+@&``!fL|jVwSbE`uyV$E8+`5v z>VwY_IF12L#^)JgE2}x6c@l|up;&AcgX0o`#Nx&HK1L!IFTi#4K(j&9QSKxhN8$d# zIQGJ^9qM4+aKO1KK5MYP;aHb_4aX4Xk7Gub9{i^Zh0_IDmL=Oc`(DNz#|EJ0z`z9d z$an|ha}OMc;y4L-&IPthL90OdLZD= zIU8hJiS3JJi=#1)E+F>TgCP5fz-K-v4zv;YCIc(RaF4aM)qY!R@j=ib8yl;`w$@fh z>}exF6*mfZpsy`MXiiPSmjt`mh0fECp&0j&ov zNo>!+XkRAQR)-lwdpq$_7i+V04=cS(KIR%XTbng|;BV68aeztVr-3F7Uj&(`yb3l} zeiLk@^cKh0K_;rN@cr`u)5cHRm^OXnhn+;c%{8yPiw!O~+lWrt3%X);)D}lUFC-$FM3*5=^u;NVcj*49=L za?=I5LT+7fL=3i?4|%Tv=G%bxE*rtVGx2tn7@zUB(6|YVp9CALybd#z|J2^70kt=h zr;aA_)X7wVI+@8+XHXZB0(CK0psp4Q)D6@XpZT1>=im7{zMk*n``e+MFhhk8tTU}m z)gF3TXkT-(7M-%Qg+5q|kHSa5Pe=}ezkT2@1%Ph>&#S;Q#|e%}?LZD7O^#ix*Z=83 zjxyxLpR69w?`qg`%J%tQYN3Pg}zV6l|>Y#?Q3beRoUUEA}>4X@V{Y zF+*|?yzT|x$RETT(1t}gj>fSQe3%paGu8v>Kt+xV|HJu#9Op+IA0d-^+`q!n4YKM9 z;yi8{;_X)0`)>B_cGi~1JYahP#*Lo0HGpjkcxT#i53!PfSA>%aO$45^{M9HXv<0o~ zs6iXMY0~DNTC}CNHf`;rO^HnXv}s#E9ZKrYN1XS~{GNZ`(o0*oetj2BTHZmO76vz` z8Ew>PoL3VX2)$sP>S2|s4;{1gA=E(OLu(VYNA6Yz7onfWSQo(mA?N_dh!nIZ0r)S* zaSV=~k;mBMa|`HuZRi4zDHMlA{IBGQg3WWk9c`}(d8k1aHlU99JdSY(=7|FCw&H_s zR)*(Uwvh41Y|Pmndt1YaZE4%eX_gLEh*LYH<8)ulbdb!qPiJ=!-) zkM@HOjM1ZmOk*=Y?;oA{{l1Zz*YWkcqI7Y;4s9O@JsF@Q=m_gkTt{`96WEN#dN!tT zdu72#u+QmeqJUT-Pa%d%?|jW#-gOe2ozBvO>|7xg?b`%G?jjxm3c+U!5a)^2paVSS znB8y8aghJdKFG4ov+pxAGvhHf6Hox!KNPrgpL`SJ4jVe?ZmEAMz_8&t zlIhE5v~EVLI{kw;W0V@HCt%Fj9v-JpMeU+gnB_0*uD$r!e zp$m>SkV#|Ce>pFJ-Sb%D|A#-p-*cQpJL}=7kNC%9up=OcSZj$S33A!zVqtJT&_Lxi z|Tg~ZlqKF=E1Mv~(kFtK}>-hTn3AjJrjBcZx zzn~{Kp*tBU|MFrJy0E|m{=%3}PB(&|F@$e0K%CL1?Su4?W9ZWA&RT-L_OVqKa>owv zU+fQB8#Q_AAQq*g|8f*nr>V+-JFK~Iw{=-GA)dcMPwUhK4>mnoL?G8L44#OGJL@I8N* z`+NM(*YkZ`#*-wJmk9kpxepS|p%WtLmk7Q@MAw#?(Zv{3=zqxmw^OCL0WB$^ zyB=`YM-FBPTQ{P#sU~!Kju~B8WJXt)i-5T~?AwCwZ?c44TLN#!%95V%6w`|oE8r;x zwpR3dx0v2A?UjJ|D5kgj@}R8Wh3oc6==B~hBeNVXkIQ|&!-}3JSwSDHgnI8KSVH$K zpbO@7C02yEV}|^}6#EXEKwpgrJC9Oge{9^>MTeq&n<0Nu#`uCF`j7GyXrTPY#oXXh zwl4tYyFnPQ7S9549|*(UHmaN}K@a}4{(&5iad50hn_8kR-Z&29+#cBPaI`c{^Ve5> z8K%$UGU%&AE)#s3K~B2Boqeeh9UNx@+|B6BJP}=9YEIWzTF_tXEa_f?7_t{*A9gW4 z+aUqw65uVNSGyTAYkI@9*M{Egvj*0g^lra3z1we70Q%?NH+#9f%yM7vwx*Z6tf32; z^*-G$f$oXncf@peqZRTAEBGW!y13XJ`YJ+G3k ziWG{N;A^Dz$ky624fb&uw!wKpB4iZ<8pt+-c-aJUtju{cl7T;=k0@XdzH4$ULpyjJ z6mxJ^tAT&2n@IOku%5z)c1E1jD^a9#V~TBues^C3+8Jp?2gaFF+B6Yxw*c;zbbXbW zZf}s#{ml}3lxR&)x7)xDZRka+4Y05U?zX_)78rr{WzyUIwj>bFGe6q_d+F&duFWYU zt1O}Hy>`&A%=%v8$o0QSv4I}iAWqoO!>!hIZ<96swO&jaaboC!C8f_XhaQM%?;GM_pd5&hCjo5Opw^6futn(d=c??B`ruwy@gdX~oJjfVv)0B=vPN(Nu z(xs&m;4Y!t@ixHS7B*%_Pj}eC*6o42J>+grulCpjchFvYVDFGg`*6%5e7_I0|2v8A z&7oZ7qOR8hW!BGpyxa}GQtY4ycJySs9X(96g&x?_t#vkZElxrgVyx)YEK52(QAE3j znb5WYMzpT09*y!)gAFKS+(3bX_2fUgo9SdACtw{o2)SWiLA(;jksx364b*Y0_8aSf zEc<-$C}59cC@30j*TG5^|Ez zwUsvXS3Kmm*`6M5vxht#=-EyOdYA^O(^Z&{%x-V;x{W@EgVgS=LM7Ujw}Ix*Hzb;v9dY zqowij06oQbVZgqNxe~_M)o4v;eM%b0HjfxN)r!u{m(b;9Hgt2X9o^l;a&x4|$&Rpj zXL^?644FCuduPZvn_M9C--vcIFPXeCpU+dBpaag}--#Y2InjeHj&ysY16^Nj2j6Cc zm>{OZlPxKAn3-S$vF&s)=g(N}Up*^V^3YFB)e_CuWH0!eU#x zw#tG2+TaLZ??exioMH1W^mL~yuy=(lvuKwqbO5ybHzx4+oGH~s;QJYP=XN|sdme6c zhHg92t@Vy{b%hvbDa-D_gO}iEJH!T-gtd zf)DTpHRGJ{H|Q70G7r4=3B0ugwFXUq&yRO8(>)WYEB}$P?`Ek&v)W+1wm14jL(S>X zBr8gvYeSb}9q7hdC%Tj1LiZD0=~1#9J=x&~nYq)`6gPU7ir05#(Q_OH+J)oqN?AN+ z^UOzX2e;=j+VwEWmF{nGK|bqD8LJ)X!V-HrG1D5hUs??IZuB709oTz7MjrHJrw3%_ z`NQabvO67KY(saqF*ZN0o-fOOg0?;0?hYMrhpxLp=iQ+DE_7*`BW%GIHX)&%QRbA; z(}*T`w?wSW(g7WXzmY$sL%tX{7V?2OeCD-hyv|68*BoZeA^%hz;5re5%EJB?(NDE! zo-m%d(otk^B0xv}W0(QYoj1goxDIXUXG*(ASi#@f(zzJ;zm+a@E8dOnZuX!D+dS!E zvL`*-?gjioJF_Uo3%XD^+8k|8#_BbwM&(jerc^PKlanO~DTicbWvNujVpOGKNm8g& zjnOgpvob#k%!PgdWR3NW!WttB$i6P;-Dua(92*dFeO@0A z+ZTbK-mv{84kF{j!2UxhulOApNp+`GFd@Lj_iZG(e6-wsdoEvj#KSP*88HO!tP|O-yC3Jkc z1F&}i_8xR=qc^bkrhD6b>3)(gJxKP24uG~74KZHQVqDPcN|ul#)dm&G5A!-JN1F@$ z7npCf^+9qg;Gfz4dx<{K0Ux>Btm&^bN$6038_brH+1qG6m~mtWdw< zb8E5HQOJ8g|Ef7`hl!@-11p5-v{+iu(1?v^V3m!gE0)`ugX|| zqeYwh!0ty{)A1Qjz}^ixz9+CpTQ|3&yIWfUe?QoNE66aLaGq2+veK>l!?6FFu5kRQ zUb!?m7&o9DGwlk%e^#5(ewG8vx)JXK9q^tUN zry?)?CXXTW!@wVFPsM9FAH=yM$6=l`1fM^0-dOPasFR<&K)4qV2CeeeYxp<_`q{xm z8F5P!dMl#T5!UeejJ-QuT@4=>?~6A2(VeZ_-qv(Cu{GLWbQBq;`BSm~nm$x0SAv|) z6lm8RN9o!I8L%AgLMC^%_|adRS|K0srOR<%@B{92DB6K`M2cyBHxr6-ZiaayMGDkz zKyJpGHz9xS6QqEaf_lLojd{%d2gZS%z8?F1jy%xj%n?JZq%uJ}ibrXyaDN=x@{3i!)Ozb4FSME zi#7$KeML(lPECJX>~re@f38=f98KtMoWBeptDB%3@&0smO=~(I>q}{~-D%HQ2jo;1 zG{aAu+9S@g&-K=8`~+BV9M}osHAJ03x}2Ls2YAguQT_4Sz49oV*Xjm8h%wa*EeR$Eh9dVuC5E9ODp~9 z^det680|*M5jI%+Y(hOTzQVrOPfOu%#DQbLh3AQuDy?W|Oi4p*!J9j!FKk5@^abxj$GKA0WhiwtbX`X$Y$bSA!Pm{u&K1KcPg?-deP&FXphuxl-CZUplu8 zZ%17Xe%FRTZ-eRTdK`Zsd5atU@%YQi%Fyx=_Ib+*a=fxOm@cgfqBBd|(6O1`=vzBc ze0K{P;?NwqAm)iQ>VL8m8J`9|cs^P10lZg%K@sEua>)70p)7u`J;=t~B(}9?gAZ)` zeZ@_&UQa|jhB?wv@N{NL09}X+qRVSS1pKe84aM=tQhT>Q-~QPTlrCAE(w4$+<|Qx4 z^wR1Oy09XM(igR+gHt?d+aOzt4Kv1=iwgRK4aiqp+_5qXdnb(ae!FIp9FTnAG z*L1+2h)~{O58cLB+i2DoY=2>(0c{PprTvpU=;XpSbZ&VNU0lU{hJwQA(wZMnXW~Mr zSh3%$-=FQ*3wm?{j(N(A<+&;p_7y^BV}mGdjvwtF<4PNQiD|sMCI#yVK7brebT7dN za2^ngBR@Z@3k-QLitm{t=JB4=uzMAh<6~=Kx)6TmBinw2T{DbHSyIYK7dke}4}K|_ z&aVJ}D?_0JVLz2xS^qixzx;HfQu$K(%MG%<5ElwN3!(IwKsq$dhms>5X=Mj9>SC%Y z_y8YmW%dEw7uW>ieQz9qUp?T@>qZOo$2x=idG8G!l+nXOujx6q{SbX6S{TTEeS10( zjq!-m6vU0`n~5t&B&Y1IF~x#mD?HLP95+O^T{ zbZmATN?#10vKhAsD6{IgH%VWK`w+YG$bk|cm&bk$ZTyt(41KJYKw%>|Q z%nzc|OT*|4@ISi@eEnh?-NBsXezSRig6L$3qxv^xcm^^)6B`D*3#H?818DbnFWS)C znnt^-QvhOfYxR0$Z)SJ~_-_Mt(KveWekui7Bf`F)*Yx3D1F@w=xSvLYx2#)zEgRFC zE*7+Ngc}{16+kCrLMeSoTj;>=L-PkX5FFhf=?gl!X-Owb$UJ>X7@b%cLIUR3OfQOO+@lkYb(6?fP7HwE^1Q${5RV18!2j2m^4TFdUek+vG_B1|2eekN|B-!v zgbkk0>@J~QV}0TKLx6usKx<>*U0N!Pc&t3cUZX&DX*aGTRoTA-?#u(P zO)aP_(-s1M*x{iWfwW_|C;Ecs)X4~WAaXU%1A!s0519`?9)x~CV_vU|y7KJ@aGuD% zg2#N^^qVCJz8~XDvwihwbGQ@ji}r`lLGCfH9qQ)#3r2_MhLT>>df$aj#j>Sn<7gkL z>h!T}_FZ-SDt%~Bv!Yb(`cmGH|I!dx$WMhh1sjj60d980FSYf(afC)zzR0J&c%9h%v;z+~K9zDV)# zFjLEy2M2>cqYuD-KXIIYzHRxIybsO*{=g+=Olv$xXhTE9O@LcHp&x+xdVYp@HZb)A z{wnYRdCmuMY~UDy>vhqG+{yR{qTjb9z=#ruc+j3nL9~Aw*Hti@*44g9v1eN>hJ0yH zbV#1O*y^bkd7VY&1DN+(RmxLOPlG)9FQ|<7PYtDA69Q;sUuT-^qAA!d<7aQGe*$E`KWq$}3qeI1c z@?xj^`{2***J)IjLhZC@aX;5Qc`m42|G7Ryz-9M@Alfq6gBGrd70A5?uXSYjUV7KNc|@DX?ZyNP3h(Jz1QxZ6b$+i|z+YJFgFK@8v{0M*CCh_+Svmn+ia6 zt5x`6IEXcs^W}x}L}{=p>T7sC$K(#S`SMl}8A^TaxL`^i?nkRSN@x(q>KQ{G3k3GO zC;15Yb>45b8vA*)`OClTXL}Spbeqi0#J@hx@zF)@=LY)^pq*m^3q*+{{PA4Ij~j~* zv(?I%9~*6zpN>DzKP~I;kuP5bm19A!PafU|eKmU;W!qf9pK-)E0Iv%h5A1D0wb;*p z2|mt+^&YrR*;_|-3*Q%n+%Kk$A#EP$Ny)%+J9J?CDCwz#gU%0=Kg)S(U-x|Z*%akR z70Ucv9}sG-nJ-TTkzawY1wKi@KfbpMMZ2iy;O}Uv$IprIKC@2j-}87zET`}9tEG67 z@$ZD^xR(Z+(&jRv zNIxnl@wk0a%blO6ax-XBAYLYgNYGy_dR}t3tz_|Hv@YDcKztQcp3+>uHNuZJ_V=Vk ztqdqc8+#4|N37kt1;0N7#Cx5R95O1^Z;wziKqC7JGi~Wt!2T&C7 zM<3uZ?0**U_W{OvtqB&^dOH|tix_*R;TZQ_+0m8~26ziPuxXGFNlPY88x)zW+2&pJ z8cAJuemqVJmQX$PNs4NnQ0WrIX|%tERJ`?Y)T3q%s#BBt)kv*=b$qTtE#zxZJ8L{g zQ2^QId+k79+6Y}=8fZqn@SGsy=&Pml0@%-n?eqR|%JA`D8v_*ZcQ$BgpN;=$E?EG`_Qj_u2!Ke&1`31pt_~yH3Bwk+Ekv{udt4Nt^WMJQ>|Tv z*7Wtvm$!wTorO9$KIB&x|1N5#K(XCj^DR%Bwr%L^MX`w6{X`7~{99=%yp{rg!T)2< z*NgGzasTo5EogNYN7~TeN6-P*18HbYZ_j+&nx7o9e-mt8w~8{f_ARGTlPAzG5H)q<=*Bd(ED>b#Z)-G_nvvKERt;*$Tb~^{D z>njLv(q6k3Z64D`Oe0%a(r{l3it;w6IqlgNq?3b(LE+|~m1|X@^-|XLB~R=7c+v8< z5*lLJG^-C#|0A%U4$3$G<8@!&It@Ey<3GhkgI0HSruDtCzO1j0)TD;EmK#rLKXXj> zHEu3-Jq6+EXI>j1Qva^@e<>%`+Eu?#7Vy7}f0S4)rw=HxvgG{VHNXBJ=LJ66Dm?}K zv4&u#o2G#OIst!g@FE>mg8$6j7HRr{4XRb7`5m34u0vX0e#Ld=N)_FhQ*S53g2|+h zH?8aCf#@U+7#ExiPrY;q_w?Ju9TG9-fLj)GyA^T zVGa~#sYw>i6iM7di6;6>a(>Ic=1)Ja?BP+Q__NN8M;;=zTwtqfy1OI)v!*CXvmE=k zva}ch{LSG5@|ypVVZHFuQg+P7f3h?1@8E#)fPYWM-&-om-IwZSr!Un#(w6-vTvt?M z3)%j{Rzp>K83L!(-Q4gzh&AT!fj{CnKf4Fq`CWsCz&Nk@Um2bk^wd%@&BlL%Gv0yP z-i}s7p9K6_2c#gzzh2b}6l|^`)%DVp`6pe&d0RGiMR8Q9UP)>>u7R&!*~OJ&gT*w+ z3i%)KZ>1ss2H1DU_>UH^?FUa^UH`-D068RI^gK0?D&Zl?pV*Px4Fn zWjT52s}+b}NI%c(tCTAvbvqb;&e<0SU>&$|Lm~ge{Lf|J@0icre-`{QGQ2(<&wQO_ z{QH8zO&_|tMYx%xqYb@HZ4`9=AZ3!MSBOD<7&i(j(F(~`1xgWmI{*wd#V|o5382S_AZwC7Z{=j~HzcxRW8X)flQ-vnZ3s%A= ze>VT~JGtjMk5rI$g}aHQ;(cA;)fYGV}En4JbCvs)ug8NYf{~+6{#Y|u6fLj z=b)O&*CL5VBN`WIpXa^bl7~v|YK3mcn*RP$)xW-f0IliegFc%bjdIY!bAXxae{4lY z{OnKmvtQYEp6Ah5y@5XK4eQTDS6##t2f_br0R9^W2LBW)Q?f*%<(3=&hIOj{i|-Jz zp0M{`?(6dUY}QPf)_+Ia#{@VOsvVV)`$;SF_yNElaXJ=be}g2=1^i*luaNhf@LrI4 zto#0#9{7rMN&){DtUp6+)M;5;TLJ%#14AfbNZ1djh24D%C9|(#*r;xe&-m`_U|irj z%46<-Y@p+3gd0JjVEco>*sDMb$uJcgM@K{rNLI%52}&S_ro*Xc+b3bbBy~* zz5fgNk_G;WoC9_-!TXuf2jrYKVQ?sIifm7te=r4F>3z4n@{*~WVapu8XLt7b?)6_h z_AslHcTQQ-$fCEa#do!*R^wkXg z_4{)Uz~wAxBNFtAb$#>DjHp;Wh8(d-j}R#AD3!+yzcUgO7neL={}Oy^%^e_2=V^Ey?f@6QhKv6H&KS^ z{JDS2f*&7cW-qtL1-7E<^mCNw0}ARYczo2>gpY%ygwM7dRx1 z=|!6&+7ZY8!M2*&<38{3+#kOe^1I&+3;QntdcZNDzgQjPz%D}mpFFlN?U*=#c1#NY zA!M&#`1O;O%a^0%318>0sPJd(HjjZU3L%Gbr9Yo1WZpK9=`DSkz#(Z&Pa!tP!uPi` z%Ix=H&3_WF^^msDpO+_q517U=AjCiw@AI`L?qjn5**SS2rA!(8LukpMj{mZWuh~gn z-?0q2jJ)_Os`WWsPhNFM`+bQoo(pNzpiY6xWZmQV&vOowy^M2wzn8XZ5b*!nb3S=N z{nhXNTGrFejsauc41{q2u5V}bAWEGU`NJqL-y;3v3`$ZLN3id$y+{`!xctu1R5*7hM6;SVt&ont^3?5Vc`YqWXH zgYAFU^eEarW7rQN8$FHh#>h`%k}prCzN0S=LHvuKT2(6LThF&-lQ4F`XJxifkuOkr ztb3emaKCJRpqPU7cn^52_tI3DQxvwJ1-}epfPeN_&}45@p&yVut}pGHF_iYq9swFz zIGj%$v!zhe(KjO{Cphi0mqPCb4KM`SAKl(Z(Alukg0|m`h+EDSi4qIm$i597(q`s z26NuO2z~QV1FZFd?fYrSFD*>Y&v<|B5BRrdAHY6lS}SwG=Wq;Q{P!;y|3k<`qu_h^ zswp+dlb6_Gy>sjhZ7kGhkyi6O>-kag$SHUJIN(2mlE?KC)@4LG>So*i2jqRt^Vr|( zYp_cF9q{Kl!M}J;xThsQ7wRF5Pwk#Hoc1rAKnG(c6*(EUEci2&9X#yws^hw&(HScwZ2zsyuWrK@bAe! zhJCU9{BsB829Bq-;9A> zzFJ37w*9MRLB0pk4vrn1fAO5`U^{JLd=9?(qmQPd){nxT^#S;oL_O!(2Xr)TO3OOA zQsT&Nw0HI>0sF(T)9LWCq9cic*1xcq!~82_@TFd~Y^0oT-BbH_{?|QUmLbh~TX(yB z>nY0i|EsLnY4ACdg?<;u{aFFX`Sn$^;(q=4MVa$K7GM2?4v4e+0#VKeLSJC#HgCW}Q=t0Dl`Jop07tl zg{Fv(|MZU;tD03S7phG4#s%LKx=g836gwuOQ1upC7LX_Vg1vLb2=lKo*c+vtag*%z zod^1~4fwA4J;w5T|DXdsg*X5m9Oi0B8wOxs;Hi;xBz6X!Si6W$u3ubeIcZ{Wz@k<2T-!*-xU}HmJYl7d$SWIh;`h5z6VPWru z4%C1T5XJ;Liki_<^aqkKcgebX5_)@j(+WDXd1axfW#h~}w3;_mp@XXy6{@T+c^TiY z`&aRAi8%4)wLkm(^rkpL|Je5T%^NG&)^zNb!M4UW2iYe8zn_xt<)WFs?7ov>3?p1_;N83K5idZ*r60*E$UXw50{_$8+2d@_XpT74R%7G5YHiS zo_cK6T)~dcZCgv{lh^-Nl)PltXSlN-@Yuqp`BQ&6pDeHRgylkik7NFdu3pp)d3M(P z&U?(s8~;pvzf~9TmjelF1$jJTn41Z09281>W{nVXL2l259UFfuYT4x9Yrvzrcl`A{ zZr>pI%wutLh{sk}_41?M*dI1~JwN7R+kXp>U-3Ke$8+QLwrA&qW4uL}n`%#-4{{E3 zJ~^H)rEUgop-a2A{!&^vZun=m&*O>1dw2b%Jh5CZrfed%m9#bUY1gzUTGuat`rGUM z)6ZA07x62wm9|dcUmkQs&;g^yG_jQx@pB10W_4;qEM3^SkuL8}q$_*2(UrYPzl?gd z4a~v6IL4G>CXM=Kya;lDJlG~UM)Fv}?&-sXXKe=|mS(T%fLy0bi^H$H4t#Q-;6k%a)ltXP0~E7pNayEY3l z&p4Dyzluf;=taj8<9}KG-0o`!Q|RixWFhBZyXTyFb>BAB&rUD5-Saz``F$OK)E{`R z106V-oexC0nbHO!Cmbo{1Dp$R`>!9_O*fA2{okS^d+7S%U4jo}yXW};&h_GYwxV7( z+PUNXBFOP;dv*R1x&YoQK?ioR4uoKRQaF6tD(H9WRE(#uo-gP<>%fg;`{?HJ{d6ns z!2f&VcCx;+-{)M9=Xm*fibdEfq#MR{bLMo^>y7;*K>h}k(1FsR_1WVC+{T3+-Gw%D z+s`GfqiY9t(#>Q0>8}%q=&zH9>914&4+-tMm39c&??b###@J{a*3C?yt;4#|m>9Icx;^e1UDg@+b56E z?bFBT>X-KPde;-A+FSy*?zwx=SgWbMm~k{evh1aWNEqrL1}U$B>iD9|dj!m_^&H z5fAQjTe-~xosB52cWXRLFo<}5`$F;tx_)Sv-~;ZSNu#@GPtv_}r~XK~d+sFoKOyKa z+db#|XSS>o=0^B=J@$b;Bw9j_&+!p*IRyDA6hNGR}xG~K^==FcGJ6+E-vvfbZ6u6J=~f-on_^W$s!1<_Cs z5w$gGn(gm-E@v{R#2*RhcQB2%ay*EH9=zo-ZT1Dd(dSv%*)wbYa5A0Qv{L9BaZbQ~ zfboBD=^Q=0%yj-Yq;mp)tgGz1Sbup;hsQp7-NxpjU1&;>19h>~$Zhj?Acz0A{{CC4 zfwrqc2et{hA@-SRhxx524>MZct2Nd-^rJ(IrwH>$*Y@oYV#2-ir!sZm$_09K^%6b4 zcKMeQ^YG~EMS2K+9$Y*t`1@PO576aZiGm;Fd0T!~avpqrU+jY~#ChJ6QM17Zv^^Tc z`!W8{|3MC3(1TkX2RSCRH)~Fj?jnlq=_lyH!9~%+d>F?CmM{AQ_633tT)#q3u3ych z8`tQ`k0#Xh7pb?$d6;X;JvCNdkE{y(^kzF#>q1drqbCFs5$Jpm^4C46CdEHg?<#>(5(d9FR z@wjeyWT;=YW6YvXX1-s0x53B>vZ{NzKJAcvhya?B1>chSIqNp;hqI(-YZ~P%rY=^Rf}dx5_ty~e`U_dO z|FPqEzd}JEvkD;IgYF*N56hFs5Icxkpxl*U3jjJ^Vuvve+vBjg8rC!n_q$Rx9Wuacn=y^=)qdZ^_`F- zz^C#$IL;G#+UnsQjS`yE5$`9!o_xF)N=oz)A?H54WU4UE%;QUJuk0&$yq)`Fmr}3} zf!88n9^>1Yzuf$76Zj73&c{$G}+cnKe>a&$boud_~_tn%>rxB0bEhEBfx7uZHM1 z6m&Do$3FnC(?Gi4YS(|i7hD36YgJH3=)wW$!l!J%z;+jA*hJ8W?s)g;5H~X#*V=|= zv~#1F?tX%wh#%5{Hbr%T-S!arnEbo~_c8c6I^NH0>xgc&5zn!#8{C%S&_`d`)rY2r zI19QJ?qp0|;n#WGlJ$;b65Dwe=5JXy!Iul@f2I##aP*4y4#>JX$Q!bs1G>yUm+@d+ zIOpQIbH<8uFt$_n6&=l6QYZAk*>-!{>QWzjed=kWE5z(hcn2ZJ7RH$KjWDAo!u_mU zTps770^aDmp*|j~8wIig@g6(>{rzGI00#w7AZQ%$i3gnly%l0H_q($712{64tS32? zg>4qTnejWbul5XO904suxsf1e5bvk=-`^h~0bs@JQk6gw5Wm+v7}OOM4nkkE!9*N~ zf%<_uf%x6mZXi=otv{fN|FQU=1pbr2e-ijl0{=>DyN&vR;s$~@05AnW#=0zPE@ETfQFfKWSs zm&HLw_U~B*MrEJNW?r9tDkBrgU*r^@RY6YiGMN=*am#lJ9OqP*Rbj?IJ&(4t(Y%s{T{1%^I57ZK%RM_?!yI|4(w*bx}|@;oDVePA#(zjH7gmHYQE&(VO~ zKQqRkpGSViJ{t7Jx#-LD&zc7WzBpI-^8B;rLjd18|4bYZ(6`PrK5tK{FV2e<_B>VQ zv%g~BIG6q6_uuXOU;Jl$);yU)%j;WsedG6U>c^M*^QFFhaUS`ly?k;0 zh5f<4qH+uLOMAq5YVO~^V&56Le}{+s>>Lj5GXdiKGl3|4asH)0g8%wVK=g$_!+Guo zg5A#=B>2mye;5=TcF> zf%#>=nSX98+GdEh1>$q0L@b^v7F#WnNW`mfTo2j^O2GLB&|0yTRV=QV1sRONeceH} zphlot{C@i%xd&olWy0;|_pqX!%D~y0`A1u3ayzZ9t&(kQtoGPhTOD*1o1Ad5G&<*Q zp?Af{LgR*~h4wX9OT&v!Vw2PMV)Ns6HsXV}HsXDdM+)xUgmRXm%qWmI>kRCrM%H^@ zehXXSb_3sXz)S_a`hxEn5{YGkjkQ&ZlaW}$#* zpOroibZq#szm3Yr?v_fQx|%CcXES-~WTx=3y_w3p)@IEfxLO)qw3S#Lv6fivLAi;L z!E#Vf$X5rtP(4c@3Jcx$-Y?5~&Nhp7y8`RU*4C0O&Xz{$exeq4xDDLafexx4XZowr zvJNe2O;-)t)LV;^2I$a^K{}KgsY^Qt>rgVzxAfJf^*uCcMJIKdAJUA5yEppO-BOV{ znkjt@G;8|U!(8vGwZ!rWbYdrD5Q{oHgIc<}x)%Cf5Cs(gV~)D3q3xF7Wel)MaI`Qy z8D!e%MQ5}*(z(&6xk1e-zNaRoMCj7Nar%@t#eh!DFr+hc4C%rGBf1o0Ojni|)8!>b zbYY9Y*!#8d-1GSPr`57ncs{d8z)yOuQ8tI4OHR?45+nJE43DbmTX5nCR% zva;Ncx)*|lATu*FrSE+gQbF6!I)^&zq5ZAF!!k#)=@EaECXYLrDbi^7CZFPaXw$AJ zeL6he5bfdinb6HuW^^}RME5s|=+PDtJ=tbX&yvmQ`F0E8_;i~EJ>F_g4>p<8y^SLJ zYpoewU1mz>=9|#5Xd~J?(tx%N(52Y{EvP%>5N4wC#?3U+q1U^`^k$EQ-tLpoJEr}a$G3YW!uPN7+bdl2B1KG3w_DM}tyXkmSz1a)eXAi=0 zza72JCYeEQKrk~mx zDSmVo>0g9j*aO~T;EP?^H=;d7CIiMDr!Otoyi}7og{bYi9z z?Tj>`X{}pQ2NOl|Fx9*TKXd@P83#S^;{2m1Y=P|^ZEu2@Gs;z@d%CTW(xFtaZXr{jw?ToUZ z^m%r4W4#;Q-{wJ&wtLd!ou2e0#VcQWu)~7}hczc>v-+f?R*g(GYm$#df%*rk(c1B* z`QDpTHtKo2!;2m!d(iC!ce=2|k@k-h)2c28*t1gglb=E3r(#RXec*Wxa5Dma-#d@b zc}-2U|NqMS4!9_eFJMdTv3G={_s-GF9Y-(H%TW$Eszg*o6h&0*-57g~8hZf?_FkhV zMorNa6BDB`CMN%Aj3$c5z3;t+J+JJ+fhNE2_kH{Oy_?(JnOA0JXJ=<#$&V0vozL+! zl9TM`W(32{b#;!t)mJUE<+@~6YE$I`J6q%{hIeGL>cva;%$cI?m= zVsTD!<%4Jq8bte-!)fqSO)7l5EfMP=5;hI-#8_EI5aZ|iJ@S77>tH;#;UJ`^^Lvr{ zJ&qq{LH_aBy(wg7|bgucyAZs=dnlX%7ZOKeBknXaq!Jn z3H-2E3P0{6$kqvN?aFMCe7e?4mrm_4PDfG$FH*RJe0_&BKV2<`BNZX|ony0op)y?$LqzF6t>FH5$b7KbL&4%06x$yn&9GzixdEmb)Kh;zB zF74q~l~lpg?dlx(W?L3~yf_ioW_w{D;K@V%{jOmhtibOCYieI@6+q8DJ}b6^eOyoE zxEtY|)*r5|OoMN>=fJnS@>&FXeco)$W3IkYEat25c56p2-1s01j#m!G*kRUkvAfkD z*rtaN(s3@Q)i#O7{NR9qgmk{))0r`jaAsy4+}M}{Uv0~SueY}hF0Ph9ySLi>tNp-u zV0R7vzTBDzA1_IT5Ayv`FU$ZUgx;T`{Bv*~r>Cv`@qYgpFUMU{zM*{g$RN0~JOgfQ z%7>eqUk|Eh#AA$##^3#1?W*gwem%Qz@K^w!twTNf$uUq)eZbZ1PkayVz~{hO%QHap z9V^UtzarQgPR~q)>+k2n=Nk$dg_WZtAU)U)BE8I@BEuIhEX(4|zrH-`U+V)VdObO5 zezqYWE-lW0wOKx>`=>7t2@st?8B?O8qiJ5Oa^UqYA^v`e5=Z^I6%sGFyd(>*ug%vA zHM7KEHmE13Owky(g{$np)d$9;cyZFZ{(e4uvML7-jE#hB90#L(_+MlDPp8%6>shKHI9%wC3cC&bd@^7JjuD(Wq^Syx>SNTS%zlHqR`s2AY@<%50QuAuy3I2Y=Sys}5@NWQH<>W0DwsQ^yR&Vti(q#AH? zmbA%!j|dg@!|U5!1xGgeQC7a+od4~xpKmEkP{GH=Bj>f*Qm845gF+9Zx;Rg}@9-H& zZde;&Le5?O;VRjPf;sMEs_~_h25r1A8#S;}1OxiEfq?vs`#}yNbf$@WeDYJV_HA zjC6}%Ph(?(mo+Dj>T$_ni2Z`((iL(7oj7rE@u=1t zzR8vm-X?WbBV%CSSg{6Fk4b8@y=Xj+b+^ zbOpiHqS2?Ej&(cS~}!M~buYgdrZL zwcCb-W87V|IekqzW8JL4dQcx2)T=AFnd-sF2+!BTxp8QWPV&<;z{UH{;qfpn+yT;E zP5#9BuLq5Jtn8GgIvY!K+>Bms&JAVa4p)y7V;sWf1C0}%&<8J~)BqZ*SLQ{v2ruzs zHlXRa!Sp@A#rMwPaWEm!2I%`1$36?>Pi22B#m!ih>0&6~m=lcUlW`15Z8lWIX&)om z`smiF15~#FH}Nw)rRnvwzTLWL@Vy($?i?NqqlH%TBsYsI_`V;2{HPo$P6Lckepo9J zVeCH%>?@Zx8@hDV?Yn3;+Sar9J=;+{(VfY}U#3`$y29ci2^zd` z@kiI@<;0-vvK0DYTWQOaA#&xUT@vH3wG7QWw~W^0y=Ht4Y|IOTEL_)$cel>fvi^hd z-walb5?af4m!`oX^x;Ucz;%T*k(*Y&lx1v(@wN9?4uvs^!A<6`NWr-{2M>L^bALyA zTbpp^-#;N2=Er-{*#F$$-(4U1;XF|OV5ystZ0kEQ3?A}1pesm%blc}CjtgXPrue%z zDgWE}OmNX(IxLN|?2ZXTH1Z#vS;9OIqXTT^Vi)6cjj#W3}<)15k8~yklm3)={K{AG8JXC z(e8n9t#;2X*UX1L`A;vJ04uUW$R55f(Z$%FQ&^6R7N3zdeaG*bi?M_oa8wpZIP)o&wKnD{^0Vc*(p42BIP+axJC})3GE872OLOL} zN8I>$>V9N84XPd!?D&Fwx>Edeihj*5K9 zk;ebG@Ev(<#axv#P0?1lkFh$>ubd8xB|-Gg|0kZ$(^&6sswUFxc_y@fz6QVR$XjmcE_p`v&47KgAXsAMPr{`Rw-@j{SAk`{1aD)|t)*2a84aFAkv}9rBY!ew4^Bo;IMk zp6h2xzyR{uOwT2GY*-Wbt%cV@7ozJ zyj$ZV-CmM^F!JwCF|Wwq6c-drQC~pIJ@xB@2J~avzf;E!7@KgH&gInc&^Z%xVAB#< znHzY5y+x z3VqPEv^?v>j>i6VMG5HF$owVxCS1}Y0d**pWw|i zkD=aQ<6*eGej&V<6(*hb8)-h6Mu5|nSv3ftg=wFq5t&*Qz#)mKY@ofUgKP&m-C4cKQ zzI?uSGaN>LelwCpGW7i>M;(fBeL+6&aDVz@ zhJ(Jx8)p5DqQf~?FNwpT%q(Z#{#*~U=Y>MMmz8loFPG*;!=}+$uxH8$IJR&S#>iQ~ z#6Krr@TZqehyAn0z_#*y#^2{`aiAPyXw=KhH@tzdQ72?L7}&j0M*jn3NnZM$u%AX} zIvKn#bv3$@>u&mUu7~*x@J3Y= z(=+%F*!<5)NS%y&q&p9=$-p@(jvcP_PEAT`S~vSYXY~IAg6LG>dA&yh^si7!E(Xvq z1LK3>46c~aIaLBCjIRP=gVzMZ2ImKu5wkH)g(g#q1(;OfPo}cLYeQv&Zv%WAR*HEoK6!p|lU-i|ls894Eai$d>Sl@Rj#TH`-U^_4siS5D^tOTYY z({5)P+7UBiHYNilSi%s0*n|8;I3Y+8TDLO7-+%w0HF)y*Kzq<+TS)px1oWS-HQb|h z`ev=!{fnG4{wf;y?1B0N&Zt8ch5N`^Xy`u*^+~3L1O?5&^D=~7ydRI?i~H>TNY9Yu zLEdy)dw#<*FgCly2l5phBoa+Po8@Y>r#}}S8h9}>Sold?koOmffv&d_g51B33G)36 zeGq&^{s+kB9&Jj==6)XP%qL-L(x5Z(U&zs#?74|=tmkaxV^2h|=wf1k+pTPY)#G9Q z#$;hVR&^7j&1GXkO=V~!U03L5`aDhG@N-O{&lf1mMZ|F& zaiRQy77cRzTYamIudi=Uq$5Uq)SWQ_USH(-Sv)NXHmRGFY+bh*{Qw**CtGPZxH!ul zuFS8ujla6k13sGL0T-sbGkyW~jdF&SS+??u!R9iw?R=Rou>UnYSab#b3{abtAPt_j zecYDzA;O1sWQsHvM+W#_&Gxf=QXXl6`=MwHGT9xjE=1e?^}cX-hX8&?8}(oI3eaYq zY})L=>oflr6Fdr4f#%JJMRNuuk%M6e6mLmM7!)Dct*D9 z=R?ru906_5pMMy_*rYS(=R(jm5okjmfwG6e?JdFZ@w@(LC+dcN1k7ZKLjI2^ z!&%e^D@PuBDA%X1|LHl!diRg?_q{m8*Q9oJwu}7of&ln_JJLKH&DbkHIYV~PvB*pF zfyxp5iMG{$9FKq6mhxet^_Sj*D=?0&~F4gG@z7vp%*thH`>525@H5kj9+ zL;Or-+loBk>XIGlT!+As&X4?ufFJ%|?>z~WL@ z_~{VZX>*kM1F!w>cq06AC;{!3qu}(E0GJ+cUzhG>^%(2$H1Z;D#`Dk`?b!^_W@Sg7 zmuc;mcRb%S(lP?6vYj^PVSo|7i?q+}C zbFi69PmX+CrMa2kU!IPBdX{6~+nC>Mcz1YEqq;J>$U@J;qLCpgv_D^;2Pdb+LxGp6 zEZpDcW3+Q~P`2};|3N~bYX+YuJBap(*Vg2rjbnidTwPND2|_ETjU%cYLjWM7WPFkf`7!d%cgAN?}%vlRVzb{w_Yp`O1BWzKvo$9TyY}EMK0Tmkw7} zpnV?Nw<$w^v;`&H>UBuZ+^SK76?yH9>-Qej^XYO<_>BhiP~cLg|MBuX*fKN_Bz)t4 z@SV0IDk@50XGQO}G>Wk2()@eq>?-;Ch`bL?k$jJim?jnS;I?a4-0;twVy~%v>p)nU}4AQ**ML zd@jjeg)K8BBcM@Pk)T38;yupCT2Yq8p)EZzJsrmQTguSh^9J%vesGwB#(mtgsNG#0 z3CE^MRG=)u8~J}l6ALKl(|_V2!P{C<=ExKYSn2oCNrpI#;iFEk(etV4sH<)dabEVf zk!NG1kK|jmisJM8;2QYL>XFfKpaN}_l)#>+y+4yqMqaS9N`AI%jJpNUeQmObI+-fU z)gZmXFg_$TY*gYx^?UlqT&{0hn z1hX@BOZEesM`-3(FaIv;d4(abeY$prfoKEaWvLIt!rc@!ib7qP{z-CDTN04X(D*oC zMIL3G%fw!QnN9Bl{Z*XFKqoNr@od3D)g$+_GCq>A7r?jKf-ykA}&pgv*o}X)aTkh zG#c%+&_<^jFdJhSCVALErk^7e1-rq{W|Sp5WPhs6v+{pqw1raTB@q_JdqAqY)sM>K zC#{2Jp$_)8!og^xB1TBj3A`M{qq`1!B-%^swIYv=^6d(;YACsc}Mn#Z)U4om{>V~z)2KHOE%I5PfFG~{w>BR4! znBOGy?yB8Jfu23W5$t5C)IRlc#(O(z;C3+9)2IXDf1es3WPdWm)9j_#!-jMkm}i$2 zAl=DeSb32Bi-VKj;nek4w-?~5clMgez&;EP_FO#;aI{pRu><1}62Hp%Oi`~{o#wV- zainvLwg#`}4p@dcQk{8vXlM1bW_&Kjs2k11siRnR+JL?@u%HIeIKFezP}n#1l@6VH zKGGvq$2&AS0J@;Q8Jl)%J?KGo?+fz^vt7t7>M|Gin=121oW;u{O$y%+}xrJt^9ZD&|WKU>PH(U4p+HP@lLmm6w}=EG0t@q z^JaDa{ry|LCFS$(Zyu4v=zU*WzW}tsIBAkbpY7GHt0KRV9=A<9^{;uwxr%)1_%kB| zHSUqV{ip!@7ZPWqB6XhC&(Y2xVT8cyuXCuw^zoLZs5`Ta6L!pfgI3 z?3y=8k+&_!dx_e|#sq!FX~D^Lopgpb4NoF{>3i658nqE&Wx=uZ=BoTC`6t^}!1bzi zoNyK6T4R3jb#~yq-={}+mG=YjE_8L`%&UzC=|fT77x`K~O>;09%<|V%n&~*mBFD}6 z@$L%r6|{FF>b7pg6aV@#m;> zy(BA4hGXLANw^lS&Yv#l7_V+LJ~vM;zCRysVXXPv=Z`iE>@3Z}%f+c#Wk_$A^rtr# ziviz9zn~shleR&P$$~m7bB776pB!H}0d8M72BZ^7x?BGSkd7VcVK2*$l%c-N&lxTQ ztsCP_*L&%X`jR{^vp=gQ6vFo(9%pp!7`@KVuGH&yzGh1Lk#|4&kkO-`7Vq;cn{RkM zm9N+6TC=Xav-wCr4D00gIpTolA8lF+_diFS%m%$P(miVtH0WMZzub*>cf$oXPo&NU zn+odpwOP_{EX}d((^cwXFh9@J?9Ua2@h`vFzm1WhUT^MO_~XahO#{aNX5zb}ULEPn zo>)8?#)i2(!M^@2=^ec>W*b42;%uOY?}+UM-eyl`CJO)FKf4U$Rae1px4vZfe{}Z; z6}?D0XJgZoe)A>NjayfoE*}+S|0u`RSpBD1Z+Tp3Nt8zFTSy%}*DBI?-d9XAuRyH-x=dWSDR*!PrO&;R=Wks63 zf#ClZ{Vvj1O>;B|Mcbx=Y**u{dG5wr^E^z?<$0JK%5^tcj_?0c9FJ2|9eK8ItOEZZ zK!l1%^?__yH8IpXG9)FUI}K_^XBaIoM*mBpHdgscEs4>05~`_>v1&}1BAQp~O{}_; zddjMoHI*vDExl4ln@srG>y4B@L)q{?lPb}_L)TgLD>hZ)pHagye5H=X%B!rFMQU`U zABX4}0!)P>Vno9fG^CWRUpRwQULB;TWrX05(3<&&f8OlD#B{**)_&}I<(oyXijBUF zgV9HMP*A`O)Xg~<7AU+rSmbjvBEauPNTB~Gs5^5MuP?&&#{}X@wRFqRa6hFR#wRI8 zTA$_z+y6E$((3PN@z%BT#5OONW!cFVNo-}alWl4z$637?6>j}h66A6ZeF$I2{jizH z3$NvrTeTt`k0_DXwc-%#XG=2dWydGFqK=Fg+}Y-XaSr_8;eG+ee<1xCKe)XKV?QkP zggv8N(8j~2Hb2nr59H%2@=@H}_QAS-D>PU%Auqu8(YxsmvWs&tCPfv+R|rPk5Y%@$ zABu4ZLgB@wFpS9%hB_sos3Q}KF&IKnZzKrgIfzi-!V@OO*wl(euB0=vl60JOtc%v@ ze|PDyAe(1<#(2taZw-fshtQut>4Kb#!59Gqv7A8n2_Bz{L0|8K;l`Q}Seof9lZqT3 zA`iQ`)>qVd!aba_;Q`kFoSZ6xJ5{mhuRRI%I>hL&K3M?;apusoTYKo)wLN}gwg)@Y z9L+AtfUdrI+oJD!JJa4w`5*UXp^xcAm=fdsGEC@m7282$ z4jbX`n_d=T_u|^BRQRqc2O(Dju5QRcpZMC>l~FFmcP0I&Z(|3uz6_pQJG0@`^k~TS zvwnhoVZ3@BNW83W?JEn#{qrCpjw4IaBZ5H2W>$72As=F*w;BifP ztxV|S)qA+e_MeZIX2NId^A)hTI0XIscY?k>Izx=Fh2pw4KeAjrbm`bmQSQ@q`EYbH zt~GjDKgN9~ceV~eyso+;e?}kHvi!%g;&lkVX2ruVd+FyPJNuZ%iB4y zJhr^PD)qzCC))cbrYiEWIF-|tnF5IQc0R?@&-F09x2H4#YR2InAA%j?X7N!<^*AQR zTXCPwH!jv2tk4Hw=ML={(C^(9wvS4HO(SApV9&RK>aZvJ(8>vLR4KbII{=cs>^^7d z7kHT5t1eAc?1^&*`ov3^qnV=2s>~or z^|U#`(#Jj4D?5wgV0URMCv3)bzAm^nOJgiE&f*wUnJD7SOE@Mci8T5~gtLVr|B@6T zBzW4*XX)p;@>Xpe5(PCCxtt)f*W8ODUr^%`0+=?YcIx$ZXV^I=OHp3gr&?Rw``TKX zp}03K)>D?iHxsb*aebRVC(-X8@?XLQ-Oxs#>W~Gh14*CJF{xeY|P03hYE*C`6}Y`}RP7Lg@a& z(S<5wU>j`Xg{4DO%2B@4YvwAh9iBA`^4yFxWM_HF z{3+0-QzvGeqK?84&Ok^MN|12^4GDz-RSDcrPJiJrq>u$mK4Fvu_cY> zAv@>w#p(ZG-Rf*-k34kG<@3(&onG?%r)!tsr%yj>5zxBof{gJ0XQfeHQ>*m@4|OykHCQi6JCywbia%B{VtZ(x+kVf9Vq8PT>995Du%f6E{+Rxxiu#v z;{MuE(%)AMPkT5$IpAK2(E4V9EALR2v%VPfHcPKunU1dikw!ZN9zs6^oSwDp0GSZi z7I0+&#}_%qVW(vp9GuCnuEQOKGxaufWXDFfak>EIWue0z#L|xdHG$*@9G;^XnvD z*7t)2J}%0P2wdzsj0m*+jC=<6)iL!~_7p}G6Yagi7&rwH}E-2SHZ1N4I$Rx>k8esjk- zNDZm?tvuM*7A~(F$@tY~>G$g18AhfGf$|Z&KRW(pl%I!drn}kdvn$5I{`X25KSqQ4 z_QY@IT)4JnI!rB0z}Rk<;O%G*JLe3C1tsaQb;eNUUd^mwyhrb71KjKX@cr3v5d8tBxS3DD=Q4Tk^igtlU;4=Fx>4Z{<4-zu}=NE|o!m@3s4MvB%fA;l>8fM?^CZ=YF zJeXEG0!j;{OdI5|A;xKd*l~jW>(CvSVp0bN;q&_%*Xxk$B*vbQH-IF@847Wr?K_7+h4<~F@?Y5 z*e#?o>W9Q>kj*qn_*XYhAC^73e;4X%Wl;B`7JkP)lur&+)s{#3TtK@0)ypZL z0({3z8x!t&3VlW$&T%m)!)va}`Pl!@4XZ?VI#h|yw5<|NZe0(pT2+a-fW1$7smx<6 G`+orYGy**U literal 0 HcmV?d00001 diff --git a/components/mbColorLib/Demo/Demo.lpi b/components/mbColorLib/Demo/Demo.lpi new file mode 100644 index 000000000..33e1ffed0 --- /dev/null +++ b/components/mbColorLib/Demo/Demo.lpi @@ -0,0 +1,82 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <TextName Value="CompanyName.ProductName.AppName"/> + <TextDesc Value="Your application description."/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="mbColorLibLaz"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="Demo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="Demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/mbColorLib/Demo/Demo.lpr b/components/mbColorLib/Demo/Demo.lpr new file mode 100644 index 000000000..21f19b07e --- /dev/null +++ b/components/mbColorLib/Demo/Demo.lpr @@ -0,0 +1,17 @@ +program Demo; + +{$mode objfpc}{$H+} + +uses + Interfaces, // this includes the LCL widgetset + Forms, + main in 'main.pas' {Form1}; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/components/mbColorLib/Demo/MXS Website.url b/components/mbColorLib/Demo/MXS Website.url new file mode 100644 index 000000000..2eac68223 --- /dev/null +++ b/components/mbColorLib/Demo/MXS Website.url @@ -0,0 +1,4 @@ +[InternetShortcut] +URL=http://mxs.bergsoft.net +IconIndex=1 +IconFile="D:\Prog_Lazarus\svn\lazarus-ccr\components\mbColorLib\Demo\Demo.exe" diff --git a/components/mbColorLib/Demo/clr.ico b/components/mbColorLib/Demo/clr.ico new file mode 100644 index 0000000000000000000000000000000000000000..f31b60547e57a60f69e6176459f47f91196313bf GIT binary patch literal 3262 zcmchaYfzKv701*4xb25dr_-s^na=K~ZN_$|?sTRd`k@wg+YY<kRjO4$t2OGnQe7?H z0J+JF++sipawh@u#*hmMkZ=nLNw|q9k^ljf<+4Ho$SraS-umx(lNz(^?3Zq*$uDP~ z_sKc`^MB6!=0kYA@6h|Lw|EqP%u{@i$NLeF$NL$5Xp6U<KHUB{y_5;NR0-j##Bg=u zU(|`a)k*(Ble}A<yhoF?hobsbq)QE521wei;_|r!6_qCt;mX8aKFwXKOFNa9c9I}h zmGak`)V(#ABebazy0pk3qI79dx+}g&3y%H17^P(*UlE~Y_Gwf1)m+|3I-2CYoCj*1 zz<JiD?$t7+8C82_e_h5QefD9!@QC5+u?7)`fw;=iaP?TD=+j0K7kxWN4Z@?8sm~VZ zvkuo2nTM!cmwrG;eN!W9QueC3M!Rd%_SdE#sLwjIG<AP@`oZ$_LywCX-HdzG6U^&` zhs!P>T<rrAS$Z_G^k`Ve?Dw5$Z(YVg^3WhUPH7(Z7oM51C$r<Pm<U=-Jedn(mcH^` z`WI9(Ge+ghu2HVb^!>WbgESCrYLp@Sa8vGQ#{AQiurfO_JKW=TSlkY4fVq(#kL!Wk zVcW#w_@H~hwm31kwlKXmKSgOSd)xFqv&Z!X4M8tFT1(@)a-cEic&qqxOX<axxi25x zX>Pj`wTT)Tlk0G9+N4W1M?+DYtMPi~9=2Bb69&{GI+w>i)|B%Z-AcM6&DT$wi_W!I zB(E+^Jv3HO+TDsI%J(B_m*?B9*M~X%#@y4=n;NN9Q(2^8^EJvmPQM|yYDkyo7ay~! z))rl>^N(nfEqSLJM4!^FH{Lj7EsN`xr>!r#9~wCuqbAwL$^uc2=~PVR;kkT_({Ctc z3hXHCL|F@1J(|im{Q$R1E>Iy&n8vm8_{-KCXBu-(&{JnBh_Oi%Zz(d@muCFO^y?cj zor(VIm@dGAc9PR?E@xyTV0)poqTUEg#aHzGjqHkywMF;p{1nZECPPOs6`r?MB=sn> z)|Y2TTV<3sYGR+RF6E&s8@&Y>uE1>FWH0R-rA*BjYWh*v38NY9Qcl0Cu&B4fd9TVj z*{P#Tnl1TUU6^hwxo8xB-js8~TzsLuGP$QZ%ey@1*Y6UaGRZFLWT)$8XAQF0dZSo3 z*+I4DN~UQV_5En<f!T--38!xpp6<HFbc&d++_+czvug`(OKEKDjeoXW`$t>x`F3ei z_sw+jzdUunOMH^jf@zRlsGBs?j#b837GN2Ltqa{P==$pXDWU!95qdt?mu6{1meM#= z!Pyq^DLP2IB(alaNZ;#u?0qtyj)DlBISo-VBv+v=hFKr|34oeIVXCMP>|+?XgCP?J zR2WrYyaW@u7*EE?5lo$h_sL_@SzDSReRJVCWBwUSNvy3rp`-Hh`tqD#{{wvZF(QxS zTpTj8P*@D53a!<D+fFU$CEN4sM?;u0!li<{3^TcyO~K45%<O{ew;%=5p(9wz;?2e9 z>EW@I#n~hY9nxfO-}Crg@ZZBbpWyvth>FE2Au`L6-;CPI@DRT~Mfpd+f@uS_K;Z_2 zKrC?ZDgFrjd;>oL>8vf!T1w(9#TV%*vXsYLr3v)=B5}^YXZ|<%>F@FOG5qcl_FTgW zInwpWcc8BF&%X$?sQma{lujW10iq{yU=rIO;GIeQ@IL3?cLYn>rM8mTw&II6Nuo`f z)FDkFWv^#}NWtHC;Jb&hH4Zz95K)UW-N+b+1TdHX;dKk?&R=rhM0R6`1zWrErUic* z_lc0syj7B5DZfNhYL_N=RHo4UH&zw{?8X}>@n#yf%JF^!qMSIp1TnlUoTcoC?*&dF zr}am2F6#$!yde*i(}JE!`q`5C&Z^W-8PmZs8>>sf#DFKp77e!bA<TtnfWa7pJ_ZJc z4Z0WHdW&yIU<fYnsJKkFY3yBWTBkg{`)0<|HBT@s_$+uPyzNA&7m@Hr!zq9%8ms_9 z0UH?_IE5xM)K74E7t4_C&MJnKyA@ft6j{&KS2m#muMb;X*an2b6^6brXu=>4Lwpzn zVH!agwV)VGK!KAb+icpc>g=9sVUJSy%)7dYF@!q71Nd0t!^ww%50(#xk7z!^`3T`_ z1mT+K*94c}Qe<~4GO5dLmFTuQr&p8v{OS7F@#6dN^5Ep5lLwXuArCP;g!2%>Gen06 zMr4SN^b=6%QHsbmneWwHyHj)Rj`sSCXWp*^2;dFDSP1$;Vb}&X6ygxXZ$nHd9l;P2 zNi7U90)M0h;TP#u=aTK)O3__i-d&yeZf*XH=TH9&4DkZ0GQ`sZ28t#hv_ppP)Lf^r z^ws9~)!pc;D}4F<*|)*O#83;01nKnYZjfziaj&kRzrLtnU-I(B^KXes7*F^`?s1+A z$h=)&Y&VqJ8_NFm^2PrUpXVYnZ*MHKH<mk^${o$pftHHFmde4Fs-c#uL8EM_m0*WV z?4X&Ve8~I?S`)3ZLBdFxRa8Q?juxq-Sz>RJkXw60X}`X>-%#vmk_<Fg5dKU~u$6V1 zSSP8q-6WiC3JwcV?ORaf7DHx*(|nV|#FdaApF$<qs9EA@ET=Ax#!}8O8Sq(kn&gx} zY*vhLg4M%TrPHb!CM>EE-(tk79=57SY!qoz$>HlY%yl8?P`*a~<1|SJn##ZFf5HE2 F|KCO`$=m<{ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/Demo/main.lfm b/components/mbColorLib/Demo/main.lfm new file mode 100644 index 000000000..7f51e68fe --- /dev/null +++ b/components/mbColorLib/Demo/main.lfm @@ -0,0 +1,1125 @@ +object Form1: TForm1 + Left = 222 + Height = 338 + Top = 89 + Width = 541 + Caption = 'mbColor Lib v2.0.1 Demo' + ClientHeight = 338 + ClientWidth = 541 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + OnCreate = FormCreate + ShowHint = True + LCLVersion = '1.7' + object Label1: TLabel + Left = 412 + Height = 13 + Top = 8 + Width = 66 + Anchors = [akTop, akRight] + Caption = 'SelectedColor' + ParentColor = False + end + object Label2: TLabel + Left = 410 + Height = 13 + Top = 112 + Width = 86 + Anchors = [akTop, akRight] + Caption = 'ColorUnderCursor' + ParentColor = False + end + object Label5: TLabel + Left = 410 + Height = 65 + Top = 238 + Width = 92 + Anchors = [akTop, akRight] + Caption = 'Aditional controls:'#13#13'- Arrow keys'#13'- Ctrl + Arrow keys'#13'- Mouse wheel' + ParentColor = False + end + object PageControl1: TPageControl + Left = 6 + Height = 325 + Top = 6 + Width = 397 + ActivePage = TabSheet8 + Anchors = [akTop, akLeft, akRight, akBottom] + TabIndex = 8 + TabOrder = 0 + object TabSheet1: TTabSheet + Caption = 'HSLColorPicker' + ClientHeight = 0 + ClientWidth = 0 + object HSLColorPicker1: THSLColorPicker + Left = 8 + Height = 283 + Top = 8 + Width = 375 + SelectedColor = 639239 + HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' + LPickerHintFormat = 'Luminance: %l' + Anchors = [akTop, akLeft, akRight, akBottom] + TabOrder = 0 + OnChange = HSLColorPicker1Change + OnMouseMove = HSLColorPicker1MouseMove + end + end + object TabSheet2: TTabSheet + Caption = 'HexaColorPicker' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 1 + object Label4: TLabel + Left = 82 + Height = 13 + Top = 278 + Width = 37 + Anchors = [akLeft, akBottom] + Caption = 'Marker:' + ParentColor = False + end + object HexaColorPicker1: THexaColorPicker + Left = 48 + Height = 267 + Top = 4 + Width = 283 + Anchors = [akTop, akLeft, akRight, akBottom] + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + IntensityText = 'Intensity' + TabOrder = 0 + Constraints.MinHeight = 85 + Constraints.MinWidth = 93 + OnChange = HexaColorPicker1Change + OnMouseMove = HexaColorPicker1MouseMove + end + object CheckBox1: TCheckBox + Left = 4 + Height = 17 + Top = 274 + Width = 75 + Anchors = [akLeft, akBottom] + Caption = 'SliderVisible' + Checked = True + OnClick = CheckBox1Click + State = cbChecked + TabOrder = 1 + end + object ComboBox1: TComboBox + Left = 124 + Height = 21 + Top = 274 + Width = 71 + Anchors = [akLeft, akBottom] + ItemHeight = 13 + ItemIndex = 0 + Items.Strings = ( + 'smArrow' + 'smRect' + ) + OnChange = ComboBox1Change + Style = csDropDownList + TabOrder = 2 + Text = 'smArrow' + end + object CheckBox2: TCheckBox + Left = 200 + Height = 17 + Top = 276 + Width = 97 + Anchors = [akLeft, akBottom] + Caption = 'NewArrowStyle' + OnClick = CheckBox2Click + TabOrder = 3 + end + end + object TabSheet3: TTabSheet + Caption = 'mbColorPalette' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 2 + object Label3: TLabel + Left = 6 + Height = 13 + Top = 272 + Width = 24 + Anchors = [akLeft, akBottom] + Caption = 'Sort:' + ParentColor = False + end + object Label6: TLabel + Left = 214 + Height = 13 + Top = 272 + Width = 28 + Anchors = [akLeft, akBottom] + Caption = 'Style:' + ParentColor = False + end + object Label7: TLabel + Left = 320 + Height = 13 + Top = 272 + Width = 23 + Anchors = [akLeft, akBottom] + Caption = 'Size:' + ParentColor = False + end + object Button1: TButton + Left = 6 + Height = 25 + Top = 232 + Width = 107 + Anchors = [akLeft, akBottom] + Caption = 'Generate blue pal' + OnClick = Button1Click + TabOrder = 0 + end + object Button2: TButton + Left = 120 + Height = 25 + Top = 232 + Width = 135 + Anchors = [akLeft, akBottom] + Caption = 'Generate gradient pal' + OnClick = Button2Click + TabOrder = 1 + end + object Button4: TButton + Left = 262 + Height = 25 + Top = 232 + Width = 121 + Anchors = [akLeft, akBottom] + Caption = 'Load palette from file' + OnClick = Button4Click + TabOrder = 2 + end + object ScrollBox1: TScrollBox + Left = 6 + Height = 217 + Top = 8 + Width = 379 + HorzScrollBar.Page = 75 + VertScrollBar.Page = 217 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderStyle = bsNone + ClientHeight = 217 + ClientWidth = 362 + TabOrder = 3 + object mbColorPalette1: TmbColorPalette + Left = 0 + Height = 234 + Top = 0 + Width = 360 + Align = alTop + Colors.Strings = ( + 'clBlack' + '$00330000' + '$00660000' + '$00990000' + '$00CC0000' + 'clBlue' + '$00FF3300' + '$00CC3300' + '$00993300' + '$00663300' + '$00333300' + '$00003300' + '$00000033' + '$00330033' + '$00660033' + '$00990033' + '$00CC0033' + '$00FF0033' + '$00FF3333' + '$00CC3333' + '$00993333' + '$00663333' + '$00333333' + '$00003333' + '$00000066' + '$00330066' + '$00660066' + '$00990066' + '$00CC0066' + '$00FF0066' + '$00FF3366' + '$00CC3366' + '$00993366' + '$00663366' + '$00333366' + '$00003366' + '$00000099' + '$00330099' + '$00660099' + '$00990099' + '$00CC0099' + '$00FF0099' + '$00FF3399' + '$00CC3399' + '$00993399' + '$00663399' + '$00333399' + '$00003399' + '$000000CC' + '$003300CC' + '$006600CC' + '$009900CC' + '$00CC00CC' + '$00FF00CC' + '$00FF33CC' + '$00CC33CC' + '$009933CC' + '$006633CC' + '$003333CC' + '$000033CC' + 'clRed' + '$003300FF' + '$006600FF' + '$009900FF' + '$00CC00FF' + 'clFuchsia' + '$00FF33FF' + '$00CC33FF' + '$009933FF' + '$006633FF' + '$003333FF' + '$000033FF' + '$000066FF' + '$003366FF' + '$006666FF' + '$009966FF' + '$00CC66FF' + '$00FF66FF' + '$00FF99FF' + '$00CC99FF' + '$009999FF' + '$006699FF' + '$003399FF' + '$000099FF' + '$000066CC' + '$003366CC' + '$006666CC' + '$009966CC' + '$00CC66CC' + '$00FF66CC' + '$00FF99CC' + '$00CC99CC' + '$009999CC' + '$006699CC' + '$003399CC' + '$000099CC' + '$00006699' + '$00336699' + '$00666699' + '$00996699' + '$00CC6699' + '$00FF6699' + '$00FF9999' + '$00CC9999' + '$00999999' + '$00669999' + '$00339999' + '$00009999' + '$00006666' + '$00336666' + '$00666666' + '$00996666' + '$00CC6666' + '$00FF6666' + '$00FF9966' + '$00CC9966' + '$00999966' + '$00669966' + '$00339966' + '$00009966' + '$00006633' + '$00336633' + '$00666633' + '$00996633' + '$00CC6633' + '$00FF6633' + '$00FF9933' + '$00CC9933' + '$00999933' + '$00669933' + '$00339933' + '$00009933' + '$00006600' + '$00336600' + '$00666600' + '$00996600' + '$00CC6600' + '$00FF6600' + '$00FF9900' + '$00CC9900' + '$00999900' + '$00669900' + '$00339900' + '$00009900' + '$0000CC00' + '$0033CC00' + '$0066CC00' + '$0099CC00' + '$00CCCC00' + '$00FFCC00' + 'clAqua' + '$00CCFF00' + '$0099FF00' + '$0066FF00' + '$0033FF00' + 'clLime' + '$0000CC33' + '$0033CC33' + '$0066CC33' + '$0099CC33' + '$00CCCC33' + '$00FFCC33' + '$00FFFF33' + '$00CCFF33' + '$0099FF33' + '$0066FF33' + '$0033FF33' + '$0000FF33' + '$0000CC66' + '$0033CC66' + '$0066CC66' + '$0099CC66' + '$00CCCC66' + '$00FFCC66' + '$00FFFF66' + '$00CCFF66' + '$0099FF66' + '$0066FF66' + '$0033FF66' + '$0000FF66' + '$0000CC99' + '$0033CC99' + '$0066CC99' + '$0099CC99' + '$00CCCC99' + '$00FFCC99' + '$00FFFF99' + '$00CCFF99' + '$0099FF99' + '$0066FF99' + '$0033FF99' + '$0000FF99' + '$0000CCCC' + '$0033CCCC' + '$0066CCCC' + '$0099CCCC' + '$00CCCCCC' + '$00FFCCCC' + '$00FFFFCC' + '$00CCFFCC' + '$0099FFCC' + '$0066FFCC' + '$0033FFCC' + '$0000FFCC' + '$0000CCFF' + '$0033CCFF' + '$0066CCFF' + '$0099CCFF' + '$00CCCCFF' + '$00FFCCFF' + 'clWhite' + '$00CCFFFF' + '$0099FFFF' + '$0066FFFF' + '$0033FFFF' + 'clYellow' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + '$00000099' + '$00009999' + '$00009900' + '$00999900' + '$00990000' + '$00990099' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clRed' + 'clYellow' + 'clLime' + 'clAqua' + 'clBlue' + 'clFuchsia' + 'clWhite' + '$00CCCCCC' + '$00999999' + '$00666666' + '$00333333' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + 'clBlack' + ) + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + AutoHeight = True + TabOrder = 0 + OnSelColorChange = mbColorPalette1SelColorChange + OnMouseMove = mbColorPalette1MouseMove + end + end + object ComboBox2: TComboBox + Left = 34 + Height = 21 + Top = 266 + Width = 87 + Anchors = [akLeft, akBottom] + ItemHeight = 13 + ItemIndex = 0 + Items.Strings = ( + 'soAscending' + 'soDescending' + ) + OnChange = ComboBox2Change + Style = csDropDownList + TabOrder = 4 + Text = 'soAscending' + end + object ComboBox3: TComboBox + Left = 124 + Height = 21 + Top = 266 + Width = 87 + Anchors = [akLeft, akBottom] + ItemHeight = 13 + ItemIndex = 7 + Items.Strings = ( + 'smRed' + 'smGreen' + 'smBlue' + 'smHue' + 'smSaturation' + 'smLuminance' + 'smValue' + 'smNone' + 'smCyan' + 'smMagenta' + 'smYellow' + 'smBlacK' + 'smCIEx' + 'smCIEy' + 'smCIEz' + 'smCIEl' + 'smCIEa' + 'smCIEb' + ) + OnChange = ComboBox3Change + Style = csDropDownList + TabOrder = 5 + Text = 'smNone' + end + object ComboBox4: TComboBox + Left = 244 + Height = 21 + Top = 266 + Width = 71 + Anchors = [akLeft, akBottom] + ItemHeight = 13 + ItemIndex = 0 + Items.Strings = ( + 'csDefault' + 'csCorel' + ) + OnChange = ComboBox4Change + Style = csDropDownList + TabOrder = 6 + Text = 'csDefault' + end + object UpDown1: TUpDown + Left = 348 + Height = 21 + Top = 266 + Width = 31 + Anchors = [akLeft, akBottom] + Min = 0 + OnChanging = UpDown1Changing + Position = 18 + TabOrder = 7 + Thousands = False + Wrap = True + end + end + object TabSheet4: TTabSheet + Caption = 'HSLRingPicker' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 3 + object HSLRingPicker1: THSLRingPicker + Left = 50 + Height = 285 + Top = 6 + Width = 291 + RingPickerHintFormat = 'Hue: %h' + SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex' + Anchors = [akTop, akLeft, akRight, akBottom] + TabOrder = 0 + OnChange = HSLRingPicker1Change + OnMouseMove = HSLRingPicker1MouseMove + end + end + object TabSheet5: TTabSheet + Caption = 'HSVColorPicker' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 4 + object HSVColorPicker1: THSVColorPicker + Left = 24 + Height = 285 + Top = 6 + Width = 297 + HintFormat = 'H: %h S: %s V: %v'#13'Hex: %hex' + Anchors = [akTop, akLeft, akRight, akBottom] + TabOrder = 0 + OnMouseMove = HSVColorPicker1MouseMove + OnChange = HSVColorPicker1Change + end + object VColorPicker2: TVColorPicker + Left = 332 + Height = 293 + Top = 2 + Width = 22 + HintFormat = 'Value: %v' + NewArrowStyle = True + Anchors = [akTop, akRight, akBottom] + TabOrder = 1 + OnChange = VColorPicker2Change + SelectedColor = clWhite + end + end + object TabSheet6: TTabSheet + Caption = 'SLHColorPicker' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 5 + object SLHColorPicker1: TSLHColorPicker + Left = 6 + Height = 287 + Top = 6 + Width = 379 + HPickerHintFormat = 'Hue: %h' + SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex' + Anchors = [akTop, akLeft, akRight, akBottom] + TabOrder = 0 + OnChange = SLHColorPicker1Change + OnMouseMove = SLHColorPicker1MouseMove + end + end + object TabSheet11: TTabSheet + Caption = 'Lists && Trees' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 10 + object mbColorList1: TmbColorList + Left = 192 + Height = 244 + Top = 12 + Width = 183 + TabOrder = 0 + end + object mbColorTree1: TmbColorTree + Left = 8 + Height = 247 + Top = 10 + Width = 171 + InfoLabelText = 'Color Values:' + InfoDisplay1 = 'RGB: %r.%g.%b' + InfoDisplay2 = 'HEX: #%hex' + Indent = 51 + TabOrder = 1 + end + object Button5: TButton + Left = 120 + Height = 25 + Top = 264 + Width = 137 + Caption = 'Add colors from palette' + OnClick = Button5Click + TabOrder = 2 + end + end + object TabSheet7: TTabSheet + Caption = 'More' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 6 + object Label9: TLabel + Left = 118 + Height = 13 + Top = 8 + Width = 103 + Caption = 'HintFormat variables:' + ParentColor = False + end + object mbDeskPickerButton1: TmbDeskPickerButton + Left = 8 + Height = 25 + Top = 8 + Width = 93 + Caption = 'Pick from screen' + TabOrder = 0 + OnSelColorChange = mbDeskPickerButton1SelColorChange + ScreenHintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + end + object Button3: TButton + Left = 8 + Height = 25 + Top = 40 + Width = 93 + Caption = 'OfficeColorDialog' + OnClick = Button3Click + TabOrder = 1 + end + object LColorPicker1: TLColorPicker + Left = 36 + Height = 25 + Top = 148 + Width = 329 + HintFormat = 'Luminance: %l' + Layout = lyHorizontal + SelectionIndicator = siRect + TabOrder = 2 + Saturation = 238 + Luminance = 60 + SelectedColor = 263284 + end + object VColorPicker1: TVColorPicker + Left = 34 + Height = 21 + Top = 116 + Width = 335 + HintFormat = 'Value: %v' + Layout = lyHorizontal + ArrowPlacement = spBefore + NewArrowStyle = True + SelectionIndicator = siRect + TabOrder = 3 + Hue = 240 + Saturation = 255 + Value = 40 + SelectedColor = 2621440 + end + object HColorPicker1: THColorPicker + Left = 36 + Height = 61 + Top = 178 + Width = 335 + HintFormat = 'Hue: %h' + Increment = 5 + ArrowPlacement = spBoth + SelectionIndicator = siRect + TabOrder = 4 + Saturation = 120 + SelectedColor = 8882175 + end + object SColorPicker1: TSColorPicker + Left = 8 + Height = 214 + Top = 70 + Width = 19 + HintFormat = 'Saturation: %s' + Layout = lyVertical + ArrowPlacement = spBefore + NewArrowStyle = True + SelectionIndicator = siRect + TabOrder = 5 + Hue = 60 + Saturation = 80 + SelectedColor = 11534335 + end + object Memo1: TMemo + Left = 118 + Height = 75 + Top = 24 + Width = 247 + Lines.Strings = ( + 'The following variables will be replaced in the ' + 'hint at runtime:' + '' + '%hex = HTML HEX color value' + '' + '%cieL = CIE L*a*b* Luminance value' + '%cieA = CIE L*a*b* A-Chrominance value' + '%cieB = CIE L*a*b* B-Chrominance value' + '' + '%cieX = CIE XYZ X value' + '%cieY = CIE XYZ Y value' + '%cieZ = CIE XYZ Z value' + '' + '%cieC = CIE LCH Chrominance value' + '%cieH = CIE LCH Hue value' + '' + '%hslH = HSL Hue value' + '%hslS = HSL Saturation value' + '%hslL = HSL Luminance value' + '' + '%hsvH = HSV Hue value' + '%hsvS = HSV Saturation value' + '%hsvV = HSV Value value' + '' + '%r = RGB Red value' + '%g = RGB Green value' + '%b = RGB Blue value' + '' + '%c = CMYK Cyan value' + '%m = CMYK Magenta value' + '%y = CMYK Yellow value' + '%k = CMYK blacK value' + '' + '%h = HSL Hue value' + '%l = HSL Luminance value' + '%v = HSV Value value' + ) + ScrollBars = ssVertical + TabOrder = 6 + end + end + object TabSheet8: TTabSheet + Caption = 'Other' + ClientHeight = 299 + ClientWidth = 389 + ImageIndex = 7 + object HSColorPicker1: THSColorPicker + Left = 6 + Height = 155 + Top = 6 + Width = 211 + SelectedColor = 518633 + HintFormat = 'H: %h S: %s'#13'Hex: %hex' + TabOrder = 0 + OnMouseMove = HSColorPicker1MouseMove + HueValue = 60 + MarkerStyle = msSquare + OnChange = HSColorPicker1Change + end + object SLColorPicker1: TSLColorPicker + Left = 222 + Height = 147 + Top = 144 + Width = 161 + HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex' + TabOrder = 1 + OnMouseMove = SLColorPicker1MouseMove + MarkerStyle = msCross + OnChange = SLColorPicker1Change + end + object HRingPicker1: THRingPicker + Left = 4 + Height = 130 + Top = 164 + Width = 133 + HintFormat = 'Hue: %h' + TabOrder = 2 + OnMouseMove = HRingPicker1MouseMove + OnChange = HRingPicker1Change + end + end + object TabSheet9: TTabSheet + Caption = 'Even more' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 8 + object Label8: TLabel + Left = 6 + Height = 13 + Top = 4 + Width = 128 + Caption = 'New: border styles added.' + ParentColor = False + end + object CColorPicker1: TCColorPicker + Left = 4 + Height = 267 + Top = 18 + Width = 22 + HintFormat = 'Cyan: %c' + TabOrder = 0 + SelectedColor = clAqua + end + object MColorPicker1: TMColorPicker + Left = 34 + Height = 267 + Top = 18 + Width = 22 + HintFormat = 'Magenta: %m' + ArrowPlacement = spBefore + TabOrder = 1 + SelectedColor = clFuchsia + end + object YColorPicker1: TYColorPicker + Left = 68 + Height = 267 + Top = 18 + Width = 31 + HintFormat = 'Yellow: %y' + ArrowPlacement = spBoth + TabOrder = 2 + SelectedColor = clYellow + end + object KColorPicker1: TKColorPicker + Left = 120 + Height = 267 + Top = 18 + Width = 22 + HintFormat = 'Black: %k' + NewArrowStyle = True + TabOrder = 3 + Cyan = 0 + Black = 255 + SelectedColor = clBlack + end + object RColorPicker1: TRColorPicker + Left = 150 + Height = 268 + Top = 18 + Width = 22 + HintFormat = 'Red: %r' + ArrowPlacement = spBefore + NewArrowStyle = True + TabOrder = 4 + SelectedColor = 8026879 + end + object GColorPicker1: TGColorPicker + Left = 182 + Height = 268 + Top = 18 + Width = 34 + HintFormat = 'Green: %g' + ArrowPlacement = spBoth + NewArrowStyle = True + TabOrder = 5 + SelectedColor = 8060794 + end + object BColorPicker1: TBColorPicker + Left = 224 + Height = 268 + Top = 18 + Width = 22 + HintFormat = 'Blue: %b' + SelectionIndicator = siRect + TabOrder = 6 + SelectedColor = 16743034 + end + object KColorPicker2: TKColorPicker + Left = 274 + Height = 71 + Top = 22 + Width = 69 + BevelInner = bvRaised + BevelOuter = bvRaised + BorderStyle = bsSingle + HintFormat = 'Black: %k' + ArrowPlacement = spBoth + NewArrowStyle = True + TabOrder = 7 + Cyan = 0 + Black = 255 + SelectedColor = clBlack + end + object MColorPicker2: TMColorPicker + Left = 272 + Height = 55 + Top = 96 + Width = 91 + BevelInner = bvLowered + BevelOuter = bvRaised + BorderStyle = bsSingle + HintFormat = 'Magenta: %m' + Layout = lyHorizontal + ArrowPlacement = spBoth + NewArrowStyle = True + TabOrder = 8 + SelectedColor = clFuchsia + end + object CColorPicker2: TCColorPicker + Left = 274 + Height = 67 + Top = 152 + Width = 61 + BevelInner = bvRaised + BevelOuter = bvLowered + BorderStyle = bsSingle + HintFormat = 'Cyan: %c' + ArrowPlacement = spBoth + NewArrowStyle = True + TabOrder = 9 + SelectedColor = clAqua + end + object YColorPicker2: TYColorPicker + Left = 272 + Height = 57 + Top = 228 + Width = 81 + BevelInner = bvLowered + BevelOuter = bvLowered + BorderStyle = bsSingle + HintFormat = 'Yellow: %y' + ArrowPlacement = spBoth + NewArrowStyle = True + TabOrder = 10 + SelectedColor = clYellow + end + end + object TabSheet10: TTabSheet + Caption = 'Yet even more' + ClientHeight = 0 + ClientWidth = 0 + ImageIndex = 9 + object RAxisColorPicker1: TRAxisColorPicker + Left = 10 + Height = 100 + Top = 8 + Width = 100 + HintFormat = 'G: %g B: %b'#13'Hex: %hex' + TabOrder = 0 + end + object GAxisColorPicker1: TGAxisColorPicker + Left = 130 + Height = 100 + Top = 10 + Width = 100 + HintFormat = 'R: %r B: %b'#13'Hex: %hex' + TabOrder = 1 + MarkerStyle = msCross + end + object BAxisColorPicker1: TBAxisColorPicker + Left = 252 + Height = 100 + Top = 10 + Width = 100 + HintFormat = 'R: %r G: %g'#13'Hex: %hex' + TabOrder = 2 + MarkerStyle = msCrossCirc + end + object CIELColorPicker1: TCIELColorPicker + Left = 8 + Height = 100 + Top = 130 + Width = 100 + SelectedColor = 16119089 + HintFormat = 'A: %cieA B: %cieB'#13'Hex: %hex' + TabOrder = 3 + LValue = 88 + AValue = -47 + BValue = -32 + end + object CIEAColorPicker1: TCIEAColorPicker + Left = 128 + Height = 100 + Top = 130 + Width = 100 + SelectedColor = 16515327 + HintFormat = 'L: %cieL B: %cieB'#13'Hex: %hex' + TabOrder = 4 + LValue = 60 + AValue = 96 + BValue = -78 + MarkerStyle = msSquare + end + object CIEBColorPicker1: TCIEBColorPicker + Left = 250 + Height = 100 + Top = 130 + Width = 100 + SelectedColor = 130823 + HintFormat = 'L: %cieL A: %cieA'#13'Hex: %hex' + TabOrder = 5 + LValue = 88 + AValue = -88 + BValue = 74 + end + end + end + object sc: TmbColorPreview + Left = 410 + Height = 62 + Top = 24 + Width = 108 + Color = clNone + Anchors = [akTop, akRight] + end + object uc: TmbColorPreview + Left = 410 + Height = 62 + Top = 130 + Width = 108 + Color = clNone + Anchors = [akTop, akRight] + end + object tb1: TTrackBar + Left = 410 + Height = 20 + Hint = 'Opacity' + Top = 90 + Width = 108 + Max = 100 + OnChange = tb1Change + Position = 100 + TickStyle = tsNone + Anchors = [akTop, akRight] + TabOrder = 3 + end + object tb2: TTrackBar + Left = 410 + Height = 20 + Top = 196 + Width = 108 + Max = 100 + OnChange = tb2Change + Position = 100 + TickStyle = tsNone + Anchors = [akTop, akRight] + TabOrder = 4 + end + object CheckBox3: TCheckBox + Left = 443 + Height = 19 + Top = 308 + Width = 64 + Anchors = [akTop, akRight] + Caption = 'WebSafe' + OnClick = CheckBox3Click + TabOrder = 5 + end + object CheckBox4: TCheckBox + Left = 428 + Height = 19 + Top = 218 + Width = 79 + Anchors = [akTop, akRight] + Caption = 'SwatchStyle' + OnClick = CheckBox4Click + TabOrder = 6 + end + object mbOfficeColorDialog1: TmbOfficeColorDialog + UseHints = True + left = 472 + top = 302 + end + object OpenDialog1: TOpenDialog + Filter = 'JASC PAL (*.pal)|*.pal|Photoshop (*.act; *.aco)|*.act;*.aco' + left = 440 + top = 304 + end +end diff --git a/components/mbColorLib/Demo/main.pas b/components/mbColorLib/Demo/main.pas new file mode 100644 index 000000000..5a23bf02f --- /dev/null +++ b/components/mbColorLib/Demo/main.pas @@ -0,0 +1,381 @@ +unit main; + +interface + + +uses + LCLIntf, LCLType, LMessages, SysUtils, Variants,Classes, Graphics, Controls, + Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, mbColorPreview, + HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils, + SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker, + HColorPicker, VColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker, + SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl, + BColorPicker, GColorPicker, RColorPicker, KColorPicker, YColorPicker, + MColorPicker, CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo, + CIELColorPicker, BAxisColorPicker, GAxisColorPicker, RAxisColorPicker, + mbColorTree, mbColorList {for internet shortcuts}; + +type + TForm1 = class(TForm) + PageControl1: TPageControl; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + TabSheet3: TTabSheet; + TabSheet4: TTabSheet; + HSLColorPicker1: THSLColorPicker; + sc: TmbColorPreview; + uc: TmbColorPreview; + Label1: TLabel; + tb1: TTrackBar; + tb2: TTrackBar; + Label2: TLabel; + HexaColorPicker1: THexaColorPicker; + mbColorPalette1: TmbColorPalette; + Button1: TButton; + Button2: TButton; + HSLRingPicker1: THSLRingPicker; + TabSheet5: TTabSheet; + TabSheet6: TTabSheet; + HSVColorPicker1: THSVColorPicker; + SLHColorPicker1: TSLHColorPicker; + TabSheet7: TTabSheet; + TabSheet8: TTabSheet; + mbDeskPickerButton1: TmbDeskPickerButton; + mbOfficeColorDialog1: TmbOfficeColorDialog; + Button3: TButton; + LColorPicker1: TLColorPicker; + VColorPicker1: TVColorPicker; + HColorPicker1: THColorPicker; + SColorPicker1: TSColorPicker; + HSColorPicker1: THSColorPicker; + SLColorPicker1: TSLColorPicker; + HRingPicker1: THRingPicker; + VColorPicker2: TVColorPicker; + CheckBox1: TCheckBox; + ComboBox1: TComboBox; + Label4: TLabel; + CheckBox2: TCheckBox; + Label5: TLabel; + Button4: TButton; + OpenDialog1: TOpenDialog; + ScrollBox1: TScrollBox; + Label3: TLabel; + ComboBox2: TComboBox; + ComboBox3: TComboBox; + Label6: TLabel; + ComboBox4: TComboBox; + Label7: TLabel; + UpDown1: TUpDown; + TabSheet9: TTabSheet; + CColorPicker1: TCColorPicker; + MColorPicker1: TMColorPicker; + YColorPicker1: TYColorPicker; + KColorPicker1: TKColorPicker; + Label8: TLabel; + RColorPicker1: TRColorPicker; + GColorPicker1: TGColorPicker; + BColorPicker1: TBColorPicker; + KColorPicker2: TKColorPicker; + MColorPicker2: TMColorPicker; + CColorPicker2: TCColorPicker; + YColorPicker2: TYColorPicker; + TabSheet10: TTabSheet; + RAxisColorPicker1: TRAxisColorPicker; + GAxisColorPicker1: TGAxisColorPicker; + BAxisColorPicker1: TBAxisColorPicker; + CIELColorPicker1: TCIELColorPicker; + CIEAColorPicker1: TCIEAColorPicker; + CIEBColorPicker1: TCIEBColorPicker; + CheckBox3: TCheckBox; + TabSheet11: TTabSheet; + mbColorList1: TmbColorList; + mbColorTree1: TmbColorTree; + Button5: TButton; + Memo1: TMemo; + Label9: TLabel; + CheckBox4: TCheckBox; + procedure tb1Change(Sender: TObject); + procedure tb2Change(Sender: TObject); + procedure HSLColorPicker1Change(Sender: TObject); + procedure HSLColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure HexaColorPicker1Change(Sender: TObject); + procedure HexaColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure mbColorPalette1SelColorChange(Sender: TObject); + procedure mbColorPalette1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure HSLRingPicker1Change(Sender: TObject); + procedure HSLRingPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure HSVColorPicker1Change(Sender: TObject); + procedure HSVColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure SLHColorPicker1Change(Sender: TObject); + procedure SLHColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure mbDeskPickerButton1SelColorChange(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure HSColorPicker1Change(Sender: TObject); + procedure HSColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure SLColorPicker1Change(Sender: TObject); + procedure SLColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); + procedure HRingPicker1Change(Sender: TObject); + procedure HRingPicker1MouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure VColorPicker2Change(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure CheckBox1Click(Sender: TObject); + procedure ComboBox1Change(Sender: TObject); + procedure CheckBox2Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure ComboBox2Change(Sender: TObject); + procedure ComboBox3Change(Sender: TObject); + procedure ComboBox4Change(Sender: TObject); + procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean); + procedure CheckBox3Click(Sender: TObject); + procedure Button5Click(Sender: TObject); + procedure CheckBox4Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} +{$R mxico.res} //MXS icon resource file, for internet shortcut only + +procedure TForm1.tb1Change(Sender: TObject); +begin +sc.opacity := tb1.position; +end; + +procedure TForm1.tb2Change(Sender: TObject); +begin +uc.opacity := tb2.position; +end; + +procedure TForm1.HSLColorPicker1Change(Sender: TObject); +begin +sc.color := HSLColorPicker1.SelectedColor; +end; + +procedure TForm1.HSLColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := HSLColorPicker1.ColorUnderCursor; +end; + +procedure TForm1.HexaColorPicker1Change(Sender: TObject); +begin +sc.color := hexacolorpicker1.selectedcolor; +end; + +procedure TForm1.HexaColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := hexacolorpicker1.ColorUnderCursor; +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin +mbColorPalette1.GeneratePalette(clblue); +end; + +procedure TForm1.Button2Click(Sender: TObject); +begin +mbColorpalette1.GenerateGradientPalette([clblue, clred]); +end; + +procedure TForm1.mbColorPalette1SelColorChange(Sender: TObject); +begin +sc.color := mbcolorpalette1.selectedcolor; +end; + +procedure TForm1.mbColorPalette1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := mbcolorpalette1.ColorUnderCursor; +end; + +procedure TForm1.HSLRingPicker1Change(Sender: TObject); +begin +sc.color := HSLRingPicker1.SelectedColor; +end; + +procedure TForm1.HSLRingPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := HSLRingPicker1.ColorUnderCursor; +end; + +procedure TForm1.HSVColorPicker1Change(Sender: TObject); +begin +sc.color := HSVColorPicker1.SelectedColor; +VColorPicker2.Saturation := HSVColorPicker1.Saturation; +VColorPicker2.Hue := HSVColorPicker1.Hue; +end; + +procedure TForm1.HSVColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.Color := HSVColorPicker1.ColorUnderCursor; +end; + +procedure TForm1.SLHColorPicker1Change(Sender: TObject); +begin +sc.color := SLHColorPicker1.SelectedColor; +end; + +procedure TForm1.SLHColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := SLHColorPicker1.ColorUnderCursor; +end; + +procedure TForm1.mbDeskPickerButton1SelColorChange(Sender: TObject); +begin +sc.color := mbDeskPickerButton1.SelectedColor; +uc.color := mbDeskPickerButton1.SelectedColor; +end; + +procedure TForm1.Button3Click(Sender: TObject); +begin + if mbOfficeColorDialog1.Execute then + sc.color := mbOfficeColorDialog1.SelectedColor; +end; + +procedure TForm1.HSColorPicker1Change(Sender: TObject); +begin +sc.color := HSColorPicker1.SelectedColor; +end; + +procedure TForm1.HSColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := HSColorpicker1.ColorUnderCursor; +end; + +procedure TForm1.SLColorPicker1Change(Sender: TObject); +begin +sc.color := SLColorPicker1.SelectedColor; +end; + +procedure TForm1.SLColorPicker1MouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin +uc.color := slcolorpicker1.ColorUnderCursor; +end; + +procedure TForm1.HRingPicker1Change(Sender: TObject); +begin +sc.color := hringpicker1.SelectedColor; +end; + +procedure TForm1.HRingPicker1MouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); +begin +uc.color := hringpicker1.ColorUnderCursor; +end; + +procedure TForm1.VColorPicker2Change(Sender: TObject); +begin +HSVColorPicker1.Value := VColorPicker2.Value; +end; + +// only for internet shortcuts +procedure TForm1.FormCreate(Sender: TObject); +begin + with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do + try + WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net'); + WriteInteger('InternetShortcut','IconIndex', 1); + WriteString('InternetShortcut','IconFile', '"' + Application.ExeName + '"'); + finally + Free; + end; +end; + +procedure TForm1.CheckBox1Click(Sender: TObject); +begin +HexaColorPicker1.SliderVisible := checkbox1.Checked; +end; + +procedure TForm1.ComboBox1Change(Sender: TObject); +begin +hexacolorpicker1.SliderMarker := TMArker(ComboBox1.ItemIndex); +end; + +procedure TForm1.CheckBox2Click(Sender: TObject); +begin +hexacolorpicker1.NewArrowStyle := checkbox2.checked; +end; + +procedure TForm1.Button4Click(Sender: TObject); +begin + if opendialog1.Execute then + mbcolorpalette1.Palette := opendialog1.FileName; +end; + +procedure TForm1.ComboBox2Change(Sender: TObject); +begin +mbcolorpalette1.SortOrder := tsortorder(combobox2.itemindex); +end; + +procedure TForm1.ComboBox3Change(Sender: TObject); +begin +mbcolorpalette1.Sortmode := tsortmode(combobox3.ItemIndex); +end; + +procedure TForm1.ComboBox4Change(Sender: TObject); +begin +mbcolorpalette1.CellStyle := tcellstyle(combobox4.ItemIndex); +end; + +procedure TForm1.UpDown1Changing(Sender: TObject; + var AllowChange: Boolean); +begin +allowchange := true; +mbcolorpalette1.CellSize := abs(updown1.Position); +end; + +procedure TForm1.CheckBox3Click(Sender: TObject); +var + i: integer; +begin + for i := 0 to ComponentCount - 1 do + if IsPublishedProp(components[i], 'WebSafe') = true then + SetOrdProp(components[i], 'WebSafe', integer(checkbox3.checked)); +end; + +procedure TForm1.Button5Click(Sender: TObject); +var + i: integer; +begin + mbcolortree1.ClearColors; + mbcolorlist1.ClearColors; + for i := 0 to mbcolorpalette1.Colors.Count - 1 do + begin + mbcolortree1.AddColor('Color '+inttostr(i), StringtoColor(mbcolorpalette1.colors.Strings[i]), false); + mbcolorlist1.AddColor('Color '+inttostr(i), StringtoColor(mbcolorpalette1.colors.Strings[i]), false); + end; + mbcolortree1.UpdateColors; + mbcolorlist1.UpdateColors; +end; + +procedure TForm1.CheckBox4Click(Sender: TObject); +begin + sc.swatchstyle := checkbox4.Checked; + uc.swatchstyle := checkbox4.checked; +end; + +end. diff --git a/components/mbColorLib/Demo/mxico.res b/components/mbColorLib/Demo/mxico.res new file mode 100644 index 0000000000000000000000000000000000000000..5b0aa7b3700ce19faed95b4e64a5d1dc907c3ccb GIT binary patch literal 25228 zcmeHv30ziXzW-xRHO<ttOx<j^b!xJODRr8(#jF`}$`;K`!UaWvFi;dXk`xd@1fkef zR78|iRLmvC7eSF75d=gOm)t-FK{k<dzu(_^&kGo~{BQrcbMN)_^LXCnob&vC&+}Wp zzvZBmQr$5$O&@sM;Wh4h<M*yOr;Ggd{B3QgJc+mb*d3#b`YryKH~R64_q`tPrkvk? zUd<ZTR~=nGNga-xuBx_%sKgnARqrS6QRDyl7d6Y~RdsCnWOZ=)G<6_;mf9CHMHR+- zsr(hbYJXCMD%rAF9b4t0Jcqraj>oyHve>DrG<Jq6STtD`#?4aMF<+>HRr6HgnqbvX zdrmbs)vMfPvsBUgP*w76lqz2}OWkwpZ&gmHv&viUrE+6utIWvBs;Qw?wPF!!P8?Dh zQIl0c!aTKaO^_;D_m$eeAxxEQidIK9eWjkd?>4n3Xf&?%R=K!-PsBuZvHFZ^yjY{^ zFPv3bi>6^rSNk_csETcil*gc6YQlTH)c$Ygs=Qe65$B`!#?MuI!Y8Qn$4gaX{ROpm zrJpKX8?1_PP3fkE>igZ_DCYrIYQ*b*RwXOFRbHI8%EvirLF3fv(oEIVSf?&sYE-40 z7pc-Mi&VKOUS)+isOKKK6KnRR%8&QOn2UArSGh|))!D;^Ds6$Isz_h2nwuNc!R^ac zVPdd4@ZAzszGH<-51$B{d{xEnb?S2KWp%nZU1cqvj<vg}>cQKgwAHF)ZJ;_5J6Y{p z9f&bsojY2r4s2bFby=v2*UVSNtNqpS?;_Q)q#$)_{T#K(^*yy@!n>+$W0=~zYOX3y zn5#-w%~2H_0@d+VU#J+@ch$TRuc_xAyhA;3$4zSDz@F;-mOynleg^h`iuw{VG9GL2 z!XtO72mkmx$Q}gr+UtMu3e5HM@4(#`&(8Gxa@HfWmA8EDI$`3yPrBVdX|ns2snez_ zb@P3nj&pEy`fQBz`0isqcTt}Vv-#9^_=u6C2HA}sV?S2CJMgymdc6O^hl8GbX7EQt zK31>2-tUe6Z@%^9-~VC#@Y@5_3oky@vsdrGzVx@3dpy_Y`M&D0$DjDqlTZEm=^jr# z^XzlaTPbzdf85>eo_p`R|A7Y|>i+N}X3Bnl^DTe4^|ssZ_+xuYe{=l}H@5%W>3hhp zywdT%={ZgF?1BNQwhVk$=E2`uFtj83HT*vwrnNintZB5v*U21L+F}0w8ivIV{{|n7 zmu|X^Pd|F(sa^12*Xz2d>$_g3Zo1(&>ek=gpziv^P3oT8f3NQU<IU=!yZ)dax%*c2 zShw5M<M-aKp1ki4_2&ofR6QQNQ$5rDF7@2Q|DmiNxm*3^(QYzcc&wY^c=54&)QgYb zqk3ZWdg5Lgy>aaQr+d|3|8$>viQ~!p)ZdKp)P3sZr|y^0_v!o9t4}|mUVr96^~SRg zsW+eRuKr>5uzLH2N7O%Gd{hnW^_Uv;w<pxceV$aqUVTaphy5J&Mh`XS&1aOO_4Dd; z_?L+TUsUcN^itCX|5bSm`J3__`m&l0TjOo>ikf5ls`7(Pns4{I3Lf)@3LW>R3U_!* zML52tqCWe(S~T8T#eDv@TIM=HEuSzz#ZCODTH*GNS~Yo~T0P}GwQk0TYLn+jYP<I* zYNxM_O7pW-yZwi&Jpm(B*8GtwCupR~#mHMQN=819!FDoogGa0E;4vyI*j{A>k5lQv z4r+I>qdr1DQ@g)%R_Pdfz8<eKLdUCY_^;ehCzT)Os0uLlg*m7qjQ!ybsyM<yl}0+M zvM48YF#0ofa3P1YDqA>Sl`eEq#S2|k!NQ3uKiW;@M7gP~s7c}j=?62S++}1&Pf=M5 zr()>-j6N-U@eB+P@v%8ezJPC;sq&Z2R0ZwE-esQn&QpADZtN`auk@4jwe*?vWqI&{ zZDWqgTQLXzodbT0!|cE4!{{4jtnw3oM!#H;5TFXa;h1msM?vt_3uMrb%18`>kNZme zchS19al`-y;MmUrpWZgYfh~*?A%2*?xOiivD*o0OQGx-81L*TgHe<l|mI9Ah#?}~B zig94;5`BEPRF!R8rpmU*s)NaK>L7e=dCDqvD0MY_?Rs@2<6Ct!Ym53m-=t0!?oy|U z_oy=mvQ=gIUUl|Jk>G>#Cl0EbQ-{@sGe=cz)p1pO_JpcCcT)Ue-T70%9;XF=T&$@S z{LxT*UNzKJ3mze+X>PozF2Uzty3~YY<B#h7zv#!0!aS$APxH9yZ1$@*tcsaG-rmi< z^HU~mO4_(3B_%5*De>#sW9_EH8FY9#Ze71&Q=GGpZ(!{9{Irynfv%G#*|nW9#bx8_ z^+`*&HJ>?J9{Wvxe$k<_@*>mLm0pvl3r#cq)~!z5u-WEp^QFsYT#C}mV*Td(25%`n zT$a8eaI#YF(Fv<ouidaVy1AyNC3i)s&$dhFP8>fpZ|mVh6-RxPvX5D@I$>?%CZEcS zP3JeQAAhi^p}x8G<h-(jW#wf~N=;ZA7niVR?S|m2)+*PfK1W*XYHFMI`jr)xmX&7> zRmyAm(v>S$uU@y-waRCO>-SA{HFd4qgGvjF%1RGyk>3}_Enl^2^}3bLadRtMYHKc5 zZwx8QEhs20IUG4m+09!V9TU4^<?6Lbkv>(Rv7t41X?{-b-n~Ud6|Te8<dEp7n3&~p ztJemts%xmJZ9Y9eDRWm=R(^g#(Gh#4#w?ADT(~%Hd7@8HV?8*mbWKW2OUum6&D~p6 zHc<_Cj0uU1ie4J$bmTG!zjVxLQ_%J_Q(AgvR({FWQEHg;!jQ<w#W9YhpsY?i?!3`w zt4~@=TH2o6ys|hu^@&eNa7a|7%Zb*Sn)>FwPDxIuTQ|g|m{QXB<dlRdH7qbPG9<=v zOLc8)Yr_`TEv}W#7b{)&Y&WH4W);lFE>3jySr8dC-q|N`U9``J)qZDM8!jE1XWDKu zWu}eA?;lN@?r!fjd%^sm1(Av0BnHhtS=HJanY1m%v}ap8DNyc{CXM%vT$&i|>g&2- zyHEOeDOqtd+N6Z<JZ8AtPnaDTvT}V~T-vtn1^!n`ntr<7Bzq^{$kj<D4j**9zU`BT zr@Omnm}lD;|84Ku5QYA(;#EznxDi9$ilH<U+&+ftY<S{(j4m8_YmBaV-xc4<0HEor zRbyxs7%jMS$5;Fx+T$2rs??P@=6QTK0>gr1Zo&uS#aaJ_uZMwg`ak!O8vW+8YR;#x zs721!YR%O5)ux$))pxUosO__dsAR8?&10xa_U8EH2V)1mvkaeMYDb4*qjt<O#;3~U z%VFC#<_=dWb4REYzmY1%pJSAao%8IJjDXQ<r;IT;n#cSxDs{fSN(~%q9^)i_Obc?5 zSa27x#jao{wTsvy#98pg?yttH-Cut$BR$kbSw@(vN)MZWn02CgxFPO!QyCGHR0c5v zMka6rF+*l_Czv4ym;rbpXUR;JgLt&#_)^CTh|w8~w;zm`JHrh+Rxo1*!3sKNU|hX- zWjoB!4m<2cEX;UV#}B{|f*%YV(RSP?n8J)J5dT|n1@J}TT8=h+Q3Q;^{D3})FTU2X zg@G}QBe8}VUlik5j68+~UzjmQ32+AU6PD2qXOseKv<*GxH!#Nm!5e1Gfq4D^F^7RW zh&?R$V|g0}LB62ev{J_+I};?nKfG(L#QzoP8-PnT0+(!3$8x>{Hc3_|3U;cKMZ_oR zW_*&b&Q|PG=Z@@G=Z=-A^WT@L>J#N=oN`26s5~ZErOu31h*x9~uXH+2OP-;g7)EeR z6>>LcC4bX+@jP-QHOS9g5X{5(jTfu`g%;p{@Kn9~S@*TF>fNsw;@O|^>d|NHbO&4O zegpdSwCd5XUyq-<<mrCy(Gd%mMEE${ec1mU>t0q?ul9NTN2cogp-*^Ncy#ol_%&<S z1WtDx_Rf3Oy{#VU^Qu+nQ$7A+NJwaSc=RGq=jlG-@tc!3FY$62`Thq3U+MWs@4io5 zd6CthheikDf{11PN4q&Y*gLrSCT!l8nw}Wq=`?icpjWIO>-EYDPqZ=BqxYE5fPj#& z@I^yQj~&{-&d0-fYQoy2q%Edhx%s;i0zVsLJJh<*BUZ0i=@<R=b;kglj|;qPPd2r- zv{WASblbQtDQR=^w5efRvI`2b*M)mIjkbI5<wyEsntlV_1AGHOQRtF^CDnK}Xjy|d zCnj!99^>WfKH7H7w9wRoyn@{1H39Cg;QSZfndjq+3j#yJXAG_51zNdd;JR%QLt>8| zFE7g3xG2CqBsU`~C$Av8AI^XL{Xj2oUw_OHvT#5-&u^-Yu}=*fvhj3dLvu?@)2X6? z5!o3TSy|Z;?<m!y*9c!vZy(<PlH@+28K<8xxh(V@nAgz2i|bkrJBDYar{jX`8GUg3 z-lM%eJ<Sva4mn)ccrw-|#>cj>u3k>BO?M2;O5KI?Gjc~`*ZW#KdU|?#`H-T(5XbPA z?>$GyI1emt)K9NZwOzQ|WReT=-og1VSWolt@bofY;AMBnW#p2vo)zch^xEnuyM)wj z$*HNkFhiO(&hKIEB^Q7N^6d7(goUHsPBh6vRi6kSlaRc5Tk;NGkg??5e#)xnhaS_W z&j3Z_85DU3+IpT6POEEA+Pf!g-ne;-enGb9%RQA<?-A48r^^MxbBK>k;whn}y6$^h zpM=D9NxT3Yq-KrnX{GuP7(30~eTD}n5EeXbH#c%!s%xt&?EC@n6O%S>+`4TW&d(ks z%k!DLyZbb`02H|o->08m-;h7ZH$EX@jZ6R*OsQGcPlMfl)7;$L-KWb1zE1W9*f6{r zYIAKv65=fvkb`CK3A^q*A1q^0$Jkdi>8GDf9261}5R3Em8Nl*xpZ<MR&)!4bT=WY( zJxAMquXEabe96$zXuF|4ykHGU0?WHxdi7BK`j434G65G%^Kc#JbVAm#w)wcnhl>J6 z#_t~zEflTYuyNz&Z5g&tTdBVN99&#*f%^>S_dWE}>$D2@!3pl~Cs((GJI5O=Y~GwY zkh|O0+1c5}#m(KxE=_A`sI9K9uRAbd*m5U_yvoMf6Lz7?^b3-bw#E*Ec3J(?&1C{+ zm^N%cc3JuNT1!hq(O~=Nz<(6CfR%>gfeFiGjn*b@3$%tbTUp!Kjd8;II1PDcm_uOv zmVJ4)P9gq2Lkk-*S9SHUX}ADatWDhE(wmm0Pw&3{-hXe1og+9HJM#U3Lu{P`ynO<v z4L;POHP+Xae;B=t7pzG%jkE&&;GjpZzE4=aWc}W|HlrQgy=F}J_wx4k3IEV>W69yl zmX?B{iOXVn!Hyx1@^tg-@jm@}yzo;0ci$O2!okfaBrq^wtgSsbODu45k6#v>kdPQZ z=w;(%<Jbcx)2i1i0|yKoIo35W%zFl`-B`QP@t`Onao)gJjq^Gjt$OzB*`s&g0oL!> zIJk#J1O|jHS%M2Txc3$EJDh9zVAbpOUOjrgWNmFd%)vc?o3?R`&aUN@AHK1&>emMs z4S2KPU^}<?4($H$WaAsFp8x3E10JMb-@e9I*N#_TfsRqtPk(A;J{hlS#CiHry=p$n zFGN)QrGit=G#?qo@iUOu)s80qjNgCi=*iP?UWX%Qme1{uJWKN6ogG1s{NBmYlRw~l z6OW8Kjbo$vGk=k2wAFmHEQRK&FA109XTQcFx85DM*7NcBfY+6AY+GHlyZo;7)AaZM zM*kz$d?_<(%3;KJn-LQRAeOX6yxGe%=hM4>4w*aWjs9%kHvt;rAq}-x41WzVo|e1x z%Sz;pcca$11hq@oo&KZV!dwsS@E&?Y`}-mm4M$w2@gB(aYLy3bwW{)bt?avH8gj52 z^0ZnZ?!9-FAAi4?7dyKMb=IU^3mhl$K6^r4Q)OP<1M#AU*hRaHf5&pRYPrk4)DYWf z7fx4bh*vbkP1*sBL#f~3UUMrEhu@0W^#td|XPJY1@LJvrv5?kScV0s+Sv#_4gSI~@ zOhbNGE8h{PAwT{t;`V2d7jHpKs-cD|yz@Qs<l2dX6b(684Ka^)FnNWxZ%v?vnyt)_ z7)?XG?T0n_m}|wkc%5-PQ<|wYH`Zwv&QxfK2{qJQag3DrsQGHhLu;u4V{9<I$RpN7 zctvhp_(bhitNy+W*9FQw3)ci`#h@K=r_g}<Z!7lVMeO%B<mu&F-lwuGM?)=J);~Xf zj)uIsR$FyULmVmhLi~#B7i!4SS3y4hnBq5L=&l70tJ1&zJTD`{trju9#=S(HTjnhR zzZXs))~XKW%l;xp7TQr)NJrkplFdPGq)W<N+Xs;Qcm?-#fV_n737fDpBXZIS$j~L^ z`elFi%k@!OdZ_EN_A+#}_d9$)y@Pv%yvfJNeRx9_*I{qUQUgYhx!N`V%I^(><B2z( zuwR~HBWb=mA0}FBvDo^RzQ~Pr2f?}>x?V`X(hhaQx6G+^ku&k8eLhXDxc1-AT>;Y^ zo4$L(T#xMz`D`<CZ~i;|M~;IW|An>^a;9&<&%IeE=j{xz^QN7nz9JVzdk5W|bqW0# z=a6&T4ZVm?oj+z8Y-qn^pJClG=gpnm=Bi(%2HLMg?n~~Ce3s}bbXjx@^*Put&b>gN zH+FVo=E5mOs6DQMjxWGmgJ3V8g^u3c*#!9QM%c70>c7}?*dE#x<dn4Y$4ayldrjJ* zoeA<A?HBDZ>S$tDgkRV=@{VhcrH8q0#~Lq%EpUXL5{PQ@9ezJ-b-m$Z41dA7kT=qr zV7JguquV#|hP<52Rgu2#a@n?64Rt?#z@N~5mu*`rwhVT>iu@pV`x0!8;b+8_)9#|y zshuoL#l34}9@O&0wsCK&4()}#tkxRfBX~T#J5kp1Am&5ePeX5x249uU`-2xJ+Ir+E z<s4pb*h>01`iTReDSOcj*&nW1L)|&dc}C_vl(I@}DEf9Z4%%c6$V4RXzjNNGP{V)F zb{qbTJ|TaFkE}D+4{N?itF1f=pLSO6d+{9R#r=5x0r(d2ky~Tr-rOhPfvL!8UzZj* zb_?%MIiY>uyF!;6W52Var^<cENBxB=xj$-_@H-K*rlp&sHS{;hnsW})Ubs4_6*~3z zl)1xiL%#Wpet*n?`;%s_RX*tAnjmK>_vLzUz0V&j2Ik-%`)eh@38>YIf22&&&vMUk zpQhy5A3q3vc@qBVQr_~};w$xa(tQ;Cw{|r1Tdm>3Sq;5h;_tby)C-=+z2P7q#3S^_ z<byZ>@=^x*{2li8W8}W6t1@^UdawAqc5)wN2eOG;t;h)Kyc+V{kgJ)xj$@wobBLeE zy3@}iKfhM?)_>F-^tNd^&?o8?ug$|;#7WJ~^%jhBJa4;!y`XE~i0q(VEpoPhL#S3v zK7avAHbu!1dm143_Zu0`{mYK=0By5?U#4q0F*60X9LwISohi-M4yUb_eIRehgA2B4 zg1!+~<u3Eo=-XuuU<4hr1Zu#Mw!A-V#(l7npTK5@0J9{)P8<N<Y=te=aMUQ5)H7m7 z>b2O7-RtGv)NS;x2|f}X1`nh^Kh9f&?R}Q_zw!lJb-QV<?NgAgw_z`5rOmfrj<wvA z89Aw**o^zcedj*V=Imb=Ds$3ia1QP>)}jjc=+xF-IUhemN3I8-l(m<D>plaYUjd_T zg4~?~e@&dT5H^u>@cyW^q=J6EnWwWG{><-yo9=+^dJ1#e0E>I21&v*f9>xl+_1vF% zi~sYd890nb)2kT3SSCcoo`6<Y4lEYKOY`W0W80`^@al=t3NY916^~%BJ1>&{Ej|3X z5~uO^*Dx$NjREAf*R>V6$_l`q_Cx%32EDyI;Dfw&_}JK(<_>==*=y)MSGnX@{Te=R z9{Rb&Uej07Zvdxi>0i4XK;3yau;yymBoENje}~T}55vdb@oN$Q+>;^xVs#Mw5%3;- z5@UA``X|P|#8^47yO|58UPjEwxGxqs^-GiAh%s2Nza`Hea{K=aO|aY7r!8<eK#Wd& z#UpVuaS{6HfIGaI{}4Y-98;7S4EzudKl8QFO01O=<8cB0uN-@r3qQOBG4SvmUPE8T zx;_aS(J68D7wtVTawX^H8W7Xdw{TwaUvuK1cBUi~Ig2Ft@HqTFU-pT3jzjVgz<l(h zf(1Yu`rQTdzz<(UJfDuei^cH6zKz^I>!Ziv%k_p0kd@*$Y8YbpR+*dg1B26Va}6@1 z-GLV}1&b5+aGb3u)N<f=bqs|Z1TYC|@?5WG<UKA^c9{P_Uc!vsmI)4J&Z6L(dGy6K z+;3w=;Mb=UUol=09BrXNk2$yos2vNYCLSeTEZG<(=M$R{OO<XyZsN=l?flVVV6>gu zQRI3K?uZvmz&rzEgoDY;fjd_KORWM%nS9EaAA1yqzDAkbg0s#0z;z(Ds5-n)FfcLv z`D3NP6<-V1$O4w-Jj9#z7b*qQa*fcRr=2WH!~9-?{S16h8i)mVhd6EI{J=K9LvP0} z!LW?oI3VXnJVCi9j${6eIV9BTWo>hTeMwivu0(xq;8DTq5?@q-Cd4(sLxybVF~(An zAL3JBn=kbFKYbwm>+wz8FUqzaYv{26v6RFESPNn+=D>*MWZ*OLDRXJW*%!~B1RYg^ zizyGpN6al5@dtVvB%YxBQZ`{nY&buT&mre0JW=0t8n_OOt1v(2ratm}$f(TCxT~r> zPhvRotj8#45eFR;>`nP2PA2a%m?t#P&o~Zi-HiD2HJyJOd-S?!`G|uU3sL9vwJ^tA zW*QjNQbtL~Imkcrh{oKFkO}4_skgjV^b&F@x@pj1rh#&h5$;wBn<H2hxN;fym-{b6 z=I1)-IY?s-av<ZB&6*Qsm>X+u=9{{}xMA-~e~}%=P1H*xzo^>>eJ!{KjFVxXc9D0J zk4+cYgk<7<?ic07LWAtZ9IXKS!`_Mwu7!Td9-HUp8l2j{TgUpa8DbL|lNfP{5yOd% z0u5UiOPrD#G<GHDhuym!cA!X?Df9eh8gyBhqcNtS%uvQGb2IkB+}}g~C=*;G#!`iA zLnLM~;ueYTB*xQYRq{_+g1)2o6a4#)coDHnjl^NF?_2}QIpu)wGZ4!#?xKw2*%@8V z%yXmXSDzblO8WP&50hApa~pAuVIOIuI2dDcjj{KrdNPi({Rr`d?pq*R#yaqbJcD*T z_d7l3Y|$^+7raN`G3@db?DrhdfS9ykr^eU~eMurW5`Qx8;XdFyOPmWC#ClzV&3S<H z!!J!nzC?I6Vo}lue<3+~+IjRVOWuO_uS5J#pT}#cm!uKT4q<(eAAtR149|Fs{###z zb}_1~K_ueC3FYuX^3Vlr(5Hy0&LdaQ#F&xSQnwjrb6v<I<&nOHJcuopoDO7NeC`*B zDT_2bLxtG5O6)<|_T^$PjWsZ2f$LA3ojT8M8Ej5luG+`ue)#JCkcls_AK{3zHX%n= z#l1%_ocKTTOI~x9&J<Y_KM8r~K5@NH>`m6r!awMCs8X;B^IEb7=6#?(qW??-PMOWM zzuF6!;Ws<|Mm`EW_`(kFVMCDXo(t@?6MC{A`*M<NlCy+025+&ElvA#k$nLV)Vq1xw z;2T;Qn=<DwYk)ifZ3<+5+|}m(vG1X)T``_8`Hi%J{7eCUh}sq8um^eldOT+!zKC|0 zxgM?w?PNz8h$NjCaP3P!HqS5l4L1B{$j}4Orx$SFQLv?p(KDHx{?+(G$ay{YXYWd1 z(Ru1Y`d6PH14jH&EcQ$0zuLLTQQd+5&cE)M^XXvdm>XnjF=YHCa(ZI-u6EtE@BeSD zK)aNJyp{fKWECn<+%_ro5Qb_$Jn{L8K|9vzz<FI!F7Jw)vBHkgN&oia?eiEn;#NPb zd$ZOw0>hHWcnlw|y{@gmwH3Iw0{_M<09-H-`SVMNtqXv87QzpYLf+~r)7(#Q#rL-W zU)_lBEIE*WCsu$*Zw5yGinx<FkN6ICmCN9z6&T_Y@^Po|do(bQJ$UF3oOmxV#+~@> zR@5tWL;l~$P_oY_-9b+(@u1X#5j#sx4|yE+%?Nf!eP~bQB;-MyS(9Yl^EmkX4*TK( zp5EnN;n|q(;PWnE;@{yr3ugcS%^G5Xmv@0K(#bp=>&DE(kQe5}n2#j3mDq}PL|{wS zE%TNmM}eG7dYB9O(a;OkgnCs9WYHJ&e*)~;+cbB?)8OlV)cbG8KL3|{3_4p2=4iRD zjF<GG({JGc^yArF$!AI&0X_@BpV5y~x_L43Y0;8<lw2@kGCUsyew<jt)X+bWg}7uX z@^+KJ(`(@GrJa7Go=*1u_)hTjU#fv|pHX|WNe@K~iuE>fk&N3(KXXTnYbY~}871yP zJVYH~%{JQ{3o$3axQBc&4<)$|=|PK-HQ9?;C_4sw73zZVIbs9n<LLj0$NUo!PkaLG z{&(=$6Y<*p;Ol4iWkCOai}mnkoJN}UoT{Erwa5|HpYtBi`3`+u2er!5Ea^upMoyFU zamG**;~{sb$MCFEn+Nkr%q1b;%N!r;=zLFJDT8=6OX6n6ubATubn08w6oau(PT*}2 zczg@Gg}oZuDNm+3w%vC6+ihknZuDjd4~8s37pN1=Q)YxukenOyBkZTZ^U0E<tUGr? zJ5{txWQ=v~QpDbR4#MC;&sn2>e+kcpU6Ot{@WtFH^DT!`6TsVY=>y=Nb1vq{xZmg@ zYldFsqBat?efCFgr~wRUuLH2{e@0HBnt2@3ZRF27$k8{b+rkz>j-|iQ$fX%a=9!qo zWv&phq{tBK>{4r|EFrJR{lzow&B%{6)6OvlmfE*DXTiOv%pFFLOgZwy?3G~-n%9cG z0BxiZ`%&MXe#n~@Z3lB6v_GU@=Yf4Vs1Hbe0(y;gVXl(7QzJKJ(9dHN`d9F`UnDLk z?_7WC0qrmIJIo8Pr?48eh0`S&$Rn?lJR9@sv~OHH@<sbWIg|W#a;%)gJ{ay%Ira-a z=X`tmVSC=Dogkf9AIVV&56mUwp2CA!mgp1G0_|n~_OwebnK@46+VI@J<R2w>2iZfe z8oeP=8lFd!d^~$om<z-+Wg>f&MfR!S@84j59mQTyu8jP9*>?2VU|;ziZAog-xKx9F z*sdGkf2QK^0LhxuMt11$A^pOGS)Z}TT%#Q14m;K-Kttsb(NpG($tTx<^iUQW%yoi} zJR^^d+#Y*9*{?$V;~tY%_Ls^q_Xv>(>IZu!kcW|;5Apy%c?)b$IQ2w&ZD8XhkK93y z^!koPA0QjMVgIViaz&2VM^wi=I^+Yn9mxaICefZ8PFss}PV0R}<{YrWgD!)orA|Q~ z$orE{?wiye$OCfE#y;ThCs3a+!6toVtUvNz55Qj@ChzP=l3IZ5fw>+*U9iZJt`CwE z#C%*U<^eAtUrC<P11+?(4+S+<^aO2`JSF>244N%RtUJFat>m+CZ4hWiKN;<;Id6X@ z4+o(GX$!`-!j|e!lz|E4)1QF7m7JyYJawpNT%8B8rBRc$GuQ*>Kj~}P3zZc;O?Y9= zhkae0)6TljNyzd7+D7;R_B6+cu1oEM>u=tJHXgVyOEl2h4Ek?1)*tf!7p%Y3fb=>5 z>JS}xXzO+Bun*8@=Gur2s0);L-8X+Jb&*ENpX>E0%bJ_zr}oTI**n@(`a06wzGlH% znb6;!2j~IU2R*>W$mjl^^h1uW10Eih9x`5N7WysqoObmTsVlYBmMEvXF3c01p?#tq z$KNp#J3?K(l4kw$X${ZDVvmqNhaKm-OZ}C3Zek9p`<QD`SMY$p*(Li59~KG>B@HB? z|M$?{2=s;OwJ6+^*o=dEPMH>6mil0OzhKs9*dqFi4CpNWUYSliYJr{6P93g3bx8Q+ zHAcOr%|~CsLwh~IK9s=^u<iodM}uyOq2Pz_ge^aqiSI3adE_Auz3_$%kq6S>o(Ho& zQ`b=&z`8|=UGI!;`UA>3>k`b(ORtwv<B)#7c6BfA1N@!TAbB+O81&QjBgc<i{3pE( z+283m;_lS>qZ^2yxSt%%W9xd*84qo`z;jX4ljjiXVLv;gUHTm1tIAEQWNy~gjQlud zM`8)V7zWnU_n@OL=ylA4@Cne}R>WEN8uUYVAB8U#dZ~+oi!D5u>zeKMLEi&E!Bv#u z!@ynbYnttOppU(H{xp2o3bBvuKhWzds4XB468byk!RSxW@t&c}#P4arj_hfZXHp<T zU7))*j9K#FPuu7>YLaGMpdJVhx*XAFWJXPezbud%RePF^_oTfJGDGafJ(qrI#uf16 zQX4V%IbNLyy+2f!BiJJN1=bYM+r1L8=`CV=&?}B-6J`?A%eupc|BwgPcMUy8UkU6z zeND~DL!H}o*hkiOYfhG<7bZmF1!79ZM2wsFU@q$J4|rg`PilTfe=FpvojsxtASMCM z`4TcCxdQCNO^BzGX?s`)qz_`hi_Sxv9&qh*P%CClmOU5vJ4Vv;V63&}2t6h3#Fq4f z=>0Zh%6a137-t^E^EXmw1V8-z16`m#e@lIa9vC(idQAMVC)`zo><^&aaQzXl{~kQl zFa{*;#<1`JnW7ENMVv@%N<LVxXTOGpX0tycj%fgPrj4OqqdpAz4i&lF9sC*W$zriV zm(Zt6%#pLi!%V;4Ybv$2&U68Lz<r=EW84ASA8x0+-B2$AeKT=C^ab-MdtjC$(9igX z{+)iCz3J=)5&Fd@ntLFCVMzb+ykuPeCGrri=;Qqgy-8n4FIRa=yvEo}dZVGwTm$wu zQLd<yZTn!Z;hUc^vc#TPf65#5=py95jeehDZ=?l|Yh|oQ*^*u<^FHu1Z769$-b$nI z<Ff;dIcng88tcFdFfaLG+{L;&*PJ$~5U~n<^G;wA_CB>-z64!q^JzT)NJbKHn1k3L z3lFTpa}PGK_Dy}z{Q`BE{vEb69lC4j1;$=HOWczV|3kl$1-nA|w)g?i&(D-s#%AP& zeLuVx<(9oBhf~)GwkLK#FPPXF`X}lr?Lq~fThn{ee~5#qPh2C)j?P0{4}tJu_HFFv zXAK%SVK(v%HyQFHIxu(mSlFNd=)xN4!oFP#kgExH6q+eF>;Y%2!kCe{1^RCzr^EFl zZ?s3*kUiQ)BktJ;9!VSb<jjFAt)&%@Od~edpEm$*K7U4fKxn&Zn@GQ9AJ7xgwhs}4 zrCHa<dJi>pw>=NAN7rL?L+<5S@bLk16vJ?yE9&x#(esVoI!9tYiA%B&<LEr0)(ku$ zeLJwPTyq^`z(1R@9-d2(JR|$1XiNA^VI_KIs0-9%{7p59&lyY8Pv|_DZ4!7e`Y5Dt z3-KrFyT9nUX2fN;@0>g0Szy)Iz~9@5@ySzgYJgoT_-UX_aeZlj*=Il>Lb+jVqvKP( zFOd0QVkGK@*f_JTCe6$*P|qo|)ME<|8^8y30q0Owp}Ut&e#1NMvv0o_KlL7b+yWhX z5V_31V2}E8PvKLhA!oJ)@>IvTp7Cx*1oR2AM!!LQVXjAFQ{Y08L+0(kS2p@spnENd z+b)yNqIKx~6q`g{W)DA}J3)R6_bxQ~kFwaFpQ7`Z{0=;b_}}Jk=+BeDBhN#}-Z1&v zc)&I<hwUn1Y^Uo#o^b%(#D@jU4MXm!C(xT#^2gkgjCMS*FN^wzdqrcd{$<_ZJA9Cj zoP(N&zui61t4G08Pw+Mp@)rc1DgaL{<cl_l{!@5@{);~*wiA4W=RBb|w2PqK1?wb! z_m`~guX!$L=n5KcN}V_A4%%_Z;#1&h2zc_xKBc1%qzZdTooa$iwX$cJ{LschcddU- zT7Ip2fhWeVH^A57`J<7yV4v>CcmKc`haSE4$ZIy?`)t@nRPC?5uC2he6}Ywn{~jxF zWgpW|eZKbhOH9A+-!Fj}^uW-xKd5)q$I4p0p$4jVEyB_M*)(=?-KcK6jeivUw`v^f z&*<#xu7Bd+CBIHR|GfDV`XsyZOzHjN-$?n5>efyF#J^N<J+G7B_&nSVyiWfF|8%4J EPpBEF;Q#;t literal 0 HcmV?d00001 diff --git a/components/mbColorLib/GAxisColorPicker.dcr b/components/mbColorLib/GAxisColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..49430574111b0312f6c1c414ae7dc8641f7163ac GIT binary patch literal 1864 zcmb`^Kj`k%0mkvP+}MhhCbzBJ+60CEJ5`j6CMZIEQ>@5Mtd&|wTF}yDu*(}9^bQ$x z%DWUKWD!aNE-hzpOx7lIvJ^Tbb3&mm2|6ajw{QKK!QDfi!*dRY&k2d5D9Yp4z)i08 zE91WpD2j94fp03mS6)$mr3A`7<qhQ}<+sYK*ZfX-{knch@syXZ{bt<N9{u*0RT0;6 z=gWNKi>4^;)x7=CO^$Qd8@{ebMb%IZRDo)to={y>A2mchqb8^+YKB^%O4JIqLG4fn z)CqM#-B54d<QBIzbOT+WTj(cr7u`n>(a-1!dWxQ*7w8hbLT}JJ^Z|WBU(h%7!!b2X z15;pHm?umZ)5i=k&zK2jikV>+m=d$XY%n{_0dvA!FgMJ@5gNik2!w?=AzXxy2oYyQ zf=Ce=qCiMQg=i2RVn9rY1+j7c7ytjrx3D#A16yEQ*e7fk+s6*E&)5leik)E>*b=+K zZm>J-0eiw;us7_(aWotQN8ngECma{Y#|d%HI0;UQli?IN5~spxa5|g;XTn)<Hk`xp zG&}=O;8}PlJQvT$3-Qi)30{hq;T3oiufl8aI=lgI!dvh*yu%4J0)s#hSOg~mm%t|o z3C;uwK}wJj6a<o>B4`LYf`MQnSO_+P!-+H^gGdlrL?<Gb$R`Sk&O`}ON|X^5M3Sf? zYKS_bfoLLHh&H0bi8W$_SP)ypC*r3+e);jYe(~fxcmMFOKPJQ}aYkGaOX7;SA?}C= z;)!@6-iQw;(MSvuL1K}7@716D=&h%o`}jA{efaC|KmEw__n%KmGLnKsl2jxONk=k} zOe71*Mshe8jf=rWaJh5;#XEm~*5%@J3Aw!e`3Da?{H^yt`yk^|aFJXpE)AEC%fMyg zvT)hB98Rv08{~rgyZ4@Ws{V^h?vsb)XYwb4XZ(NsDI+h)C3!{Okay$*`9!{uZ{&wl zYLo`0p!~txr=NcGrc3ElhLmT@$DE%>|9mf_EGQ*qMcGhxlmq2NxlnGDha)wlffUHQ zpZ@KZ_Ruf?{Z}6uBA>bc+K=zuO_3S0KuTnVY>*vtKu*X7xgigy)~F3?L2XgL@af;b z^W<X>{_wW?@Pj`KUVQiSPg3fPx}cWS6?H@1Q4iD;^+LT-A5N>$8nlAeqCL^Nw6Fc= zlQ%!B&$J0`N}JIZw34=>ZD>2%fp(%@XgAu!={0(TUeH_gCwiCOrw{4R^a*`RpV1fe zlD?vE=sWs>exhIKH~PaFHAaI`Fj|Z!MwiiN3>nXi31iBbF&2!Hv0`i(JH~-=Vq6$E z#>1I4W`kKUTg)eBm)U0yna|7#bIP1C7tE5mVs4l_=7D))UYIxL!&x;}gH^CvtS45N z)n^S^&#Vb+%9^njtdg~2ZCE?jfpubCSU1+g*)?{9U9em1Cw7<JXAjxW><N3yp0O9~ XlD%SY*gN)tePUnOH})InYnlHCtq=^G literal 0 HcmV?d00001 diff --git a/components/mbColorLib/GAxisColorPicker.pas b/components/mbColorLib/GAxisColorPicker.pas new file mode 100644 index 000000000..dfd3f9137 --- /dev/null +++ b/components/mbColorLib/GAxisColorPicker.pas @@ -0,0 +1,380 @@ +unit GAxisColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLType, LCLIntf, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, Forms, + HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines; + +type + TGAxisColorPicker = class(TmbColorPickerControl) + private + FSelected: TColor; + FBmp: TBitmap; + FOnChange: TNotifyEvent; + FR, FG, FB: integer; + FManual: boolean; + dx, dy, mxx, myy: integer; + + procedure SetRValue(r: integer); + procedure SetGValue(g: integer); + procedure SetBValue(b: integer); + protected + function GetSelectedColor: TColor; override; + procedure WebSafeChanged; override; + procedure SetSelectedColor(c: TColor); 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure DrawMarker(x, y: integer); + procedure Paint; override; + procedure CreateRGBGradient; + procedure Resize; override; + procedure CreateWnd; override; + procedure CorrectCoords(var x, y: integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + published + property SelectedColor default clLime; + property RValue: integer read FR write SetRValue default 0; + property GValue: integer read FG write SetGValue default 255; + property BValue: integer read FB write SetBValue default 0; + property MarkerStyle default msCircle; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R GAxisColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TGAxisColorPicker]); +end; + +{TGAxisColorPicker} + +constructor TGAxisColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(256, 256); + Width := 256; + Height := 256; + HintFormat := 'R: %r B: %b'#13'Hex: %hex'; + FG := 255; + FB := 0; + FR := 0; + FSelected := clLime; + FManual := false; + dx := 0; + dy := 0; + mxx := 0; + myy := 0; + MarkerStyle := msCircle; +end; + +destructor TGAxisColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TGAxisColorPicker.CreateWnd; +begin + inherited; + CreateRGBGradient; +end; + +procedure TGAxisColorPicker.CreateRGBGradient; +var + r, b : integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.Width := 256; + FBmp.Height := 256; + end; + for r := 255 downto 0 do + begin + row := FBmp.Scanline[255-r]; + for b := 0 to 255 do + if not WebSafe then + row[b] := RGBtoRGBQuad(r, FG, b) + else + row[b] := RGBtoRGBQuad(GetWebSafe(RGB(r, FG, b))); + end; +end; + +procedure TGAxisColorPicker.CorrectCoords(var x, y: integer); +begin + if x < 0 then x := 0; + if y < 0 then y := 0; + if x > Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure TGAxisColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + FR := GetRValue(FSelected); + FG := GetGValue(FSelected); + FB := GetBValue(FSelected); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function TGAxisColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +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)); + CreateRGBGradient; + Invalidate; +end; + +procedure TGAxisColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBmp); + 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.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 TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +end; + +procedure TGAxisColorPicker.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; + end; +end; + +procedure TGAxisColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TGAxisColorPicker.SetRValue(r: integer); +begin + if r > 255 then r := 255; + if r < 0 then r := 0; + FR := r; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +procedure TGAxisColorPicker.SetGValue(g: integer); +begin + if g > 255 then g := 255; + if g < 0 then g := 0; + FG := g; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +procedure TGAxisColorPicker.SetBValue(b: integer); +begin + if b > 255 then b := 255; + if b < 0 then b := 0; + FB := b; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +function TGAxisColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure TGAxisColorPicker.WebSafeChanged; +begin + inherited; + CreateRGBGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/GColorPicker.dcr b/components/mbColorLib/GColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..85fedc12fad471a2c5870e38f21bbb87abbc51b3 GIT binary patch literal 1856 zcmchSu}VWh5Jg8p5p0Z=2!drw8^JOVL?nVD7WVe}fb#)<fSrYX3S0a1`2l+yJ3qi; zo#*<Nb=l-D77k}%X4rdp&&=%5JA~Li{;Ky)vlG9Bux>YYW@Edw3-4>YvUA@icItDi zqn-V&K0Nec@2A(kC$qV`cDG~q@7(+kuz{rIGZ-Lg@*IGo$uk5+ljj%|O`Z`ba?j)J zIg%fJW`ZO|+z|TmIo&(YEt2#;_qZ=taff7?Cs#2=vci*8G}H=D`Zey6Eb}CZKi~mL z)sss)&l8g5@xkMf{MdPBNQy{x<poJKSR9!nDI(RC1(Is8IP!|5h*VeJkW_=kkq;zA Nq`LBnq#FG5@eBS%5#Im+ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/GColorPicker.pas b/components/mbColorLib/GColorPicker.pas new file mode 100644 index 000000000..ec410051f --- /dev/null +++ b/components/mbColorLib/GColorPicker.pas @@ -0,0 +1,264 @@ +unit GColorPicker; + +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + mbTrackBarPicker, HTMLColors, Scanlines; + +type + TGColorPicker = class(TmbTrackBarPicker) + private + FRed, FGreen, FBlue: integer; + FBmp: TBitmap; + + function ArrowPosFromGreen(g: integer): integer; + function GreenFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateGGradient; + procedure SetRed(r: integer); + procedure SetGreen(g: integer); + procedure SetBlue(b: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Red: integer read FRed write SetRed default 122; + property Green: integer read FGreen write SetGreen default 255; + property Blue: integer read FBlue write SetBlue default 122; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Layout default lyVertical; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} +{$R GColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TGColorPicker]); +end; + +{TGColorPicker} + +constructor TGColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(12, 256); + Width := 22; + Height := 268; + Layout := lyVertical; + FRed := 122; + FGreen := 255; + FBlue := 122; + FArrowPos := ArrowPosFromGreen(255); + FChange := false; + SetGreen(255); + HintFormat := 'Green: %value'; + FManual := false; + FChange := true; +end; + +destructor TGColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TGColorPicker.CreateWnd; +begin + inherited; + CreateGGradient; +end; + +procedure TGColorPicker.CreateGGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FBmp.width := 256; + FBmp.height := 12; + for i := 0 to 255 do + for j := 0 to 11 do + begin + row := FBmp.ScanLine[j]; + if not WebSafe then + row[i] := RGBtoRGBQuad(FRed, i, FBlue) +// FBmp.Canvas.Pixels[i, j] := RGB(FRed, i, FBlue) + else + row[i] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, i, FBlue))); +// FBmp.Canvas.Pixels[i, j] := GetWebSafe(RGB(FRed, i, FBlue)); + end; + end + else + begin + FBmp.width := 12; + FBmp.height := 256; + for i := 0 to 255 do + begin + row := FBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBtoRGBQuad(FRed, 255-i, FBlue) + else + row[j] := RGBtoRGBQuad(GetWebSafe(RGB(FRed, 255-i, FBlue))); + end; + end; +end; + +procedure TGColorPicker.SetRed(r: integer); +begin + if r < 0 then r := 0; + if r > 255 then r := 255; + if FRed <> r then + begin + FRed := r; + FManual := false; + CreateGGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TGColorPicker.SetGreen(g: integer); +begin + if g > 255 then g := 255; + if g < 0 then g := 0; + if FGreen <> g then + begin + FGreen := g; + FArrowPos := ArrowPosFromGreen(g); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TGColorPicker.SetBlue(b: integer); +begin + if b > 255 then b := 255; + if b < 0 then b := 0; + if FBlue <> b then + begin + FBlue := b; + FManual := false; + CreateGGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TGColorPicker.ArrowPosFromGreen(g: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*g); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + g := 255 - g; + a := Round(((Height - 12)/255)*g); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TGColorPicker.GreenFromArrowPos(p: integer): integer; +var + g: integer; +begin + if Layout = lyHorizontal then + g := Round(p/((Width - 12)/255)) + else + g := Round(255 - p/((Height - 12)/255)); + if g < 0 then g := 0; + if g > 255 then g := 255; + Result := g; +end; + +function TGColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := RGB(FRed, FGreen, FBlue) + else + Result := GetWebSafe(RGB(FRed, FGreen, FBlue)); +end; + +function TGColorPicker.GetSelectedValue: integer; +begin + Result := FGreen; +end; + +procedure TGColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FChange := false; + SetRed(GetRValue(c)); + SetBlue(GetBValue(c)); + SetGreen(GetGValue(c)); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +function TGColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromGreen(FGreen); +end; + +procedure TGColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetGreen(FGreen); + TBA_Paint: Canvas.StretchDraw(FPickRect, FBmp); + TBA_MouseMove: FGreen := GreenFromArrowPos(FArrowPos); + TBA_MouseDown: FGreen := GreenFromArrowPos(FArrowPos); + TBA_MouseUp: FGreen := GreenFromArrowPos(FArrowPos); + TBA_WheelUp: SetGreen(FGreen + Increment); + TBA_WheelDown: SetGreen(FGreen - Increment); + TBA_VKRight: SetGreen(FGreen + Increment); + TBA_VKCtrlRight: SetGreen(255); + TBA_VKLeft: SetGreen(FGreen - Increment); + TBA_VKCtrlLeft: SetGreen(0); + TBA_VKUp: SetGreen(FGreen + Increment); + TBA_VKCtrlUp: SetGreen(255); + TBA_VKDown: SetGreen(FGreen - Increment); + TBA_VKCtrlDown: SetGreen(0); + TBA_RedoBMP: CreateGGradient; + end; +end; + +end. diff --git a/components/mbColorLib/HColorPicker.dcr b/components/mbColorLib/HColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..28e897bc1ee137c3468efabd8492151a17315029 GIT binary patch literal 1856 zcmds%-%Aux6vuBph*0b%$`A{!u@5`4$g&F~%+ih_W6PTB?@<F;BNls6LkLt1%Lpkl zE2|BueCWY{AS!}DT}&xcgMJu6e?YIzO2aVsoYR=K=qkp%^w41reD9ZYK6CE9a2aFl zsGUTcY0GW#t$;Dvc8K;fjm4SD8d$>4X4c4R>{Ts0Ve8EZ9r6_ZX)d$H;orIMmtt(r zX5|NM{Q3X?20EcX2?MA3P>K(C@yp%TXrDDcXgS?`Iu7X=+^>Pj1UzWsQ*Hcll23Oz z<}9nY6vd@VT&{wZ7_8R8I}JXhxYK#eh+&2eQ!-51Fcrg84YSrTJAOFjU?_v)EC%K< zm_cbCqYI!eg7(%ahy26j9VFiniNjbvg3>4|*P;HNV~$rQAw(XDN@emN$6yTQdOX?b zm~%`Z$whK8ReGq}hlv1c5~gB~IU_}Mp^z@R=!!sBy?8^!i7-B_cFb8kK(7jD@gTh} zp*KfpS;W;4zE_=cvR0996=p40))KOocij@#t?;^)KTmIO@80BRBs?M4Q!0K=o)_eM ziGi7o>)&=hZLO^>EiHR<dZ?t2g!AO-r_v$vU&7!h%GaPO*A<V)6-9|eA~|PQ;irVx zz9)){lqknW3ELIytcRY>VjEIXQ6Y+=&*$5<J!gjKZW-MS;O!vZkuV*_NfjPxFr6z9 z%S1sC+-`Ty*;PbvEsP%}{3PR=f@>;#u7xih{Oi_Y8)CnzTb-R+)gh`w<#(vkA*S;> zoohNzW%J*Szs}Q;f!GYx%tB%gnlik7o+lT0_fkG*=Ky(5^B8X)18p2m-Qpb+{7l+9 PJ87Mpa?HuY{`=)m6aib@ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HColorPicker.pas b/components/mbColorLib/HColorPicker.pas new file mode 100644 index 000000000..4abcc1278 --- /dev/null +++ b/components/mbColorLib/HColorPicker.pas @@ -0,0 +1,264 @@ +unit HColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + THColorPicker = class(TmbTrackBarPicker) + private + FVal, FSat, FHue: integer; + FHBmp: TBitmap; + + function ArrowPosFromHue(h: integer): integer; + function HueFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateHGradient; + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetValue(v: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 255; + property Value: integer read FVal write SetValue default 255; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THColorPicker]); +end; + +{THColorPicker} + +constructor THColorPicker.Create(AOwner: TComponent); +begin + inherited; + FHBmp := TBitmap.Create; + FHBmp.PixelFormat := pf32bit; + Width := 267; + Height := 22; + FSat := 255; + FVal := 255; + FArrowPos := ArrowPosFromHue(0); + FChange := false; + SetHue(0); + HintFormat := 'Hue: %value'; + FManual := false; + FChange := true; +end; + +destructor THColorPicker.Destroy; +begin + FHBmp.Free; + inherited Destroy; +end; + +procedure THColorPicker.CreateWnd; +begin + inherited; + CreateHGradient; +end; + +procedure THColorPicker.CreateHGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FHBmp = nil then + begin + FHBmp := TBitmap.Create; + FHBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FHBmp.width := 360; + FHBmp.height := 12; + for i := 0 to 359 do + for j := 0 to 11 do + begin + row := FHBmp.ScanLine[j]; + if not WebSafe then + row[i] := RGBtoRGBQuad(HSVtoColor(i, FSat, FVal)) +// FHBmp.Canvas.Pixels[i, j] := HSVtoColor(i, FSat, FVal) + else + row[i] := RGBtoRGBQuad(GetWebSafe(HSVtoColor(i, FSat, FVal))); +// FHBmp.Canvas.Pixels[i, j] := GetWebSafe(HSVtoColor(i, FSat, FVal)); + end; + end + else + begin + FHBmp.width := 12; + FHBmp.height := 360; + for i := 0 to 359 do + begin + row := FHBmp.ScanLine[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBtoRGBQuad(HSVtoColor(i, FSat, FVal)) + else + row[j] := RGBtoRGBQuad(GetWebSafe(HSVtoColor(i, FSat, FVal))); + end; + end; +end; + +procedure THColorPicker.SetValue(v: integer); +begin + if v < 0 then v := 0; + if v > 255 then v := 255; + if FVal <> v then + begin + FVal := v; + FManual := false; + CreateHGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure THColorPicker.SetHue(h: integer); +begin + if h > 360 then h := 360; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + FArrowPos := ArrowPosFromHue(h); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure THColorPicker.SetSat(s: integer); +begin + if s > 255 then s := 255; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + CreateHGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function THColorPicker.ArrowPosFromHue(h: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/360)*h); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + a := Round(((Height - 12)/360)*h); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function THColorPicker.HueFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/360)) + else + r := Round(p/((Height - 12)/360)); + if r < 0 then r := 0; + if r > 360 then r := 360; + Result := r; +end; + +function THColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := HSVtoColor(FHue, FSat, FVal) + else + Result := GetWebSafe(HSVtoColor(FHue, FSat, FVal)); +end; + +function THColorPicker.GetSelectedValue: integer; +begin + Result := FHue; +end; + +procedure THColorPicker.SetSelectedColor(c: TColor); +var + h, s, v: integer; +begin + if WebSafe then c := GetWebSafe(c); + RGBToHSV(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 THColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromHue(FHue); +end; + +procedure THColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetHue(FHue); + TBA_Paint: Canvas.StretchDraw(FPickRect, FHBmp); + TBA_MouseMove: FHue := HueFromArrowPos(FArrowPos); + TBA_MouseDown: FHue := HueFromArrowPos(FArrowPos); + TBA_MouseUp: FHue := HueFromArrowPos(FArrowPos); + TBA_WheelUp: SetHue(FHue + Increment); + TBA_WheelDown: SetHue(FHue - Increment); + TBA_VKLeft: SetHue(FHue - Increment); + TBA_VKCtrlLeft: SetHue(0); + TBA_VKRight: SetHue(FHue + Increment); + TBA_VKCtrlRight: SetHue(360); + TBA_VKUp: SetHue(FHue - Increment); + TBA_VKCtrlUp: SetHue(0); + TBA_VKDown: SetHue(FHue + Increment); + TBA_VKCtrlDown: SetHue(360); + TBA_RedoBMP: CreateHGradient; + end; +end; + +end. diff --git a/components/mbColorLib/HRingPicker.dcr b/components/mbColorLib/HRingPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..44649eb3a05d7d61887a34282655b8e18964c146 GIT binary patch literal 1856 zcmdUvA&lEF6o$QlX|V8VXphZoW(&<UZS$mQiiVB`76u*-EG!HSEG(=vR9JX0v}1*V z-=33Iy5@FW4h+nyQ`b(v_xt(%cFwui)?w^6yl6jPIQPzG;JN$mKDokuc3<5`_szcF zyD#p8&79lY#jBU+@f#b+@BVBUIrqa@(?*K?pM0t{u_mktEpbQHJz05-NI(nx5?|vR z{1!bR9kHKF3xZeFI5|=xw@8B+=MFug9A!p63n40oQpHEICDC@bCEF7^v_C1GvcHb1 zgi0AvMSQ5gj~so1Y?byg)Fx-G+zzO^cnBG1?n<_vR@1vp{L=<El9n5x$sdD^^P7U& z0xHXglDZ{(Whd<Xb;!6{1xn?{R8^Ofjv=M*PUx~ZoMldK2jVFwTkD11(=V`8&alZ% zfeOKsg$q4Ba>Ad|^DoI6qZC$F0iO}F3r<I7MP~JSAk5K|S3|KE#B#!^cBy1#WA!>? zU;Y+dq9ta*$@?vf7F{7`%gNH@XKumPXpKw`YY@<quTYC)TVFn&rD*2Zp%&8Y(oDsS z5vxQnlUoYKQdm*nSF++{N!4RYqM@YyGi3ZrWDy6en^A?_3M5bmTF-7Muaov@hwQIG zMwE%MTf;oB$@!%u%dH1%9z16ER2=tpUK!`aMY=l*^N^?ZG@2}auyT*gzQ@kzUa`)S V9nF+Y#<t?=_v#sSMe{#e`UN3gT8sby literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas new file mode 100644 index 000000000..2d5ccf126 --- /dev/null +++ b/components/mbColorLib/HRingPicker.pas @@ -0,0 +1,511 @@ +unit HRingPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, RGBHSVUtils, + Forms, {IFDEF DELPHI_7_UP Themes, $ENDIF} HTMLColors, mbColorPickerControl, + Scanlines; + +type + THRingPicker = class(TmbColorPickerControl) + private + FHue, FSat, FValue: integer; + FHueLineColor: TColor; + FSelectedColor: TColor; + FOnChange: TNotifyEvent; + FManual: boolean; + mx, my, mdx, mdy: integer; + Fchange: boolean; + FRadius: integer; + FBMP: TBitmap; + FDoChange: boolean; + + procedure CreateHSVCircle; + function RadHue(New: integer): integer; + procedure SetRadius(r: integer); + procedure SetValue(v: integer); + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetHueLineColor(c: TColor); + procedure DrawHueLine; + procedure SelectionChanged(x, y: integer); + procedure UpdateCoords; + protected + function GetSelectedColor: TColor; override; + procedure WebSafeChanged; override; + procedure SetSelectedColor(c: TColor); override; + procedure Paint; override; + procedure Resize; override; + procedure CreateWnd; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); + message CN_KEYDOWN; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 0; + property Value: integer read FValue write SetValue default 255; + property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; + property SelectedColor default clNone; + property Radius: integer read FRadius write SetRadius default 30; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HRingPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THRingPicker]); +end; + +function PointInCirc(p: TPoint; size : integer): boolean; +var + r: integer; +begin + r := size div 2; + Result := (SQR(p.x - r) + SQR(p.y - r) <= SQR(r)); +end; + +constructor THRingPicker.Create(AOwner: TComponent); +begin + inherited; + FBMP := TBitmap.Create; + FBMP.PixelFormat := pf32bit; + Width := 204; + Height := 204; + FValue := 255; + FHue := 0; + FSat := 0; + FHueLineColor := clGray; + FSelectedColor := clNone; + FManual := false; + Fchange := true; + FRadius := 30; + FDoChange := false; +end; + +destructor THRingPicker.Destroy; +begin + FBMP.Free; + inherited; +end; + +procedure THRingPicker.CreateHSVCircle; +var + dSquared, H, S, V, i, j, Radius, RadiusSquared, x, y, size: integer; + row: pRGBQuadArray; + tc: TColor; +begin + if FBMP = nil then + begin + FBMP := TBitmap.Create; + FBMP.PixelFormat := pf32bit; + end; + size := Min(Width, Height); + FBMP.Width := size; + FBMP.Height := size; + Radius := size div 2; + RadiusSquared := Radius*Radius; + PaintParentBack(FBMP.Canvas); + V := FValue; + for j := 0 to size - 1 do + begin + Y := Size - 1 - j - Radius; + row := FBMP.Scanline[Size - 1 - j]; + for i := 0 to size - 1 do + begin + X := i - Radius; + dSquared := X*X + Y*Y; + if dSquared <= RadiusSquared then + begin + if Radius <> 0 then + S := ROUND((255*SQRT(dSquared))/Radius) + else + S := 0; + H := ROUND( 180 * (1 + ArcTan2(X, Y) / PI)); + H := H + 90; + if H > 360 then H := H - 360; + if not WebSafe then + row[i] := HSVtoRGBQuad(H,S,V) + else + begin + tc := GetWebSafe(HSVtoColor(H, S, V)); + row[i] := RGBtoRGBQuad(GetRValue(tc), GetGValue(tc), GetBValue(tc)); + end; + end + end; + end; +end; + +procedure THRingPicker.Resize; +begin + inherited; + CreateHSVCircle; + UpdateCoords; +end; + +procedure THRingPicker.CreateWnd; +begin + inherited; + CreateHSVCircle; + UpdateCoords; +end; + +procedure THRingPicker.UpdateCoords; +var + r, angle: real; + radius: integer; +begin + radius := Min(Width, Height) div 2; + r := -MulDiv(radius, FSat, 255); + angle := -FHue*PI/180 - PI; + mdx := ROUND(COS(angle)*ROUND(r)) + radius; + mdy := ROUND(SIN(angle)*ROUND(r)) + radius; +end; + +procedure THRingPicker.SetHue(h: integer); +begin + if h > 360 then h := 360; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + FManual := false; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure THRingPicker.SetSat(s: integer); +begin + if s > 255 then s := 255; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure THRingPicker.SetValue(v: integer); +begin + if V > 255 then V := 255; + if V < 0 then V := 0; + if FValue <> V then + begin + FValue := V; + FManual := false; + CreateHSVCircle; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure THRingPicker.SetHueLineColor(c: TColor); +begin + if FHueLineColor <> c then + begin + FHueLineColor := c; + Invalidate; + end; +end; + +procedure THRingPicker.SetRadius(r: integer); +begin + if FRadius <> r then + begin + FRadius := r; + Invalidate; + end; +end; + +procedure THRingPicker.DrawHueLine; +var + angle: double; + radius: integer; +begin + Radius := Min(Width, Height) div 2; + if (FHue >= 0) and (FHue <= 360) then + begin + Angle := -FHue*PI/180; + Canvas.Pen.Color := FHueLineColor; + Canvas.MoveTo(Radius,Radius); + Canvas.LineTo(Radius + Round(Radius*COS(angle)), Radius + Round(Radius*SIN(angle))); + end; +end; + +procedure THRingPicker.Paint; +var + rgn, r1, r2: HRGN; + r: TRect; +begin + PaintParentBack(Canvas); + r := ClientRect; + r.Right := R.Left + Min(Width, Height); + R.Bottom := R.Top + Min(Width, Height); + r1 := CreateEllipticRgnIndirect(R); + rgn := r1; + InflateRect(R, - Min(Width, Height) + FRadius, - Min(Width, Height) + FRadius); + r2 := CreateEllipticRgnIndirect(R); + CombineRgn(rgn, r1, r2, RGN_DIFF); + SelectClipRgn(Canvas.Handle, rgn); + Canvas.Draw(0, 0, FBMP); + DeleteObject(rgn); + DrawHueLine; + if FDoChange then + begin + if Assigned(FOnChange) then FOnChange(Self); + FDoChange := false; + end; +end; + +procedure THRingPicker.SelectionChanged(x, y: integer); +var + Angle, Distance, xDelta, yDelta, Radius: integer; +begin + if not PointInCirc(Point(x, y), Min(Width, Height)) then + begin + FChange := false; + SetSelectedColor(clNone); + FChange := true; + Exit; + end + else + FSelectedColor := clWhite; + Radius := Min(Width, Height) div 2; + xDelta := x - Radius; + yDelta := y - Radius; + Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI); + if Angle < 0 then Inc(Angle, 360) + else if Angle > 360 then + Dec(Angle, 360); + Fchange := false; + SetHue(Angle); + Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta))); + if Distance >= Radius then SetSat(255) + else SetSat(MulDiv(Distance, 255, Radius)); + Fchange := true; +end; + +procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + if csDesigning in ComponentState then Exit; + if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then + begin + mdx := x; + mdy := y; + FDoChange := true; + SelectionChanged(X, Y); + FManual := true; + end; +end; + +procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + R: TRect; +begin + inherited; + if csDesigning in ComponentState then Exit; + if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then + begin + mdx := x; + mdy := y; + R := ClientRect; + InflateRect(R, 1, 1); + R.TopLeft := ClientToScreen(R.TopLeft); + R.BottomRight := ClientToScreen(R.BottomRight); + {$IFDEF DELPHI} + ClipCursor(@R); + {$ENDIF} + FDoChange := true; + SelectionChanged(X, Y); + FManual := true; + end; + SetFocus; +end; + +procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + if csDesigning in ComponentState then Exit; + if (ssLeft in Shift) and PointInCirc(Point(x, y), Min(Width, Height)) then + begin + mdx := x; + mdy := y; + FDoChange := true; + SelectionChanged(X, Y); + FManual := true; + end; +end; + +function THRingPicker.GetSelectedColor: TColor; +begin + if FSelectedColor <> clNone then + begin + if not WebSafe then + Result := HSVtoColor(FHue, FSat, FValue) + else + Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue)); + end + else + Result := clNone; +end; + +function THRingPicker.GetColorAtPoint(x, y: integer): TColor; +var + Angle, Distance, xDelta, yDelta, Radius: integer; + h, s: integer; +begin + Radius := Min(Width, Height) div 2; + xDelta := x - Radius; + yDelta := y - Radius; + Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI); + if Angle < 0 then Inc(Angle, 360) + else if Angle > 360 then + Dec(Angle, 360); + h := Angle; + Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta))); + if Distance >= Radius then s := 255 + else s := MulDiv(Distance, 255, Radius); + if PointInCirc(Point(mx, my), Min(Width, Height)) then + begin + if not WebSafe then + Result := HSVtoColor(h, s, FValue) + else + Result := GetWebSafe(HSVtoColor(h, s, FValue)); + end + else + Result := clNone; +end; + +procedure THRingPicker.SetSelectedColor(c: TColor); +var + changeSave: boolean; +begin + if WebSafe then c := GetWebSafe(c); + changeSave := FChange; + FManual := false; + Fchange := false; + SetValue(GetVValue(c)); + SetHue(GetHValue(c)); + SetSat(GetSValue(c)); + FSelectedColor := c; + Fchange := changeSave; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + FChange := true; +end; + +function THRingPicker.RadHue(New: integer): integer; +begin + if New < 0 then New := New + 360; + if New > 360 then New := New - 360; + Result := New; +end; + +procedure THRingPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +begin + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + if not (ssCtrl in Shift) then + case Message.CharCode of + VK_LEFT: + begin + FChange := false; + SetHue(RadHue(FHue + 1)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + FChange := false; + SetHue(RadHue(FHue - 1)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end + else + begin + FInherited := true; + inherited; + end; + end + else + case Message.CharCode of + VK_LEFT: + begin + FChange := false; + SetHue(RadHue(FHue + 10)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + FChange := false; + SetHue(RadHue(FHue - 10)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end + else + begin + FInherited := true; + inherited; + end; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure THRingPicker.WebSafeChanged; +begin + inherited; + CreateHSVCircle; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/HSColorPicker.dcr b/components/mbColorLib/HSColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..08cc2270db24bfe10700ff65f93e8e4085e7c8de GIT binary patch literal 1860 zcmds%FYM+f9EW=oOC^#_4R^R9n@n|CvT;kcuqiAOiL9+eBC$v$l4Pn9iNtaaS;=@` z-b;RWIXQI%nr|OIJSF|NEX(ra7`@Li%Fo)z@0aE0L3;mg`DgiU`Fr_g`E&VW47U8W z{65Y;EWeKWQ~L@0uzsrFj{?5NyJxj5{|?`mtv{~*ZFa5AdFoTY?GNxJ8}nbq+RQt1 z97Y{lom%PHPo)o~zse?lrDtv|pB{Bsc^G*bX-3!5oYE+1UQACs*fFts&OGpl4t6N} z@+c<`E3_5H3TuQtg;mlDWyNX5e83NO2rGpZV`iqUeln%p^hoKsa$GxZ9e0MilRGJ# z80>U>dYtA?aVNOr((%J_WBG#}14}<WLVBh=)1Eocyk-7mUUJU|KK<+M^qP6aJZGK> z&koOwW8N@-jHq~dxCm4Qssr_b21~<9gJglpK+izueuAb!(ZFb+BYgyFJ@tl$V?=qF z`(ZpjJm%?%?&%R@!SFoXkw#C$SR<#04^O0aT++}u+=9jFq5Rrq+)dm=+@pW{<><Kk z!NMNR{+7qx4Q%(Q_Q>h=^02hYYctmtukHHWb8TU;xLsy@>$x^Ju-z`TU7V)r*=Z&+ z5tGQ3ND3sKB=Ic~k%&$t3>HZ;BuSEXk_b)YNW@(vIg%7fY|qoP(Sl{hHsdSf9B@8y zW+Y>tvCepIBO9D0&Ku5{W_)Dq6V482HKJRY9<moC3$g{Jf=Wc?M1|pkctN_L=_wW! zfeJwdjr38F&!{+56e^UwJb0^6RA?*A71jvr2`fbvu?ls4{KH187FGc(h86A=9u<ZH zi-%Rgy5l<cgGd9S0oy=npk1Jypi$T$Yrr%xJ<Wn9KtrH`t%0L~P(k&eDbRM*rU&AC z75D1ywchKU*85!V9o&H3tGU-aSXpno-h92$dav8P9`_pC+QNFv_1@q;J$UO-cIZ27 v9rg^n2A!e~c?Y(`GFXM(!!AL`u!FtBv%~9#cYs~NzT<E6w>)po|8@KiXws)b literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HSColorPicker.pas b/components/mbColorLib/HSColorPicker.pas new file mode 100644 index 000000000..9f64d6f60 --- /dev/null +++ b/components/mbColorLib/HSColorPicker.pas @@ -0,0 +1,377 @@ +unit HSColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, Forms, + RGBHSLUtils, HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines; + +type + THSColorPicker = class(TmbColorPickerControl) + private + FSelected: TColor; + FHSLBmp: TBitmap; + FOnChange: TNotifyEvent; + FHue, FSaturation, FLuminance: integer; + FLum: integer; + FManual: boolean; + dx, dy, mxx, myy: integer; + + procedure SetHValue(h: integer); + procedure SetSValue(s: integer); + protected + function GetSelectedColor: TColor; override; + procedure WebSafeChanged; override; + procedure SetSelectedColor(c: TColor); 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure DrawMarker(x, y: integer); + procedure Paint; override; + procedure CreateHSLGradient; + procedure Resize; override; + procedure CreateWnd; override; + procedure CorrectCoords(var x, y: integer); + function PredictColor: TColor; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Lum: integer read FLum write FLum default 120; + property Manual: boolean read FManual; + published + property SelectedColor default clRed; + property HueValue: integer read FHue write SetHValue default 0; + property SaturationValue: integer read FSaturation write SetSValue default 240; + property MarkerStyle default msCross; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HSColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THSColorPicker]); +end; + +{THSColorPicker} + +constructor THSColorPicker.Create(AOwner: TComponent); +begin + inherited; + FHSLBmp := TBitmap.Create; + FHSLBmp.PixelFormat := pf32bit; + FHSLBmp.SetSize(240, 241); + Width := 239; + Height := 240; + HintFormat := 'H: %h S: %hslS'#13'Hex: %hex'; + FHue := 0; + FSaturation := 240; + FLuminance := 120; + FSelected := clRed; + FLum := 120; + FManual := false; + dx := 0; + dy := 0; + mxx := 0; + myy := 0; + MarkerStyle := msCross; +end; + +destructor THSColorPicker.Destroy; +begin + FHSLBmp.Free; + inherited Destroy; +end; + +procedure THSColorPicker.CreateWnd; +begin + inherited; + CreateHSLGradient; +end; + +procedure THSColorPicker.CreateHSLGradient; +var + Hue, Sat : integer; + row: pRGBQuadArray; +begin + if FHSLBmp = nil then + begin + FHSLBmp := TBitmap.Create; + FHSLBmp.PixelFormat := pf32bit; + FHSLBmp.Width := 240; + FHSLBmp.Height := 241; + end; + for Hue := 0 to 239 do + for Sat := 0 to 240 do + begin + row := FHSLBmp.ScanLine[240 - Sat]; + if not WebSafe then + row[Hue] := RGBToRGBQuad(HSLRangeToRGB(Hue, Sat, 120)) +// FHSLBmp.Canvas.Pixels[Hue, 240 - Sat] := HSLRangeToRGB(Hue, Sat, 120) + else + row[Hue] := RGBToRGBQuad(GetWebSafe(HSLRangeToRGB(Hue, Sat, 120))); +// FHSLBmp.Canvas.Pixels[Hue, 240 - Sat] := GetWebSafe(HSLRangeToRGB(Hue, Sat, 120)); + end; +end; + +procedure THSColorPicker.CorrectCoords(var x, y: integer); +begin + if x < 0 then x := 0; + if y < 0 then y := 0; + if x > Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure THSColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + RGBtoHSLRange(FSelected, FHue, FSaturation, FLuminance); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function THSColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +end; + +procedure THSColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + RGBtoHSLRange(c, FHue, FSaturation, FLuminance); + FSelected := c; + FManual := false; + mxx := Round(FHue*(Width/239)); + myy := Round((240-FSaturation)*(Height/240)); + Invalidate; +end; + +procedure THSColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FHSLBmp); + CorrectCoords(mxx, myy); + DrawMarker(mxx, myy); +end; + +procedure THSColorPicker.Resize; +begin + SetSelectedColor(FSelected); + inherited; +end; + +procedure THSColorPicker.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 THSColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +end; + +procedure THSColorPicker.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; + end; +end; + +function THSColorPicker.PredictColor: TColor; +var + FTHue, FTSat, FTLum: integer; +begin + RGBtoHSLRange(GetColorUnderCursor, FTHue, FTSat, FTLum); + Result := HSLRangeToRGB(FTHue, FTSat, FLum); +end; + +procedure THSColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure THSColorPicker.SetHValue(h: integer); +begin + if h > 239 then h := 239; + if h < 0 then h := 0; + FHue := h; + SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); +end; + +procedure THSColorPicker.SetSValue(s: integer); +begin + if s > 240 then s := 240; + if s < 0 then s := 0; + FSaturation := s; + SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); +end; + +function THSColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure THSColorPicker.WebSafeChanged; +begin + inherited; + CreateHSLGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/HSLColorPicker.dcr b/components/mbColorLib/HSLColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..f193bf4d562e57322eef53bf909e73de4cff4819 GIT binary patch literal 1860 zcmd6mFRaxt6vhjJTsgU*m}8DBn>;l_0)^y}f~u{otgM}^tgM}^tZag+ymE4OxXCNa z=?Z(}=9;%4XudYz+1dH^>`xIw=nc%2$^`q@`1uN<2e^{bOY|LmMBmUC^d3FJ`iLm{ ziatT~8GQg>#=GkE=?~y7nELm8u{wl)0Pl9By!(GArFzvDWqUVLvJW9b^OOqE-KP-J zh~5aJg;Bx?WrQw~ged1AA-N9zvT`(~`YwkH%k{vmWma*^m1V~AL31mZWn$pkax1Cz zu5cWs?k<ONN42AFpiWW8q@xxhL!F>*%|SvE=iHe4VHZ&0z-QY72@Avo;$0UM2}Fj@ z1riJiybE2<IpQVuZpa+Qt{^bw+wVD;Mr<OE9!G^^Cm}jl(c;K(Tyv0+=Q!92s)WcY z<v0DbWNgjYUSd0{^OzwiC3CJp<C=@@MK+@~Gn8wSwQpndO*b`mZl+5!sb*@$R2y6a zD${U1Hx?42noPeyiT7Ds?cP*)sq9kCW3{MyX~a?)+!PM17B^!x3$$pJU&}aU?aMcR zI$uviI$dX!RCTT4CmYkrb~{wp2$XucmX{5lbDC_|K6ORfZQlcCAm<I0{d3y5xp|=Y z2?ZXdeB}^uVBLmttSdT(a-0AP*1e9R))NPZZq+e}7j%0xFIdq*lw^SNl9v@s_J>}$ iSGmwDIH-9ItB#>cRmeYgf;F2%Ep1gnE6^7H6Y~putwSOJ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas new file mode 100644 index 000000000..d6aa64a76 --- /dev/null +++ b/components/mbColorLib/HSLColorPicker.pas @@ -0,0 +1,399 @@ +unit HSLColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, Menus, + {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} + RGBHSLUtils, HSColorPicker, LColorPicker, HTMLColors; + +type + THSLColorPicker = class(TCustomControl) + private + FOnChange: TNotifyEvent; + FHSPicker: THSColorPicker; + FLPicker: TLColorPicker; + FSelectedColor: TColor; + FHValue, FSValue, FLValue: integer; + FRValue, FGValue, FBValue: integer; + FHSHint, FLHint: string; + FLMenu, FHSMenu: TPopupMenu; + FLumIncrement: integer; + FHSCursor, FLCursor: TCursor; + PBack: TBitmap; + + function GetManual: boolean; + procedure SetLumIncrement(i: integer); + procedure SelectColor(c: TColor); + procedure SetH(v: integer); + procedure SetS(v: integer); + procedure SetL(v: integer); + procedure SetR(v: integer); + procedure SetG(v: integer); + procedure SetB(v: integer); + procedure SetHSHint(h: string); + procedure SetLHint(h: string); + procedure SetLMenu(m: TPopupMenu); + procedure SetHSMenu(m: TPopupMenu); + procedure SetHSCursor(c: TCursor); + procedure SetLCursor(c: TCursor); + procedure PaintParentBack; + procedure SetSelectedColor(Value: TColor); + protected + procedure CreateWnd; override; + procedure Resize; override; + procedure Paint; override; + procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); + message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF}; + procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); + message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF}; + procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure HSPickerChange(Sender: TObject); + procedure LPickerChange(Sender: TObject); + procedure DoChange; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorUnderCursor: TColor; + function GetHexColorUnderCursor: string; + function GetSelectedHexColor: string; + property ColorUnderCursor: TColor read GetColorUnderCursor; + property HValue: integer read FHValue write SetH default 0; + property SValue: integer read FSValue write SetS default 240; + property LValue: integer read FLValue write SetL default 120; + property RValue: integer read FRValue write SetR default 255; + property GValue: integer read FGValue write SetG default 0; + property BValue: integer read FBValue write SetB default 0; + property Manual: boolean read GetManual; + published + property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1; + property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clRed; + property HSPickerPopupMenu: TPopupMenu read FHSMenu write SetHSMenu; + property LPickerPopupMenu: TPopupMenu read FLMenu write SetLMenu; + property HSPickerHintFormat: string read FHSHint write SetHSHint; + property LPickerHintFormat: string read FLHint write SetLHint; + property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault; + property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault; + property TabStop default true; + property ShowHint; + property ParentShowHint; + property Anchors; + property Align; + property Visible; + property Enabled; + property TabOrder; + property Color; + property ParentColor default true; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF}{$ENDIF} + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnMouseMove; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HSLColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THSLColorPicker]); +end; + +{THSLColorPicker} + +constructor THSLColorPicker.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; + DoubleBuffered := true; + ParentColor := true; + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF} {$ENDIF} + Width := 206; + Height := 146; + TabStop := true; + FSelectedColor := clRed; + FHSPicker := THSColorPicker.Create(Self); + InsertControl(FHSPicker); + FLumIncrement := 1; + FHSCursor := crDefault; + FLCursor := crDefault; + with FHSPicker do + begin + Height := 134; + Width := 174; + Top := 6; + Left := 0; + Anchors := [akLeft, akTop, akRight, akBottom]; + Visible := true; + OnChange := HSPickerChange; + OnMouseMove := DoMouseMove; + end; + FLPicker := TLColorPicker.Create(Self); + InsertControl(FLPicker); + with FLPicker do + begin + Height := 146; + Top := 0; + Left := 184; + Anchors := [akRight, akTop, akBottom]; + Visible := true; + OnChange := LPickerChange; + OnMouseMove := DoMouseMove; + end; + FHValue := 0; + FSValue := 240; + FLValue := 120; + FRValue := 255; + FGValue := 0; + FBValue := 0; + FHSHint := 'H: %h S: %hslS'#13'Hex: %hex'; + FLHint := 'Luminance: %l'; +end; + +destructor THSLColorPicker.Destroy; +begin + PBack.Free; + FHSPicker.Free; + FLPicker.Free; + inherited Destroy; +end; + +procedure THSLColorPicker.HSPickerChange(Sender: TObject); +begin + FLPicker.Hue := FHSPicker.HueValue; + FLPicker.Saturation := FHSPicker.SaturationValue; + DoChange; +end; + +procedure THSLColorPicker.LPickerChange(Sender: TObject); +begin + FHSPicker.Lum := FLPicker.Luminance; + FSelectedColor := FLPicker.SelectedColor; + DoChange; +end; + +procedure THSLColorPicker.DoChange; +begin + FHValue := FLPicker.Hue; + FSValue := FLPicker.Saturation; + FLValue := FLPicker.Luminance; + FRValue := GetRValue(FLPicker.SelectedColor); + FGValue := GetGValue(FLPicker.SelectedColor); + FBValue := GetBValue(FLPicker.SelectedColor); + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure THSLColorPicker.SelectColor(c: TColor); +begin + FSelectedColor := c; + FHSPicker.SelectedColor := c; + FLPicker.SelectedColor := c; +end; + +procedure THSLColorPicker.SetH(v: integer); +begin + FHValue := v; + FHSPicker.HueValue := v; + FLPicker.Hue := v; +end; + +procedure THSLColorPicker.SetS(v: integer); +begin + FSValue := v; + FHSPicker.SaturationValue := v; + FLPicker.Saturation := v; +end; + +procedure THSLColorPicker.SetL(v: integer); +begin + FLValue := v; + FLPicker.Luminance := v; +end; + +procedure THSLColorPicker.SetR(v: integer); +begin + FRValue := v; + SetSelectedColor(RGB(FRValue, FGValue, FBValue)); +end; + +procedure THSLColorPicker.SetG(v: integer); +begin + FGValue := v; + SetSelectedColor(RGB(FRValue, FGValue, FBValue)); +end; + +procedure THSLColorPicker.SetB(v: integer); +begin + FBValue := v; + SetSelectedColor(RGB(FRValue, FGValue, FBValue)); +end; + +function THSLColorPicker.GetSelectedHexColor: string; +begin + Result := ColorToHex(FSelectedColor); +end; + +procedure THSLColorPicker.SetHSHint(h: string); +begin + FHSHint := h; + FHSPicker.HintFormat := h; +end; + +procedure THSLColorPicker.SetLHint(h: string); +begin + FLHint := h; + FLPicker.HintFormat := h; +end; + +procedure THSLColorPicker.SetLMenu(m: TPopupMenu); +begin + FLMenu := m; + FLPicker.PopupMenu := m; +end; + +procedure THSLColorPicker.SetHSMenu(m: TPopupMenu); +begin + FHSMenu := m; + FHSPicker.PopupMenu := m; +end; + +procedure THSLColorPicker.SetLumIncrement(i: integer); +begin + FLumIncrement := i; + FLPicker.Increment := i; +end; + +procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +begin + if Assigned(OnMouseMove) then + OnMouseMove(Self, Shift, x, y); + inherited; +end; + +function THSLColorPicker.GetColorUnderCursor: TColor; +begin + Result := FHSPicker.GetColorUnderCursor; +end; + +function THSLColorPicker.GetHexColorUnderCursor: string; +begin + Result := FHSPicker.GetHexColorUnderCursor; +end; + +procedure THSLColorPicker.SetHSCursor(c: TCursor); +begin + FHSCursor := c; + FHSPicker.Cursor := c; +end; + +procedure THSLColorPicker.SetLCursor(c: TCursor); +begin + FLCursor := c; + FLPicker.Cursor := c; +end; + +procedure THSLColorPicker.WMSetFocus( + var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} ); +begin + FHSPicker.SetFocus; + Message.Result := 1; +end; + +function THSLColorPicker.GetManual:boolean; +begin + Result := FHSPicker.Manual or FLPicker.Manual; +end; + +procedure THSLColorPicker.PaintParentBack; +{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} +var + MemDC: HDC; + OldBMP: HBITMAP; + {$ENDIF} {$ENDIF} +begin + if PBack = nil then + begin + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + end; + PBack.Width := Width; + PBack.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + PBack.Canvas.Brush.Color := clForm + else + {$ENDIF} + PBack.Canvas.Brush.Color := Color; + PBack.Canvas.FillRect(PBack.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, PBack.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF} {$ENDIF} +end; + +procedure THSLColorPicker.Resize; +begin + inherited; + PaintParentBack; +end; + +procedure THSLColorPicker.CreateWnd; +begin + inherited; + PaintParentBack; +end; + +procedure THSLColorPicker.Paint; +begin + PaintParentBack; + Canvas.Draw(0, 0, PBack); +end; + +procedure THSLColorPicker.WMEraseBkgnd( + var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF} ); +begin + Message.Result := 1; +end; + +procedure THSLColorPicker.SetSelectedColor(Value: TColor); +begin + if FSelectedColor <> Value then + begin + SelectColor(Value); + //FLPicker.Hue := FHSPicker.HueValue; + //FLPicker.Saturation := FHSPicker.SaturationValue; + end; +end; + +end. diff --git a/components/mbColorLib/HSLRingPicker.dcr b/components/mbColorLib/HSLRingPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..1386d4c0314cdd4add9f84844a36883409dc6e6a GIT binary patch literal 1860 zcmdT^D~#MQ5OoWxg9}GR9agg%Mk;buwRNkia*LJ*1{#J21_p)(8V0UZv@met(v$@T zzK)aIRd4UQx&sBZ9B1SizxjBcl~U@Je8BpNcxU{2q10R10iLTL>ZAIuz9_FgsjupT z`X>K(>a%(;JE!qx^YZ2-zZQXRzh{f2)K9^?97x{(lNlPg3Z{nX;C2YdCr9oa$bda` z0bN12&^>qn9pUE3q8Wl_u;5rw4k|${NN^6|35<~*QBO~B41r>XcE}1i$*xDXhdF}h ziE(7?uR{ewV60Hy-H(5E7<B^a8QtHYqD8|f7pThL2U&LxIeLwblWprBN-$DVw}jTp zku1x!=DU-!%!n#_RN|0P+z;tkV9(eQc6#+|tu;m)!^Y4uH^$spORF{*<czIE74C*K znpD06;h3$Kd7gW3z0bTi-fQp4`Asf|m*y`l1k!2b7pcvJS!3QnO1W5;Wf{V@2)+om z2&M>J1S%z&MZ5K2g3*vf*PV5pK@;?p)>IssZQImMsGGcQeBHRZ$*P)~_7=xWTN&sK zCcA@kL?%rp{W>63QfA-B7@HW&81vZs*xN30l>1(^HZ0BV;qnWduuCmVQTlbUJRF8$ zh{MnfL)Z`7{b2Wl-XCtYx&#;C974g>{=9bBbl@5!w3N+x9;a!TrZ`Q_IF;j+kCPqe zbPHCTHQ)+#aal_M9c&F2KazTJs?yoZS#Uy*9avlnUE0fFR<n>0gyd2}k`e|~=i?&O zn53vYrXmUybq|BAM;tb8p}G*2V5LC}DuYgAx3t&9Gx!MFUjtd8Bp7)$g!7!3pHre- zvru!;5W1)4_%qHcvW45Ex5EpEG%5}08@cj9+TG#N@7Pjy@e<HviH<_bHbWoq^mp|H KbtUG1r1}jTqA<$< literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas new file mode 100644 index 000000000..fc1a4f958 --- /dev/null +++ b/components/mbColorLib/HSLRingPicker.pas @@ -0,0 +1,405 @@ +unit HSLRingPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, Menus, Math, + {$IFDEF DELPHI_7_UP}Themes,{$ENDIF} + RGBHSLUtils, HRingPicker, SLColorPicker, HTMLColors; + +type + THSLRingPicker = class(TCustomControl) + private + FOnChange: TNotifyEvent; + FRingPicker: THRingPicker; + FSLPicker: TSLColorPicker; + FSelectedColor: TColor; + FHValue, FSValue, FLValue: integer; + FRValue, FGValue, FBValue: integer; + FRingHint, FSLHint: string; + FSLMenu, FRingMenu: TPopupMenu; + FSLCursor, FRingCursor: TCursor; + PBack: TBitmap; + + function GetManual: boolean; + procedure SelectColor(c: TColor); + procedure SetH(v: integer); + procedure SetS(v: integer); + procedure SetL(v: integer); + procedure SetR(v: integer); + procedure SetG(v: integer); + procedure SetB(v: integer); + procedure SetRingHint(h: string); + procedure SetSLHint(h: string); + procedure SetSLMenu(m: TPopupMenu); + procedure SetRingMenu(m: TPopupMenu); + procedure SetRingCursor(c: TCursor); + procedure SetSLCursor(c: TCursor); + procedure PaintParentBack; + protected + procedure CreateWnd; override; + procedure Paint; override; + procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure RingPickerChange(Sender: TObject); + procedure SLPickerChange(Sender: TObject); + procedure DoChange; + procedure Resize; override; + {$IFDEF DELPHI} + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; + {$ELSE} + procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND; + procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS; + {$ENDIF} + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorUnderCursor: TColor; + function GetHexColorUnderCursor: string; + function GetSelectedHexColor: string; + property ColorUnderCursor: TColor read GetColorUnderCursor; + property HValue: integer read FHValue write SetH default 0; + property SValue: integer read FSValue write SetS default 240; + property LValue: integer read FLValue write SetL default 120; + property RValue: integer read FRValue write SetR default 255; + property GValue: integer read FGValue write SetG default 0; + property BValue: integer read FBValue write SetB default 0; + property Manual: boolean read GetManual; + published + property SelectedColor: TColor read FSelectedColor write SelectColor default clRed; + property RingPickerPopupMenu: TPopupMenu read FRingMenu write SetRingMenu; + property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu; + property RingPickerHintFormat: string read FRingHint write SetRingHint; + property SLPickerHintFormat: string read FSLHint write SetSLHint; + property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault; + property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault; + property TabStop default true; + property ShowHint; + property ParentShowHint; + property Anchors; + property Align; + property Visible; + property Enabled; + property TabOrder; + property Color; + property ParentColor default true; + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF} {$ENDIF} + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnMouseMove; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HSLRingPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THSLRingPicker]); +end; + +{THSLRingPicker} + +constructor THSLRingPicker.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}]; + DoubleBuffered := true; + ParentColor := true; + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF} {$ENDIF} + Width := 245; + Height := 245; + TabStop := true; + FSelectedColor := clRed; + FRingPicker := THRingPicker.Create(Self); + InsertControl(FRingPicker); + FRingCursor := crDefault; + FSLCursor := crDefault; + with FRingPicker do + begin + Height := 246; + Width := 246; + Top := 0; + Left := 0; + Align := alClient; + Visible := true; + Saturation := 255; + Value := 255; + Hue := 0; + OnChange := RingPickerChange; + OnMouseMove := DoMouseMove; + end; + FSLPicker := TSLColorPicker.Create(Self); + InsertControl(FSLPicker); + with FSLPicker do + begin + Height := 120; + Width := 120; + Left := 63; + Top := 63; + Visible := true; + OnChange := SLPickerChange; + OnMouseMove := DoMouseMove; + end; + FHValue := 0; + FSValue := 255; + FLValue := 255; + FRValue := 255; + FGValue := 0; + FBValue := 0; + FRingHint := 'Hue: %h'; + FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; +end; + +destructor THSLRingPicker.Destroy; +begin + PBack.Free; + FRingPicker.Free; + FSLPicker.Free; + inherited Destroy; +end; + +procedure THSLRingPicker.Resize; +begin + inherited; + if (FRingPicker = nil) or (FSLPicker = nil) then + exit; + FRingPicker.Radius := (Min(Width, Height)*30) div 245; + FSLPicker.Left := (21*FRingPicker.Radius) div 10; + FSLPicker.Top := (21*FRingPicker.Radius) div 10; + FSLPicker.Width := 4*FRingPicker.Radius; + FSLPicker.Height := 4*FRingPicker.Radius; + PaintParentBack; +end; + +procedure THSLRingPicker.RingPickerChange(Sender: TObject); +begin + if (FRingPicker = nil) or (FSLPicker = nil) then + exit; + FSLPicker.Hue := FRingPicker.Hue; + DoChange; +end; + +procedure THSLRingPicker.SLPickerChange(Sender: TObject); +begin + if FSLPicker = nil then + exit; + FSelectedColor := FSLPicker.SelectedColor; + DoChange; +end; + +procedure THSLRingPicker.DoChange; +begin + if (FRingPicker = nil) or (FSLPicker = nil) then + exit; + + FHValue := FRingPicker.Hue; + FSValue := FSLPicker.Saturation; + FLValue := FSLPicker.Luminance; + FRValue := GetRValue(FSLPicker.SelectedColor); + FGValue := GetGValue(FSLPicker.SelectedColor); + FBValue := GetBValue(FSLPicker.SelectedColor); + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure THSLRingPicker.SelectColor(c: TColor); +begin + if (FRingPicker = nil) or (FSLPicker = nil) then + exit; + + FRingPicker.Hue := GetHValue(c); + FRingPicker.Saturation := 255; + FRingPicker.Value := 255; + FSLPicker.SelectedColor := c; + FSelectedColor := c; +end; + +procedure THSLRingPicker.SetH(v: integer); +begin + if (FRingPicker = nil) or (FSLPicker = nil) then + exit; + + FHValue := v; + FRingPicker.Hue := v; + FSLPicker.Hue := v; +end; + +procedure THSLRingPicker.SetS(v: integer); +begin + if (FSLPicker = nil) then + exit; + FSValue := v; + FSLPicker.Saturation := v; +end; + +procedure THSLRingPicker.SetL(v: integer); +begin + if (FSLPicker = nil) then + exit; + FLValue := v; + FSLPicker.Luminance := v; +end; + +procedure THSLRingPicker.SetR(v: integer); +begin + FRValue := v; + SelectColor(RGB(FRValue, FGValue, FBValue)); +end; + +procedure THSLRingPicker.SetG(v: integer); +begin + FGValue := v; + SelectColor(RGB(FRValue, FGValue, FBValue)); +end; + +procedure THSLRingPicker.SetB(v: integer); +begin + FBValue := v; + SelectColor(RGB(FRValue, FGValue, FBValue)); +end; + +function THSLRingPicker.GetSelectedHexColor: string; +begin + Result := ColorToHex(FSelectedColor); +end; + +procedure THSLRingPicker.SetRingHint(h: string); +begin + FRingHint := h; + FRingPicker.HintFormat := h; +end; + +procedure THSLRingPicker.SetSLHint(h: string); +begin + FSLHint := h; + FSLPicker.HintFormat := h; +end; + +procedure THSLRingPicker.SetRingMenu(m: TPopupMenu); +begin + FRingMenu := m; + FRingPicker.PopupMenu := m; +end; + +procedure THSLRingPicker.SetSLMenu(m: TPopupMenu); +begin + FSLMenu := m; + FSLPicker.PopupMenu := m; +end; + +procedure THSLRingPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +begin + if Assigned(OnMouseMove) then + OnMouseMove(Self, Shift, x, y); + inherited; +end; + +function THSLRingPicker.GetColorUnderCursor: TColor; +begin + Result := FSLPicker.GetColorUnderCursor; +end; + +function THSLRingPicker.GetHexColorUnderCursor: string; +begin + Result := FSLPicker.GetHexColorUnderCursor; +end; + +procedure THSLRingPicker.SetRingCursor(c: TCursor); +begin + FRingCursor := c; + FRingPicker.Cursor := c; +end; + +procedure THSLRingPicker.SetSLCursor(c: TCursor); +begin + FSLCursor := c; + FSLPicker.Cursor := c; +end; + +procedure THSLRingPicker.WMSetFocus( + var Message: {$IFDEF DELPHI}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF} ); +begin + FRingPicker.SetFocus; + Message.Result := 1; +end; + +function THSLRingPicker.GetManual:boolean; +begin + Result := FRingPicker.Manual or FSLPicker.Manual; +end; + +procedure THSLRingPicker.PaintParentBack; +var + MemDC: HDC; + OldBMP: HBITMAP; +begin + if PBack = nil then + begin + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + end; + PBack.Width := Width; + PBack.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + PBack.Canvas.Brush.Color := clForm + else + {$ENDIF} + PBack.Canvas.Brush.Color := Color; + PBack.Canvas.FillRect(PBack.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, PBack.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF} {$ENDIF} +end; + +procedure THSLRingPicker.Paint; +begin + PaintParentBack; + Canvas.Draw(0, 0, PBack); +end; + +procedure THSLRingPicker.CreateWnd; +begin + inherited; + PaintParentBack; +end; + +procedure THSLRingPicker.WMEraseBkgnd( + var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} ); +begin + Message.Result := 1; +end; + +end. diff --git a/components/mbColorLib/HSVColorPicker.dcr b/components/mbColorLib/HSVColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..6cd61feb4d1225627001bf63c2dd4163f479e32d GIT binary patch literal 1860 zcmd^;e@xV67{I^vN9)i2YR!b2g8XPlP>K8yL{CFP@ea>8Mg%DgWLL0@k(B&05s_fP zrXY~0T!Wk<KV9q&=E9KS=}=Chfy*g(BiEfNG3mSG`{_$pf1nrHe{DT`o_EjtzRy1I z^Stl#3W6ZKDjT>=c9+P^bAqs5UV&!?jj&bNDZDEvg&o2++2RG25F^iGg)Or0lE4>M zJpUKKS9V_d)1LXm6NHO0?{Q)A^#7BtP_sH2zkT>s<JXF}iI=ba>l^S^5VW1JEFupQ z)kIV`5yJ%ELh;b)DLpOiZ3W6mq7zW(qOB&ejl=<VjS=?~O6M=ZOnE)UyJQ8Cxrq-{ zr0gN1i0nr6J>*<Lcbl}id95@Z!)Pcb?`2Vk6_jt}kcN^ye5R+coU&FbE>iwIpWB`J z3yu$&c#pvt&IMEd%HN<2t1yJqqT*B<&3QDGQdh@`P7G#FPt!0zSIM0M%sMV;X;yMX zvB;60>^+l$fi3hWVa&mJkiI&)Tj?FZI6>b7XNPp}B$g@$@@Y$_CXW1dq<Oka$+DL5 z?Tn{!^HauaxY^2$K1R)qS-CFGUSjGzLrt77<@iSw?;;}t)swgMvj>h)9BLeyIErx` z=Y9wF%h)He&;B+oS+8@okKR*!SwX2DT_Tz&!hHzzS(1{7hbV=Ls73aQl!#J;NS7#$ zh|(RWH1C*Ye3Jfe`RZ#bYsk$fDFtOT{;xmIv9Z$1IvXk*88!-S9J6w6n!&qFSh;`8 zxnRD>g)y3ql(mpkLBhvuNMenWkfo(rW&*Adbd^{$yUpw~Q#r!vA-ca~XoTCtJnDbM z*}K%4Dd|Ob0!<m~v++t?Qk1LDd+_UJQxDp1bX^p;Q+tM!XZfZJODFa=X`#Wv;UCBy zWOqBU$9SuVm6>ihjd(N>+{m_i-akrqHHB5w9HqUH;Rb%JW$w_t^of;>QFfZxV8FKu zADtVHoK*p9iis>BE{|mSP4Xx$q~!pn1Kilpj2<!l0SQxV9wx90|62DDS9PiQrxK~< zodi-+*`G;$7M**!oX%u25938?^9*lT7CEl?WyWxP!U)-jCKkP#FXA!8W8A@LG`0xD zfL{r^_RkO(|3y~$vh_{ULnsQPKAeuVTnb>q3&(3S3(Mr-cFW%`e;~alM_ejHWOW<) HA6)z$H{7Nq literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HSVColorPicker.pas b/components/mbColorLib/HSVColorPicker.pas new file mode 100644 index 000000000..8828a8295 --- /dev/null +++ b/components/mbColorLib/HSVColorPicker.pas @@ -0,0 +1,622 @@ +unit HSVColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, RGBHSVUtils, Scanlines, + Forms, {IFDEF DELPHI_7_UP Themes, $ENDIF} HTMLColors, SelPropUtils, + mbColorPickerControl; + +type + THSVColorPicker = class(TmbColorPickerControl) + private + FHue, FSat, FValue: integer; + FSatCircColor, FHueLineColor: TColor; + FSelectedColor: TColor; + FOnChange: TNotifyEvent; + FManual: boolean; + FShowSatCirc: boolean; + FShowHueLine: boolean; + FShowSelCirc: boolean; + Fchange: boolean; + FHSVBmp: TBitmap; + FDoChange: boolean; + + procedure CreateHSVCircle; + function RadHue(New: integer): integer; + procedure SetValue(V: integer); + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetSatCircColor(c: TColor); + procedure SetHueLineColor(c: TColor); + procedure DrawSatCirc; + procedure DrawHueLine; + procedure DrawMarker(x, y: integer); + procedure SelectionChanged(x, y: integer); + procedure SetShowSatCirc(s: boolean); + procedure SetShowSelCirc(s: boolean); + procedure SetShowHueLine(s: boolean); + procedure UpdateCoords; + protected + function GetSelectedColor: TColor; override; + procedure SetSelectedColor(c: TColor); override; + procedure WebSafeChanged; override; + procedure Paint; override; + procedure Resize; override; + procedure CreateWnd; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); + message CN_KEYDOWN; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 0; + property Value: integer read FValue write SetValue default 255; + property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver; + property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; + property SelectedColor default clNone; + property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true; + property ShowHueLine: boolean read FShowHueLine write SetShowHueLine default true; + property ShowSelectionCircle: boolean read FShowSelCirc write SetShowSelCirc default true; + property MarkerStyle default msCrossCirc; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HSVColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THSVColorPicker]); +end; + +function PointInCirc(p: TPoint; size : integer): boolean; +var + r: integer; +begin + r := size div 2; + Result := (SQR(p.x - r) + SQR(p.y - r) <= SQR(r)); +end; + +constructor THSVColorPicker.Create(AOwner: TComponent); +begin + inherited; + FHSVBmp := TBitmap.Create; + FHSVBmp.PixelFormat := pf32bit; + Width := 204; + Height := 204; + FValue := 255; + FHue := 0; + FSat := 0; + FSatCircColor := clSilver; + FHueLineColor := clGray; + FSelectedColor := clNone; + FManual := false; + FShowSatCirc := true; + FShowHueLine := true; + FShowSelCirc := true; + Fchange := true; + FDoChange := false; + MarkerStyle := msCrossCirc; +end; + +destructor THSVColorPicker.Destroy; +begin + FHSVBmp.Free; + inherited; +end; + +procedure THSVColorPicker.Paint; +var + rgn: HRGN; + R: TRect; +begin + PaintParentBack(Canvas); + R := ClientRect; + R.Right := R.Left + Min(Width, Height); + R.Bottom := R.Top + Min(Width, Height); + rgn := CreateEllipticRgnIndirect(R); + SelectClipRgn(Canvas.Handle, rgn); + Canvas.Draw(0, 0, FHSVBmp); + DeleteObject(rgn); + DrawSatCirc; + DrawHueLine; + DrawMarker(mdx, mdy); + if FDoChange then + begin + if Assigned(FOnChange) then FOnChange(Self); + FDoChange := false; + end; +end; + +procedure THSVColorPicker.CreateHSVCircle; +var + dSquared, H, S, V, i, j, Radius, RadiusSquared, x, y, size: integer; + row: pRGBQuadArray; + tc: TColor; +begin + if FHSVBmp = nil then + begin + FHSVBmp := TBitmap.Create; + FHSVBmp.PixelFormat := pf32bit; + end; + size := Min(Width, Height); + FHSVBmp.Width := size; + FHSVBmp.Height := size; + + Radius := size div 2; + RadiusSquared := Radius*Radius; + PaintParentBack(FHSVBmp.Canvas); + + V := FValue; + for j := 0 to size-1 do + begin + Y := Size - 1 - j - Radius; + row := FHSVBmp.Scanline[Size - 1 - j]; + for i := 0 to size-1 do + begin + X := i - Radius; + dSquared := X*X + Y*Y; + if dSquared <= RadiusSquared then + begin + if Radius <> 0 then + S := ROUND((255*SQRT(dSquared))/Radius) + else + S := 0; + H := ROUND(180*(1 + ArcTan2(X, Y)/PI)); + H := H + 90; + if H > 360 then H := H - 360; + if not WebSafe then + row[i] := HSVtoRGBQuad(H,S,V) + else + begin + tc := GetWebSafe(HSVtoColor(H, S, V)); + row[i] := RGBtoRGBQuad(GetRValue(tc), GetGValue(tc), GetBValue(tc)); + end; + end + end; + end; +end; + +procedure THSVColorPicker.Resize; +begin + inherited; + CreateHSVCircle; + UpdateCoords; +end; + +procedure THSVColorPicker.CreateWnd; +begin + inherited; + CreateHSVCircle; + UpdateCoords; +end; + +procedure THSVColorPicker.UpdateCoords; +var + r, angle: real; + radius: integer; +begin + radius := Min(Width, Height) div 2; + r := -MulDiv(radius, FSat, 255); + angle := -FHue*PI/180 - PI; + mdx := ROUND(COS(angle)*ROUND(r)) + radius; + mdy := ROUND(SIN(angle)*ROUND(r)) + radius; +end; + +procedure THSVColorPicker.SetHue(h: integer); +begin + if h > 360 then h := 360; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + FManual := false; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure THSVColorPicker.SetSat(s: integer); +begin + if s > 255 then s := 255; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure THSVColorPicker.SetValue(V: integer); +begin + if V > 255 then V := 255; + if V < 0 then V := 0; + if FValue <> V then + begin + FValue := V; + FManual := false; + CreateHSVCircle; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure THSVColorPicker.SetSatCircColor(c: TColor); +begin + if FSatCircColor <> c then + begin + FSatCircColor := c; + Invalidate; + end; +end; + +procedure THSVColorPicker.SetHueLineColor(c: TColor); +begin + if FHueLineColor <> c then + begin + FHueLineColor := c; + Invalidate; + end; +end; + +procedure THSVColorPicker.SetShowSatCirc(s: boolean); +begin + if FShowSatCirc <> s then + begin + FShowSatCirc := s; + Invalidate; + end; +end; + +procedure THSVColorPicker.SetShowSelCirc(s: boolean); +begin + if FShowSelCirc <> s then + begin + FShowSelCirc := s; + Invalidate; + end; +end; + +procedure THSVColorPicker.SetShowHueLine(s: boolean); +begin + if FShowHueLine <> s then + begin + FShowHueLine := s; + Invalidate; + end; +end; + +procedure THSVColorPicker.DrawSatCirc; +var + delta: integer; + Radius: integer; +begin + if not FShowSatCirc then Exit; + if FSat in [1..254] then + begin + Radius:= Min(Width, Height) div 2; + Canvas.Pen.Color := FSatCircColor; + Canvas.Brush.Style := bsClear; + delta := MulDiv(Radius, FSat, 255); + Canvas.Ellipse(Radius - delta, Radius - delta, Radius + delta, Radius + delta); + end; +end; + +procedure THSVColorPicker.DrawHueLine; +var + angle: double; + radius: integer; +begin + if not FShowHueLine then Exit; + Radius := Min(Width, Height) div 2; + if (FHue >= 0) and (FHue <= 360) then + begin + Angle := -FHue*PI/180; + Canvas.Pen.Color := FHueLineColor; + Canvas.MoveTo(Radius,Radius); + Canvas.LineTo(Radius + Round(Radius*COS(angle)), Radius + Round(Radius*SIN(angle))); + end; +end; + +procedure THSVColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + if not FShowSelCirc then Exit; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clGray; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +procedure THSVColorPicker.SelectionChanged(x, y: integer); +var + Angle, Distance, xDelta, yDelta, Radius: integer; +begin + if not PointInCirc(Point(x, y), Min(Width, Height)) then + begin + FChange := false; + SetSelectedColor(clNone); + FChange := true; + Exit; + end + else + FSelectedColor := clWhite; + Radius := Min(Width, Height) div 2; + xDelta := x - Radius; + yDelta := y - Radius; + Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI); + if Angle < 0 then Inc(Angle, 360) + else if Angle > 360 then + Dec(Angle, 360); + Fchange := false; + SetHue(Angle); + Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta))); + if Distance >= Radius then SetSat(255) + else SetSat(MulDiv(Distance, 255, Radius)); + Fchange := true; +end; + +procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + if csDesigning in ComponentState then Exit; + if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then + begin + mdx := x; + mdy := y; + FDoChange := true; + SelectionChanged(X, Y); + FManual := true; + end; +end; + +procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + R: TRect; +begin + inherited; + if csDesigning in ComponentState then Exit; + if (Button = mbLeft) and PointInCirc(Point(x, y), Min(Width, Height)) then + begin + mdx := x; + mdy := y; + R := ClientRect; + InflateRect(R, 1, 1); + R.TopLeft := ClientToScreen(R.TopLeft); + R.BottomRight := ClientToScreen(R.BottomRight); + {$IFDEF DELPHI} + ClipCursor(@R); + {$ENDIF} + FDoChange := true; + SelectionChanged(X, Y); + FManual := true; + end; + SetFocus; +end; + +procedure THSVColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + if csDesigning in ComponentState then Exit; + if (ssLeft in Shift) and PointInCirc(Point(x, y), Min(Width, Height)) then + begin + mdx := x; + mdy := y; + FDoChange := true; + SelectionChanged(X, Y); + FManual := true; + end; +end; + +function THSVColorPicker.GetSelectedColor: TColor; +begin + if FSelectedColor <> clNone then + begin + if not WebSafe then + Result := HSVtoColor(FHue, FSat, FValue) + else + Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue)); + end + else + Result := clNone; +end; + +function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor; +var + Angle, Distance, xDelta, yDelta, Radius: integer; + h, s: integer; +begin + Radius := Min(Width, Height) div 2; + xDelta := x - Radius; + yDelta := y - Radius; + Angle := ROUND(360 + 180*ArcTan2(-yDelta,xDelta)/PI); + if Angle < 0 then Inc(Angle, 360) + else if Angle > 360 then + Dec(Angle, 360); + h := Angle; + Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta))); + if Distance >= Radius then s := 255 + else s := MulDiv(Distance, 255, Radius); + if PointInCirc(Point(mx, my), Min(Width, Height)) then + begin + if not WebSafe then + Result := HSVtoColor(h, s, FValue) + else + Result := GetWebSafe(HSVtoColor(h, s, FValue)); + end + else + Result := clNone; +end; + +procedure THSVColorPicker.SetSelectedColor(c: TColor); +var + changeSave: boolean; +begin + if WebSafe then c := GetWebSafe(c); + changeSave := FChange; + FManual := false; + Fchange := false; + SetValue(GetVValue(c)); + SetHue(GetHValue(c)); + SetSat(GetSValue(c)); + FSelectedColor := c; + Fchange := changeSave; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + FChange := true; +end; + +function THSVColorPicker.RadHue(New: integer): integer; +begin + if New < 0 then New := New + 360; + if New > 360 then New := New - 360; + Result := New; +end; + +procedure THSVColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +begin + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + if not (ssCtrl in Shift) then + case Message.CharCode of + VK_LEFT: + begin + FChange := false; + SetHue(RadHue(FHue + 1)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + FChange := false; + SetHue(RadHue(FHue - 1)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + begin + FChange := false; + if FSat + 1 <= 255 then + SetSat(FSat + 1); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + begin + FChange := false; + if FSat - 1 >= 0 then + SetSat(FSat - 1); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + begin + FInherited := true; + inherited; + end; + end + else + case Message.CharCode of + VK_LEFT: + begin + FChange := false; + SetHue(RadHue(FHue + 10)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + FChange := false; + SetHue(RadHue(FHue - 10)); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + begin + FChange := false; + if FSat + 10 <= 255 then + SetSat(FSat + 10); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + begin + FChange := false; + if FSat - 10 >= 0 then + SetSat(FSat - 10); + FChange := true; + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + begin + FInherited := true; + inherited; + end; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure THSVColorPicker.WebSafeChanged; +begin + inherited; + CreateHSVCircle; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/HTMLColors.pas b/components/mbColorLib/HTMLColors.pas new file mode 100644 index 000000000..a5a8bf5af --- /dev/null +++ b/components/mbColorLib/HTMLColors.pas @@ -0,0 +1,346 @@ +unit HTMLColors; + +interface + +{$I mxs.inc} + +uses + SysUtils, + {$IFDEF FPC} + LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Graphics{$IFDEF DELPHI_6_UP}, Variants{$ENDIF}; + +const + SPECIAL_COUNT = 140; + WEBSAFE_COUNT = 216; + SYSTEM_COUNT = 28; + BASIC_COUNT = 16; + SPECIAL_HEX: array [0..139] of string = ('000000', 'FAEBD7', '00FFFF', '7FFFD4', 'F0FFFF', 'F5F5DC', 'FFE4C4', + 'F0F8FF', 'FFEBCD', '0000FF', '8A2BE2', 'A52A2A', 'DEB887', '5F9EA0', + '7FFF00', 'D2691E', 'FF7F50', '6495ED', 'FFF8DC', 'DC143C', '00FFFF', + '00008B', '008B8B', 'B8860B', 'A9A9A9', '006400', 'BDB76B', '8B008B', + '556B2F', 'FF8C00', '9932CC', '8B0000', 'E9967A', '8FBC8B', '483D8B', + '2F4F4F', '00CED1', '9400D3', 'FF1493', '00BFFF', '696969', '1E90FF', + 'B22222', 'FFFAF0', '228B22', 'FF00FF', 'DCDCDC', 'F8F8FF', 'FFD700', + 'DAA520', '808080', '008000', 'ADFF2F', 'F0FFF0', 'FF69B4', 'CD5C5C', + '4B0082', 'FFFFF0', 'F0E68C', 'E6E6FA', 'FFF0F5', '7CFC00', 'FFFACD', + 'ADD8E6', 'F08080', 'E0FFFF', 'FAFAD2', '90EE90', 'D3D3D3', 'FFB6C1', + 'FFA07A', '20B2AA', '87CEFA', '778899', 'B0C4DE', 'FFFFE0', '00FF00', + '32CD32', 'FAF0E6', 'FF00FF', '800000', '66CDAA', '0000CD', 'BA55D3', + '9370DB', '3CB371', '7B68EE', '00FA9A', '48D1CC', 'C71585', '191970', + 'F5FFFA', 'FFE4E1', 'FFE4B5', 'FFDEAD', '000080', 'FDF5E6', '808000', + '6B8E23', 'FFA500', 'FF4500', 'DA70D6', 'EEE8AA', '98FB98', 'AFEEEE', + 'DB7093', 'FFEFD5', 'FFDAB9', 'CD853F', 'FFC0CB', 'DDA0DD', 'B0E0E6', + '800080', 'FF0000', 'BC8F8F', '4169E1', '8B4513', 'FA8072', 'F4A460', + '2E8B57', 'FFF5EE', 'A0522D', 'C0C0C0', '87CEEB', '6A5ACD', '708090', + 'FFFAFA', '00FF7F', '4682B4', 'D2B48C', '008080', 'D8BFD8', 'FF6347', + '40E0D0', 'EE82EE', 'F5DEB3', 'FFFFFF', 'F5F5F5', 'FFFF00', '9ACD32'); + SPECIAL_NAMES: array [0..139] of string = ('black', 'antiquewhite', 'aqua', 'aquamarine', 'azure', 'beige', + 'bisque', 'aliceblue', 'blanchedalmond', 'blue', 'blueviolet', 'brown', + 'burlywood', 'cadetblue', 'chartreuse', 'chocolate', 'coral', + 'cornflower', 'cornsilk', 'crimson', 'cyan', 'darkblue', 'darkcyan', + 'darkgoldenrod', 'darkgray', 'darkgreen', 'darkkhaki', 'darkmagenta', + 'darkolivegreen', 'darkorange', 'darkorchid', 'darkred', 'darksalmon', + 'darkseagreen', 'darkslateblue', 'darkslategray', 'darkturquoise', + 'darkviolet', 'deeppink', 'deepskyblue', 'dimgray', 'dodgerblue', + 'firebrick', 'floralwhite', 'forestgreen', 'fuchsia', 'gainsboro', + 'ghostwhite', 'gold', 'goldenrod', 'gray', 'green', 'greenyellow', + 'honeydew', 'hotpink', 'indianred', 'indigo', 'ivory', 'khaki', 'lavender', + 'lavenderblush', 'lawngreen', 'lemonchiffon', 'lightblue', 'lightcoral', + 'lightcyan', 'lightgoldenrodyellow', 'lightgreen', 'lightgray', 'lightpink', + 'lightsalmon', 'lightseagreen', 'lightskyblue', 'lightslategray', + 'lightsteelblue', 'lightyellow', 'lime', 'limegreen', 'linen', 'magenta', + 'maroon', 'mediumaquamarine', 'mediumblue', 'mediumorchid', 'mediumpurple', + 'mediumseagreen', 'mediumslateblue', 'mediumspringgreen', 'mediumturquoise', + 'mediumvioletred', 'midnightblue', 'mintcream', 'mistyrose', 'moccasin', + 'navajowhite', 'navy', 'oldlace', 'olive', 'olivedrab', 'orange', 'orangered', + 'orchid', 'palegoldenrod', 'palegreen', 'paleturquoise', 'palevioletred', + 'papayawhip', 'peachpuff', 'peru', 'pink', 'plum', 'powderblue', 'purple', + 'red', 'rosybrown', 'royalblue', 'saddlebrown', 'salmon', 'sandybrown', + 'seagreen', 'seashell', 'sienna', 'silver', 'skyblue', 'slateblue', + 'slategray', 'snow', 'springgreen', 'steelblue', 'tan', 'teal', 'thistle', + 'tomato', 'turquoise', 'violet', 'wheat', 'white', 'whitesmoke', 'yellow', + 'yellowgreen'); + WEBSAFE_HEX: array [0..215] of string = ('000000' ,'000033' ,'000066' ,'000099' ,'0000cc' ,'0000ff', + '003300' ,'003333' ,'003366' ,'003399' ,'0033cc' ,'0033ff', + '006600' ,'006633' ,'006666' ,'006699' ,'0066cc' ,'0066ff', + '009900' ,'009933' ,'009966' ,'009999' ,'0099cc' ,'0099ff', + '00cc00' ,'00cc33' ,'00cc66' ,'00cc99' ,'00cccc' ,'00ccff', + '00ff00' ,'00ff33' ,'00ff66' ,'00ff99' ,'00ffcc' ,'00ffff', + '330000' ,'330033' ,'330066' ,'330099' ,'3300cc' ,'3300ff', + '333300' ,'333333' ,'333366' ,'333399' ,'3333cc' ,'3333ff', + '336600' ,'336633' ,'336666' ,'336699' ,'3366cc' ,'3366ff', + '339900' ,'339933' ,'339966' ,'339999' ,'3399cc' ,'3399ff', + '33cc00' ,'33cc33' ,'33cc66' ,'33cc99' ,'33cccc' ,'33ccff', + '33ff00' ,'33ff33' ,'33ff66' ,'33ff99' ,'33ffcc' ,'33ffff', + '660000' ,'660033' ,'660066' ,'660099' ,'6600cc' ,'6600ff', + '663300' ,'663333' ,'663366' ,'663399' ,'6633cc' ,'6633ff', + '666600' ,'666633' ,'666666' ,'666699' ,'6666cc' ,'6666ff', + '669900' ,'669933' ,'669966' ,'669999' ,'6699cc' ,'6699ff', + '66cc00' ,'66cc33' ,'66cc66' ,'66cc99' ,'66cccc' ,'66ccff', + '66ff00' ,'66ff33' ,'66ff66' ,'66ff99' ,'66ffcc' ,'66ffff', + '990000' ,'990033' ,'990066' ,'990099' ,'9900cc' ,'9900ff', + '993300' ,'993333' ,'993366' ,'993399' ,'9933cc' ,'9933ff', + '996600' ,'996633' ,'996666' ,'996699' ,'9966cc' ,'9966ff', + '999900' ,'999933' ,'999966' ,'999999' ,'9999cc' ,'9999ff', + '99cc00' ,'99cc33' ,'99cc66' ,'99cc99' ,'99cccc' ,'99ccff', + '99ff00' ,'99ff33' ,'99ff66' ,'99ff99' ,'99ffcc' ,'99ffff', + 'cc0000' ,'cc0033' ,'cc0066' ,'cc0099' ,'cc00cc' ,'cc00ff', + 'cc3300' ,'cc3333' ,'cc3366' ,'cc3399' ,'cc33cc' ,'cc33ff', + 'cc6600' ,'cc6633' ,'cc6666' ,'cc6699' ,'cc66cc' ,'cc66ff', + 'cc9900' ,'cc9933' ,'cc9966' ,'cc9999' ,'cc99cc' ,'cc99ff', + 'cccc00' ,'cccc33' ,'cccc66' ,'cccc99' ,'cccccc' ,'ccccff', + 'ccff00' ,'ccff33' ,'CCFF66' ,'ccff99' ,'ccffcc' ,'ccffff', + 'ff0000' ,'ff0033' ,'ff0066' ,'ff0099' ,'ff00cc' ,'ff00ff', + 'ff3300' ,'ff3333' ,'ff3366' ,'ff3399' ,'ff33cc' ,'ff33ff', + 'ff6600' ,'ff6633' ,'ff6666' ,'ff6699' ,'ff66cc' ,'ff66ff', + 'ff9900' ,'ff9933' ,'ff9966' ,'ff9999' ,'ff99cc' ,'ff99ff', + 'ffcc00' ,'ffcc33' ,'ffcc66' ,'ffcc99' ,'ffcccc' ,'ffccff', + 'ffff00' ,'ffff33' ,'ffff66' ,'ffff99' ,'ffffcc' ,'ffffff'); + SYSTEM_VALUES: array [0..27] of TColor = (clActiveBorder, clActiveCaption, clAppWorkspace, clBackground, + clBtnFace, clBtnHighlight, clBtnShadow, clBtnText, clCaptionText, + clGrayText, clHighlight, clHighlightText, clInactiveBorder, + clInactiveCaption, clInactiveCaptionText, clInfoBk, clInfoText, + clMenu, clMenuText, clScrollbar, cl3dDkShadow, cl3dLight, + clBtnHighlight, clActiveBorder, clBtnShadow, clWindow, + clWindowFrame, clWindowText); + SYSTEM_NAMES: array [0..27] of string = ('activeborder', 'activecaption', 'appworkspace', 'background', + 'buttonface', 'buttonhighlight', 'buttonshadow', 'buttontext', + 'captiontext', 'graytext', 'highlight', 'highlighttext', + 'inactiveborder', 'inactivecaption', 'inactivecaptiontext', + 'infobackground', 'infotext', 'menu', 'menutext', 'scrollbar', + 'threeddarkshadow', 'threedface', 'threedhighlight', + 'threedlightshadow', 'threedshadow', 'window', 'windowframe', + 'windowtext'); + BASIC_VALUES: array [0..15] of TColor = (clBlack, clAqua, clBlue, clFuchsia, clGray, clGreen, clLime, + clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, + clWhite, clYellow); + BASIC_NAMES: array [0..15] of string = ('black', 'aqua', 'blue', 'fuchsia', 'gray', 'green', 'lime', + 'maroon', 'navy', 'olive', 'purple', 'red', 'silver', 'teal', + 'white', 'yellow'); + +procedure MakeIntoHex(var s: string); +function IsMember(a: array of string; n: integer; s: string): boolean; +function IsSpecialColor(s: string): boolean; +function FormatHexColor(S: string): string; +function ColorToHex(Color: TColor): string; +function HexToTColor(s: OleVariant): TColor; +function GetHexFromName(s: string): string; +function GetValueFromName(s: string): TColor; +function IsWebSafe(s: string): boolean; overload; +function IsWebSafe(c: TColor): boolean; overload; +function GetWebSafe(C: TColor): TColor; + +implementation + +var + WS: array [0..255] of byte; + +//------------------------------------------------------------------------------ + +//checks membership of a string array +function IsMember(a: array of string; n: integer; s: string): boolean; +var + i: integer; +begin + Result := false; + for i := 0 to n - 1 do + if SameText(s, a[i]) then + Result := true; +end; + +//------------------------------------------------------------------------------ + +//checks if the color's nam was used instead of hex +function IsSpecialColor(s: string): boolean; +begin + Result := IsMember(BASIC_NAMES, BASIC_COUNT, s) or IsMember(SPECIAL_NAMES, SPECIAL_COUNT, s) or IsMember(SYSTEM_NAMES, SYSTEM_COUNT, s); +end; + +//------------------------------------------------------------------------------ + +//is hex was used then remove the wrong characters +procedure MakeIntoHex(var s: string); +var + i: integer; +begin +if s <> '' then + for i := 1 to Length(s) do + if not (s[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then + s[i] := '0'; +end; + +//------------------------------------------------------------------------------ + +//formats entered text into a true hex value +function FormatHexColor(S: string): string; +var + c: string; + i: integer; +begin + c := ''; + if not IsSpecialColor(s) then + begin + if (s <> '') and (s[1] = '#') then + Delete(s, 1, 1); + + if s <> '' then + begin + MakeIntoHex(c); + if Length(c) = 6 then + Result := c + else + begin + if Length(c) > 6 then + c := Copy(c, 1, 6); + if Length(c) < 6 then + for i := 0 to 6 - Length(c) - 1 do + c := '0' + c; + Result := c; + end; + end + else + Result := '000000'; + end + else + Result := s; +end; + +//------------------------------------------------------------------------------ + +//gets a hex value from a color name from special colors +function GetHexFromName(s: string): string; +var + i, k: integer; +begin + k := 0; + for i := 0 to SPECIAL_COUNT - 1 do + if SameText(s, SPECIAL_NAMES[i]) then + begin + k := i; + Break; + end; + Result := SPECIAL_HEX[k]; +end; + +//------------------------------------------------------------------------------ + +// gets a TColor value from a color name from basic or system colors +function GetValueFromName(s: string): TColor; +var + i, k: integer; +begin + k := 0; + s := LowerCase(s); + if IsMember(BASIC_NAMES, BASIC_COUNT, s) then + begin + for i := 0 to BASIC_COUNT - 1 do + if SameText(s, BASIC_NAMES[i]) then + begin + k := i; + Break; + end; + Result := BASIC_VALUES[k]; + end + else + if IsMember(SYSTEM_NAMES, SYSTEM_COUNT, s) then + begin + for i := 0 to SYSTEM_COUNT - 1 do + if SameText(s, SYSTEM_NAMES[i]) then + begin + k := i; + Break; + end; + Result := SYSTEM_VALUES[k]; + end + else + Result := clNone; +end; + +//------------------------------------------------------------------------------ + +//converts a TColor value to a hex value +function ColorToHex(Color: TColor): string; +begin +// if Color <> $ then + Result := IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) + IntToHex(GetBValue(Color), 2) +// else +// Result := '000000'; +end; + +//------------------------------------------------------------------------------ + +//converts a hex value to a TColor +function HexToTColor(s: OleVariant): TColor; +begin + if s <> null then + begin + if not IsSpecialColor(s) then + begin + s := FormatHexColor(s); + if s <> '' then + Result := RGB(StrToInt('$'+Copy(S, 1, 2)), StrToInt('$'+Copy(S, 3, 2)), StrToInt('$'+Copy(S, 5, 2))) + else + Result := clNone; + end + else + if IsMember(SPECIAL_NAMES, SPECIAL_COUNT, s) then + begin + s := GetHexFromName(s); + Result := RGB(StrToInt('$'+Copy(S, 1, 2)), StrToInt('$'+Copy(S, 3, 2)), StrToInt('$'+Copy(S, 5, 2))); + end + else + Result := GetValueFromName(s); + end + else + Result := clNone; +end; + +//------------------------------------------------------------------------------ + +//checks if a hex value belongs to the websafe palette +function IsWebSafe(s: string): boolean; +begin + s := FormatHexColor(s); + Result := IsMember(WEBSAFE_HEX, WEBSAFE_COUNT, s); +end; + +//------------------------------------------------------------------------------ + +//checks if a color belongs to the websafe palette +function IsWebSafe(c: TColor): boolean; +var + s: string; +begin + s := ColorToHex(c); + Result := IsMember(WEBSAFE_HEX, WEBSAFE_COUNT, s); +end; + +//------------------------------------------------------------------------------ + +//initializes the websafe comparison array +procedure InitializeWS; + var + i: integer; + begin + for i := 0 to 255 do + WS[I] := ((i + $19) div $33) * $33; + end; + +//------------------------------------------------------------------------------ + +//returns the closest web safe color to the one given +function GetWebSafe(C: TColor): TColor; +begin + Result := RGB(WS[GetRValue(C)], WS[GetGValue(C)], WS[GetBValue(C)]); +end; + +//------------------------------------------------------------------------------ + +initialization + InitializeWS; + +end. diff --git a/components/mbColorLib/HexaColorPicker.dcr b/components/mbColorLib/HexaColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..c3a880c5bfaac1d9d81b18d832a11ac34538c15c GIT binary patch literal 1864 zcmd^=FRZ0T6o*eM8swFvs<<6jByLO7WOv%64XJ3b$dO3wNF?&wkw_%TDkKs)_SRjA z{CeiSZS&sdz3s{-g_&gjz~MK)`OY9B@|{+AtlE5b{rQc^TOEO~<#%}}Kgl2RgZwDJ z$}d_Q`Ayzy?`Iuv{(0~F%eUFzoj2OZKi01vS|T4b=BF1)!T+K(P-uymonpZR%t+Bw zb`&+Hq^iEihm4yVmfesInUM(@kQS*CgJfi1;AhD$>;-3eQmUl&qaM>^T8!#36hf7M zPLfMOLe6f87MeSD$1d0_)?*#E!B*IUTJZYBE5dT7jH_X(Ia+QGT*Pg-88_huT#Ku5 zhAyMOyd0+|2rg$VnH#o_!*h;z#sk0L1K#5uzQLFHf<ai?7eWd4LT8fRYs);akHi_m zjj$7D!bBJdEx{5D;gUZ5$<i!NC=1$(zF~9(&wAxpxNj%h!M3smR?pV6soaXKU=@z? zS*VQslF+c0u45ROCgz!KCq`0@+M0<IaUgbS8)8Yk5T8g=BC>>rQdYGzJ^hH+b*wB0 z$H`r94p>eC_>&&gnd(fuX6MtT6=a62!8mG9du5mzcji00%1MH@$b2wGhJ!X@m92wI zM2@F%hUAPgtN2$FjqdY?k6d9@hd4Htm8*`eX{OnzRtm*^rPff-ENT!(<`cj5LVM8P znK%Q-HCY@2V_*oh0jnt&xCBJYvmlS%J|$B=Q!2$b6hlw+?4HGQReC&~r}31Y+^4MT zmKWnZd`7hv2lc5|o{pnqRSG)Bj^5FB)GoQ0b>y18FNk>@)coGbZzvX)n`O7mmdP?G z5jJsAT5^k6+VL}SBK5-t819BcQ%%8D#!X79#!x98dUh0vk=MmMPMushl~iHV>=#C% w7aBb*Bpn(0%g{6E--4tE=r}84#a^?Ngqo>hDCz4Ysn&x-*Y&D1|B<P`0N$8&#Q*>R literal 0 HcmV?d00001 diff --git a/components/mbColorLib/HexaColorPicker.pas b/components/mbColorLib/HexaColorPicker.pas new file mode 100644 index 000000000..55a853a7d --- /dev/null +++ b/components/mbColorLib/HexaColorPicker.pas @@ -0,0 +1,1531 @@ +unit HexaColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +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; + +const + CustomCell = -2; + NoCell = -1; + +type + TMarker = (smArrow, smRect); + + TCombEntry = record + Position: TPoint; + Color: COLORREF; + TabIndex: integer; + end; + + TCombArray = array of TCombEntry; + + TFloatPoint = record + X, Y: Extended; + end; + + TRGBrec = record + Red, Green, Blue: Single; + end; + + TSelectionMode = (smNone, smColor, smBW, smRamp); + + THexaColorPicker = class(TCustomControl) + 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, // 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; + + 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 Initialise; + procedure DrawAll; + procedure SetSelectedColor(const Value: TColor); + procedure DrawCombControls; + procedure PaintParentBack; + 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 WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); + message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF}; + procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); + message CN_KEYDOWN; + procedure CMHintShow(var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF}); + message CM_HINTSHOW; + procedure WMLButtonDown(var Message: {$IFDEF FPC}TLMLButtonDown{$ELSE}TWMLButtonDown{$ENDIF}); + message {$IFDEF FPC}LM_LBUTTONDOWN{$ELSE}WM_LBUTTONDOWN{$ENDIF}; + procedure WMLButtonUp(var Message: {$IFDEF FPC}TLMLButtonUp{$ELSE}TWMLButtonUp{$ENDIF}); + message {$IFDEF FPC}LM_LBUTTONUP{$ELSE}WM_LBUTTONUP{$ENDIF}; + procedure WMMouseMove(var Message: {$IFDEF FPC}TLMMouseMove{$ELSE}TWMMouseMove{$ENDIF}); + message {$IFDEF FPC}LM_MOUSEMOVE{$ELSE}WM_MOUSEMOVE{$ENDIF}; + procedure Paint; override; + procedure CreateWnd; override; + procedure Resize; 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; + property ParentColor default true; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF}{$ENDIF} + property TabOrder; + property Color; + 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); + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R HexaColorPicker.dcr} +{$ENDIF} + +uses + PalUtils; + +procedure Register; +begin + RegisterComponents('mbColor Lib', [THexaColorPicker]); +end; + +constructor THexaColorPicker.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; + FRadius := 90; + FSliderWidth := 12; + DoubleBuffered := true; + ParentColor := true; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF}{$ENDIF} + Width := 204; + Height := 206; + Constraints.MinHeight := 85; + Constraints.MinWidth := 93; + TabStop := true; + FSelectedCombIndex := 0; + FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: #%hex'; + ShowHint := True; + FSliderVisible := true; + FMarker := smArrow; + FNewArrowStyle := false; + Initialise; + DrawAll; + OnMouseWheelUp := WheelUp; + OnMouseWheelDown := WheelDown; + FIntensityText := 'Intensity'; + MaxHue := 360; + MaxLum := 255; + MaxSat := 255; +end; + +procedure THexaColorPicker.CreateWnd; +var + rw, rh: integer; +begin + inherited; + SetSelectedColor(clBlack); + if (Width >= 93) and (Height >= 85) then + begin + if FSliderVisible then + rw := Round((Width - 10 - FSliderWidth)/2) + else + rw := Round(Width/2 - 5); + rh := Round((24/53)*(Height - 6)); + SetRadius(Min(rw, rh)); + end; +end; + +procedure THexaColorPicker.Initialise; +var + I: Integer; +begin + FSelectedIndex := NoCell; + for I := 0 to 5 do + begin + FCombCorners[I].X := 0.5 * cos(Pi * (90 - I * 60) / 180); + FCombCorners[I].Y := 0.5 * sin(Pi * (90 - I * 60) / 180); + end; + FLevels := 7; + FCombSize := Round(FRadius / (FLevels - 1)); + FCenterColor := DefCenterColor; + FIncrement := 1; + FCenterIntensity := 1; +end; + +destructor THexaColorPicker.Destroy; +begin + FBWCombs := nil; + FColorCombs := nil; + inherited; +end; + +procedure THexaColorPicker.DrawComb(Canvas: TCanvas; X, Y: Integer; Size: Integer); +var + I: Integer; + P: array[0..5] of TPoint; +begin + for I := 0 to 5 do + begin + P[I].X := Round(FCombCorners[I].X * Size + X); + P[I].Y := Round(FCombCorners[I].Y * Size + Y); + end; + Canvas.Polygon(P); +end; + +procedure THexaColorPicker.DrawCombControls; +var + I, Index: Integer; + XOffs, YOffs, Count: Integer; + dColor: Single; + OffScreen: TBitmap; + {$IFDEF DELPHI_7_UP} + MemDC: HDC; + OldBMP: HBITMAP; + {$ENDIF} +begin + OffScreen := TBitmap.Create; + try + OffScreen.PixelFormat := pf32bit; + OffScreen.Width := Width; + OffScreen.Height := FColorCombRect.Bottom - FColorCombRect.Top + FBWCombRect.Bottom - FBWCombRect.Top; + //Parent background + {$IFDEF FPC} + if Color = clDefault then + Offscreen.Canvas.Brush.Color := clForm + else + {$ENDIF} + OffScreen.Canvas.Brush.Color := Color; + OffScreen.Canvas.FillRect(OffScreen.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, OffScreen.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF}{$ENDIF} + with OffScreen.Canvas do + begin + Pen.Style := psClear; + // draw color comb from FColorCombs array + XOffs := FRadius + FColorCombRect.Left; + YOffs := FRadius + FColorCombRect.Top; + // draw the combs + for I := 0 to High(FColorCombs) do + begin + Brush.Color := FColorCombs[I].Color; + Pen.mode := pmCopy; // the pen is set here so there are no gaps between the combs + Pen.style := psSolid; + Pen.color := FColorCombs[I].Color; + DrawComb(OffScreen.Canvas, FColorCombs[I].Position.X + XOffs, FColorCombs[I].Position.Y + YOffs, FCombSize); + end; + // mark selected comb + if FCustomIndex > 0 then + begin + Index := FCustomIndex - 1; + FSelectedCombIndex := index; + Pen.Style := psSolid; + Pen.Mode := pmXOR; + Pen.Color := clWhite; + Pen.Width := 2; + Brush.Style := bsClear; + DrawComb(OffScreen.Canvas, FColorCombs[Index].Position.X + XOffs, FColorCombs[Index].Position.Y + YOffs, FCombSize); + Pen.Style := psClear; + Pen.Mode := pmCopy; + Pen.Width := 1; + end; + // draw white-to-black combs + XOffs := FColorCombRect.Left; + YOffs := FColorCombRect.Bottom - 4; + // brush is automatically reset to bsSolid + for I := 0 to High(FBWCombs) do + begin + Pen.Mode := pmCopy; // the pen is set here so there are no gaps between the combs + Pen.Style := psSolid; + Pen.Color := FBWCombs[I].Color; + Brush.Color := FBWCombs[I].Color; + if I in [0, High(FBWCombs)] then + DrawComb(OffScreen.Canvas, FBWCombs[I].Position.X + XOffs, FBWCombs[I].Position.Y + YOffs, 2 * FCombSize) + else + DrawComb(OffScreen.Canvas, FBWCombs[I].Position.X + XOffs, FBWCombs[I].Position.Y + YOffs, FCombSize); + end; + // mark selected comb + if FCustomIndex < 0 then + begin + Index := -(FCustomIndex + 1); + if index < 0 then + FSelectedCombIndex := Index + else + FSelectedCombIndex := -index; + Pen.Style := psSolid; + Pen.Mode := pmXOR; + Pen.Color := clWhite; + Pen.Width := 2; + Brush.Style := bsClear; + if Index in [0, High(FBWCombs)] then + begin + if ((FColorCombs[0].Color = Cardinal(clWhite)) and (Index = 0)) or ((FColorCombs[0].Color = Cardinal(clBlack)) and (Index = High(FBWCombs))) then + DrawComb(OffScreen.Canvas, FRadius + FColorCombRect.Left, FRadius + FColorCombRect.Top, FCombSize); // mark white or black center + DrawComb(OffScreen.Canvas, FBWCombs[Index].Position.X + XOffs, FBWCombs[Index].Position.Y + YOffs, 2 * FCombSize); + end + else + DrawComb(OffScreen.Canvas, FBWCombs[Index].Position.X + XOffs, FBWCombs[Index].Position.Y + YOffs, FCombSize); + Pen.Style := psClear; + Pen.Mode := pmCopy; + Pen.Width := 1; + end; + if FSliderVisible then + begin + // center-color trackbar + XOffs := FSliderRect.Left; + YOffs := FSliderRect.Top; + Count := FSliderRect.Bottom - FSliderRect.Top - 1; + dColor := 255 / Count; + Pen.Style := psSolid; + // b&w ramp + for I := 0 to Count do + begin + Pen.Color := RGB(Round((Count - I) * dColor), Round((Count - I) * dColor), Round((Count - I) * dColor)); + MoveTo(XOffs, YOffs + I); + LineTo(XOffs + FSliderWidth, YOffs + I); + end; + // draw marker + Inc(XOffs, FSliderWidth + 1); + Inc(YOffs, Round(Count * (1 - FCenterIntensity))); + case FMarker of + smArrow: + begin + if not FNewArrowStyle then + begin + Brush.Color := clBlack; + Polygon([Point(XOffs, YOffs), Point(XOffs + 6, YOffs - 4), Point(XOffs + 6, YOffs + 4)]) + end + else + begin + Brush.Color := clWhite; + Pen.Color := clBtnShadow; + Polygon([Point(XOffs, YOffs), Point(XOffs + 4, YOffs - 4), Point(XOffs + 6, YOffs - 4), + Point(XOffs + 7, YOffs - 3), Point(XOffs + 7, YOffs + 3), + Point(XOffs + 6, YOffs + 4), Point(XOffs + 4, YOffs + 4)]); + end; + end; + smRect: + begin + Brush.Style := bsClear; + Pen.Mode := pmNot; + Rectangle(XOffs - FSliderWidth - 4, YOffs - 3, XOffs + 2, YOffs + 3); + Pen.Mode := pmCopy; + Brush.Style := bsSolid; + end; + end; + Pen.Style := psClear; + end; + end; + Canvas.Draw(0, 0, OffScreen); + finally + Offscreen.Free; + end; + EnumerateCombs; +end; + +procedure THexaColorPicker.WMEraseBkgnd( + var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); +begin + Message.Result := 1; +end; + +procedure THexaColorPicker.PaintParentBack; +var + OffScreen: TBitmap; + {$IFDEF DELPHI_7_UP} + MemDC: HDC; + OldBMP: HBITMAP; + {$ENDIF} +begin + Offscreen := TBitmap.Create; + Offscreen.PixelFormat := pf32bit; + Offscreen.Width := Width; + Offscreen.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + Offscreen.Canvas.Brush.Color := clForm + else + {$ENDIF} + Offscreen.Canvas.Brush.Color := Color; + Offscreen.Canvas.FillRect(Offscreen.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, OffScreen.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF}{$ENDIF} + Canvas.Draw(0, 0, Offscreen); + Offscreen.Free; +end; + +procedure THexaColorPicker.Paint; +begin + PaintParentBack; + if FColorCombs = nil then + CalculateCombLayout; + DrawCombControls; +end; + +// determines whether the mouse position is within the slider area and acts accordingly +function THexaColorPicker.HandleSlider( + const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean; +var + Shift: TShiftState; + dY: Integer; + R: TRect; +begin + if not FSliderVisible then + begin + Result := false; + Exit; + end; + Result := PtInRect(FSliderRect, Point(Message.XPos, Message.YPos)) and (FSelectionMode = smNone) or + ((Message.XPos >= FSliderRect.Left) and (Message.XPos <= FSliderRect.Right) and (FSelectionMode = smRamp)); + if Result then + begin + Shift := KeysToShiftState(Message.Keys); + if ssLeft in Shift then + begin + FSelectionMode := smRamp; + dY := FSliderRect.Bottom - FSliderRect.Top; + FCenterIntensity := 1 - (Message.YPos - FSliderRect.Top) / dY; + if FCenterIntensity < 0 then FCenterIntensity := 0; + if FCenterIntensity > 1 then FCenterIntensity := 1; + FCenterColor.Red := DefCenterColor.Red * FCenterIntensity; + FCenterColor.Green := DefCenterColor.Green * FCenterIntensity; + FCenterColor.Blue := DefCenterColor.Blue * FCenterIntensity; + R := FSliderRect; + Dec(R.Top, 3); + Inc(R.Bottom, 3); + Inc(R.Left, 10); + InvalidateRect(Handle, @R, False); + FColorCombs := nil; + InvalidateRect(Handle, @FColorCombRect, False); + InvalidateRect(Handle, @FCustomColorRect, False); + CalculateCombLayout; + EndSelection; + if Assigned(FOnIntensityChange) then + FOnIntensityChange(Self); + end; + end; +end; + +function THexaColorPicker.PtInComb(Comb: TCombEntry; P: TPoint; Scale: Integer): Boolean; +begin + Result := (Sqr(Comb.Position.X - P.X) + Sqr(Comb.Position.Y - P.Y)) <= (Scale * Scale); +end; + +// Looks for a comb at position (X, Y) in the black&white area. +// Result is -1 if nothing could be found else the index of the particular comb +// into FBWCombs. +function THexaColorPicker.FindBWArea(X, Y: Integer): Integer; +var + I, Scale: Integer; + Pt: TPoint; +begin + Result := -1; + Pt := Point(X - FBWCombRect.Left, Y - FBWCombRect.Top); + for I := 0 to High(FBWCombs) do + begin + if I in [0, High(FBWCombs)] then + Scale := FCombSize + else + Scale := FCombSize div 2; + if PtInComb(FBWCombs[I], Pt, Scale) then + begin + Result := I; + Break; + end; + end; +end; + +// determines whether the mouse position is within the B&W comb area and acts accordingly +function THexaColorPicker.HandleBWArea( + const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean; +var + Index: Integer; + Shift: TShiftState; +begin + Result := PtInRect(FBWCombRect, Point(Message.XPos, Message.YPos)) and (FSelectionMode in [smNone, smBW]); + if Result then + begin + Shift := KeysToShiftState(Message.Keys); + if ssLeft in Shift then + begin + FSelectionMode := smBW; + Index := FindBWArea(Message.XPos, Message.YPos); + if Index > -1 then + begin + // remove selection comb if it was previously in color comb + if FCustomIndex > 0 then InvalidateRect(Handle, @FColorCombRect, False); + if FCustomIndex <> -(Index + 1) then + begin + FCustomIndex := -(Index + 1); + InvalidateRect(Handle, @FBWCombRect, False); + InvalidateRect(Handle, @FCustomColorRect, False); + EndSelection; + end; + end + else + Result := False; + end; + end; +end; + +// Looks for a comb at position (X, Y) in the custom color area. +// Result is -1 if nothing could be found else the index of the particular comb +// into FColorCombs. +function THexaColorPicker.FindColorArea(X, Y: Integer): Integer; +var + I: Integer; + Pt: TPoint; +begin + Result := -1; + Pt := Point(X - (FRadius + FColorCombRect.Left), Y - (FRadius + FColorCombRect.Top)); + for I := 0 to High(FColorCombs) do + begin + if PtInComb(FColorCombs[I], Pt, FCombSize div 2) then + begin + Result := I; + Break; + end; + end; +end; + +// determines whether the mouse position is within the color comb area and acts accordingly +function THexaColorPicker.HandleColorComb( + const Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}): Boolean; +var + Index: Integer; + Shift: TShiftState; +begin + Result := PtInRect(FColorCombRect, Point(Message.XPos, Message.YPos)) and (FSelectionMode in [smNone, smColor]); + if Result then + begin + Shift := KeysToShiftState(Message.Keys); + if ssLeft in Shift then + begin + FSelectionMode := smColor; + Index := FindColorArea(Message.XPos, Message.YPos); + if Index > -1 then + begin + // remove selection comb if it was previously in b&w comb + if FCustomIndex < 0 then InvalidateRect(Handle, @FBWCombRect, False); + if FCustomIndex <> (Index + 1) then + begin + FCustomIndex := Index + 1; + InvalidateRect(Handle, @FColorCombRect, False); + InvalidateRect(Handle, @FCustomColorRect, False); + EndSelection; + end; + end + else + Result := False; + end; + end; +end; + +procedure THexaColorPicker.HandleCustomColors( + var Message: {$IFDEF FPC}TLMMouse{$ELSE}TWMMouse{$ENDIF}); +begin + if not HandleSlider(Message) then + if not HandleBWArea(Message) then + HandleColorComb(Message); +end; + +procedure THexaColorPicker.WMMouseMove( + var Message: {$IFDEF FPC}TLMMouseMove{$ELSE}TWMMouseMove{$ENDIF} ); +var + Shift: TShiftState; + Index: Integer; + Colors: TCombArray; +begin + inherited; + mX := Message.XPos; + mY := Message.YPos; + //get color under cursor + Colors := nil; + FUnderCursor := clNone; + if PtInRect(FBWCombRect, Point(Message.XPos, Message.YPos)) then + begin + Index := FindBWArea(Message.XPos, Message.YPos); + Colors := FBWCombs; + if (Index > -1) and (Colors <> nil) then + FUnderCursor := Colors[Index].Color; + end + else + if PtInRect(FColorCombRect, Point(Message.XPos, Message.YPos)) then + begin + Index := FindColorArea(Message.XPos, Message.YPos); + Colors := FColorCombs; + if (Index > -1) and (Colors <> nil) then + FUnderCursor := Colors[Index].Color; + end + else + FUnderCursor := clNone; + // further process message + Shift := KeysToShiftState(Message.Keys); + if ssLeft in Shift then + HandleCustomColors(Message); +end; + +procedure THexaColorPicker.WMLButtonDown( + var Message: {$IFDEF FPC}TLMLButtonDown{$ELSE}TWMLButtonDown{$ENDIF} ); +begin + inherited; + SetFocus; // needed so the key events work + if PtInRect(ClientRect, Point(Message.XPos, Message.YPos)) then + HandleCustomColors(Message); +end; + +procedure THexaColorPicker.WMLButtonUp( + var Message: {$IFDEF FPC}TLMLButtonUp{$ELSE}TWMLButtonUp{$ENDIF} ); +var + LastMode: TSelectionMode; +begin + inherited; + LastMode := FSelectionMode; + FSelectionMode := smNone; + if (FSelectedIndex = CustomCell) and (FCustomIndex <> 0) then + begin + if ((FSelectedIndex = CustomCell) and (LastMode in [smColor, smBW])) or + (FSelectedIndex <> NoCell) and (FSelectedIndex <> CustomCell) then + EndSelection + end; +end; + +procedure THexaColorPicker.DrawAll; +var + WinTop: integer; +begin + WinTop := - FRadius div 8; // use 10 instead of 8 if the top has been cut + FCombSize := Round(1 + FRadius / (FLevels - 1)); + FColorCombRect := Rect(0, WinTop, 2 * FRadius, 2 * FRadius + WinTop); + FBWCombRect := Rect(FColorCombRect.Left, FColorCombRect.Bottom - 4, + Round(17 * FCombSize * cos(Pi / 6) / 2) + 6 * FCombSize, + FColorCombRect.Bottom + 2 * FCombSize); + if FSliderVisible then + FSliderRect := Rect(FColorCombRect.Right, FCombSize, FColorCombRect.Right + 10 + FSliderWidth, FColorCombRect.Bottom - FCombSize) + else + FSliderRect := Rect(-1, -1, -1, -1); +end; + +// fills arrays with centers and colors for the custom color and black & white combs, +// these arrays are used to quickly draw the combx and do hit tests + +function RGBFromFloat(Color: TRGBrec): COLORREF; +begin + Result := RGB(Round(255 * Color.Red), Round(255 * Color.Green), Round(255 * Color.Blue)); +end; + +{function TRGBrecFromTColor(Color: TColor): TRGBrec; +begin + Result.Red := GetRValue(Color)/255; + Result.Green := GetGValue(Color)/255; + Result.Blue := GetBValue(Color)/255; +end;} + +procedure THexaColorPicker.CalculateCombLayout; + + function GrayFromIntensity(Intensity: Byte): COLORREF; + begin + Result := RGB(Intensity, Intensity, Intensity); + end; + +var + I, J, Level, CurrentIndex, CombCount: Cardinal; + CurrentColor: TRGBrec; + CurrentPos: TFloatPoint; + Scale: Extended; + // triangle vars + Pos1, Pos2, dPos1, dPos2, dPos: TFloatPoint; + Color1, Color2, dColor1, dColor2, dColor: TRGBrec; +begin + // this ensures the radius and comb size is set correctly + HandleNeeded; + if FLevels < 1 then FLevels := 1; + // To draw perfectly aligned combs we split the final comb into six triangles (sextants) + // and calculate each separately. The center comb is stored as first entry in the array + // and will not considered twice (as with the other shared combs too). + // + // The way used here for calculation of the layout seems a bit complicated, but works + // correctly for all cases (even if the comb corners are rotated). + // initialization + CurrentIndex := 0; + CurrentColor := FCenterColor; + // number of combs can be calculated by: + // 1 level: 1 comb (the center) + // 2 levels: 1 comb + 6 combs + // 3 levels: 1 comb + 1 * 6 combs + 2 * 6 combs + // n levels: 1 combs + 1 * 6 combs + 2 * 6 combs + .. + (n-1) * 6 combs + // this equals to 1 + 6 * (1 + 2 + 3 + .. + (n-1)), by using Gauss' famous formula we get: + // Count = 1 + 6 * (((n-1) * n) / 2) + // Because there's always an even number involved (either n or n-1) we can use an integer div + // instead of a float div here... + CombCount := 1 + 6 * (((FLevels - 1) * FLevels) div 2); + SetLength(FColorCombs, CombCount); + // store center values + FColorCombs[CurrentIndex].Position := Point(0, 0); + FColorCombs[CurrentIndex].Color := RGBFromFloat(CurrentColor); + Inc(CurrentIndex); + // go out off here if there are not further levels to draw + if FLevels < 2 then Exit; + // now go for each sextant, the generic corners have been calculated already at creation + // time for a comb with diameter 1 + // ------ + // /\ 1 /\ + // / \ / \ + // / 2 \/ 0 \ + // ----------- + // \ 3 /\ 5 / + // \ / \ / + // \/ 4 \/ + // ------ + for I := 0 to 5 do + begin + // initialize triangle corner values + // + // center (always at 0,0) + // /\ + // dPos1 / \ dPos2 + // dColor1 / \ dColor2 + // / dPos \ + // /--------\ (span) + // / dColor \ + // /____________\ + // comb corner 1 comb corner 2 + // + // Pos1, Pos2, Color1, Color2 are running terms for both sides of the triangle + // incremented by dPos1/2 and dColor1/2. + // dPos and dColor are used to interpolate a span between the values just mentioned. + // + // The small combs are actually oriented with corner 0 at top (i.e. mirrored at y = x, + // compared with the values in FCombCorners), we can achieve that by simply exchanging + // X and Y values. + Scale := 2 * FRadius * cos(Pi / 6); + Pos1.X := FCombCorners[I].Y * Scale; + Pos1.Y := FCombCorners[I].X * Scale; + Color1 := DefColors[I]; + if I = 5 then + begin + Pos2.X := FCombCorners[0].Y * Scale; + Pos2.Y := FCombCorners[0].X * Scale; + Color2 := DefColors[0]; + end + else + begin + Pos2.X := FCombCorners[I + 1].Y * Scale; + Pos2.Y := FCombCorners[I + 1].X * Scale; + Color2 := DefColors[I + 1]; + end; + dPos1.X := Pos1.X / (FLevels - 1); + dPos1.Y := Pos1.Y / (FLevels - 1); + dPos2.X := Pos2.X / (FLevels - 1); + dPos2.Y := Pos2.Y / (FLevels - 1); + dColor1.Red := (Color1.Red - FCenterColor.Red) / (FLevels - 1); + dColor1.Green := (Color1.Green - FCenterColor.Green) / (FLevels - 1); + dColor1.Blue := (Color1.Blue - FCenterColor.Blue) / (FLevels - 1); + + dColor2.Red := (Color2.Red - FCenterColor.Red) / (FLevels - 1); + dColor2.Green := (Color2.Green - FCenterColor.Green) / (FLevels - 1); + dColor2.Blue := (Color2.Blue - FCenterColor.Blue) / (FLevels - 1); + + Pos1 := DefCenter; + Pos2 := DefCenter; + Color1 := FCenterColor; + Color2 := FCenterColor; + + // Now that we have finished the initialization for this step we'll go + // through a loop for each level to calculate the spans. + // We can ignore level 0 (as this is the center we already have determined) as well + // as the last step of each span (as this is the start value in the next triangle and will + // be calculated there). We have, though, take them into the calculation of the running terms. + for Level := 0 to FLevels - 1 do + begin + if Level > 0 then + begin + // initialize span values + dPos.X := (Pos2.X - Pos1.X) / Level; + dPos.Y := (Pos2.Y - Pos1.Y) / Level; + dColor.Red := (Color2.Red - Color1.Red) / Level; + dColor.Green := (Color2.Green - Color1.Green) / Level; + dColor.Blue := (Color2.Blue - Color1.Blue) / Level; + CurrentPos := Pos1; + CurrentColor := Color1; + for J := 0 to Level - 1 do + begin + // store current values in the array + FColorCombs[CurrentIndex].Position.X := Round(CurrentPos.X); + FColorCombs[CurrentIndex].Position.Y := Round(CurrentPos.Y); + FColorCombs[CurrentIndex].Color := RGBFromFloat(CurrentColor); + Inc(CurrentIndex); + + // advance in span + CurrentPos.X := CurrentPos.X + dPos.X; + CurrentPos.Y := CurrentPos.Y + dPos.Y; + + CurrentColor.Red := CurrentColor.Red + dColor.Red; + CurrentColor.Green := CurrentColor.Green + dColor.Green; + CurrentColor.Blue := CurrentColor.Blue + dColor.Blue; + end; + end; + // advance running terms + Pos1.X := Pos1.X + dPos1.X; + Pos1.Y := Pos1.Y + dPos1.Y; + Pos2.X := Pos2.X + dPos2.X; + Pos2.Y := Pos2.Y + dPos2.Y; + + Color1.Red := Color1.Red + dColor1.Red; + Color1.Green := Color1.Green + dColor1.Green; + Color1.Blue := Color1.Blue + dColor1.Blue; + + Color2.Red := Color2.Red + dColor2.Red; + Color2.Green := Color2.Green + dColor2.Green; + Color2.Blue := Color2.Blue + dColor2.Blue; + end; + end; + + // second step is to build a list for the black & white area + // 17 entries from pure white to pure black + // the first and last are implicitely of double comb size + SetLength(FBWCombs, 17); + CurrentIndex := 0; + FBWCombs[CurrentIndex].Color := GrayFromIntensity(255); + FBWCombs[CurrentIndex].Position := Point(FCombSize, FCombSize); + Inc(CurrentIndex); + + CurrentPos.X := 3 * FCombSize; + CurrentPos.Y := 3 * (FCombSize div 4); + dPos.X := Round(FCombSize * cos(Pi / 6) / 2); + dPos.Y := Round(FCombSize * (1 + sin(Pi / 6)) / 2); + for I := 0 to 14 do + begin + FBWCombs[CurrentIndex].Color := GrayFromIntensity((16 - CurrentIndex) * 15); + if Odd(I) then + FBWCombs[CurrentIndex].Position := Point(Round(CurrentPos.X + I * dPos.X), Round(CurrentPos.Y + dPos.Y)) + else + FBWCombs[CurrentIndex].Position := Point(Round(CurrentPos.X + I * dPos.X), Round(CurrentPos.Y)); + Inc(CurrentIndex); + end; + FBWCombs[CurrentIndex].Color := 0; + FBWCombs[CurrentIndex].Position := Point(Round(CurrentPos.X + 16 * dPos.X + FCombSize), FCombSize); + EnumerateCombs; +end; + +// determine hint message and out-of-hint rect +procedure THexaColorPicker.CMHintShow( + var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF} ); +var + Index: Integer; + Colors: TCombArray; +begin + Colors := nil; +if (GetColorUnderCursor <> clNone) or PtInRect(FSliderRect, Point(mX, mY)) then + with TCMHintShow(Message) do + begin + if not ShowHint then + Message.Result := 1 + else + begin + with HintInfo^ do + begin + // show that we want a hint + Result := 0; + ReshowTimeout := 1; + HideTimeout := 5000; + if PtInRect(FSliderRect, Point(CursorPos.X, CursorPos.Y)) and FSliderVisible then + begin + // in case of the intensity slider we show the current intensity + HintStr := FIntensityText + Format(': %d%%', [Round(100 * FCenterIntensity)]); + HintPos := ClientToScreen(Point(FSliderRect.Right, CursorPos.Y - 8)); + end + else + begin + Index := -1; + if PtInRect(FBWCombRect, Point(CursorPos.X, CursorPos.Y)) then + begin + // considering black&white area... + if csLButtonDown in ControlState then + Index := -(FCustomIndex + 1) + else + Index := FindBWArea(CursorPos.X, CursorPos.Y); + Colors := FBWCombs; + end + else + if PtInRect(FColorCombRect, Point(CursorPos.X, CursorPos.Y)) then + begin + // considering color comb area... + if csLButtonDown in ControlState then + Index := FCustomIndex - 1 + else + Index := FindColorArea(CursorPos.X, CursorPos.Y); + Colors := FColorCombs; + end; + if (Index > -1) and (Colors <> nil) then + HintStr := FormatHint(FHintFormat, Colors[Index].Color); + end; + end; + end; + end; +end; + +procedure THexaColorPicker.SetSelectedColor(const Value: TColor); +begin + FCurrentColor := Value; + SelectColor(Value); + Invalidate; +end; + +procedure THexaColorPicker.EndSelection; +begin + if FCustomIndex < 0 then + SetSelectedColor(FBWCombs[-(FCustomIndex + 1)].Color) + else + if FCustomIndex > 0 then + SetSelectedColor(FColorCombs[FCustomIndex - 1].Color) + else + SetSelectedColor(clNone); +end; + +function THexaColorPicker.GetColorUnderCursor: TColor; +begin + Result := FUnderCursor; +end; + +function THexaColorPicker.GetColorAtPoint(X, Y: integer): TColor; +var + Index: Integer; + Colors: TCombArray; +begin + Colors := nil; + Index := -1; + if PtInRect(FBWCombRect, Point(X, Y)) then + begin + Index := FindBWArea(X, Y); + Colors := FBWCombs; + end + else + if PtInRect(FColorCombRect, Point(X, Y)) then + begin + Index := FindColorArea(X, Y); + Colors := FColorCombs; + end; + if (Index > -1) and (Colors <> nil) then + Result := Colors[Index].Color + else + Result := clNone; +end; + +function THexaColorPicker.GetHexColorUnderCursor: string; +begin + Result := ColorToHex(GetColorUnderCursor); +end; + +function THexaColorPicker.GetHexColorAtPoint(X, Y: integer): string; +begin + Result := ColorToHex(GetColorAtPoint(X, Y)); +end; + +procedure THexaColorPicker.EnumerateCombs; +var + i, k: integer; +begin + k := 0; + if FBWCombs <> nil then + for i := 1 to High(FBWCombs) do + begin + case i of + // b & w comb indices + 1: k := -1; + 2: k := -9; + 3: k := -2; + 4: k := -10; + 5: k := -3; + 6: k := -11; + 7: k := -4; + 8: k := -12; + 9: k := -5; + 10: k := -13; + 11: k := -6; + 12: k := -14; + 13: k := -7; + 14: k := -15; + 15: k := -8; + // big black comb index (match center comb) + 16: K := 64; + end; + FBWCombs[i].TabIndex := k; + end; + if FColorCombs <> nil then + for i := 0 to High(FColorCombs) do + begin + case i of + // center comb index + 0: k := 64; + // color comb indices + 1: k := 65; + 2: k := 66; + 3: k := 78; + 4: k := 67; + 5: k := 79; + 6: k := 90; + 7: k := 68; + 8: k := 80; + 9: k := 91; + 10: k := 101; + 11: k := 69; + 12: k := 81; + 13: k := 92; + 14: k := 102; + 15: k := 111; + 16: k := 70; + 17: k := 82; + 18: k := 93; + 19: k := 103; + 20: k := 112; + 21: k := 120; + 22: k := 77; + 23: k := 89; + 24: k := 88; + 25: k := 100; + 26: k := 99; + 27: k := 98; + 28: k := 110; + 29: k := 109; + 30: k := 108; + 31: k := 107; + 32: k := 119; + 33: k := 118; + 34: k := 117; + 35: k := 116; + 36: k := 115; + 37: k := 127; + 38: k := 126; + 39: k := 125; + 40: k := 124; + 41: k := 123; + 42: k := 122; + 43: k := 76; + 44: k := 87; + 45: k := 75; + 46: k := 97; + 47: k := 86; + 48: k := 74; + 49: k := 106; + 50: k := 96; + 51: k := 85; + 52: k := 73; + 53: k := 114; + 54: k := 105; + 55: k := 95; + 56: k := 84; + 57: k := 72; + 58: k := 121; + 59: k := 113; + 60: k := 104; + 61: k := 94; + 62: k := 83; + 63: k := 71; + 64: k := 63; + 65: k := 62; + 66: k := 50; + 67: k := 61; + 68: k := 49; + 69: k := 38; + 70: k := 60; + 71: k := 48; + 72: k := 37; + 73: k := 27; + 74: k := 59; + 75: k := 47; + 76: k := 36; + 77: k := 26; + 78: k := 17; + 79: k := 58; + 80: k := 46; + 81: k := 35; + 82: k := 25; + 83: k := 16; + 84: k := 8; + 85: k := 51; + 86: k := 39; + 87: k := 40; + 88: k := 28; + 89: k := 29; + 90: k := 30; + 91: k := 18; + 92: k := 19; + 93: k := 20; + 94: k := 21; + 95: k := 9; + 96: k := 10; + 97: k := 11; + 98: k := 12; + 99: k := 13; + 100: k := 1; + 101: k := 2; + 102: k := 3; + 103: k := 4; + 104: k := 5; + 105: k := 6; + 106: k := 52; + 107: k := 41; + 108: k := 53; + 109: k := 31; + 110: k := 42; + 111: k := 54; + 112: k := 22; + 113: k := 32; + 114: k := 43; + 115: k := 55; + 116: k := 14; + 117: k := 23; + 118: k := 33; + 119: k := 44; + 120: k := 56; + 121: k := 7; + 122: k := 15; + 123: k := 24; + 124: k := 34; + 125: k := 45; + 126: k := 57; + end; + FColorCombs[i].TabIndex := k; + end; +end; + +procedure THexaColorPicker.SelectCombIndex(i: integer); +var + j: integer; +begin + if i > 0 then + begin + if FColorCombs <> nil then + for j := 0 to High(FColorCombs) do + begin + if FColorCombs[j].TabIndex = i then + begin + SetSelectedColor(FColorCombs[j].Color); + Break; + end; + end; + end + else + if FBWCombs <> nil then + for j := 1 to High(FBWCombs) - 1 do + begin + if FBWCombs[j].TabIndex = i then + begin + SetSelectedColor(FBWCombs[j].Color); + Break; + end; + end; +end; + +function THexaColorPicker.GetSelectedCombIndex: integer; +begin + if FSelectedCombIndex < 0 then + Result := FBWCombs[-FSelectedCombIndex].TabIndex + else + Result := FColorCombs[FSelectedCombIndex].TabIndex; +end; + +function THexaColorPicker.GetNextCombIndex(i: integer): integer; +begin + if i = 127 then + Result := -1 + else + if i = -15 then + Result := 1 + else + if i > 0 then + Result := i + 1 + else + Result := i - 1; +end; + +function THexaColorPicker.GetPreviousCombIndex(i: integer): integer; +begin + if i = 1 then + Result := -15 + else + if i = -1 then + Result := 127 + else + if i > 0 then + Result := i - 1 + else + Result := i + 1; +end; + +function THexaColorPicker.GetIntensity: integer; +begin + Result := ROUND(FCenterIntensity * 100); +end; + +procedure THexaColorPicker.SetIntensity(v: integer); +var + R: TRect; + s: single; +begin + s := v/100; + FCenterIntensity := s; + if FCenterIntensity < 0 then FCenterIntensity := 0; + if FCenterIntensity > 1 then FCenterIntensity := 1; + FCenterColor.Red := DefCenterColor.Red * FCenterIntensity; + FCenterColor.Green := DefCenterColor.Green * FCenterIntensity; + FCenterColor.Blue := DefCenterColor.Blue * FCenterIntensity; + R := FSliderRect; + Dec(R.Top, 3); + Inc(R.Bottom, 3); + Inc(R.Left, 10); + InvalidateRect(Handle, @R, False); + FColorCombs := nil; + InvalidateRect(Handle, @FColorCombRect, False); + InvalidateRect(Handle, @FCustomColorRect, False); + CalculateCombLayout; + EndSelection; + if Assigned(FOnIntensityChange) then + FOnIntensityChange(Self); +end; + +procedure THexaColorPicker.ChangeIntensity(increase: boolean); +var + i: integer; +begin + i := ROUND(FCenterIntensity * 100); + if increase then + begin + Inc(i, FIncrement); + if i > 100 then i := 100; + SetIntensity(i); + end + else + begin + Dec(i, FIncrement); + if i < 0 then i := 0; + SetIntensity(i); + end; +end; + +procedure THexaColorPicker.SetRadius(r: integer); +begin + {$IFDEF FPC} + if Parent = nil then + exit; + {$ENDIF} + FRadius := r; + DrawAll; + CalculateCombLayout; + DrawCombControls; + Invalidate; +end; + +procedure THexaColorPicker.SetSliderWidth(w: integer); +begin + if (FSliderWidth <> w) and FSliderVisible then + begin + FSliderWidth := w; + DrawAll; + Width := FSliderRect.Right + 2; +// Height := FBWCombRect.Bottom + 2; + CalculateCombLayout; + DrawCombControls; + Invalidate; + end; +end; + +procedure THexaColorPicker.Resize; +var + rw, rh: integer; +begin + if (Width >= 93) and (Height >= 85) then + begin + if FSliderVisible then + rw := Round((Width - 10 - FSliderWidth)/2) + else + rw := Round(Width/2 - 5); + rh := Round((24/53)*(Height - 6)); + SetRadius(Min(rw, rh)); + inherited; + end; +end; + +procedure THexaColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); +var + Shift: TShiftState; + FInherited: boolean; +begin + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + if ssCtrl in Shift then + case Message.CharCode of + VK_LEFT: SetSelectedColor(clWhite); + VK_RIGHT: SetSelectedColor(clBlack); + VK_UP: if FSliderVisible then SetIntensity(100); + VK_DOWN: if FSliderVisible then SetIntensity(0); + else + begin + FInherited := true; + inherited; + end; + end + else + case Message.CharCode of + VK_LEFT: SelectCombIndex(GetPreviousCombIndex(GetSelectedCombIndex)); + VK_RIGHT: SelectCombIndex(GetNextCombIndex(GetSelectedCombIndex)); + VK_UP: if FSliderVisible then ChangeIntensity(true); + VK_DOWN: if FSliderVisible then ChangeIntensity(false); + else + begin + FInherited := true; + inherited; + end; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure THexaColorPicker.WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + if FSliderVisible then + begin + Handled := true; + ChangeIntensity(true); + end; +end; + +procedure THexaColorPicker.WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + if FSliderVisible then + begin + Handled := true; + ChangeIntensity(false); + end; +end; + +function THexaColorPicker.SelectAvailableColor(Color: TColor): boolean; +var + I: integer; + //intens: single; + //SC: TRGBrec; + C: COLORREF; + found: Boolean; +begin + found := False; + Result := false; + C := ColorToRGB(Color); + if FColorCombs = nil then CalculateCombLayout; + FCustomIndex := 0; + FSelectedIndex := NoCell; + for I := 0 to High(FBWCombs) do + if FBWCombs[I].Color = C then + begin + FSelectedIndex := CustomCell; + FCustomIndex := -(I + 1); + found := True; + Result := true; + Break; + end; + if not found then + for I := 0 to High(FColorCombs) do + if FColorCombs[I].Color = C then + begin + FSelectedIndex := CustomCell; + FCustomIndex := I + 1; + //found := true; + Result := true; + Break; + end; + {if not found then // calculate & set intensity if not found + begin + SC := TRGBrecFromTColor(Color); + intens := SC.Red/DefCenterColor.Red; + //SetIntensity(Round(intens * 100)); // EStackOverflow + //SelectAvailableColor(Color); + end;} +end; + +procedure THexaColorPicker.SelectColor(Color: TColor); +begin + SelectAvailableColor(Color); + DrawCombControls; + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure THexaColorPicker.SetSliderVisible(Value: boolean); +begin + if FSliderVisible <> Value then + begin + FSliderVisible := Value; + DrawAll; + CalculateCombLayout; + DrawCombControls; + Invalidate; + end; +end; + +procedure THexaColorPicker.SetMarker(Value: TMarker); +begin + if FMarker <> Value then + begin + FMarker := Value; + DrawAll; + CalculateCombLayout; + DrawCombControls; + Invalidate; + end; +end; + +procedure THexaColorPicker.SetNewArrowStyle(Value: boolean); +begin + if FNewArrowStyle <> Value then + begin + FNewArrowStyle := Value; + DrawAll; + CalculateCombLayout; + DrawCombControls; + Invalidate; + end; +end; + +end. diff --git a/components/mbColorLib/KColorPicker.dcr b/components/mbColorLib/KColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..90c463530d6dd23985dd1c617fa0c45bfc91afd9 GIT binary patch literal 1856 zcmb`GF$%&!5JkThBBW5PL@X>*3O05YVj&R}5j=pmu=W5Rzyo*yd+oh|MGoKr(yyaq zhE=Ee;3E_MhW#&_A^^~n2|-8V2lpB<lqVrnu|kG1=9tMWvA|ST877jIezQ|A%c+F+ zdn&I4T*TE%bjp3<`R0FKIgfh)UX#0?8;|R`^0=NekLx+{xSk`A>pAeao;{E2+3~oZ zEzg%nf3<=~i)NFh<PDFsw5ux3Yo1?^sQAw+q$TKK>^|bLZX5<YaouvtW8FA(dE&a| T29I^)knqHH%e*GB?jOSg%>KS= literal 0 HcmV?d00001 diff --git a/components/mbColorLib/KColorPicker.pas b/components/mbColorLib/KColorPicker.pas new file mode 100644 index 000000000..d22757377 --- /dev/null +++ b/components/mbColorLib/KColorPicker.pas @@ -0,0 +1,290 @@ +unit KColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TKColorPicker = class(TmbTrackBarPicker) + private + FCyan, FMagenta, FYellow, FBlack: integer; + FKBmp: TBitmap; + + function ArrowPosFromBlack(k: integer): integer; + function BlackFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateKGradient; + procedure SetCyan(c: integer); + procedure SetMagenta(m: integer); + procedure SetYellow(y: integer); + procedure SetBlack(k: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + 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; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R KColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TKColorPicker]); +end; + +{TKColorPicker} + +constructor TKColorPicker.Create(AOwner: TComponent); +begin + inherited; + FKBmp := TBitmap.Create; + FKBmp.PixelFormat := pf32bit; + FKBmp.SetSize(12, 255); + Width := 22; + Height := 267; + Layout := lyVertical; + FCyan := 0; + FMagenta := 0; + FYellow := 0; + FBlack := 255; + FArrowPos := ArrowPosFromBlack(255); + FChange := false; + SetBlack(255); + HintFormat := 'Black: %value'; + FManual := false; + FChange := true; +end; + +destructor TKColorPicker.Destroy; +begin + FKBmp.Free; + inherited Destroy; +end; + +procedure TKColorPicker.CreateWnd; +begin + inherited; + CreateKGradient; +end; + +procedure TKColorPicker.CreateKGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FKBmp = nil then + begin + FKBmp := TBitmap.Create; + FKBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FKBmp.width := 255; + FKBmp.height := 12; + for i := 0 to 254 do + for j := 0 to 11 do + begin + row := FKBmp.ScanLine[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, FYellow, i)) +// FKBmp.Canvas.Pixels[i, j] := CMYKtoTColor(FCyan, FMagenta, FYellow, i) + else + row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, i))); +// FKBmp.Canvas.Pixels[i, j] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, i)); + end; + end + else + begin + FKBmp.width := 12; + FKBmp.height := 255; + for i := 0 to 254 do + begin + row := FKBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i)) +// FKBmp.Canvas.Pixels[j, i] := CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i) + else + row[j] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i))); +// FKBmp.Canvas.Pixels[j, i] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, 255-i)); + end; + end; +end; + +procedure TKColorPicker.SetBlack(k: integer); +begin + if k < 0 then k := 0; + if k > 255 then k := 255; + if FBlack <> k then + begin + FBlack := k; + FArrowPos := ArrowPosFromBlack(k); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TKColorPicker.SetMagenta(m: integer); +begin + if m > 255 then m := 255; + if m < 0 then m := 0; + if FMagenta <> m then + begin + FMagenta := m; + FManual := false; + CreateKGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TKColorPicker.SetYellow(y: integer); +begin + if y > 255 then y := 255; + if y < 0 then y := 0; + if FYellow <> y then + begin + FYellow := y; + FManual := false; + CreateKGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TKColorPicker.SetCyan(c: integer); +begin + if c > 255 then c := 255; + if c < 0 then c := 0; + if FCyan <> c then + begin + FCyan := c; + FManual := false; + CreateKGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TKColorPicker.ArrowPosFromBlack(k: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*k); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + k := 255 - k; + a := Round(((Height - 12)/255)*k); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TKColorPicker.BlackFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +function TKColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) + else + Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); +end; + +function TKColorPicker.GetSelectedValue: integer; +begin + Result := FBlack; +end; + +procedure TKColorPicker.SetSelectedColor(c: TColor); +var + cy, m, y, k: integer; +begin + if WebSafe then c := GetWebSafe(c); + ColorToCMYK(c, cy, m, y, k); + FChange := false; + SetMagenta(m); + SetYellow(y); + SetCyan(cy); + SetBlack(k); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +function TKColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromBlack(FBlack); +end; + +procedure TKColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetBlack(FBlack); + TBA_Paint: Canvas.StretchDraw(FPickRect, FKBmp); + TBA_MouseMove: FBlack := BlackFromArrowPos(FArrowPos); + TBA_MouseDown: FBlack := BlackFromArrowPos(FArrowPos); + TBA_MouseUp: FBlack := BlackFromArrowPos(FArrowPos); + TBA_WheelUp: SetBlack(FBlack + Increment); + TBA_WheelDown: SetBlack(FBlack - Increment); + TBA_VKRight: SetBlack(FBlack + Increment); + TBA_VKCtrlRight: SetBlack(255); + TBA_VKLeft: SetBlack(FBlack - Increment); + TBA_VKCtrlLeft: SetBlack(0); + TBA_VKUp: SetBlack(FBlack + Increment); + TBA_VKCtrlUp: SetBlack(255); + TBA_VKDown: SetBlack(FBlack - Increment); + TBA_VKCtrlDown: SetBlack(0); + TBA_RedoBMP: CreateKGradient; + end; +end; + +end. diff --git a/components/mbColorLib/LColorPicker.dcr b/components/mbColorLib/LColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..f1f30be32c7c5b1280b00cb29d6f906aac5a342b GIT binary patch literal 1856 zcmd6mF%E)25JkThhSJhlNvEBq)W*VSf+605Yj6av!5yqP2DKeW7zbB3IR0d_g^8QD z<j>^qUzV@{u+k~wrpk|Tp8-4Vh)i+C8GGdV%u(QiqgE#zRJ*aAFO&D;wTi`SPM!+5 zX_g%_?EKdN8%peJ0~sYgN53~AKBoi-@i`Shh|j43LVQjG5aM%MfM9a;hc+Ek0v%;+ zbGKsL`PRce4Da+;%Xg?q5}`P=4+)+tO@-n&^-;b<MV1L=Y<5xO&bKZKp%`cITxBT~ tlM^hfN+`jF#!%NnF}7gYG(rh3G={bnim?UDt`kadp)vHmP>k(I<pT+x^(FuS literal 0 HcmV?d00001 diff --git a/components/mbColorLib/LColorPicker.pas b/components/mbColorLib/LColorPicker.pas new file mode 100644 index 000000000..6de4e5d33 --- /dev/null +++ b/components/mbColorLib/LColorPicker.pas @@ -0,0 +1,270 @@ +unit LColorPicker; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBHSLUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TLColorPicker = class(TmbTrackBarPicker) + private + FHue, FSat, FLuminance: integer; + FLBmp: TBitmap; + + function ArrowPosFromLum(l: integer): integer; + function LumFromArrowPos(p: integer): integer; + procedure CreateLGradient; + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetLuminance(l: integer); + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 240; + property Luminance: integer read FLuminance write SetLuminance default 120; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Layout default lyVertical; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R LColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TLColorPicker]); +end; + +{TLColorPicker} + +constructor TLColorPicker.Create(AOwner: TComponent); +begin + inherited; + FLBmp := TBitmap.Create; + FLBmp.PixelFormat := pf32bit; + Width := 22; + Height := 252; + Layout := lyVertical; + FHue := 0; + FSat := MaxSat; + FArrowPos := ArrowPosFromLum(MaxLum div 2); + Fchange := false; + SetLuminance(MaxLum div 2); + HintFormat := 'Luminance: %value'; + FManual := false; + FChange := true; +end; + +destructor TLColorPicker.Destroy; +begin + FLBmp.Free; + inherited Destroy; +end; + +procedure TLColorPicker.CreateWnd; +begin + inherited; + CreateLGradient; +end; + +procedure TLColorPicker.CreateLGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FLBmp = nil then + begin + FLBmp := TBitmap.Create; + FLBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FLBmp.width := MaxLum; + FLBmp.height := 12; + for i := 0 to MaxLum - 1 do + for j := 0 to 11 do + begin + row := FLBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(HSLRangeToRGB(FHue, FSat, i)) +// FLBmp.Canvas.Pixels[i, j] := HSLRangeToRGB(FHue, FSat, i) + else + row[i] := RGBToRGBQuad(GetWebSafe(HSLRangeToRGB(FHue, FSat, i))); +// FLBmp.Canvas.Pixels[i, j] := GetWebSafe(HSLRangeToRGB(FHue, FSat, i)); + end; + end + else + begin + FLBmp.width := 12; + FLBmp.height := MaxLum; + for i := 0 to MaxLum - 1 do + begin + row := FLBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBToRGBQuad(HSLRangeToRGB(FHue, FSat, MaxLum - i)) +// FLBmp.Canvas.Pixels[j, i] := HSLRangeToRGB(FHue, FSat, MaxLum - i) + else + row[j] := RGBToRGBQuad(GetWebSafe(HSLRangeToRGB(FHue, FSat, MaxLum - i))); +// FLBmp.Canvas.Pixels[j, i] := GetWebSafe(HSLRangeToRGB(FHue, FSat, MaxLum - i)); + end; + end; +end; + +procedure TLColorPicker.SetHue(h: integer); +begin + if h > MaxHue then h := MaxHue; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + FManual := false; + CreateLGradient; + Invalidate; + if Fchange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TLColorPicker.SetSat(s: integer); +begin + if s > MaxSat then s := MaxSat; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + CreateLGradient; + Invalidate; + if Fchange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TLColorPicker.ArrowPosFromLum(l: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/MaxLum)*l); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + l := MaxLum - l; + a := Round(((Height - 12)/MaxLum)*l); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TLColorPicker.LumFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/MaxLum)) + else + r := Round(MaxLum - p/((Height - 12)/MaxLum)); + if r < 0 then r := 0; + if r > MaxLum then r := MaxLum; + Result := r; +end; + +procedure TLColorPicker.SetLuminance(l: integer); +begin + if l < 0 then l := 0; + if l > MaxLum then l := MaxLum; + if FLuminance <> l then + begin + FLuminance := l; + FArrowPos := ArrowPosFromLum(l); + FManual := false; + Invalidate; + if Fchange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TLColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := HSLRangeToRGB(FHue, FSat, FLuminance) + else + Result := GetWebSafe(HSLRangeToRGB(FHue, FSat, FLuminance)); +end; + +function TLColorPicker.GetSelectedValue: integer; +begin + Result := FLuminance; +end; + +procedure TLColorPicker.SetSelectedColor(c: TColor); +var + h1, s1, l1: integer; +begin + if WebSafe then c := GetWebSafe(c); + RGBtoHSLRange(c, h1, s1, l1); + Fchange := false; + SetHue(h1); + SetSat(s1); + SetLuminance(l1); + Fchange := true; + FManual := false; + if Fchange then + if Assigned(OnChange) then OnChange(Self); +end; + +function TLColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromLum(FLuminance); +end; + +procedure TLColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetLuminance(FLuminance); + TBA_Paint: Canvas.StretchDraw(FPickRect, FLBmp); + TBA_MouseMove: FLuminance := LumFromArrowPos(FArrowPos); + TBA_MouseDown: Fluminance := LumFromArrowPos(FArrowPos); + TBA_MouseUp: Fluminance := LumFromArrowPos(FArrowPos); + TBA_WheelUp: SetLuminance(FLuminance + Increment); + TBA_WheelDown: SetLuminance(FLuminance - Increment); + TBA_VKRight: SetLuminance(FLuminance + Increment); + TBA_VKCtrlRight: SetLuminance(MaxLum); + TBA_VKLeft: SetLuminance(FLuminance - Increment); + TBA_VKCtrlLeft: SetLuminance(0); + TBA_VKUp: SetLuminance(FLuminance + Increment); + TBA_VKCtrlUp: SetLuminance(MaxLum); + TBA_VKDown: SetLuminance(FLuminance - Increment); + TBA_VKCtrlDown: SetLuminance(0); + TBA_RedoBMP: CreateLGradient; + end; +end; + +end. diff --git a/components/mbColorLib/MColorPicker.dcr b/components/mbColorLib/MColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..8f04d4602cc45b250cc4f272bb3058a18d68a81c GIT binary patch literal 1856 zcmdUuJxYT?5QbkZL`Wk6L9AkD6G-{>NeWSkNJ<ajEz;Y2fE*wPNS7vk4v+%`YpowA z-%lWB2)<zB@C?i@yAQJqBT1b|s4~jE*qlj4?7*qUdQ@K{Jw!h1Nq4cj*D&fTdKcH{ z&E?xDuIfA~D`^p~cB{(fT$ukBKKaQP93^dl4KBH74JNr~1tz&?2`0H`4ko#01}3>@ z3MRSd9ZYi18<^yt378ys%3=GET<Rg+O=zs))u!xcd$*zVynspO@gEhRP{*#HZNb2% ddCtD40F&I)1(V!!117oW5={PuCvEcgo8N5IG?)MY literal 0 HcmV?d00001 diff --git a/components/mbColorLib/MColorPicker.pas b/components/mbColorLib/MColorPicker.pas new file mode 100644 index 000000000..ff9528b4f --- /dev/null +++ b/components/mbColorLib/MColorPicker.pas @@ -0,0 +1,290 @@ +unit MColorPicker; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TMColorPicker = class(TmbTrackBarPicker) + private + FCyan, FMagenta, FYellow, FBlack: integer; + FMBmp: TBitmap; + + function ArrowPosFromMagenta(m: integer): integer; + function MagentaFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateMGradient; + procedure SetCyan(c: integer); + procedure SetMagenta(m: integer); + procedure SetYellow(y: integer); + procedure SetBlack(k: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Cyan: integer read FCyan write SetCyan default 0; + property Magenta: integer read FMagenta write SetMagenta default 255; + 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; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R MColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TMColorPicker]); +end; + +{TMColorPicker} + +constructor TMColorPicker.Create(AOwner: TComponent); +begin + inherited; + FMBmp := TBitmap.Create; + FMBmp.PixelFormat := pf32bit; + FMBmp.SetSize(12, 255); + Width := 22; + Height := 267; + Layout := lyVertical; + FCyan := 0; + FMagenta := 255; + FYellow := 0; + FBlack := 0; + FArrowPos := ArrowPosFromMagenta(255); + FChange := false; + SetMagenta(255); + HintFormat := 'Magenta: %value'; + FManual := false; + FChange := true; +end; + +destructor TMColorPicker.Destroy; +begin + FMBmp.Free; + inherited Destroy; +end; + +procedure TMColorPicker.CreateWnd; +begin + inherited; + CreateMGradient; +end; + +procedure TMColorPicker.CreateMGradient; + var + i,j: integer; + row: pRGBQuadArray; +begin + if FMBmp = nil then + begin + FMBmp := TBitmap.Create; + FMBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FMBmp.width := 255; + FMBmp.height := 12; + for i := 0 to 254 do + for j := 0 to 11 do + begin + row := FMBmp.ScanLine[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(CMYKtoTColor(FCyan, i, FYellow, FBlack)) +// FMBmp.Canvas.Pixels[i, j] := CMYKtoTColor(FCyan, i, FYellow, FBlack) + else + row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, i, FYellow, FBlack))); +// FMBmp.Canvas.Pixels[i, j] := GetWebSafe(CMYKtoTColor(FCyan, i, FYellow, FBlack)); + end; + end + else + begin + FMBmp.width := 12; + FMBmp.height := 255; + for i := 0 to 254 do + begin + row := FMBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBToRGBQuad(CMYKtoTColor(FCyan, 255-i, FYellow, FBlack)) +// FMBmp.Canvas.Pixels[j, i] := CMYKtoTColor(FCyan, 255-i, FYellow, FBlack) + else + row[j] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, 255-i, FYellow, FBlack))); +// FMBmp.Canvas.Pixels[j, i] := GetWebSafe(CMYKtoTColor(FCyan, 255-i, FYellow, FBlack)); + end; + end; +end; + +procedure TMColorPicker.SetMagenta(m: integer); +begin + if M < 0 then M := 0; + if M > 255 then M := 255; + if FMagenta <> m then + begin + FMagenta := m; + FArrowPos := ArrowPosFromMagenta(m); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TMColorPicker.SetCyan(c: integer); +begin + if c > 255 then c := 255; + if c < 0 then c := 0; + if FCyan <> c then + begin + FCyan := c; + FManual := false; + CreateMGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TMColorPicker.SetYellow(y: integer); +begin + if y > 255 then y := 255; + if y < 0 then y := 0; + if FYellow <> y then + begin + FYellow := y; + FManual := false; + CreateMGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TMColorPicker.SetBlack(k: integer); +begin + if k > 255 then k := 255; + if k < 0 then k := 0; + if FBlack <> k then + begin + FBlack := k; + FManual := false; + CreateMGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TMColorPicker.ArrowPosFromMagenta(m: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*m); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + m := 255 - m; + a := Round(((Height - 12)/255)*m); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TMColorPicker.MagentaFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +function TMColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) + else + Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); +end; + +function TMColorPicker.GetSelectedValue: integer; +begin + Result := FMagenta; +end; + +procedure TMColorPicker.SetSelectedColor(c: TColor); +var + cy, m, y, k: integer; +begin + if WebSafe then c := GetWebSafe(c); + ColorToCMYK(c, cy, m, y, k); + FChange := false; + SetCyan(cy); + SetYellow(y); + SetBlack(k); + SetMagenta(m); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +function TMColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromMagenta(FMagenta); +end; + +procedure TMColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetMagenta(FMagenta); + TBA_Paint: Canvas.StretchDraw(FPickRect, FMBmp); + TBA_MouseMove: FMagenta := MagentaFromArrowPos(FArrowPos); + TBA_MouseDown: FMagenta := MagentaFromArrowPos(FArrowPos); + TBA_MouseUp: FMagenta := MagentaFromArrowPos(FArrowPos); + TBA_WheelUp: SetMagenta(FMagenta + Increment); + TBA_WheelDown: SetMagenta(FMagenta - Increment); + TBA_VKRight: SetMagenta(FMagenta + Increment); + TBA_VKCtrlRight: SetMagenta(255); + TBA_VKLeft: SetMagenta(FMagenta - Increment); + TBA_VKCtrlLeft: SetMagenta(0); + TBA_VKUp: SetMagenta(FMagenta + Increment); + TBA_VKCtrlUp: SetMagenta(255); + TBA_VKDown: SetMagenta(FMagenta - Increment); + TBA_VKCtrlDown: SetMagenta(0); + TBA_RedoBMP: CreateMGradient; + end; +end; + +end. diff --git a/components/mbColorLib/OfficeMoreColorsDialog.dfm b/components/mbColorLib/OfficeMoreColorsDialog.dfm new file mode 100644 index 000000000..5ec10d554 --- /dev/null +++ b/components/mbColorLib/OfficeMoreColorsDialog.dfm @@ -0,0 +1,204 @@ +object OfficeMoreColorsWin: TOfficeMoreColorsWin + Left = 194 + Top = 112 + Width = 331 + Height = 358 + ActiveControl = OKbtn + BorderIcons = [biSystemMenu] + Caption = 'More colors...' + Color = clBtnFace + Constraints.MinHeight = 358 + Constraints.MinWidth = 331 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + OnCreate = FormCreate + OnKeyDown = FormKeyDown + OnResize = FormResize + DesignSize = ( + 315 + 319) + PixelsPerInch = 96 + TextHeight = 13 + object Label4: TLabel + Left = 268 + Top = 218 + Width = 21 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'New' + Transparent = True + end + object Label5: TLabel + Left = 260 + Top = 306 + Width = 37 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'Current' + Transparent = True + end + object Pages: TPageControl + Left = 6 + Top = 6 + Width = 227 + Height = 316 + ActivePage = Standard + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + OnChange = PagesChange + object Standard: TTabSheet + Caption = 'Standard' + DesignSize = ( + 219 + 288) + object Label2: TLabel + Left = 6 + Top = 7 + Width = 34 + Height = 13 + Caption = '&Colors:' + FocusControl = Hexa + Transparent = True + end + object Hexa: THexaColorPicker + Left = 6 + Top = 26 + Width = 209 + Height = 207 + Anchors = [akLeft, akTop, akRight, akBottom] + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + IntensityText = 'Intensity' + TabOrder = 0 + Constraints.MinHeight = 85 + Constraints.MinWidth = 93 + OnChange = HexaChange + end + end + object Custom: TTabSheet + Caption = 'Custom' + ImageIndex = 1 + DesignSize = ( + 219 + 288) + object Label1: TLabel + Left = 6 + Top = 7 + Width = 34 + Height = 13 + Caption = '&Colors:' + FocusControl = HSL + end + object Label3: TLabel + Left = 6 + Top = 178 + Width = 60 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Color mo&del:' + FocusControl = ColorModel + end + object LRed: TLabel + Left = 6 + Top = 204 + Width = 23 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = '&Red:' + end + object LGreen: TLabel + Left = 6 + Top = 230 + Width = 33 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = '&Green:' + end + object LBlue: TLabel + Left = 6 + Top = 256 + Width = 24 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = '&Blue:' + end + object HSL: THSLColorPicker + Left = 6 + Top = 20 + Width = 211 + Height = 152 + HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' + LPickerHintFormat = 'Luminance: %l' + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + OnChange = HSLChange + DesignSize = ( + 211 + 152) + end + object ColorModel: TComboBox + Left = 74 + Top = 172 + Width = 92 + Height = 21 + Style = csDropDownList + Anchors = [akLeft, akBottom] + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 1 + Text = 'RGB' + OnChange = ColorModelChange + Items.Strings = ( + 'RGB' + 'HSL') + end + end + end + object OKbtn: TButton + Left = 242 + Top = 6 + Width = 73 + Height = 23 + Anchors = [akTop, akRight] + Caption = 'OK' + ModalResult = 1 + TabOrder = 1 + end + object Cancelbtn: TButton + Left = 242 + Top = 36 + Width = 73 + Height = 23 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object NewSwatch: TmbColorPreview + Left = 246 + Top = 238 + Width = 68 + Height = 32 + Hint = 'RGB(255, 255, 255)' + Anchors = [akRight, akBottom] + ShowHint = True + ParentShowHint = False + OnColorChange = NewSwatchColorChange + end + object OldSwatch: TmbColorPreview + Left = 246 + Top = 269 + Width = 68 + Height = 32 + Hint = 'RGB(255, 255, 255)'#13#10'Hex: FFFFFF' + Anchors = [akRight, akBottom] + ShowHint = True + ParentShowHint = False + OnColorChange = OldSwatchColorChange + end +end diff --git a/components/mbColorLib/OfficeMoreColorsDialog.lfm b/components/mbColorLib/OfficeMoreColorsDialog.lfm new file mode 100644 index 000000000..5ec10d554 --- /dev/null +++ b/components/mbColorLib/OfficeMoreColorsDialog.lfm @@ -0,0 +1,204 @@ +object OfficeMoreColorsWin: TOfficeMoreColorsWin + Left = 194 + Top = 112 + Width = 331 + Height = 358 + ActiveControl = OKbtn + BorderIcons = [biSystemMenu] + Caption = 'More colors...' + Color = clBtnFace + Constraints.MinHeight = 358 + Constraints.MinWidth = 331 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + OnCreate = FormCreate + OnKeyDown = FormKeyDown + OnResize = FormResize + DesignSize = ( + 315 + 319) + PixelsPerInch = 96 + TextHeight = 13 + object Label4: TLabel + Left = 268 + Top = 218 + Width = 21 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'New' + Transparent = True + end + object Label5: TLabel + Left = 260 + Top = 306 + Width = 37 + Height = 13 + Anchors = [akRight, akBottom] + Caption = 'Current' + Transparent = True + end + object Pages: TPageControl + Left = 6 + Top = 6 + Width = 227 + Height = 316 + ActivePage = Standard + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + OnChange = PagesChange + object Standard: TTabSheet + Caption = 'Standard' + DesignSize = ( + 219 + 288) + object Label2: TLabel + Left = 6 + Top = 7 + Width = 34 + Height = 13 + Caption = '&Colors:' + FocusControl = Hexa + Transparent = True + end + object Hexa: THexaColorPicker + Left = 6 + Top = 26 + Width = 209 + Height = 207 + Anchors = [akLeft, akTop, akRight, akBottom] + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + IntensityText = 'Intensity' + TabOrder = 0 + Constraints.MinHeight = 85 + Constraints.MinWidth = 93 + OnChange = HexaChange + end + end + object Custom: TTabSheet + Caption = 'Custom' + ImageIndex = 1 + DesignSize = ( + 219 + 288) + object Label1: TLabel + Left = 6 + Top = 7 + Width = 34 + Height = 13 + Caption = '&Colors:' + FocusControl = HSL + end + object Label3: TLabel + Left = 6 + Top = 178 + Width = 60 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Color mo&del:' + FocusControl = ColorModel + end + object LRed: TLabel + Left = 6 + Top = 204 + Width = 23 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = '&Red:' + end + object LGreen: TLabel + Left = 6 + Top = 230 + Width = 33 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = '&Green:' + end + object LBlue: TLabel + Left = 6 + Top = 256 + Width = 24 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = '&Blue:' + end + object HSL: THSLColorPicker + Left = 6 + Top = 20 + Width = 211 + Height = 152 + HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' + LPickerHintFormat = 'Luminance: %l' + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + OnChange = HSLChange + DesignSize = ( + 211 + 152) + end + object ColorModel: TComboBox + Left = 74 + Top = 172 + Width = 92 + Height = 21 + Style = csDropDownList + Anchors = [akLeft, akBottom] + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 1 + Text = 'RGB' + OnChange = ColorModelChange + Items.Strings = ( + 'RGB' + 'HSL') + end + end + end + object OKbtn: TButton + Left = 242 + Top = 6 + Width = 73 + Height = 23 + Anchors = [akTop, akRight] + Caption = 'OK' + ModalResult = 1 + TabOrder = 1 + end + object Cancelbtn: TButton + Left = 242 + Top = 36 + Width = 73 + Height = 23 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object NewSwatch: TmbColorPreview + Left = 246 + Top = 238 + Width = 68 + Height = 32 + Hint = 'RGB(255, 255, 255)' + Anchors = [akRight, akBottom] + ShowHint = True + ParentShowHint = False + OnColorChange = NewSwatchColorChange + end + object OldSwatch: TmbColorPreview + Left = 246 + Top = 269 + Width = 68 + Height = 32 + Hint = 'RGB(255, 255, 255)'#13#10'Hex: FFFFFF' + Anchors = [akRight, akBottom] + ShowHint = True + ParentShowHint = False + OnColorChange = OldSwatchColorChange + end +end diff --git a/components/mbColorLib/OfficeMoreColorsDialog.pas b/components/mbColorLib/OfficeMoreColorsDialog.pas new file mode 100644 index 000000000..f7e85d435 --- /dev/null +++ b/components/mbColorLib/OfficeMoreColorsDialog.pas @@ -0,0 +1,340 @@ +unit OfficeMoreColorsDialog; + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, {$IFDEF DELPHI_6_UP}Variants,{$ENDIF} Classes, Graphics, Controls, + Forms, StdCtrls, ExtCtrls, ComCtrls, + HexaColorPicker, HSLColorPicker, RGBHSLUtils, + mbColorPreview, {$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF} + HTMLColors; + +type + TOfficeMoreColorsWin = class(TForm) + Pages: TPageControl; + Standard: TTabSheet; + Custom: TTabSheet; + Hexa: THexaColorPicker; + HSL: THSLColorPicker; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ColorModel: TComboBox; + LRed: TLabel; + LGreen: TLabel; + LBlue: TLabel; + Label4: TLabel; + Label5: TLabel; + OKbtn: TButton; + Cancelbtn: TButton; + NewSwatch: TmbColorPreview; + OldSwatch: TmbColorPreview; + procedure ColorModelChange(Sender: TObject); + procedure HSLChange(Sender: TObject); + procedure ERedChange(Sender: TObject); + procedure EGreenChange(Sender: TObject); + procedure EBlueChange(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure HexaChange(Sender: TObject); + procedure NewSwatchColorChange(Sender: TObject); + procedure OldSwatchColorChange(Sender: TObject); + function GetHint(c: TColor): string; + procedure SetAllToSel(c: TColor); + procedure PagesChange(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure FormCreate(Sender: TObject); + protected + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + end; + +var + OfficeMoreColorsWin: TOfficeMoreColorsWin; + h, s, l: integer; + {$IFDEF mbXP_Lib} + ERed, EGreen, EBlue: TmbXPSpinEdit; + grip: TmbXPSizeGrip; + {$ELSE} + ERed, EGreen, EBlue: TSpinEdit; + {$ENDIF} + +implementation + +{$IFDEF DELPHI} + {$R *.dfm} +{$ELSE} + {$R *.lfm} +{$ENDIF} + +procedure TOfficeMoreColorsWin.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + Params.Style := WS_CAPTION or WS_SIZEBOX or WS_SYSMENU; + Params.ExStyle := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE; +end; + +procedure TOfficeMoreColorsWin.CreateWnd; +begin + inherited CreateWnd; + { wp : LM_SETICON not used in LCL } + // SendMessage(Self.Handle, {$IFDEF FPC}LM_SETICON{$ELSE}WM_SETICON{$ENDIF}, 1, 0); +end; + +procedure TOfficeMoreColorsWin.ColorModelChange(Sender: TObject); +begin + case ColorModel.ItemIndex of + 0: + begin + LRed.Caption := '&Red:'; + LGreen.Caption := '&Green:'; + LBlue.Caption := '&Blue:'; + ERed.MaxValue := 255; + EGreen.MaxValue := 255; + EBlue.MaxValue := 255; + ERed.Value := GetRValue(NewSwatch.Color); + EGreen.Value := GetGValue(NewSwatch.Color); + EBlue.Value := GetBValue(NewSwatch.Color); + end; + 1: + begin + LRed.Caption := 'H&ue:'; + LGreen.Caption := '&Sat:'; + LBlue.Caption := '&Lum:'; + ERed.MaxValue := 238; + EGreen.MaxValue := 240; + EBlue.MaxValue := 240; + RGBtoHSLRange(NewSwatch.Color, h, s, l); + ERed.Value := h; + EGreen.Value := s; + EBlue.Value := l; + end; + end; +end; + +procedure TOfficeMoreColorsWin.HSLChange(Sender: TObject); +begin + if HSL.Manual then + case ColorModel.ItemIndex of + 0: + begin + ERed.Value := HSL.RValue; + EGreen.Value := HSL.GValue; + EBlue.Value := HSL.BValue; + NewSwatch.Color := HSL.SelectedColor; + end; + 1: + begin + ERed.Value := HSL.HValue; + EGreen.Value := HSL.SValue; + EBlue.Value := HSL.LValue; + NewSwatch.Color := HSL.SelectedColor; + end; + end; +end; + +procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject); +begin + if (ERed.Text <> '') and + (ERed.Focused {$IFDEF DELPHI} or ERed.Button.Focused{$ENDIF}) + then + case ColorModel.ItemIndex of + 0: begin + HSL.RValue := ERed.Value; + NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); + end; + 1: begin + HSL.HValue := ERed.Value; + NewSwatch.Color := HSLRangeToRGB(ERed.Value, EGreen.Value, EBlue.Value); + end; + end; +end; + +procedure TOfficeMoreColorsWin.EGreenChange(Sender: TObject); +begin + if (EGreen.Text <> '') and + (EGreen.Focused {$IFDEF DELPHI}or EGreen.Button.Focused{$ENDIF}) + then + case ColorModel.ItemIndex of + 0: begin + HSL.GValue := EGreen.Value; + NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); + end; + 1: begin + HSL.SValue := EGreen.Value; + NewSwatch.Color := HSLRangeToRGB(ERed.Value, EGreen.Value, EBlue.Value); + end; + end; +end; + +procedure TOfficeMoreColorsWin.EBlueChange(Sender: TObject); +begin + if (EBlue.Text <> '') and + (EBlue.Focused {$IFDEF DELPHI} or EBlue.Button.Focused{$ENDIF}) + then + case ColorModel.ItemIndex of + 0: begin + HSL.BValue := EBlue.Value; + NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); + end; + 1: begin + HSL.LValue := EBlue.Value; + NewSwatch.Color := HSLRangeToRGB(ERed.Value, EGreen.Value, EBlue.Value); + end; + end; +end; + +procedure TOfficeMoreColorsWin.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + case Key of + VK_RETURN: ModalResult := mrOK; + VK_ESCAPE: ModalResult := mrCancel; + end; +end; + +procedure TOfficeMoreColorsWin.HexaChange(Sender: TObject); +begin + NewSwatch.Color := Hexa.SelectedColor; +end; + +function TOfficeMoreColorsWin.GetHint(c: TColor): string; +begin + Result := Format('RGB(%u, %u, %u)'#13'Hex: %s', [GetRValue(c), GetGValue(c), GetBValue(c), ColorToHex(c)]); +end; + +procedure TOfficeMoreColorsWin.NewSwatchColorChange(Sender: TObject); +begin + NewSwatch.Hint := GetHint(NewSwatch.Color); +end; + +procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject); +begin + OldSwatch.Hint := GetHint(OldSwatch.Color); + SetAllToSel(OldSwatch.Color); +end; + +procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor); +begin + case Pages.ActivePageIndex of + // Standard Page + 0: Hexa.SelectedColor := c; + // Custom Page + 1: + begin + HSL.SelectedColor := c; + case ColorModel.ItemIndex of + 0: + begin + ERed.Value := GetRValue(c); + EGreen.Value := GetGValue(c); + EBlue.Value := GetBValue(c); + end; + 1: + begin + RGBtoHSLRange(c, h, s, l); + ERed.Value := h; + EGreen.Value := s; + EBlue.Value := l; + end; + end; + end; + end; + NewSwatch.Color := c; +end; + +procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject); +begin + SetAllToSel(NewSwatch.Color); +end; + +procedure TOfficeMoreColorsWin.FormResize(Sender: TObject); +begin +{$IFDEF mbXP_Lib} +grip.Left := ClientWidth - 15; +grip.Top := ClientHeight - 15; +{$ENDIF} +end; + +procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject); +begin + {$IFDEF mbXP_Lib} + ERed := TmbXPSpinEdit.CreateParented(Custom.Handle); + EGreen := TmbXPSpinEdit.CreateParented(Custom.Handle); + EBlue := TmbXPSpinEdit.CreateParented(Custom.Handle); + grip := TmbXPSizeGrip.CreateParented(Self.Handle); + {$ELSE} + ERed := TSpinEdit.CreateParented(Custom.Handle); + EGreen := TSpinEdit.CreateParented(Custom.Handle); + EBlue := TSpinEdit.CreateParented(Custom.Handle); + {$ENDIF} + with ERed do + begin + Name := 'ERed'; + Width := 47; + Height := 22; + Left := 74; + Top := 198; + Anchors := [akLeft, akBottom]; + MaxValue := 255; + MinValue := 0; + Value := 0; + { to do + OnChange := ERedChange; + } + end; + with EGreen do + begin + Name := 'EGreen'; + Width := 47; + Height := 22; + Left := 74; + Top := 224; + Anchors := [akLeft, akBottom]; + MaxValue := 255; + MinValue := 0; + Value := 0; + { to do + OnChange := EGreenChange; + } + end; + with EBlue do + begin + Name := 'EBlue'; + Width := 47; + Height := 22; + Left := 74; + Top := 251; + Anchors := [akLeft, akBottom]; + MaxValue := 255; + MinValue := 0; + Value := 0; + { to do + OnChange := EBlueChange; + } + end; + Custom.InsertControl(ERed); + Custom.InsertControl(EGreen); + Custom.InsertControl(EBlue); + {$IFDEF mbXP_Lib} + with grip do + begin + Name := 'grip'; + Width := 15; + Height := 15; + Left := 308; + Top := 314; + Anchors := [akRight, akBottom]; + end; + InsertControl(grip); + {$ENDIF} +end; + +end. diff --git a/components/mbColorLib/PalUtils.pas b/components/mbColorLib/PalUtils.pas new file mode 100644 index 000000000..e6c22bc1e --- /dev/null +++ b/components/mbColorLib/PalUtils.pas @@ -0,0 +1,706 @@ +unit PalUtils; + +interface + +uses + LCLType, LCLIntf, SysUtils, Classes, Graphics, + RGBHSVUtils, RGBHSLUtils, RGBCIEUtils, RGBCMYKUtils, + HTMLColors; + +const + clCustom = $2FFFFFFF; + clTransparent = $3FFFFFFF; + +type + TSortOrder = (soAscending, soDescending); + TSortMode = (smRed, smGreen, smBlue, smHue, smSaturation, smLuminance, smValue, smNone, smCyan, smMagenta, smYellow, smBlacK, smCIEx, smCIEy, smCIEz, smCIEl, smCIEa, smCIEb); + + AcoColors = record + Colors: array of TColor; + Names: array of WideString; + HasNames: boolean; + end; + +//replaces passed strings with passed value +function ReplaceFlags(s: string; flags: array of string; value: integer): string; +//replaces the appropriate tags with values in a hint format string +function FormatHint(fmt: string; c: TColor): string; +//converts a string value to TColor including clCustom and clTransparent +function mbStringToColor(s: string): TColor; +//converts a TColor to a string value including clCustom and clTransparent +function mbColorToString(c: TColor): string; +//blends two colors together in proportion C1 : C2 = W1 : 100 - W1, where 0 <= W1 <= 100 +function Blend(C1, C2: TColor; W1: Integer): TColor; +//generates a white-color-black or a black-color-white gradient palette +function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string; +//generates a gradient palette from the given colors +function MakeGradientPalette(Colors: array of TColor): string; +//sorts colors in a string list +procedure SortPalColors(Colors: TStrings; SortMode: TSortMode; SortOrder: TSortOrder); +//reads JASC .pal file +function ReadJASCPal(PalFile: TFileName): string; +//saves a string list to a JASC .pal file +procedure SaveJASCPal(pal: TStrings; FileName: TFileName); +//reads Photoshop .aco file into an Aco record +function ReadPhotoshopAco(PalFile: TFileName): AcoColors; +//reads Photoshop .act file +function ReadPhotoshopAct(PalFile: TFileName): string; + +implementation + +function ReplaceFlags(s: string; flags: array of string; value: integer): string; +var + i, p: integer; + v: string; +begin + Result := s; + v := IntToStr(value); + for i := 0 to Length(flags) - 1 do + begin + p := Pos(flags[i], Result); + if p > 0 then + begin + Delete(Result, p, Length(flags[i])); + Insert(v, Result, p); + end; + end; +end; + +function AnsiReplaceText(const AText, AFromText, AToText: string): string; +begin + Result := StringReplace(AText, AFromText, AToText, [rfReplaceAll, rfIgnoreCase]); +end; + +function FormatHint(fmt: string; c: TColor): string; +var + h: string; +begin + h := AnsiReplaceText(fmt, '%hex', ColorToHex(c)); + h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c)))); + h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c)))); + h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c)))); + h := AnsiReplaceText(h, '%cieX', IntToStr(Round(GetCIExValue(c)))); + h := AnsiReplaceText(h, '%cieY', IntToStr(Round(GetCIEyValue(c)))); + h := AnsiReplaceText(h, '%cieZ', IntToStr(Round(GetCIEzValue(c)))); + h := AnsiReplaceText(h, '%cieC', IntToStr(Round(GetCIEcValue(c)))); + h := AnsiReplaceText(h, '%cieH', IntToStr(Round(GetCIEhValue(c)))); + h := AnsiReplaceText(h, '%hslH', IntToStr(RGBHSLUtils.GetHValue(c))); + h := AnsiReplaceText(h, '%hslS', IntToStr(RGBHSLUtils.GetSValue(c))); + h := AnsiReplaceText(h, '%hslL', IntToStr(RGBHSLUtils.GetLValue(c))); + h := AnsiReplaceText(h, '%hsvH', IntToStr(RGBHSVUtils.GetHValue(c))); + h := AnsiReplaceText(h, '%hsvS', IntToStr(RGBHSVUtils.GetSValue(c))); + h := AnsiReplaceText(h, '%hsvV', IntToStr(RGBHSVUtils.GetVValue(c))); + h := AnsiReplaceText(h, '%r', IntToStr(GetRValue(c))); + h := AnsiReplaceText(h, '%g', IntToStr(GetGValue(c))); + h := AnsiReplaceText(h, '%b', IntToStr(GetBValue(c))); + h := AnsiReplaceText(h, '%c', IntToStr(GetCValue(c))); + h := AnsiReplaceText(h, '%m', IntToStr(GetMValue(c))); + h := AnsiReplaceText(h, '%y', IntToStr(GetYValue(c))); + h := AnsiReplaceText(h, '%k', IntToStr(GetKValue(c))); + h := AnsiReplaceText(h, '%h', IntToStr(RGBHSLUtils.GetHValue(c))); + h := AnsiReplaceText(h, '%s', IntToStr(RGBHSLUtils.GetSValue(c))); + h := AnsiReplaceText(h, '%l', IntToStr(RGBHSLUtils.GetLValue(c))); + h := AnsiReplaceText(h, '%v', IntToStr(RGBHSVUtils.GetVValue(c))); + Result := h; +end; + +function mbStringToColor(s: string): TColor; +begin + //remove spaces + s := AnsiReplaceText(s, ' ', ''); + if SameText(s, 'clCustom') then + Result := clCustom + else + if SameText(s, 'clTransparent') then + Result := clTransparent + else + Result := StringToColor(s); +end; + +function mbColorToString(c: TColor): string; +begin + if c = clCustom then + Result := 'clCustom' + else + if c = clTransparent then + Result := 'clTransparent' + else + Result := ColorToString(c); +end; + +//taken from TBXUtils, TBX Package © Alex Denisov (www.g32.org) +function Blend(C1, C2: TColor; W1: Integer): TColor; +var + W2, A1, A2, D, F, G: Integer; +begin + if C1 < 0 then C1 := GetSysColor(C1 and $FF); + if C2 < 0 then C2 := GetSysColor(C2 and $FF); + + if W1 >= 100 then D := 1000 + else D := 100; + + W2 := D - W1; + F := D div 2; + + A2 := C2 shr 16 * W2; + A1 := C1 shr 16 * W1; + G := (A1 + A2 + F) div D and $FF; + Result := G shl 16; + + A2 := (C2 shr 8 and $FF) * W2; + A1 := (C1 shr 8 and $FF) * W1; + G := (A1 + A2 + F) div D and $FF; + Result := Result or G shl 8; + + A2 := (C2 and $FF) * W2; + A1 := (C1 and $FF) * W1; + G := (A1 + A2 + F) div D and $FF; + Result := Result or G; +end; + +function IsMember(sl: TStrings; s: string): boolean; +var + i: integer; +begin + Result := false; + for i := 0 to sl.count -1 do + if sl.Strings[i] = s then + Result := true; +end; + +function MakePalette(BaseColor: TColor; SortOrder: TSortOrder): string; +var + i: integer; + s: TStrings; +begin + Result := ''; + s := TStringList.Create; + try + case SortOrder of + soAscending: + for i := 239 downto 0 do + s.Add(ColorToString(HSLRangeToRGB(GetHValue(BaseColor), GetSValue(BaseColor), 240 - i))); + soDescending: + for i := 0 to 239 do + s.Add(ColorToString(HSLRangeToRGB(GetHValue(BaseColor), GetSValue(BaseColor), 240 - i))); + end; + Result := s.Text; + finally + s.Free; + end; +end; + +function MakeGradientPalette(Colors: array of TColor): string; +type + RGBArray = array[0..2] of Byte; +var + i, j, k, Span: Integer; + s: TStringList; + Scolor: string; + Faktor: double; + a: RGBArray; + b: array of RGBArray; +begin + Result := ''; + Span := 300; + s := TStringList.Create; + try + SetLength(b, High(Colors) + 1); + for i := 0 to High(Colors) do + begin + Colors[i] := ColorToRGB(Colors[i]); + b[i, 0] := GetRValue(Colors[i]); + b[i, 1] := GetGValue(Colors[i]); + b[i, 2] := GetBValue(Colors[i]); + end; + for i := 0 to High(Colors) - 1 do + for j := 0 to Span do + begin + Faktor := j / Span; + for k := 0 to 3 do + a[k] := Trunc(b[i, k] + ((b[i + 1, k] - b[i, k]) * Faktor)); + Scolor := ColorToString(RGB(a[0], a[1], a[2])); + if not IsMember(s, Scolor) then + s.add(Scolor); + end; + Result := s.Text; + finally + s.Free; + end; +end; + +procedure SortPalColors(Colors: TStrings; SortMode: TSortMode; SortOrder: TSortOrder); + + function MaxPos(s: TStrings; sm: TSortMode): integer; + var + i: integer; + first: TColor; + begin + Result := 0; + first := clBlack; + for i := 0 to s.Count - 1 do + case sm of + smRed: + if GetRValue(first) < GetRValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smGreen: + if GetGValue(first) < GetGValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smBlue: + if GetBValue(first) < GetBValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smHue: + if GetHValue(first) < GetHValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smSaturation: + if GetSValue(first) < GetSValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smLuminance: + if GetLValue(first) < GetLValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smValue: + if GetVValue(first) < GetVValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCyan: + if GetCValue(first) < GetCValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smMagenta: + if GetMValue(first) < GetMValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smYellow: + if GetYValue(first) < GetYValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smBlacK: + if GetKValue(first) < GetKValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEx: + if GetCIEXValue(first) < GetCIEXValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEy: + if GetCIEYValue(first) < GetCIEYValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEz: + if GetCIEZValue(first) < GetCIEZValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEl: + if GetCIELValue(first) < GetCIELValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEa: + if GetCIEAValue(first) < GetCIEAValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEb: + if GetCIEBValue(first) < GetCIEBValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + end; + end; + + function MinPos(s: TStrings; sm: TSortMode): integer; + var + i: integer; + first: TColor; + begin + Result := 0; + first := clWhite; + for i := 0 to s.Count - 1 do + case sm of + smRed: + if GetRValue(first) > GetRValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smGreen: + if GetGValue(first) > GetGValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smBlue: + if GetBValue(first) > GetBValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smHue: + if GetHValue(first) > GetHValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smSaturation: + if GetSValue(first) > GetSValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smLuminance: + if GetLValue(first) > GetLValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smValue: + if GetVValue(first) > GetVValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCyan: + if GetCValue(first) > GetCValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smMagenta: + if GetMValue(first) > GetMValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smYellow: + if GetYValue(first) > GetYValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smBlacK: + if GetKValue(first) > GetKValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEx: + if GetCIEXValue(first) > GetCIEXValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEy: + if GetCIEYValue(first) > GetCIEYValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEz: + if GetCIEZValue(first) > GetCIEZValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEl: + if GetCIELValue(first) > GetCIELValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEa: + if GetCIEAValue(first) > GetCIEAValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + smCIEb: + if GetCIEBValue(first) > GetCIEBValue(mbStringToColor(s.Strings[i])) then + begin + first := mbStringToColor(s.Strings[i]); + Result := i; + end; + end; + end; + +var + i, m: integer; + s: TStrings; +begin + if SortMode <> smNone then + begin + if Colors.Count = 0 then Exit; + m := 0; + s := TStringList.Create; + s.AddStrings(Colors); + Colors.Clear; + for i := s.Count - 1 downto 0 do + begin + case SortOrder of + soAscending: m := MinPos(s, SortMode); + soDescending: m := MaxPos(s, SortMode); + end; + Colors.Add(s.Strings[m]); + s.Delete(m); + end; + s.Free; + end; +end; + +function ReadJASCPal(PalFile: TFileName): string; +var + p, t, c: TStrings; + i: integer; +begin + if not FileExists(PalFile) then + begin + raise Exception.Create('File not found'); + Exit; + end; + p := TStringList.Create; + t := TStringList.Create; + c := TStringList.Create; + try + p.LoadFromFile(PalFile); + for i := 0 to p.Count - 1 do + if p.strings[i] <> '' then + begin + t.Clear; + ExtractStrings([' '], [], PChar(p.strings[i]), t); + if t.Count = 3 then + c.Add(ColorToString(RGB(StrToInt(t.strings[0]), StrToInt(t.strings[1]), StrToInt(t.strings[2])))); + end; + Result := c.Text; + finally + c.Free; + t.Free; + p.Free; + end; +end; + +procedure SaveJASCPal(pal: TStrings; FileName: TFileName); +var + i: integer; + p: TStringList; + c: TColor; +begin + if not FileExists(FileName) then + begin + raise Exception.Create('File not found'); + Exit; + end; + p := TStringList.Create; + try + p.Add('JASC-PAL'); + p.Add('0100'); + p.Add('256'); + for i := 0 to pal.Count - 1 do + if (pal.Strings[i] <> '') and not SameText(pal.Strings[i], 'clCustom') and not SameText(pal.Strings[i], 'clTransparent') then + begin + c := StringToColor(pal.Strings[i]); + p.Add(IntToStr(GetRValue(c)) + ' ' + IntToStr(GetGValue(c)) + ' ' + IntToStr(GetBValue(c))); + end; + p.SaveToFile(FileName); + finally + p.Free; + end; +end; + +procedure ExchangeBytes(var w: Word); +begin + Swap(w); +{ +asm + MOV DX,[w] //assign the word to the data register + XCHG DL,DH // exchange low and high data values + MOV [w],DX //assign the register data to the word + } +end; + +procedure ExchangeChars(var s: WideString); +var + i: Integer; + w: Word; +begin + for i := 1 to Length(s) do + begin + w := Word(s[i]); + ExchangeBytes(w); + s[i] := WideChar(w); + end; +end; + +function GetAcoColor(space,w,x,y,z: word): TColor; +begin + case space of + 0: //RGB + Result := RGB(w div 256, x div 256, y div 256); + 1: //HSB - HSV + Result := HSVToColor(Round(w/182.04), Round(x/655.35), Round(y/655.35)); + 2: //CMYK + Result := CMYKToTColor(Round(100-w/55.35), Round(100-x/655.35), Round(100-y/655.35), Round(100-z/655.35)); + 7: //Lab + Result := LabToRGB(w/100, x/100, y/100); + 8: //Grayscale + Result := RGB(Round(w/39.0625), Round(w/39.0625), Round(w/39.0625)); + 9: //Wide CMYK + Result := CMYKToTColor(w div 100, x div 100, y div 100, z div 100) + else //unknown + Result := RGB(w div 256, x div 256, y div 256); + end; +end; + +function ReadPhotoshopAco(PalFile: TFileName): AcoColors; +var + f: file; + ver, num, space, w, x, y, z, dummy: Word; + i: integer; + v0Length: byte; + v0Name: string; + v2Length: Word; + v2Name: WideString; +begin + if not FileExists(PalFile) then + begin + raise Exception.Create('File not found'); + SetLength(Result.Colors, 0); + SetLength(Result.Names, 0); + Result.HasNames := false; + Exit; + end; + AssignFile(f, PalFile); + Reset(f, 1); + //read version + BlockRead(f, ver, sizeof(ver)); + ExchangeBytes(ver); + if not (ver in [0, 1, 2]) then + begin + CloseFile(f); + Exception.Create('The file you are trying to load is not (yet) supported.'#13'Please submit the file for testing to MXS so loading of this version will be supported too'); + Exit; + end; + //read number of colors + BlockRead(f, num, sizeof(num)); + ExchangeBytes(num); + //read names + if (ver = 0) or (ver = 2) then + begin + SetLength(Result.Names, num); + Result.HasNames := true; + end + else + begin + SetLength(Result.Names, 0); + Result.HasNames := false; + end; + //read colors + SetLength(Result.Colors, num); + for i := 0 to num - 1 do + begin + BlockRead(f, space, sizeof(space)); + ExchangeBytes(space); + BlockRead(f, w, sizeof(w)); + ExchangeBytes(w); + BlockRead(f, x, sizeof(x)); + ExchangeBytes(x); + BlockRead(f, y, sizeof(y)); + ExchangeBytes(y); + BlockRead(f, z, sizeof(z)); + ExchangeBytes(z); + Result.Colors[i] := GetAcoColor(space, w, x, y, z); + case ver of + 0: + begin + BlockRead(f, v0Length, SizeOf(v0Length)); + SetLength(v0Name, v0Length); + if v0Length > 0 then + BlockRead(f, PChar(v0Name)^, v0Length); + Result.Names[i] := v0Name; + end; + 2: + begin + BlockRead(f, dummy, sizeof(dummy)); + BlockRead(f, v2Length, SizeOf(v2Length)); + ExchangeBytes(v2Length); + SetLength(v2Name, v2Length - 1); + if v2Length > 0 then + begin + BlockRead(f, PWideChar(v2Name)^, 2*(v2Length - 1)); + ExchangeChars(v2Name); + end; + Result.Names[i] := v2Name; + BlockRead(f, dummy, sizeof(dummy)); + end; + end; + end; + CloseFile(f); +end; + +function ReadPhotoshopAct(PalFile: TFileName): string; +var + f: file; + r, g, b: byte; + s: TStringList; + i: integer; +begin + if not FileExists(PalFile) then + begin + raise Exception.Create('File not found'); + Result := ''; + Exit; + end; + s := TStringList.Create; + try + AssignFile(f, PalFile); + Reset(f, 1); + for i := 0 to 255 do + begin + BlockRead(f, r, sizeof(r)); + BlockRead(f, g, sizeof(g)); + BlockRead(f, b, sizeof(b)); + s.Add(ColorToString(RGB(r, g, b))); + end; + Result := s.Text; + finally + s.Free; + end; + CloseFile(f); +end; + +end. diff --git a/components/mbColorLib/PickCursor.res b/components/mbColorLib/PickCursor.res new file mode 100644 index 0000000000000000000000000000000000000000..41626c1ab66327566089f780471d3230044cec00 GIT binary patch literal 448 zcma)(u?oU46h&|B&<>&<1VJ1+y6NEHSP%zsP!zw%ii4xSq<<p#1C9>j^Tb-Ti}i-{ zZf^1*X(~wxnB_1nY3Pc5M-KtTaVIL8BDK{cB#?q*y!5s_e5(0_{?&lS5p<yeAp{wR z9GT!H#ijHsaEEFgXxYOKPH=|n#_ZNNyEn}qAqxTS@GbbJ3skGc<@{%v)wR%6W6d<t Y5?@nSno|pXzqM53brVL)w*NCuPu@6<O#lD@ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/RAxisColorPicker.dcr b/components/mbColorLib/RAxisColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..9529005219d20b11b16d062e157529a2aecf1d3b GIT binary patch literal 1864 zcmb`|Kj`k%9mnys7+bO0#A>;16BPRIR8cNAK`GQH#X8)?+F}by3tE~Cc1duscgRp( z@+^XcEQOMQOUoG?leGzSOBTT)nG=M%B<Pq7@BZk$8M^!BeBg5qhZko%ilQh_-30FC zrvBgj=RrkrZcgB<%I}odm0u`<a!2{C^0M-4<<*<KuKea^|FYsKuiW%|b6flF*Y8(F z+>~4Q^OgTKMd@zLe?NLJ=RM^;<;z;Cil$<y2o+1^qT;IfDxpfOlB#4Xxk{-bRce)1 zrB@kMW|dWCSGo6+2OdMyF?58ErE}47b$p#rC)P=IGM!wf)R8*1POH=Fj5@Q<s<Z2- zW1^WDCc?xrxtO>nzDZ~jo1`Y0Np4b_NR!&6HR(-8li6f7+0D}tXaYkZ1eV|;a0R{~ z6vTp5kO^`@DUgC%&<c9ND3}GSU>B!jquCfX!p5?>*tj;nO=uI_q&AsNZd2Mwo7$$e z>1{@v*=Dub?bC7491I8HU^!eITnFDFbch{Nhs+^&C>^9j?a(^(4x_{DusZC{>3C=! zhKKO5JT4xthwl-3#2%?f=8=1p9@3-sXgzw5(PQ>lJ$CPO0<-`lKm=F;mjE}w4+sO| zfHWWr$OFm%8Bhnb0e!$2FbAvwdvH1tT7(fHBCLo@gd5>Ugb{H>8j(fh5oLsos3Y2l zK4OfRBi4vLI-LY9!AKAZR>CFWxmP}X>L+hLbNlVz|KZ~_Axp>;$^@BEC$tHD!k928 ztO<K^Iw@L;ks?y8lyCju)$cv~<_o|2@P%J~@c6f%d-27)SxTN#rpS~!rA_Hm#*{f_ zP1)1axuRV$u81qQUb=hhr+;#<_*cR!Z@v4)gI{~(ukU`IUn#H1EA^H3N`Ga%GGAG* z?AOyN&<czKQSi;D?>zhG#x3v*!h*Qq>E{FgkN?aI$^uzX7qkU^!B{XCtOa{<Iu%-l zQ6VaxxV-hlH~!{U_!VJAT=C?Oo#-$B$}7qWSy5NC6@A56F;}b=dv!VzO=3ud<o4e` zd*EU1=kI^wOG3%>uigFr?K_zymy{AIsU@wXmyD8GvPyP&It^Nb(I6VEhM)c8vu`~4 z%tMcTM}6p#AH5X3^U)VsL*7s}$cDP1ZRi`uhPh#F*qhVo&^n9`(P4F5I^2%eKKk^H z=JU8C?Z`Uvj<Q2`)E#X{-!XQ~9c#zloz8$ZU<`->Yv3~A4)_D%Ks=BRWCQs?IUon> zfp(xD7zgHobzmP(XF{7WCd7m_ahY%@{E2WPo=7LMiF~4*kQ4PpJJC;!6Z6D6u}`P7 zpe+~+V!>LtEVv8)Lbwnwqzl<XzECd6g?gb~=oiL?d0}1Hm($tMHjE9iVQpMC+zo#t z+=w^Qjcg;|C^zIrz0q#;8{@{jv2N_!=^SVW#(_An4lW1ofqxJl#0Tj?c90*G2lAjk VXb<{>@nAk!5BB4}^QHVd{{`0T;9CFy literal 0 HcmV?d00001 diff --git a/components/mbColorLib/RAxisColorPicker.pas b/components/mbColorLib/RAxisColorPicker.pas new file mode 100644 index 000000000..15192d6b5 --- /dev/null +++ b/components/mbColorLib/RAxisColorPicker.pas @@ -0,0 +1,382 @@ +unit RAxisColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, Forms, + HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines; + +type + TRAxisColorPicker = class(TmbColorPickerControl) + private + FSelected: TColor; + FBmp: TBitmap; + FOnChange: TNotifyEvent; + FR, FG, FB: integer; + FManual: boolean; + dx, dy, mxx, myy: integer; + + procedure SetRValue(r: integer); + procedure SetGValue(g: integer); + procedure SetBValue(b: integer); + protected + function GetSelectedColor: TColor; override; + procedure WebSafeChanged; override; + procedure SetSelectedColor(c: TColor); 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 MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure DrawMarker(x, y: integer); + procedure Paint; override; + procedure CreateRGBGradient; + procedure Resize; override; + procedure CreateWnd; override; + procedure CorrectCoords(var x, y: integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + published + property SelectedColor default clRed; + property RValue: integer read FR write SetRValue default 255; + property GValue: integer read FG write SetGValue default 0; + property BValue: integer read FB write SetBValue default 0; + property MarkerStyle default msCircle; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R RAxisColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TRAxisColorPicker]); +end; + +{TRAxisColorPicker} + +constructor TRAxisColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(256, 256); + Width := 256; + Height := 256; + HintFormat := 'G: %g B: %b'#13'Hex: %hex'; + FG := 0; + FB := 0; + FR := 255; + FSelected := clRed; + FManual := false; + dx := 0; + dy := 0; + mxx := 0; + myy := 0; + MarkerStyle := msCircle; +end; + +destructor TRAxisColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TRAxisColorPicker.CreateWnd; +begin + inherited; + CreateRGBGradient; +end; + +procedure TRAxisColorPicker.CreateRGBGradient; +var + g, b : integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.Width := 256; + FBmp.Height := 256; + end; + for g := 255 downto 0 do + begin + row := FBmp.Scanline[255-g]; + for b := 0 to 255 do + if not WebSafe then + row[b] := RGBtoRGBQuad(FR, g, b) +// FBmp.Canvas.Pixels[b,255-g] := RGB(FR, g, b) + else + row[b] := RGBtoRGBQuad(GetWebSafe(RGB(FR, g, b))); +// FBmp.Canvas.Pixels[b,255-g] := GetWebSafe(RGB(FR, g, b)); + end; +end; + +procedure TRAxisColorPicker.CorrectCoords(var x, y: integer); +begin + if x < 0 then x := 0; + if y < 0 then y := 0; + if x > Width - 1 then x := Width - 1; + if y > Height - 1 then y := Height - 1; +end; + +procedure TRAxisColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + CorrectCoords(x, y); + FR := GetRValue(FSelected); + FG := GetGValue(FSelected); + FB := GetBValue(FSelected); + if Assigned(FOnChange) then + FOnChange(Self); + dx := x; + dy := y; + if Focused or (csDesigning in ComponentState) then + c := clBlack + else + c := clWhite; + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +function TRAxisColorPicker.GetSelectedColor: TColor; +begin + Result := FSelected; +end; + +procedure TRAxisColorPicker.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-FG)*(Height/255)); + mxx := Round(FB*(Width/255)); + CreateRGBGradient; + Invalidate; +end; + +procedure TRAxisColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBmp); + CorrectCoords(mxx, myy); + DrawMarker(mxx, myy); +end; + +procedure TRAxisColorPicker.Resize; +begin + FManual := false; + myy := Round((255-FG)*(Height/255)); + mxx := Round(FB*(Width/255)); + inherited; +end; + +procedure TRAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + R: TRect; +begin + inherited; + mxx := x; + myy := y; + if Button = mbLeft then + begin + 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 TRAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + mxx := x; + myy := y; + FSelected := GetColorAtPoint(x, y); + FManual := true; + Invalidate; +end; + +procedure TRAxisColorPicker.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; + end; +end; + +procedure TRAxisColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +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; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TRAxisColorPicker.SetRValue(r: integer); +begin + if r > 255 then r := 255; + if r < 0 then r := 0; + FR := r; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +procedure TRAxisColorPicker.SetGValue(g: integer); +begin + if g > 255 then g := 255; + if g < 0 then g := 0; + FG := g; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +procedure TRAxisColorPicker.SetBValue(b: integer); +begin + if b > 255 then b := 255; + if b < 0 then b := 0; + FB := b; + SetSelectedColor(RGB(FR, FG, FB)); +end; + +function TRAxisColorPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := Canvas.Pixels[x, y]; +end; + +procedure TRAxisColorPicker.WebSafeChanged; +begin + inherited; + CreateRGBGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/RColorPicker.dcr b/components/mbColorLib/RColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..97e11aca59abe334cc817af6d66a5d1f061fcef8 GIT binary patch literal 1856 zcmcJNu}T9$5QaxV5p2{-1i><88o^Qs77{@T7WVc&!1n+?KspQi6t?#1^8)rZc0Pc` zI=S_hb=l-!1eb4MX4wC`J2*456R!|rdHd^pY@40=CWKA9wTX@F+OE7Nc4L=5jqSqw zc!qmNJAHWI&EZdNbe-AUT?f0d`g_aA{y(rKX?YFUm$Z3~LD1$IfS}ED3W7GzISAT3 zV-U1??m&=xo@OtReCa*hOH#xQp+Cz$`@P{olJ4go_vI=Y&MHr?f=9_3Pg22Dvc{7> z4W1>dJW1jgU?!=0a!KcT1wrz7<MBwo>^yT26p`u(3rRItEa6R3M5-gaORB+Q37?W8 NQXSz-QVsrj`3*U!5$XT{ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/RColorPicker.pas b/components/mbColorLib/RColorPicker.pas new file mode 100644 index 000000000..7aa5bf7ff --- /dev/null +++ b/components/mbColorLib/RColorPicker.pas @@ -0,0 +1,268 @@ +unit RColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + mbTrackBarPicker, HTMLColors, Scanlines; + +type + TRColorPicker = class(TmbTrackBarPicker) + private + FRed, FGreen, FBlue: integer; + FBmp: TBitmap; + + function ArrowPosFromRed(r: integer): integer; + function RedFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateRGradient; + procedure SetRed(r: integer); + procedure SetGreen(g: integer); + procedure SetBlue(b: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Red: integer read FRed write SetRed default 255; + property Green: integer read FGreen write SetGreen default 122; + property Blue: integer read FBlue write SetBlue default 122; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Layout default lyVertical; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R RColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TRColorPicker]); +end; + +{TRColorPicker} + +constructor TRColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + FBmp.SetSize(12, 256); + Width := 22; + Height := 268; + Layout := lyVertical; + FRed := 255; + FGreen := 122; + FBlue := 122; + FArrowPos := ArrowPosFromRed(255); + FChange := false; + SetRed(255); + HintFormat := 'Red: %value'; + FManual := false; + FChange := true; +end; + +destructor TRColorPicker.Destroy; +begin + FBmp.Free; + inherited Destroy; +end; + +procedure TRColorPicker.CreateWnd; +begin + inherited; + CreateRGradient; +end; + +procedure TRColorPicker.CreateRGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FBmp = nil then + begin + FBmp := TBitmap.Create; + FBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FBmp.width := 256; + FBmp.height := 12; + for i := 0 to 255 do + for j := 0 to 11 do + begin + row := FBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(i, FGreen, FBlue) +// FBmp.Canvas.Pixels[i, j] := RGB(i, FGreen, FBlue) + else + row[i] := RGBToRGBQuad(GetWebSafe(RGB(i, FGreen, FBlue))); +// FBmp.Canvas.Pixels[i, j] := GetWebSafe(RGB(i, FGreen, FBlue)); + end; + end + else + begin + FBmp.width := 12; + FBmp.height := 256; + for i := 0 to 255 do + begin + row := FBmp.ScanLine[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBtoRGBQuad(255-i, FGreen, FBlue) +// FBmp.Canvas.Pixels[j, i] := RGB(255-i, FGreen, FBlue) + else + row[j] := RGBtoRGBQuad(GetWebSafe(RGB(255-i, FGreen, FBlue))); +// FBmp.Canvas.Pixels[j, i] := GetWebSafe(RGB(255-i, FGreen, FBlue)); + end; + end; +end; + +procedure TRColorPicker.SetRed(r: integer); +begin + if r < 0 then r := 0; + if r > 255 then r := 255; + if FRed <> r then + begin + FRed := r; + FArrowPos := ArrowPosFromRed(r); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TRColorPicker.SetGreen(g: integer); +begin + if g > 255 then g := 255; + if g < 0 then g := 0; + if FGreen <> g then + begin + FGreen := g; + FManual := false; + CreateRGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TRColorPicker.SetBlue(b: integer); +begin + if b > 255 then b := 255; + if b < 0 then b := 0; + if FBlue <> b then + begin + FBlue := b; + FManual := false; + CreateRGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TRColorPicker.ArrowPosFromRed(r: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*r); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + r := 255 - r; + a := Round(((Height - 12)/255)*r); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TRColorPicker.RedFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +function TRColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := RGB(FRed, FGreen, FBlue) + else + Result := GetWebSafe(RGB(FRed, FGreen, FBlue)); +end; + +function TRColorPicker.GetSelectedValue: integer; +begin + Result := FRed; +end; + +procedure TRColorPicker.SetSelectedColor(c: TColor); +begin + if WebSafe then c := GetWebSafe(c); + FChange := false; + SetGreen(GetGValue(c)); + SetBlue(GetBValue(c)); + SetRed(GetRValue(c)); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +function TRColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromRed(FRed); +end; + +procedure TRColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetRed(FRed); + TBA_Paint: Canvas.StretchDraw(FPickRect, FBmp); + TBA_MouseMove: FRed := RedFromArrowPos(FArrowPos); + TBA_MouseDown: FRed := RedFromArrowPos(FArrowPos); + TBA_MouseUp: FRed := RedFromArrowPos(FArrowPos); + TBA_WheelUp: SetRed(FRed + Increment); + TBA_WheelDown: SetRed(FRed - Increment); + TBA_VKRight: SetRed(FRed + Increment); + TBA_VKCtrlRight: SetRed(255); + TBA_VKLeft: SetRed(FRed - Increment); + TBA_VKCtrlLeft: SetRed(0); + TBA_VKUp: SetRed(FRed + Increment); + TBA_VKCtrlUp: SetRed(255); + TBA_VKDown: SetRed(FRed - Increment); + TBA_VKCtrlDown: SetRed(0); + TBA_RedoBMP: CreateRGradient; + end; +end; + +end. diff --git a/components/mbColorLib/RGBCIEUtils.pas b/components/mbColorLib/RGBCIEUtils.pas new file mode 100644 index 000000000..9b395c8e6 --- /dev/null +++ b/components/mbColorLib/RGBCIEUtils.pas @@ -0,0 +1,323 @@ +unit RGBCIEUtils; + +interface + +uses + SysUtils, + {$IFDEF FPC}LCLIntf,{$ELSE}Windows,{$ENDIF} + Graphics, Math; + +const + {// Observer= 2°, Illuminant= D65 - Daylignt + ref_X = 95.047; + ref_Z = 108.883; + // Observer= 10°, Illuminant= D65 - Daylight + ref_X = 94.811; + ref_Z = 35.2; + + // Observer= 2°, Illuminant= A - Incadescent + ref_X = 109.850; + ref_Z = 35.585; + // Observer= 10°, Illuminant= A - Incadescent + ref_X = 111.144; + ref_Z = 35.2; + + // Observer= 2°, Illuminant= C + ref_X = 98.074; + ref_Z = 118.232; + // Observer= 10°, Illuminant= C + ref_X = 97.285; + ref_Z = 116.145; + } + // Observer= 2°, Illuminant= D50 + ref_X = 96.422; + ref_Z = 82.521;{ + // Observer= 10°, Illuminant= D50 - Photoshop + ref_X = 96.72; + ref_Z = 81.427; } + + {// Observer= 2°, Illuminant= D55 + ref_X = 95.682; + ref_Z = 92.149; + // Observer= 10°, Illuminant= D55 + ref_X = 95.799; + ref_Z = 90.926; + + // Observer= 2°, Illuminant= D75 + ref_X = 94.972; + ref_Z = 122.638; + // Observer= 10°, Illuminant= D75 + ref_X = 94.416; + ref_Z = 12.641; + + // Observer= 2°, Illuminant= F2 - Fluorescent + ref_X = 99.187; + ref_Z = 67.395; + // Observer= 10°, Illuminant= F2 - Fluorescent + ref_X = 103.28; + ref_Z = 69.026; + + // Observer= 2°, Illuminant= F7 + ref_X = 95.044; + ref_Z = 108.755; + // Observer= 10°, Illuminant= F7 + ref_X = 95.792; + ref_Z = 107.678; + + // Observer= 2°, Illuminant= F11 + ref_X = 100.966; + ref_Z = 64.370; + // Observer= 10°, Illuminant= F11 + ref_X = 103.866; + ref_Z = 65.627; } + +type + xyz = record + x: real; + y: real; + z: real; + end; + +function LabToXYZ(l, a, b: real): xyz; +function XYZToRGB(space: xyz): TColor; +function LabToRGB(l, a, b: real): TColor; +function RGBToXYZ(c: TColor): xyz; +procedure RGBToLab(clr: TColor; var l, a, b: real); +procedure XYZToLab(space: xyz; var l, a, b: real); +procedure LCHToLab(lum, c, h: real; var l, a, b: real); +procedure LabToLCH(l, a, b: real; var lum, c, h: real); +function LCHToRGB(l, c, h: real): TColor; +procedure RGBToLCH(clr: TColor; var l, c, h: real); +function GetCIEXValue(c: TColor): real; +function GetCIEYValue(c: TColor): real; +function GetCIEZValue(c: TColor): real; +function GetCIELValue(c: TColor): real; +function GetCIEAValue(c: TColor): real; +function GetCIEBValue(c: TColor): real; +function GetCIECValue(c: TColor): real; +function GetCIEHValue(c: TColor): real; + +implementation + +function LabToXYZ(l, a, b: real): xyz; +var + x, y, z: real; +begin + y := (l + 16)/116; + x := a/500 + y; + z := y - b/200; + if y > 0.2069 then + y := IntPower(y, 3) + else + y := (y - 0.138)/7.787; + if x > 0.2069 then + x := IntPower(x, 3) + else + x := (x - 0.138)/7.787; + if z > 0.2069 then + z := IntPower(z, 3) + else + z := (z - 0.138)/7.787; + Result.x := ref_X * x; + Result.y := 100 * y; + Result.z := ref_Z * z; +end; + +function XYZToRGB(space: xyz): TColor; +var + r, g, b, x, y, z: real; +begin + x := space.x/100; + y := space.y/100; + z := space.z/100; + r := x * 3.2406 + y * (-1.5372) + z * (-0.49); + g := x * (-0.969) + y * 1.8758 + z * 0.0415; + b := x * 0.0557 + y * (-0.2040) + z * 1.0570; + if r > 0.00313 then + r := 1.055 * Power(r, 1/2.4) - 0.055 + else + r := 12.92 * r; + if g > 0.00313 then + g := 1.055 * Power(g, 1/2.4) - 0.055 + else + g := 12.92 * g; + if b > 0.00313 then + b := 1.055 * Power(b, 1/2.4) - 0.055 + else + b := 12.92 * b; + + if r < 0 then r := 0; + if r > 1 then r := 1; + if g < 0 then g := 0; + if g > 1 then g := 1; + if b < 0 then b := 0; + if b > 1 then b := 1; + Result := RGB(Round(r*255), Round(g*255), Round(b*255)); +end; + +function LabToRGB(l, a, b: real): TColor; +begin + Result := XYZToRGB(LabToXYZ(l, a, b)); +end; + +function RGBToXYZ(c: TColor): xyz; +var + r, g, b: real; +begin + r := GetRValue(c)/255; + g := GetGValue(c)/255; + b := GetBValue(c)/255; + if r > 0.04045 then + r := Power((r + 0.055)/1.055, 2.4) + else + r := r/12.92; + if g > 0.04045 then + g := Power((g + 0.055)/1.055, 2.4) + else + g := g/12.92; + if b > 0.04045 then + b := Power((b + 0.055)/1.055, 2.4) + else + b := b/12.92; + r := r * 100; + g := g * 100; + b := b * 100; + // Observer= 2°, Illuminant= D65 + Result.x := r * 0.4124 + g * 0.3576 + b * 0.1805; + Result.y := r * 0.2126 + g * 0.7152 + b * 0.0722; + Result.z := r * 0.0193 + g * 0.1192 + b * 0.9505; +end; + +procedure XYZToLab(space: xyz; var l, a, b: real); +var +x, y, z: real; +begin + x := space.x/ref_X; + y := space.y/100; + z := space.z/ref_Z; + if x > 0.008856 then + x := Power(x, 1/3) + else + x := (7.787*x) + 0.138; + if y > 0.008856 then + y := Power(y, 1/3) + else + y := (7.787*y) + 0.138; + if z > 0.008856 then + z := Power(z, 1/3) + else + z := (7.787*z) + 0.138; + l := (116*y) - 16; + a := 500 * (x - y); + b := 200 * (y - z); + if l > 100 then l := 100; + if l < 0 then l := 0; + if a < -128 then a := -128; + if a > 127 then a := 127; + if b < -128 then b := -128; + if b > 127 then b := 127; +end; + +procedure RGBToLab(clr: TColor; var l, a, b: real); +var + s: xyz; +begin + s := RGBToXYZ(clr); + XYZToLab(s, l, a, b); +end; + +procedure LCHToLab(lum, c, h: real; var l, a, b: real); +begin + l := lum; + a := cos(DegToRad(h)) * c; + b := sin(DegToRad(h)) * c; +end; + +procedure LabToLCH(l, a, b: real; var lum, c, h: real); +begin + h := ArcTan2(b, a); + if h > 0 then + h := (h/PI) * 180 + else + h := 360 - (ABS(h)/PI) * 180; + lum := l; + c := SQRT(a*a + b*b); +end; + +procedure RGBToLCH(clr: TColor; var l, c, h: real); +var + a, b: real; +begin + RGBToLab(clr, l, a, b); + LabToLCH(l, a, b, l, c, h); +end; + +function LCHToRGB(l, c, h: real): TColor; +var + lum, a, b: real; +begin + LCHToLab(l, c, h, lum, a, b); + Result := LabToRGB(lum, a, b); +end; + +function GetCIEXValue(c: TColor): real; +var + d: xyz; +begin + d := RGBToXYZ(c); + Result := d.x; +end; + +function GetCIEYValue(c: TColor): real; +var + d: xyz; +begin + d := RGBToXYZ(c); + Result := d.y; +end; + +function GetCIEZValue(c: TColor): real; +var + d: xyz; +begin + d := RGBToXYZ(c); + Result := d.z; +end; + +function GetCIELValue(c: TColor): real; +var + d: real; +begin + XYZToLab(RGBToXYZ(c), Result, d, d); +end; + +function GetCIEAValue(c: TColor): real; +var + d: real; +begin + XYZToLab(RGBToXYZ(c), d, Result, d); +end; + +function GetCIEBValue(c: TColor): real; +var + d: real; +begin + XYZToLab(RGBToXYZ(c), d, d, Result); +end; + +function GetCIECValue(c: TColor): real; +var + d: real; +begin + RGBToLCH(c, d, Result, d); +end; + +function GetCIEHValue(c: TColor): real; +var + d: real; +begin + RGBToLCH(c, d, d, Result); +end; + +end. + diff --git a/components/mbColorLib/RGBCMYKUtils.pas b/components/mbColorLib/RGBCMYKUtils.pas new file mode 100644 index 000000000..a08407593 --- /dev/null +++ b/components/mbColorLib/RGBCMYKUtils.pas @@ -0,0 +1,76 @@ +unit RGBCMYKUtils; + +interface + +uses + {$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF} + Graphics, Math; + +function CMYtoTColor(C, M, Y: integer): TColor; +procedure RGBtoCMY(clr: TColor; var C, M, Y: integer); +function CMYKToTColor (C, M, Y, K: integer): TColor; +procedure ColorToCMYK(clr: TColor; var C, M, Y, K: integer); +function GetCValue(c: TColor): integer; +function GetMValue(c: TColor): integer; +function GetYValue(c: TColor): integer; +function GetKValue(c: TColor): integer; + +implementation + +function CMYtoTColor(C, M, Y: integer): TColor; +begin + Result := RGB(255 - C, 255 - M, 255 - Y); +end; + +procedure RGBtoCMY(clr: TColor; var C, M, Y: integer); +begin + C := 255 - GetRValue(clr); + M := 255 - GetGValue(clr); + Y := 255 - GetBValue(clr); +end; + +function CMYKToTColor (C, M, Y, K: integer): TColor; +begin + Result := RGB(255 - (C + K), 255 - (M + K), 255 - (Y + K)); +end; + +procedure ColorToCMYK(clr: TColor; var C, M, Y, K: integer); +begin + C := 255 - GetRValue(clr); + M := 255 - GetGValue(clr); + Y := 255 - GetBValue(clr); + K := MinIntValue([C, M, Y]); + C := C - K; + M := M - K; + Y := Y - K; +end; + +function GetCValue(c: TColor): integer; +var + d: integer; +begin + ColorToCMYK(c, Result, d, d, d); +end; + +function GetMValue(c: TColor): integer; +var + d: integer; +begin + ColorToCMYK(c, d, Result, d, d); +end; + +function GetYValue(c: TColor): integer; +var + d: integer; +begin + ColorToCMYK(c, d, d, Result, d); +end; + +function GetKValue(c: TColor): integer; +var + d: integer; +begin + ColorToCMYK(c, d, d, d, Result); +end; + +end. diff --git a/components/mbColorLib/RGBHSLUtils.pas b/components/mbColorLib/RGBHSLUtils.pas new file mode 100644 index 000000000..f43559790 --- /dev/null +++ b/components/mbColorLib/RGBHSLUtils.pas @@ -0,0 +1,276 @@ +unit RGBHSLUtils; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, + {$ELSE} + Windows, + {$ENDIF} + Graphics, Math, Scanlines; + +var //set these variables to your needs, e.g. 360, 255, 255 + MaxHue: integer = 239; + MaxSat: integer = 240; + MaxLum: integer = 240; + +function HSLtoRGB (H, S, L: double): TColor; +function HSLRangeToRGB (H, S, L: integer): TColor; +procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer); +function GetHValue(AColor: TColor): integer; +function GetSValue(AColor: TColor): integer; +function GetLValue(AColor: TColor): integer; +procedure Clamp(var Input: integer; Min, Max: integer); +function HSLToRGBTriple(H, S, L : integer) : TRGBTriple; +function HSLToRGBQuad(H, S, L: integer): TRGBQuad; +procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer); + +implementation + +function HSLtoRGB(H, S, L: double): TColor; +var + M1, M2: double; + + function HueToColorValue(Hue: double): byte; + var + V : double; + begin + if Hue < 0 then + Hue := Hue + 1 + else + if Hue > 1 then + Hue := Hue - 1; + if 6 * Hue < 1 then + V := M1 + (M2 - M1) * Hue * 6 + else + if 2 * Hue < 1 then + V := M2 + else + if 3 * Hue < 2 then + V := M1 + (M2 - M1) * (2/3 - Hue) * 6 + else + V := M1; + Result := round (255 * V) + end; + +var + R, G, B: byte; +begin + if S = 0 then + begin + R := round (MaxLum * L); + G := R; + B := R + end + else + begin + if L <= 0.5 then + M2 := L * (1 + S) + else + M2 := L + S - L * S; + M1 := 2 * L - M2; + R := HueToColorValue (H + 1/3); + G := HueToColorValue (H); + B := HueToColorValue (H - 1/3) + end; + Result := RGB (R, G, B) +end; + +function HSLRangeToRGB(H, S, L : integer): TColor; +begin + if s > MaxSat then s := MaxSat; + if s < 0 then s := 0; + if l > MaxLum then l := MaxLum; + if l < 0 then l := 0; + Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum); +end; + +procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1 : integer); +var + R, G, B, D, Cmax, Cmin, h, s, l: double; +begin + H := h1; + S := s1; + L := l1; + R := GetRValue (RGB) / 255; + G := GetGValue (RGB) / 255; + B := GetBValue (RGB) / 255; + Cmax := Max (R, Max (G, B)); + Cmin := Min (R, Min (G, B)); + L := (Cmax + Cmin) / 2; + if Cmax = Cmin then + begin + H := 0; + S := 0; + end + else + begin + D := Cmax - Cmin; + //calc L + if L < 0.5 then + S := D / (Cmax + Cmin) + else + S := D / (2 - Cmax - Cmin); + //calc H + if R = Cmax then + H := (G - B) / D + else + if G = Cmax then + H := 2 + (B - R) /D + else + H := 4 + (R - G) / D; + H := H / 6; + if H < 0 then + H := H + 1; + end; + H1 := round (H * MaxHue); + S1 := round (S * MaxSat); + L1 := round (L * MaxLum); +end; + +function GetHValue(AColor: TColor): integer; +var + d, h: integer; +begin + RGBToHSLRange(AColor, h, d, d); + Result := h; +end; + +function GetSValue(AColor: TColor): integer; +var + d, s: integer; +begin + RGBToHSLRange(AColor, d, s, d); + Result := s; +end; + +function GetLValue(AColor: TColor): integer; +var + d, l: integer; +begin + RGBToHSLRange(AColor, d, d, l); + Result := l; +end; + +procedure Clamp(var Input: integer; Min, Max: integer); +begin + if (Input < Min) then Input := Min; + if (Input > Max) then Input := Max; +end; + +function HSLToRGBTriple(H, S, L: integer): TRGBTriple; +const + Divisor = 255*60; +var + hTemp, f, LS, p, q, r: integer; +begin + Clamp(H, 0, MaxHue); + Clamp(S, 0, MaxSat); + Clamp(L, 0, MaxLum); + if (S = 0) then + Result := RGBToRGBTriple(L, L, L) + else + begin + hTemp := H mod MaxHue; + f := hTemp mod 60; + hTemp := hTemp div 60; + LS := L*S; + p := L - LS div MaxLum; + q := L - (LS*f) div Divisor; + r := L - (LS*(60 - f)) div Divisor; + case hTemp of + 0: Result := RGBToRGBTriple(L, r, p); + 1: Result := RGBToRGBTriple(q, L, p); + 2: Result := RGBToRGBTriple(p, L, r); + 3: Result := RGBToRGBTriple(p, q, L); + 4: Result := RGBToRGBTriple(r, p, L); + 5: Result := RGBToRGBTriple(L, p, q); + else + Result := RGBToRGBTriple(0, 0, 0); + end; + end; +end; + +function HSLToRGBQuad(H, S, L: integer): TRGBQuad; +const + Divisor = 255*60; +var + hTemp, f, LS, p, q, r: integer; +begin + Clamp(H, 0, MaxHue); + Clamp(S, 0, MaxSat); + Clamp(L, 0, MaxLum); + if (S = 0) then + Result := RGBToRGBQuad(L, L, L) + else + begin + hTemp := H mod MaxHue; + f := hTemp mod 60; + hTemp := hTemp div 60; + LS := L*S; + p := L - LS div MaxLum; + q := L - (LS*f) div Divisor; + r := L - (LS*(60 - f)) div Divisor; + case hTemp of + 0: Result := RGBToRGBQuad(L, r, p); + 1: Result := RGBToRGBQuad(q, L, p); + 2: Result := RGBToRGBQuad(p, L, r); + 3: Result := RGBToRGBQuad(p, q, L); + 4: Result := RGBToRGBQuad(r, p, L); + 5: Result := RGBToRGBQuad(L, p, q); + else + Result := RGBToRGBQuad(0, 0, 0); + end; + end; +end; + +procedure RGBTripleToHSL(RGBTriple: TRGBTriple; var h, s, l: integer); + + function RGBMaxValue(RGB: TRGBTriple): byte; + begin + Result := RGB.rgbtRed; + if (Result < RGB.rgbtGreen) then Result := RGB.rgbtGreen; + if (Result < RGB.rgbtBlue) then Result := RGB.rgbtBlue; + end; + + function RGBMinValue(RGB: TRGBTriple) : byte; + begin + Result := RGB.rgbtRed; + if (Result > RGB.rgbtGreen) then Result := RGB.rgbtGreen; + if (Result > RGB.rgbtBlue) then Result := RGB.rgbtBlue; + end; +var + Delta, Min: byte; +begin + L := RGBMaxValue(RGBTriple); + Min := RGBMinValue(RGBTriple); + Delta := L-Min; + if (L = Min) then + begin + H := 0; + S := 0; + end + else + begin + S := MulDiv(Delta, 255, L); + with RGBTriple do + begin + if (rgbtRed = L) then + H := MulDiv(60, rgbtGreen-rgbtBlue, Delta) + else + if (rgbtGreen = L) then + H := MulDiv(60, rgbtBlue-rgbtRed, Delta) + 120 + else + if (rgbtBlue = L) then + H := MulDiv(60, rgbtRed-rgbtGreen, Delta) + 240; + if (H < 0) then H := H + 360; + end; + end; +end; + +end. diff --git a/components/mbColorLib/RGBHSVUtils.pas b/components/mbColorLib/RGBHSVUtils.pas new file mode 100644 index 000000000..a86234810 --- /dev/null +++ b/components/mbColorLib/RGBHSVUtils.pas @@ -0,0 +1,179 @@ +unit RGBHSVUtils; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, + {$ELSE} + Windows, + {$ENDIF} + SysUtils, Classes, Graphics, Math, Scanlines; + +procedure Clamp(var Input: integer; Min, Max: integer); +function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; +function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; +function RGBTripleToColor(Triple: TRGBTriple): TColor; +procedure RGBToHSV(R,G,B: integer; var H,S,V: integer); +function HSVtoRGBTriple(H, S, V: integer): TRGBTriple; +function HSVtoRGBQuad(H, S, V: integer): TRGBQuad; +function HSVtoColor(H, S, V: integer): TColor; +function GetHValue(Color: TColor): integer; +function GetVValue(Color: TColor): integer; +function GetSValue(Color: TColor): integer; + +implementation + +procedure Clamp(var Input: integer; Min, Max: integer); +begin + if Input < Min then Input := Min; + if Input > Max then Input := Max; +end; + +function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; +begin + with Result do + begin + rgbtRed := R; + rgbtGreen := G; + rgbtBlue := B; + end +end; + +function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; +begin + with Result do + begin + rgbRed := R; + rgbGreen := G; + rgbBlue := B; + rgbReserved := 0; + end +end; + +function RGBTripleToColor(Triple: TRGBTriple): TColor; +begin + Result := TColor(RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue)); +end; + +procedure RGBToHSV(R, G, B: integer; var H, S, V: integer); +var + Delta, Min, H1, S1: real; +begin + h1 := h; + s1 := s; + Min := MinIntValue([R, G, B]); + V := MaxIntValue([R, G, B]); + Delta := V - Min; + if V = 0.0 then S1 := 0 else S1 := Delta / V; + if S1 = 0.0 then + H1 := 0 + else + begin + if R = V then + H1 := 60.0 * (G - B) / Delta + else + if G = V then + H1 := 120.0 + 60.0 * (B - R) / Delta + else + if B = V then + H1 := 240.0 + 60.0 * (R - G) / Delta; + if H1 < 0.0 then H1 := H1 + 360.0; + end; + h := round(h1); + s := round(s1*255); +end; + +function HSVtoRGBTriple(H, S, V: integer): TRGBTriple; +const + divisor: integer = 255*60; +var + f, hTemp, p, q, t, VS: integer; +begin + if H > 360 then H := H - 360; + if H < 0 then H := H + 360; + if s = 0 then + Result := RGBtoRGBTriple(V, V, V) + else + begin + if H = 360 then hTemp := 0 else hTemp := H; + f := hTemp mod 60; + hTemp := hTemp div 60; + VS := V*S; + p := V - VS div 255; + q := V - (VS*f) div divisor; + t := V - (VS*(60 - f)) div divisor; + case hTemp of + 0: Result := RGBtoRGBTriple(V, t, p); + 1: Result := RGBtoRGBTriple(q, V, p); + 2: Result := RGBtoRGBTriple(p, V, t); + 3: Result := RGBtoRGBTriple(p, q, V); + 4: Result := RGBtoRGBTriple(t, p, V); + 5: Result := RGBtoRGBTriple(V, p, q); + else Result := RGBtoRGBTriple(0,0,0) + end; + end; +end; + +function HSVtoRGBQuad(H, S, V: integer): TRGBQuad; +const + divisor: integer = 255*60; +var + f, hTemp, p, q, t, VS: integer; +begin + if H > 360 then H := H - 360; + if H < 0 then H := H + 360; + if s = 0 then + Result := RGBtoRGBQuad(V, V, V) + else + begin + if H = 360 then hTemp := 0 else hTemp := H; + f := hTemp mod 60; + hTemp := hTemp div 60; + VS := V*S; + p := V - VS div 255; + q := V - (VS*f) div divisor; + t := V - (VS*(60 - f)) div divisor; + case hTemp of + 0: Result := RGBtoRGBQuad(V, t, p); + 1: Result := RGBtoRGBQuad(q, V, p); + 2: Result := RGBtoRGBQuad(p, V, t); + 3: Result := RGBtoRGBQuad(p, q, V); + 4: Result := RGBtoRGBQuad(t, p, V); + 5: Result := RGBtoRGBQuad(V, p, q); + else Result := RGBtoRGBQuad(0,0,0) + end; + end; +end; + +function HSVtoColor(H, S, V: integer): TColor; +begin + Result := RGBTripleToColor(HSVtoRGBTriple(H, S, V)); +end; + +function GetHValue(Color: TColor): integer; +var + s, v: integer; +begin + RGBToHSV(GetRValue(Color), GetGValue(Color), GetBValue(Color), Result, s, v); +end; + +function GetSValue(Color: TColor): integer; +var + h, v: integer; +begin + RGBToHSV(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, Result, v); +end; + +function GetVValue(Color: TColor): integer; +var + h, s: integer; +begin + RGBToHSV(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, s, Result); +end; + +end. diff --git a/components/mbColorLib/Readme.rtf b/components/mbColorLib/Readme.rtf new file mode 100644 index 0000000000000000000000000000000000000000..8a7be24ee07b990bff171d6082fe7ce35e1eda72 GIT binary patch literal 3211 zcmb_e+iu%N5bblmV(J&CfhtRi-4yXl-NZqJ#CG7g2n-M?mgJDynB1jzmsSWv|K2l8 zQnqs`T%dp<OXTj{&Y3fFo48QS6J@-PA6Zk*7YB<Z=c1U&XQfOzpFMv*elJ*l-6n-K zA*2<)%#y;dwf9NUxa&nyWGm%7hsE>XZ<A+9VN}g@<g}^|H}N06IzHUs-u(ObX5-<_ zliMV-m344Khl%6-V4jqY+018)B&}Lr92~^wv;OgH`%tbvOG-BERIrXtd=WU;fexno z^XdEmf3p{do8(6G`bwL8KWVdh(kPcF#;$dqg$h3spU!8q#4GvC5U<o?F?+F}q<z+l zeR{7mHlF3~lYcjG{TVh8;%vM_+EeM2L1YvxwVo$b+gukNDU%cO)jl|#wt*?E*fX_8 z2T$5iXIn?AX)2wmpsn$wygVe&Ooa|py2KCVm`Z)ahF+bWe0YC+aZGQ{kB?uUozPl` zl^7)tOBs7AYzv<-9aaddQQ6g@7~F-40wo^;B$N<mj!rL0%0{-3D55pn24eA5vyqUr zDXH#A&_`Mwd5tsxg)$vkcy{DNTND#GRDp7C*yNt<kXvbO4zpDiOJQ(9>~ZCJO3UFz zmT?oJy;!xoQp7|u>lzF6W9{k(nUO9e_ih*FS6nqzt1Fh&QVxOLUGY#7#Cdu~Hm!6S zD=md+REK&wu>nvrTQ}AqX)o^#qq4XJ&YM14yo-TTaGfN9L!RLo$A++2JIY$;U_<QI zNU?}$qN{)s&bJM6kt*GAWgDrml>Qt4!hlQ}%5lX~+95X6Ge{hJi=cYE1qdW9PZds^ znA(I?sYV8PTXEI>7?<fI7%wf8(%Bka=vTUV#ErWiSxQ*DfwD^J8kvG4ON5*YoC85g zh~^|pWLkG9D%ccZ!C};fbk1lC^i?D_@Rf!D746zgU=2pim2lQ|g3)?qBO7pfD9t@a zd{7Sf#+t)>W)X)N%WTs*U9Ltr03?hf-DoXaS?~k+ZDEKk!-JSZrBkO|H>Kk-1jCFT zh?GPM5wFH-fGv8!Ujh=AerbLGuBX5VX$)$FPZ~H<K~=&8G;!>2w3ifS&8Y~+T4;#> zxHNQRF9wIP&7lI$-k^rkh*2$ux=-YS2+@7cB8q5w>$qr5CORNi8g@WQl0YQDqi8{Y z8*MoD4QC>Oc<%hRyU{EHRmvV%_Q1qekEgZ`3<y^0MraH#X~i{?dJro;jj`?mJK&^^ zsv`A8Wi@<m6&8X1GLal04I+CtP)^&6%XNzwL}Mp+PLRqTnC9EE99|A|g(Bz>MF%or z``CqCBUD2pqsv>w3KK#Nl?Bm@9Aw7e=^o!&r<T^r$q4EGQ*&KN3k^zuZ`&%MA^;2m zvUBv2mLGR0RUYpnsiJgL)U=RQuo?-aEQRmkoY1G`#oM#LF6h(I`T5c5#U-7+iF4xJ z^7QqD236!Q4FHdc>l)LG^DW@ecwq;~FQd;xQoRPEJ=6#y(i;U6;@#JKupA*^0AjA> zs#ay3GOdBDo>wr|R=9*LfUFY`F?H*w9)PdxTKaz+DP^T{5H&U+hyato4&3<x#~!Nx z09!A5uLf9!^P_reQ`jD+VGp?ImEkM+F&%ITAn>oX(y>vnENRpwu2WU6jSshPFFzcg zzh9odqa8UF?8{oYEBkk<jn4k))XLf^CesdWWYwy2=c|Bqs#qlGz3(2~Y&LO0*)Du- zWsrWqr(x3(w%%<(#q56%st-N7hzn;ir&4me@027dEMG{gk9G`FmQVyaj?Tngw-&Si zdwu-C!`E4%p`f==9LI6wDoWc@4mplOfO%Q43N4hUsW4vfZ)kH7))DHVzaiqQ5So{J zd-WGTP1%*+7GY{Q><uTNI8l1RZy=sxVa4{=mwBu~un!7gzfLiyN@ION$fNg1tO;X% zkOrmzY8nk}_lABYKzGNEk=B#d)G%hJL;jqnm@hrymuRAf<GNDFO8CuE(hCHpocV0K XpJM}@2vzA%P&L`*-{Paqlb`+pszQB+ literal 0 HcmV?d00001 diff --git a/components/mbColorLib/SColorPicker.dcr b/components/mbColorLib/SColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..484a46d953f4fd421d56208b132c33ef527346e9 GIT binary patch literal 1856 zcmeH{F%AJy5Qc|BbhfmjQ0*$V&`1<pELI@|K_%JR1suQuT)+h!zyU<>0uG?iI>Be` zk}Rbak=V)nlmESB{`Y6z%M%f)C?JB;r#R<C8oC2nnaV`kGL*hzEF<aaswW-gQPhl5 z{?S}jQoJJ*GLgM%y#}|F)BMr|E^vY)9AF1q*uWZAu!IH7VFm+eK^>}4hC-O}Yf5$g zb3XAm@Z;R~{p1d9+jbnsb=@RVrfC|6p;e{ccBM{KM1N1MmSuTOF9?DpuF~F*OyCND CD7?Y| literal 0 HcmV?d00001 diff --git a/components/mbColorLib/SColorPicker.pas b/components/mbColorLib/SColorPicker.pas new file mode 100644 index 000000000..07ddec8aa --- /dev/null +++ b/components/mbColorLib/SColorPicker.pas @@ -0,0 +1,267 @@ +unit SColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TSColorPicker = class(TmbTrackBarPicker) + private + FVal, FHue, FSat: integer; + FSBmp: TBitmap; + + function ArrowPosFromSat(s: integer): integer; + function SatFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateSGradient; + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetValue(v: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 255; + property Value: integer read FVal write SetValue default 255; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R SColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TSColorPicker]); +end; + +{ TSColorPicker } + +constructor TSColorPicker.Create(AOwner: TComponent); +begin + inherited; + FSBmp := TBitmap.Create; + FSBmp.PixelFormat := pf32bit; + Width := 267; + Height := 22; + FHue := 0; + FVal := 255; + FArrowPos := ArrowPosFromSat(0); + FChange := false; + SetSat(255); + HintFormat := 'Saturation: %value'; + FManual := false; + FChange := true; +end; + +destructor TSColorPicker.Destroy; +begin + FSBmp.Free; + inherited Destroy; +end; + +procedure TSColorPicker.CreateWnd; +begin + inherited; + CreateSGradient; +end; + +procedure TSColorPicker.CreateSGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FSBmp = nil then + begin + FSBmp := TBitmap.Create; + FSBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FSBmp.width := 255; + FSBmp.height := 12; + for i := 0 to 254 do + for j := 0 to 11 do + begin + row := FSBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(HSVtoColor(FHue, i, FVal)) +// FSBmp.Canvas.Pixels[i, j] := HSVtoColor(FHue, i, FVal) + else + row[i] := RGBToRGBQuad(GetWebSafe(HSVtoColor(FHue, i, FVal))); +// FSBmp.Canvas.Pixels[i, j] := GetWebSafe(HSVtoColor(FHue, i, FVal)); + end; + end + else + begin + FSBmp.width := 12; + FSBmp.height := 255; + for i := 0 to 254 do + begin + row := FSBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBToRGBQuad(HSVtoColor(FHue, 255-i, FVal)) +// FSBmp.Canvas.Pixels[j, i] := HSVtoColor(FHue, 255-i, FVal) + else + row[j] := RGBToRGBQuad(GetWebSafe(HSVtoColor(FHue, 255-i, FVal))); +// FSBmp.Canvas.Pixels[j, i] := GetWebSafe(HSVtoColor(FHue, 255-i, FVal)); + end; + end; +end; + +procedure TSColorPicker.SetValue(v: integer); +begin + if v < 0 then v := 0; + if v > 255 then v := 255; + if FVal <> v then + begin + FVal := v; + FManual := false; + CreateSGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TSColorPicker.SetHue(h: integer); +begin + if h > 360 then h := 360; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + CreateSGradient; + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TSColorPicker.SetSat(s: integer); +begin + if s > 255 then s := 255; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + FArrowPos := ArrowPosFromSat(s); + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TSColorPicker.ArrowPosFromSat(s: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*s); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + s := 255 - s; + a := Round(((Height - 12)/255)*s); + 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)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +function TSColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := HSVtoColor(FHue, FSat, FVal) + else + Result := GetWebSafe(HSVtoColor(FHue, FSat, FVal)); +end; + +function TSColorPicker.GetSelectedValue: integer; +begin + Result := FSat; +end; + +procedure TSColorPicker.SetSelectedColor(c: TColor); +var + h, s, v: integer; +begin + if WebSafe then c := GetWebSafe(c); + RGBToHSV(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 + Result := ArrowPosFromSat(FSat); +end; + +procedure TSColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetSat(FSat); + TBA_Paint: Canvas.StretchDraw(FPickRect, FSBmp); + TBA_MouseMove: FSat := SatFromArrowPos(FArrowPos); + TBA_MouseDown: FSat := SatFromArrowPos(FArrowPos); + TBA_MouseUp: FSat := SatFromArrowPos(FArrowPos); + TBA_WheelUp: SetSat(FSat + Increment); + TBA_WheelDown: SetSat(FSat - Increment); + TBA_VKLeft: SetSat(FSat - Increment); + TBA_VKCtrlLeft: SetSat(0); + TBA_VKRight: SetSat(FSat + Increment); + TBA_VKCtrlRight: SetSat(255); + TBA_VKUp: SetSat(FSat + Increment); + TBA_VKCtrlUp: SetSat(255); + TBA_VKDown: SetSat(FSat - Increment); + TBA_VKCtrlDown: SetSat(0); + TBA_RedoBMP: CreateSGradient; + end; +end; + +end. diff --git a/components/mbColorLib/SLColorPicker.dcr b/components/mbColorLib/SLColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..500a42a261a3fec2c8932a4fe4f37a08e48263f3 GIT binary patch literal 1860 zcmd7SA<Q!;7zc1Rv7i<tnHp}mAxWlKCdQV03!B0skteaplgP73WF^UxCCEx7_MJnX z?4G{2ez{Bb&2CSAkf)dSUm&yyA@ntj$Kx2#Uh2;;5c&?DJRYB;-_Wn<XY@V#0P_cA z&@bpmc=Z$d0s2>cOTNOd{u^lM-{Z6Q4x!&6?~gB!@p|9m`R)HZ_+JabE<f$O9rCd# zAt#vPfAl=4mvat#6=n2{Fmi?&K0^$FbB+*#3w~gN)mHa?hnWic5fS8o1wJ5wz&S_0 zmyiNL!sGGalEVx=lMGNv0g>c@B|ac|$<bOXtw6gs__)yG06jcmngOcmfoKA-#sKL{ zj(IO_G%P?F1*DNcnCJ4i;moiDHIx_vu)zRs?|EO&IqNLA_dBdXJFT1o&-L^soZyZF z<`{Jp5Jv!Z7`aQ1e=p~q^>%+e&qsR=GxX9+AiUt7GtU6^6cA6a$H-rDLI_J(eDJ^p zcOQ4y4$L}e6_gB81Oa&9EHFR=C4u08QMly97()z8T!4?>MQ5Wm(EuH_ib_T)q5wQ{ z78#9{M1ms*=krM^t!a%Zh7^{x_~c!3Hd&Jl&`GPLWRfBYo;XX4CQ1^)34?RambaAC zn%9_P$YIHg&)#Kcvo+c1tbxi(W+}4ZnX}AjrX&-bFFB=@T=G`7RMJ}3P{L9cU%V^M z7Hf*pMXRD@k)jA*I4g`6N(#Z{l5?xKQcJFRt6QpRt!t=Zsf(}PRcEU;)#$2KRiX-B zIjf9TN-DwilG9qdwOeT=x4gA2wY0W1w6L_rH}9IW&FTi%UCAaz6Ra`XC}{+@OAcH= zxNo)B(o61n>s#t6_859t`r^B{-I{K6*Ro5|1@D}8N;<*)k~7BWqqouOsAZHq@;0`0 ztZ~F;EPi-5oE=sVt%edq@WI(&WDq<qIdAiA%yFOhHrs99$}D;2G}AiQFvBtzKfRsS zOrxffQ}W5#WMmRNFF9~~-}bk$!#%#Yz1{X(*~_+XX-{#FVGn-yZg*yfU$T}v{J99W QGrCi}UvkcO>A&s&0$uDgV*mgE literal 0 HcmV?d00001 diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas new file mode 100644 index 000000000..f11f86b66 --- /dev/null +++ b/components/mbColorLib/SLColorPicker.pas @@ -0,0 +1,416 @@ +unit SLColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Math, RGBHSLUtils, + Forms, HTMLColors, SelPropUtils, mbColorPickerControl, Scanlines; + +type + TSLColorPicker = class(TmbColorPickerControl) + private + FManual: boolean; + FHue, FSat, FLum: integer; + FOnChange: TNotifyEvent; + FChange: boolean; + FBMP: TBitmap; + + procedure CreateSLGradient; + procedure DrawMarker(x, y: integer); + procedure SelectionChanged(x, y: integer); + procedure UpdateCoords; + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetLum(l: integer); + protected + procedure WebSafeChanged; override; + function GetSelectedColor: TColor; override; + procedure SetSelectedColor(c: TColor); override; + procedure Paint; override; + procedure Resize; override; + procedure CreateWnd; override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); + message CN_KEYDOWN; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorAtPoint(x, y: integer): TColor; override; + property Manual: boolean read FManual; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 0; + property Luminance: integer read FLum write SetLum default 255; + property SelectedColor default clWhite; + property MarkerStyle default msCircle; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R SLColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TSLColorPicker]); +end; + +constructor TSLColorPicker.Create(AOwner: TComponent); +begin + inherited; + FBMP := TBitmap.Create; + FBMP.PixelFormat := pf32bit; + FBMP.SetSize(256, 256); + Width := 255; + Height := 255; + MaxHue := 360; + MaxSat := 255; + MaxLum := 255; + FHue := 0; + FSat := 0; + FLum := 255; + FChange := true; + MarkerStyle := msCircle; +end; + +destructor TSLColorPicker.Destroy; +begin + FBMP.Free; + inherited; +end; + +procedure TSLColorPicker.CreateSLGradient; +var + x, y, skip: integer; + row: pRGBQuadArray; + tc: TColor; +begin + if FBMP = nil then + begin + FBMP := TBitmap.Create; + FBMP.PixelFormat := pf32bit; + FBMP.Width := 256; + FBMP.Height := 256; + end; + row := FBMP.ScanLine[0]; + skip := integer(FBMP.ScanLine[1]) - Integer(row); + for y := 0 to 255 do + begin + for x := 0 to 255 do + if not WebSafe then + row[x] := HSLtoRGBQuad(FHue, x, 255 - y) + else + begin + tc := GetWebSafe(RGBTripleToTColor(HSLToRGBTriple(FHue, x, 255 - y))); + row[x] := RGBtoRGBQuad(GetRValue(tc), GetGValue(tc), GetBValue(tc)); + end; + row := pRGBQuadArray(Integer(row) + skip); + end; +end; + +procedure TSLColorPicker.Resize; +begin + inherited; + UpdateCoords; +end; + +procedure TSLColorPicker.CreateWnd; +begin + inherited; + CreateSLGradient; + UpdateCoords; +end; + +procedure TSLColorPicker.UpdateCoords; +begin + mdx := MulDiv(FSat, Width, 255); + mdy := MulDiv(255-FLum, Height, 255); +end; + +procedure TSLColorPicker.DrawMarker(x, y: integer); +var + c: TColor; +begin + c := not GetColorAtPoint(x, y); + case MarkerStyle of + msCircle: DrawSelCirc(x, y, Canvas); + msSquare: DrawSelSquare(x, y, Canvas); + msCross: DrawSelCross(x, y, Canvas, c); + msCrossCirc: DrawSelCrossCirc(x, y, Canvas, c); + end; +end; + +procedure TSLColorPicker.Paint; +begin + Canvas.StretchDraw(ClientRect, FBMP); + DrawMarker(mdx, mdy); +end; + +procedure TSLColorPicker.SetHue(h: integer); +begin + if h > 360 then h := 360; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + FManual := false; + CreateSLGradient; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TSLColorPicker.SetSat(s: integer); +begin + if s > 255 then s := 255; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TSLColorPicker.SetLum(l: integer); +begin + if l > 255 then l := 255; + if l < 0 then l := 0; + if FLum <> l then + begin + FLum := l; + FManual := false; + UpdateCoords; + Invalidate; + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TSLColorPicker.SelectionChanged(x, y: integer); +begin + FChange := false; +// SetSat(MulDiv(255, x, Width)); +// SetLum(MulDiv(255, Height - y, Height)); + SetSat(MulDiv(255, x, Width - 1)); + SetLum(MulDiv(255, Height - y -1, Height - 1)); + FChange := true; +end; + +procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + if csDesigning in ComponentState then Exit; + if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then + begin + mdx := x; + mdy := y; + SelectionChanged(X, Y); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +var + R: TRect; +begin + inherited; + if csDesigning in ComponentState then Exit; + if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then + begin + mdx := x; + mdy := y; + R := ClientRect; + R.TopLeft := ClientToScreen(R.TopLeft); + R.BottomRight := ClientToScreen(R.BottomRight); + {$IFDEF DELPHI} + ClipCursor(@R); + {$ENDIF} + SelectionChanged(X, Y); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + SetFocus; +end; + +procedure TSLColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + if csDesigning in ComponentState then Exit; + if (ssLeft in Shift) and PtInRect(ClientRect, Point(x, y)) then + begin + mdx := x; + mdy := y; + SelectionChanged(X, Y); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TSLColorPicker.SetSelectedColor(c: TColor); +var + h, s, l: integer; +begin + if WebSafe then c := GetWebSafe(c); + FManual := false; + Fchange := false; + RGBTripleToHSL(RGBtoRGBTriple(GetRValue(c), GetGValue(c), GetBValue(c)), h, s, l); + SetHue(h); + SetSat(s); + SetLum(l); + if Fchange then + if Assigned(FOnChange) then FOnChange(Self); + FChange := true; +end; + +function TSLColorPicker.GetSelectedColor: TColor; +var + triple: TRGBTriple; +begin + triple := HSLToRGBTriple(FHue, FSat, FLum); + if not WebSafe then + Result := RGBTripleToTColor(triple) + else + Result := GetWebSafe(RGBTripleToTColor(triple)); +end; + +function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor; +var + triple: TRGBTriple; +begin + triple := HSLToRGBTriple(FHue, MulDiv(255, x, Width), MulDiv(255, Height - y, Height)); + if not WebSafe then + Result := RGBTripleToTColor(triple) + else + Result := GetWebSafe(RGBTripleToTColor(triple)); +end; + +procedure TSLColorPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); +var + Shift: TShiftState; + FInherited: boolean; +begin + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + if not (ssCtrl in Shift) then + case Message.CharCode of + VK_LEFT: + if not (mdx - 1 < 0) then + begin + Dec(mdx, 1); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + if not (mdx + 1 > Width) then + begin + Inc(mdx, 1); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + if not (mdy - 1 < 0) then + begin + Dec(mdy, 1); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + if not (mdy + 1 > Height) then + begin + Inc(mdy, 1); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + begin + FInherited := true; + inherited; + end; + end + else + case Message.CharCode of + VK_LEFT: + if not (mdx - 10 < 0) then + begin + Dec(mdx, 10); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + if not (mdx + 10 > Width) then + begin + Inc(mdx, 10); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + if not (mdy - 10 < 0) then + begin + Dec(mdy, 10); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + if not (mdy + 10 > Height) then + begin + Inc(mdy, 10); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + begin + FInherited := true; + inherited; + end; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TSLColorPicker.WebSafeChanged; +begin + inherited; + CreateSLGradient; + Invalidate; +end; + +end. diff --git a/components/mbColorLib/SLHColorPicker.dcr b/components/mbColorLib/SLHColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..48354ff3c048dc20877804a15977b7788bd50b2f GIT binary patch literal 1860 zcmds%A@DpU6oAp-5Q&V*ZPFy}j0wjXMQ3zY6O~9LQi((&bt92@GbSSO;?|#SBM~3F zcj2$e=J@7=d&j_ck7YT85c&$*7<Ys8llb!sguaE5F+NAXqu<ca=m+#2`UO6JK^yuN z{RrQFLf=Dv$2a6l{1$u-34OKCt_-0+!1wnU^Vk1dFvjS=2tw(EGX@(GbcpwMmSwp# z*91c7Ctync0Y(%fSOgw_aX%T(IjG)2VZsYamQTP7y&!lYh_mTA@HpP}2q8elIfGIk z_0fBWp0fpJ^5ur`<p%Qwa|)o9PtU;TK)^gHDWzCf01RUcu`=i(7krs8fL;*6h*$s& z$o2N5fq>~zN`b1j3d_NG!6AncxiYyfk^}UDNCseFdwIk_!1QRX)wV$aYLjXcN&+h| zM+8@bDY2*(pc76mu!f_8<rEKsZ;!RsXx*L-YA|XuN}5f~dY;ute!+}bE~r@vpgFd3 znaedE>g93HfeBoF%;#hE20i3f39DAS@rh)xa3ZJ`#ID%go(CS~<q08p=e)DtnszkU z4)oq^UQ4fqSF2atZ|q|6l6pzJ!2a^|fqQ>>VvJw{SMWAC6PylKP0SXI3|a)e2E~J7 zK`mjUVIx73xXpd#f%Dt5?<vKYVo1SFyqP$ioJw{}Rwg5oS(D~Tv!s@!XxhkrdDOt_ z?a2^($|>d)a`ZX69BlR`dzIamoy=BbyJo|)VOcL((X2>OvmP=qd3zp@QgSXil|7a{ zl;lfvC7Kd+399(5I9Z%1b}fb#vlLB>CRNXK$3x;S=fR;-As(fcT+3c_tb3@tugTVE zYScBT>bL4eb!)Y}T2>9MhCI#f*>T@*&-2+@gO|6oM{Z?rCAJ*e?%Qr#GA-&Bw-#jc zqB-6iYj$ad9QO8{xWDe#0r7;Ru170J&Br4hB_1Ul*&Vw*l0K3;qCA2)!g_dixaF|q zbeE?M4EO2U*Li-NAIEvL^I1<&f#(rVp!hS}Gn;eQXWGsv&$ym}pME(V>3({Uo!p*z zx6hA$9{r<@W2$=FdrQ5>{_wrHUQExr@2V%+ljxE6z($<^hm;RW-=3?gm-GLU{{<kw BdK3Tv literal 0 HcmV?d00001 diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas new file mode 100644 index 000000000..c5699c45a --- /dev/null +++ b/components/mbColorLib/SLHColorPicker.pas @@ -0,0 +1,379 @@ +unit SLHColorPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBHSLUtils, mbTrackBarPicker, SLColorPicker, HColorPicker, Menus, + {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} HTMLColors; + +type + TSLHColorPicker = class(TCustomControl) + private + FOnChange: TNotifyEvent; + FSLPicker: TSLColorPicker; + FHPicker: THColorPicker; + FSelectedColor: TColor; + FHValue, FSValue, FLValue: integer; + FRValue, FGValue, FBValue: integer; + FSLHint, FHHint: string; + FSLMenu, FHMenu: TPopupMenu; + FSLCursor, FHCursor: TCursor; + PBack: TBitmap; + + function GetManual: boolean; + procedure SelectColor(c: TColor); + procedure SetH(v: integer); + procedure SetS(v: integer); + procedure SetL(v: integer); + procedure SetR(v: integer); + procedure SetG(v: integer); + procedure SetB(v: integer); + procedure SetHHint(h: string); + procedure SetSLHint(h: string); + procedure SetSLMenu(m: TPopupMenu); + procedure SetHMenu(m: TPopupMenu); + procedure SetHCursor(c: TCursor); + procedure SetSLCursor(c: TCursor); + procedure PaintParentBack; + protected + procedure CreateWnd; override; + procedure Resize; override; + procedure Paint; override; + procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); + message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF}; + procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); + message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF}; + procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure HPickerChange(Sender: TObject); + procedure SLPickerChange(Sender: TObject); + procedure DoChange; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetColorUnderCursor: TColor; + function GetHexColorUnderCursor: string; + function GetSelectedHexColor: string; + property ColorUnderCursor: TColor read GetColorUnderCursor; + property HValue: integer read FHValue write SetH default 0; + property SValue: integer read FSValue write SetS default 240; + property LValue: integer read FLValue write SetL default 120; + property RValue: integer read FRValue write SetR default 255; + property GValue: integer read FGValue write SetG default 0; + property BValue: integer read FBValue write SetB default 0; + property Manual: boolean read GetManual; + published + property SelectedColor: TColor read FSelectedColor write SelectColor default clRed; + property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu; + property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu; + property HPickerHintFormat: string read FHHint write SetHHint; + property SLPickerHintFormat: string read FSLHint write SetSLHint; + property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault; + property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault; + property TabStop default true; + property ShowHint; + property ParentShowHint; + property Anchors; + property Align; + property Visible; + property Enabled; + property TabOrder; + property Color; + property ParentColor default true; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF}{$ENDIF} + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnMouseMove; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R SLHColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TSLHColorPicker]); +end; + +{TSLHColorPicker} + +constructor TSLHColorPicker.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; + DoubleBuffered := true; + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + ParentColor := true; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF}{$ENDIF} + Width := 297; + Height := 271; + TabStop := true; + FSelectedColor := clRed; + FHPicker := THColorPicker.Create(Self); + InsertControl(FHPicker); + FHCursor := crDefault; + FSLCursor := crDefault; + with FHPicker do + begin + Height := 271; + Width := 40; + Top := 0; + Left := 257; + Anchors := [akTop, akRight, akBottom]; + Visible := true; + Layout := lyVertical; + ArrowPlacement := spBoth; + NewArrowStyle := true; + OnChange := HPickerChange; + OnMouseMove := DoMouseMove; + end; + FSLPicker := TSLColorPicker.Create(Self); + InsertControl(FSLPicker); + with FSLPicker do + begin + Width := 255; + Height := 255; + Top := 8; + Left := 0; + Anchors := [akRight, akTop, akBottom, akLeft]; + Visible := true; + SelectedColor := clRed; + OnChange := SLPickerChange; + OnMouseMove := DoMouseMove; + end; + FHValue := 0; + FSValue := 255; + FLValue := 255; + FRValue := 255; + FGValue := 0; + FBValue := 0; + FHHint := 'Hue: %h'; + FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; +end; + +destructor TSLHColorPicker.Destroy; +begin + PBack.Free; + FHPicker.Free; + FSLPicker.Free; + inherited Destroy; +end; + +procedure TSLHColorPicker.HPickerChange(Sender: TObject); +begin + FSLPicker.Hue := FHPicker.Hue; + DoChange; +end; + +procedure TSLHColorPicker.SLPickerChange(Sender: TObject); +begin + FSelectedColor := FSLPicker.SelectedColor; + DoChange; +end; + +procedure TSLHColorPicker.DoChange; +begin + FHValue := FHPicker.Hue; + FSValue := FSLPicker.Saturation; + FLValue := FSLPicker.Luminance; + FRValue := GetRValue(FSLPicker.SelectedColor); + FGValue := GetGValue(FSLPicker.SelectedColor); + FBValue := GetBValue(FSLPicker.SelectedColor); + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TSLHColorPicker.SelectColor(c: TColor); +begin + FSelectedColor := c; + FHPicker.Hue := GetHValue(c); + FSLPicker.SelectedColor := c; +end; + +procedure TSLHColorPicker.SetH(v: integer); +begin + FHValue := v; + FSLPicker.Hue := v; + FHPicker.Hue := v; +end; + +procedure TSLHColorPicker.SetS(v: integer); +begin + FSValue := v; + FSLPicker.Saturation := v; +end; + +procedure TSLHColorPicker.SetL(v: integer); +begin + FLValue := v; + FSLPicker.Luminance := v; +end; + +procedure TSLHColorPicker.SetR(v: integer); +begin + FRValue := v; + SelectColor(RGB(FRValue, FGValue, FBValue)); +end; + +procedure TSLHColorPicker.SetG(v: integer); +begin + FGValue := v; + SelectColor(RGB(FRValue, FGValue, FBValue)); +end; + +procedure TSLHColorPicker.SetB(v: integer); +begin + FBValue := v; + SelectColor(RGB(FRValue, FGValue, FBValue)); +end; + +function TSLHColorPicker.GetSelectedHexColor: string; +begin + Result := ColorToHex(FSelectedColor); +end; + +procedure TSLHColorPicker.SetHHint(h: string); +begin + FHHint := h; + FHPicker.HintFormat := h; +end; + +procedure TSLHColorPicker.SetSLHint(h: string); +begin + FSLHint := h; + FSLPicker.HintFormat := h; +end; + +procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu); +begin + FSLMenu := m; + FSLPicker.PopupMenu := m; +end; + +procedure TSLHColorPicker.SetHMenu(m: TPopupMenu); +begin + FHMenu := m; + FHPicker.PopupMenu := m; +end; + +procedure TSLHColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +begin + if Assigned(OnMouseMove) then + OnMouseMove(Self, Shift, x, y); + inherited; +end; + +function TSLHColorPicker.GetColorUnderCursor: TColor; +begin + Result := FSLPicker.GetColorUnderCursor; +end; + +function TSLHColorPicker.GetHexColorUnderCursor: string; +begin + Result := FSLPicker.GetHexColorUnderCursor; +end; + +procedure TSLHColorPicker.SetHCursor(c: TCursor); +begin + FHCursor := c; + FHPicker.Cursor := c; +end; + +procedure TSLHColorPicker.SetSLCursor(c: TCursor); +begin + FSLCursor := c; + FSLPicker.Cursor := c; +end; + +procedure TSLHColorPicker.WMSetFocus( + var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} ); +begin + FHPicker.SetFocus; + Message.Result := 1; +end; + +function TSLHColorPicker.GetManual:boolean; +begin + Result := FHPicker.Manual or FSLPicker.Manual; +end; + +procedure TSLHColorPicker.Resize; +begin + inherited; + PaintParentBack; +end; + +procedure TSLHColorPicker.PaintParentBack; +{$IFDEF DELPHI_7_UP} +var + MemDC: HDC; + OldBMP: HBITMAP; +{$ENDIF} +begin + if PBack = nil then + begin + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + end; + PBack.Width := Width; + PBack.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + PBack.Canvas.Brush.Color := clForm else + {$ENDIF} + PBack.Canvas.Brush.Color := Color; + PBack.Canvas.FillRect(PBack.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, PBack.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF}{$ENDIF} +end; + +procedure TSLHColorPicker.Paint; +begin + PaintParentBack; + Canvas.Draw(0, 0, PBack); +end; + +procedure TSLHColorPicker.CreateWnd; +begin + inherited; + PaintParentBack; +end; + +procedure TSLHColorPicker.WMEraseBkgnd( + var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF} ); +begin + Message.Result := 1; +end; + +end. diff --git a/components/mbColorLib/Scanlines.pas b/components/mbColorLib/Scanlines.pas new file mode 100644 index 000000000..9a10ceb37 --- /dev/null +++ b/components/mbColorLib/Scanlines.pas @@ -0,0 +1,72 @@ +unit Scanlines; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC}LCLIntf, LCLType, + {$ELSE}Windows, + {$ENDIF} + Graphics; + +type + TRGBTripleArray = array [0..65535] of TRGBTriple; + pRGBTripleArray = ^TRGBTripleArray; + TRGBQuadArray = array [0..65535] of TRGBQuad; + pRGBQuadArray = ^TRGBQuadArray; + +function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; +function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; overload; +function RGBToRGBQuad(c: TColor): TRGBQuad; overload; +function RGBQuadToRGB(q: TRGBQuad): TColor; +function RGBTripleToTColor(RGBTriple : TRGBTriple) : TColor; + +implementation + +function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; +begin + with Result do + begin + rgbtRed := R; + rgbtGreen := G; + rgbtBlue := B; + end +end; + +function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; overload; +begin + with Result do + begin + rgbRed := R; + rgbGreen := G; + rgbBlue := B; + rgbReserved := 0; + end +end; + +function RGBToRGBQuad(c: TColor): TRGBQuad; overload; +begin + with Result do + begin + rgbRed := GetRValue(c); + rgbGreen := GetGValue(c); + rgbBlue := GetBValue(c); + rgbReserved := 0 + end; +end; + +function RGBQuadToRGB(q: TRGBQuad): TColor; +begin + Result := RGB(q.rgbRed, q.rgbGreen, q.rgbBlue); +end; + +function RGBTripleToTColor(RGBTriple: TRGBTriple): TColor; +begin + Result := RGBTriple.rgbtBlue shl 16 + RGBTriple.rgbtGreen shl 8 + RGBTriple.rgbtRed; +end; + +end. + diff --git a/components/mbColorLib/ScreenWin.dfm b/components/mbColorLib/ScreenWin.dfm new file mode 100644 index 000000000..680598087 --- /dev/null +++ b/components/mbColorLib/ScreenWin.dfm @@ -0,0 +1,26 @@ +object ScreenForm: TScreenForm + Left = 198 + Top = 117 + Align = alClient + BorderIcons = [] + BorderStyle = bsNone + Caption = 'Pick a color...' + ClientHeight = 96 + ClientWidth = 149 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [] + FormStyle = fsStayOnTop + OldCreateOrder = False + Position = poDefault + OnCreate = FormCreate + OnKeyDown = FormKeyDown + OnMouseMove = FormMouseMove + OnMouseUp = FormMouseUp + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 +end diff --git a/components/mbColorLib/ScreenWin.lfm b/components/mbColorLib/ScreenWin.lfm new file mode 100644 index 000000000..297562a00 --- /dev/null +++ b/components/mbColorLib/ScreenWin.lfm @@ -0,0 +1,20 @@ +object ScreenForm: TScreenForm + Left = 198 + Height = 96 + Top = 117 + Width = 149 + Align = alClient + BorderIcons = [] + BorderStyle = bsNone + Caption = 'Pick a color...' + Color = clBtnFace + Font.Color = clWindowText + FormStyle = fsStayOnTop + OnCreate = FormCreate + OnKeyDown = FormKeyDown + OnMouseMove = FormMouseMove + OnMouseUp = FormMouseUp + OnShow = FormShow + Position = poDefault + LCLVersion = '1.7' +end diff --git a/components/mbColorLib/ScreenWin.pas b/components/mbColorLib/ScreenWin.pas new file mode 100644 index 000000000..5ebe6eb60 --- /dev/null +++ b/components/mbColorLib/ScreenWin.pas @@ -0,0 +1,162 @@ +unit ScreenWin; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, StdCtrls, + PalUtils; + +const + crPickerCursor = 13; + +type + TScreenForm = class(TForm) + procedure FormShow(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure EndSelection(x, y: integer; ok: boolean); + procedure FormMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + + private + FOnSelColorChange: TNotifyEvent; + FOnKeyDown: TKeyEvent; + + protected + procedure CreateParams(var Params:TCreateParams); override; + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + + public + FHintFormat: string; + SelectedColor: TColor; + property OnSelColorChange: TNotifyEvent read FOnSelColorChange write FOnSelColorChange; + property OnScreenKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; + end; + +var + ScreenForm: TScreenForm; + +implementation + +{$IFDEF DELPHI} + {$R *.dfm} +{$ELSE} + {$R *.lfm} +{$ENDIF} + +{$R PickCursor.res} + +function ColorToHex(Color: TColor): string; +begin + Result := IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) + IntToHex(GetBValue(Color), 2); +end; + +function GetDesktopColor(const X, Y: Integer): TColor; +{$IFDEF DELPHI} +var + c: TCanvas; +begin + c := TCanvas.Create; + try + c.Handle := GetWindowDC(GetDesktopWindow); + Result := GetPixel(c.Handle, X, Y); + finally + 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.CreateParams(var Params:TCreateParams); +Begin + inherited CreateParams(Params); + Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST; +end; + +procedure TScreenForm.FormShow(Sender: TObject); +begin + Width := Screen.Width; + Height := Screen.Height; + Left := 0; + Top := 0; +end; + +procedure TScreenForm.FormCreate(Sender: TObject); +begin + Brush.Style := bsClear; + Screen.Cursors[crPickerCursor] := LoadCursor(HInstance, 'PickerCursor'); + Cursor := crPickerCursor; + SelectedColor := clNone; + FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: %h'; +end; + +procedure TScreenForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if (key = VK_ESCAPE) or (ssAlt in Shift) or (ssCtrl in Shift) then + EndSelection(0, 0, false); + if Assigned(FOnKeyDown) then 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 + SelectedColor := GetDesktopColor(x, y); + if Assigned(FOnSelColorChange) then FOnSelColorChange(Self); +end; + +procedure TScreenForm.CMHintShow(var Message: TCMHintShow); +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; +end; + +end. diff --git a/components/mbColorLib/SelPropUtils.pas b/components/mbColorLib/SelPropUtils.pas new file mode 100644 index 000000000..8e2d00da7 --- /dev/null +++ b/components/mbColorLib/SelPropUtils.pas @@ -0,0 +1,80 @@ +unit SelPropUtils; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, + {$ELSE} + Windows, + {$ENDIF} + Classes, Graphics; + +procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor); +procedure DrawSelCrossCirc(x, y: integer; Canvas: TCanvas; Color: TColor); +procedure DrawSelCirc(x, y: integer; Canvas: TCanvas); +procedure DrawSelSquare(x, y: integer; Canvas: TCanvas); + +implementation + +procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor); +const + w = 5; + h = 3; + o = 8; +var + R: TRect; +begin + R := Rect(x-10, y-10, x+9, y+9); + Canvas.Brush.Color := Color; + Canvas.FillRect(Rect(R.Left, R.Top + o, R.Left + w, R.Top + o + h)); + Canvas.FillRect(Rect(R.Left + o, R.Top, R.Left + o + h, R.Top + w)); + Canvas.FillRect(Rect(R.Right - w, R.Top + o, R.Right, R.Top + o + h)); + Canvas.FillRect(Rect(R.Left + o, R.Bottom - w, R.Left + o + h, R.Bottom)); +end; + +procedure DrawSelCrossCirc(x, y: integer; Canvas: TCanvas; Color: TColor); +var + R: TRect; +begin + R := Rect(x - 6, y - 6, x + 6, y + 6); + ExcludeClipRect(Canvas.Handle, x - 6, y - 1, x + 6, y + 1); + ExcludeClipRect(Canvas.Handle, x - 1, y - 6, x + 1, y + 6); + Canvas.Pen.Color := Color; + Canvas.Brush.Style := bsClear; + InflateRect(R, -1, -1); + Canvas.Ellipse(R); + InflateRect(R, -1, -1); + Canvas.Ellipse(R); + Canvas.Brush.Style := bsSolid; +end; + +procedure DrawSelCirc(x, y: integer; Canvas: TCanvas); +var + R: TRect; +begin + R := Rect(x - 5, y - 5, x + 5, y + 5); + Canvas.Brush.Style := bsClear; + Canvas.Pen.Mode := pmNot; + Canvas.Ellipse(R); + Canvas.Pen.Mode := pmCopy; + Canvas.Brush.Style := bsSolid; +end; + +procedure DrawSelSquare(x, y: integer; Canvas: TCanvas); +var + R: TRect; +begin + R := Rect(x - 5, y - 5, x + 5, y + 5); + Canvas.Brush.Style := bsClear; + Canvas.Pen.Mode := pmNot; + Canvas.Rectangle(R); + Canvas.Pen.Mode := pmCopy; + Canvas.Brush.Style := bsSolid; +end; + +end. diff --git a/components/mbColorLib/VColorPicker.dcr b/components/mbColorLib/VColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..d8326a005dfb18a3a5232fd1c8370e8cdb05b101 GIT binary patch literal 1856 zcmds$u}cDB7{;F(DtL!$Iw~B*z_SR7!qVX=NWoIbG$kiDr*6q9r?wWymevU8pgC}k z{(xvN+FOO|E$g@*4?f(YkKYIH`{Q}vyBiJw;(C35c(wd>-ll+z8sDG95$f2*0ZMu+ zC}U5%BJx@f&)V$5%+GL2i@EPR@l^qR-NncMeDeRtnnon!etU9WVipLM<L=pr%d!nZ z<+yuxlCl*8p_2A^o=1k-(u(93L8uJJ>a|+6S`C}gy0I>mB@iluWT8-ST{oM}1}3s- zWu&<ZLgg^5OVa7I<2Z>#B62*C?QQWkL8uG@PRg-u+p?^{L>A|H>9`<NhQqo<|E{nZ zt-B?;$bnEvN#pxmRpfFXgi6|DY<ms4J_MoCI7orJrraKbP)RXk+i%Hz6NF0RAO#*h yd1!%9Nik#ld@4^TAXFL$De!tGFKrMiDQ0ZnJBY+MNP$7GJh&+`y)woAe)|D<v%&oU literal 0 HcmV?d00001 diff --git a/components/mbColorLib/VColorPicker.pas b/components/mbColorLib/VColorPicker.pas new file mode 100644 index 000000000..05ae87442 --- /dev/null +++ b/components/mbColorLib/VColorPicker.pas @@ -0,0 +1,270 @@ +unit VColorPicker; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Forms, Graphics, + RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TVColorPicker = class(TmbTrackBarPicker) + private + FHue, FSat, FVal: integer; + FVBmp: TBitmap; + + function ArrowPosFromVal(l: integer): integer; + function ValFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateVGradient; + procedure SetHue(h: integer); + procedure SetSat(s: integer); + procedure SetValue(v: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Hue: integer read FHue write SetHue default 0; + property Saturation: integer read FSat write SetSat default 0; + property Value: integer read FVal write SetValue default 255; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Layout default lyVertical; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R VColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TVColorPicker]); +end; + +{TVColorPicker} + +constructor TVColorPicker.Create(AOwner: TComponent); +begin + inherited; + FVBmp := TBitmap.Create; + FVBmp.PixelFormat := pf32bit; + FVBmp.SetSize(12, 255); + Width := 22; + Height := 267; + Layout := lyVertical; + FHue := 0; + FSat := 0; + FArrowPos := ArrowPosFromVal(255); + FChange := false; + SetValue(255); + HintFormat := 'Value: %value'; + FManual := false; + FChange := true; +end; + +destructor TVColorPicker.Destroy; +begin + FVBmp.Free; + inherited Destroy; +end; + +procedure TVColorPicker.CreateWnd; +begin + inherited; + CreateVGradient; +end; + +procedure TVColorPicker.CreateVGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FVBmp = nil then + begin + FVBmp := TBitmap.Create; + FVBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FVBmp.width := 255; + FVBmp.height := 12; + for i := 0 to 254 do + for j := 0 to 11 do + begin + row := FVBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(HSVtoColor(FHue, FSat, i)) +// FVBmp.Canvas.Pixels[i, j] := HSVtoColor(FHue, FSat, i) + else + row[i] := RGBToRGBQuad(GetWebSafe(HSVtoColor(FHue, FSat, i))); +// FVBmp.Canvas.Pixels[i, j] := GetWebSafe(HSVtoColor(FHue, FSat, i)); + end; + end + else + begin + FVBmp.width := 12; + FVBmp.height := 255; + for i := 0 to 254 do + begin + row := FVBmp.ScanLine[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBToRGBQuad(HSVtoColor(FHue, FSat, 255 - i)) +// FVBmp.Canvas.Pixels[j, i] := HSVtoColor(FHue, FSat, 255 - i) + else + row[j] := RGBToRGBQuad(GetWebSafe(HSVtoColor(FHue, FSat, 255 - i))); +// FVBmp.Canvas.Pixels[j, i] := GetWebSafe(HSVtoColor(FHue, FSat, 255 - i)); + end; + end; +end; + +procedure TVColorPicker.SetHue(h: integer); +begin + if h > 360 then h := 360; + if h < 0 then h := 0; + if FHue <> h then + begin + FHue := h; + FManual := false; + CreateVGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TVColorPicker.SetSat(s: integer); +begin + if s > 255 then s := 255; + if s < 0 then s := 0; + if FSat <> s then + begin + FSat := s; + FManual := false; + CreateVGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TVColorPicker.ArrowPosFromVal(l: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*l); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + l := 255 - l; + a := Round(((Height - 12)/255)*l); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TVColorPicker.ValFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +procedure TVColorPicker.SetValue(V: integer); +begin + if v < 0 then v := 0; + if v > 255 then v := 255; + if FVal <> v then + begin + FVal := v; + FArrowPos := ArrowPosFromVal(v); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TVColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := HSVtoColor(FHue, FSat, FVal) + else + Result := GetWebSafe(HSVtoColor(FHue, FSat, FVal)); +end; + +function TVColorPicker.GetSelectedValue: integer; +begin + Result := FVal; +end; + +procedure TVColorPicker.SetSelectedColor(c: TColor); +var + h, s, v: integer; +begin + if WebSafe then c := GetWebSafe(c); + RGBToHSV(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 TVColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromVal(FVal); +end; + +procedure TVColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetValue(FVal); + TBA_Paint: Canvas.StretchDraw(FPickRect, FVBmp); + TBA_MouseMove: FVal := ValFromArrowPos(FArrowPos); + TBA_MouseDown: FVal := ValFromArrowPos(FArrowPos); + TBA_MouseUp: FVal := ValFromArrowPos(FArrowPos); + TBA_WheelUp: SetValue(FVal + Increment); + TBA_WheelDown: SetValue(FVal - Increment); + TBA_VKRight: SetValue(FVal + Increment); + TBA_VKCtrlRight: SetValue(255); + TBA_VKLeft: SetValue(FVal - Increment); + TBA_VKCtrlLeft: SetValue(0); + TBA_VKUp: SetValue(FVal + Increment); + TBA_VKCtrlUp: SetValue(255); + TBA_VKDown: SetValue(FVal - Increment); + TBA_VKCtrlDown: SetValue(0); + TBA_RedoBMP: CreateVGradient; + end; +end; + +end. diff --git a/components/mbColorLib/XPLibIntegration.txt b/components/mbColorLib/XPLibIntegration.txt new file mode 100644 index 000000000..f426f2522 --- /dev/null +++ b/components/mbColorLib/XPLibIntegration.txt @@ -0,0 +1,3 @@ +mbXP Lib Integration + +If you want to use mbXP Lib for the mbColor Lib open the file mxs.inc and remove the dot (.) from {.$DEFINE mbXP_Lib}. \ No newline at end of file diff --git a/components/mbColorLib/YColorPicker.dcr b/components/mbColorLib/YColorPicker.dcr new file mode 100644 index 0000000000000000000000000000000000000000..b7f1a7245abac883a2b49d9dab86ac3c7aec6445 GIT binary patch literal 1856 zcmb`Gp-Mzi6h)5)8PG78WIzy;wh0C?38EkhiWtUVv-k}Llffuh1*>2c>tNOoFxc&W zz;f$#E>}He!#vh~>^H2v=S`T1hy@)eNAcJ7J{7U5Phc_*<0v*_FLrefVn4R^v=f`k z<?45Pol$v7VeaQle5Z(^wq~cx8F_qt^Ei0}m-GeP5&7xPE4ZXPFYxRjKizqPp@aN% z=Mf$p<fl9LaOWUD-MNJu2l?sFHC#E!Pj@ci!a;tza}H+?^8f6VzuHHHODWbhJu08V ziGzH#O1Dgvd<+8z`Tut`<^Cx7<ti^z?_03$Ais9oum&p*^4ogNeOPvoU%PEsgn0+~ YZN26$xYTYNX27Mb*X)kSuiY_*Pe{A#rvLx| literal 0 HcmV?d00001 diff --git a/components/mbColorLib/YColorPicker.pas b/components/mbColorLib/YColorPicker.pas new file mode 100644 index 000000000..c4179b16f --- /dev/null +++ b/components/mbColorLib/YColorPicker.pas @@ -0,0 +1,290 @@ +unit YColorPicker; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines; + +type + TYColorPicker = class(TmbTrackBarPicker) + private + FYellow, FMagenta, FCyan, FBlack: integer; + FYBmp: TBitmap; + + function ArrowPosFromYellow(y: integer): integer; + function YellowFromArrowPos(p: integer): integer; + function GetSelectedColor: TColor; + procedure SetSelectedColor(c: TColor); + procedure CreateYGradient; + procedure SetYellow(y: integer); + procedure SetMagenta(m: integer); + procedure SetCyan(c: integer); + procedure SetBlack(k: integer); + protected + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); override; + function GetArrowPos: integer; override; + function GetSelectedValue: integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Yellow: integer read FYellow write SetYellow default 255; + property Magenta: integer read FMagenta write SetMagenta default 0; + property Cyan: integer read FCyan write SetCyan 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; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R YColorPicker.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TYColorPicker]); +end; + +{TYColorPicker} + +constructor TYColorPicker.Create(AOwner: TComponent); +begin + inherited; + FYBmp := TBitmap.Create; + FYBmp.PixelFormat := pf32bit; + FYBmp.SetSize(12, 255); + Width := 22; + Height := 267; + Layout := lyVertical; + FYellow := 255; + FMagenta := 0; + FCyan := 0; + FBlack := 0; + FArrowPos := ArrowPosFromYellow(255); + FChange := false; + SetYellow(255); + HintFormat := 'Yellow: %value'; + FManual := false; + FChange := true; +end; + +destructor TYColorPicker.Destroy; +begin + FYBmp.Free; + inherited Destroy; +end; + +procedure TYColorPicker.CreateWnd; +begin + inherited; + CreateYGradient; +end; + +procedure TYColorPicker.CreateYGradient; +var + i,j: integer; + row: pRGBQuadArray; +begin + if FYBmp = nil then + begin + FYBmp := TBitmap.Create; + FYBmp.PixelFormat := pf32bit; + end; + if Layout = lyHorizontal then + begin + FYBmp.width := 255; + FYBmp.height := 12; + for i := 0 to 254 do + for j := 0 to 11 do + begin + row := FYBmp.Scanline[j]; + if not WebSafe then + row[i] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, i, FBlack)) +// FYBmp.Canvas.Pixels[i, j] := CMYKtoTColor(FCyan, FMagenta, i, FBlack) + else + row[i] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, i, FBlack))); +// FYBmp.Canvas.Pixels[i, j] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, i, FBlack)); + end; + end + else + begin + FYBmp.width := 12; + FYBmp.height := 255; + for i := 0 to 254 do + begin + row := FYBmp.Scanline[i]; + for j := 0 to 11 do + if not WebSafe then + row[j] := RGBToRGBQuad(CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack)) +// FYBmp.Canvas.Pixels[j, i] := CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack) + else + row[j] := RGBToRGBQuad(GetWebSafe(CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack))); +// FYBmp.Canvas.Pixels[j, i] := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, 255-i, FBlack)); + end; + end; +end; + +procedure TYColorPicker.SetYellow(y: integer); +begin + if y < 0 then y := 0; + if y > 255 then y := 255; + if FYellow <> y then + begin + FYellow := y; + FArrowPos := ArrowPosFromYellow(y); + FManual := false; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TYColorPicker.SetMagenta(m: integer); +begin + if m > 255 then m := 255; + if m < 0 then m := 0; + if FMagenta <> m then + begin + FMagenta := m; + FManual := false; + CreateYGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TYColorPicker.SetCyan(c: integer); +begin + if c > 255 then c := 255; + if c < 0 then c := 0; + if FCyan <> c then + begin + FCyan := c; + FManual := false; + CreateYGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TYColorPicker.SetBlack(k: integer); +begin + if k > 255 then k := 255; + if k < 0 then k := 0; + if FBlack <> k then + begin + FBlack := k; + FManual := false; + CreateYGradient; + Invalidate; + if FChange then + if Assigned(OnChange) then OnChange(Self); + end; +end; + +function TYColorPicker.ArrowPosFromYellow(y: integer): integer; +var + a: integer; +begin + if Layout = lyHorizontal then + begin + a := Round(((Width - 12)/255)*y); + if a > Width - FLimit then a := Width - FLimit; + end + else + begin + y := 255 - y; + a := Round(((Height - 12)/255)*y); + if a > Height - FLimit then a := Height - FLimit; + end; + if a < 0 then a := 0; + Result := a; +end; + +function TYColorPicker.YellowFromArrowPos(p: integer): integer; +var + r: integer; +begin + if Layout = lyHorizontal then + r := Round(p/((Width - 12)/255)) + else + r := Round(255 - p/((Height - 12)/255)); + if r < 0 then r := 0; + if r > 255 then r := 255; + Result := r; +end; + +function TYColorPicker.GetSelectedColor: TColor; +begin + if not WebSafe then + Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) + else + Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); +end; + +function TYColorPicker.GetSelectedValue: integer; +begin + Result := FYellow; +end; + +procedure TYColorPicker.SetSelectedColor(c: TColor); +var + cy, m, y, k: integer; +begin + if WebSafe then c := GetWebSafe(c); + ColorToCMYK(c, cy, m, y, k); + FChange := false; + SetMagenta(m); + SetCyan(cy); + SetBlack(k); + SetYellow(y); + FManual := false; + FChange := true; + if Assigned(OnChange) then OnChange(Self); +end; + +function TYColorPicker.GetArrowPos: integer; +begin + Result := ArrowPosFromYellow(FYellow); +end; + +procedure TYColorPicker.Execute(tbaAction: integer); +begin + case tbaAction of + TBA_Resize: SetYellow(FYellow); + TBA_Paint: Canvas.StretchDraw(FPickRect, FYBmp); + TBA_MouseMove: FYellow := YellowFromArrowPos(FArrowPos); + TBA_MouseDown: FYellow := YellowFromArrowPos(FArrowPos); + TBA_MouseUp: FYellow := YellowFromArrowPos(FArrowPos); + TBA_WheelUp: SetYellow(FYellow + Increment); + TBA_WheelDown: SetYellow(FYellow - Increment); + TBA_VKRight: SetYellow(FYellow + Increment); + TBA_VKCtrlRight: SetYellow(255); + TBA_VKLeft: SetYellow(FYellow - Increment); + TBA_VKCtrlLeft: SetYellow(0); + TBA_VKUp: SetYellow(FYellow + Increment); + TBA_VKCtrlUp: SetYellow(255); + TBA_VKDown: SetYellow(FYellow - Increment); + TBA_VKCtrlDown: SetYellow(0); + TBA_RedoBMP: CreateYGradient; + end; +end; + +end. diff --git a/components/mbColorLib/clean.bat b/components/mbColorLib/clean.bat new file mode 100644 index 000000000..26c843101 --- /dev/null +++ b/components/mbColorLib/clean.bat @@ -0,0 +1,13 @@ +@echo off +del /S *.drc +del /S *.mes +del /S *.local +del /S *.IDENTCACHE +del /S *.dcu +del /S *.dsk +del /S *.dof +del /S *.cfg +del /S *.~* +del /S *.exe +del /S *.map +@cls \ No newline at end of file diff --git a/components/mbColorLib/clear history.bat b/components/mbColorLib/clear history.bat new file mode 100644 index 000000000..64b5e2585 --- /dev/null +++ b/components/mbColorLib/clear history.bat @@ -0,0 +1,4 @@ +@echo off +del __history\*.* +rd __history +@cls \ No newline at end of file diff --git a/components/mbColorLib/mbColorLibD10.dpk b/components/mbColorLib/mbColorLibD10.dpk new file mode 100644 index 000000000..9f7f28b1a --- /dev/null +++ b/components/mbColorLib/mbColorLibD10.dpk @@ -0,0 +1,110 @@ +package mbColorLibD10; + +{$R *.res} +{$R 'HexaColorPicker.dcr'} +{$R 'HSColorPicker.dcr'} +{$R 'HSLColorPicker.dcr'} +{$R 'LColorPicker.dcr'} +{$R 'mbColorPreview.dcr'} +{$R 'mbDeskPickerButton.dcr'} +{$R 'mbOfficeColorDialog.dcr'} +{$R 'mbColorPalette.dcr'} +{$R 'HColorPicker.dcr'} +{$R 'SColorPicker.dcr'} +{$R 'VColorPicker.dcr'} +{$R 'SLColorPicker.dcr'} +{$R 'HSVColorPicker.dcr'} +{$R 'HRingPicker.dcr'} +{$R 'HSLRingPicker.dcr'} +{$R 'SLHColorPicker.dcr'} +{$R 'YColorPicker.dcr'} +{$R 'BAxisColorPicker.dcr'} +{$R 'BColorPicker.dcr'} +{$R 'CColorPicker.dcr'} +{$R 'CIEAColorPicker.dcr'} +{$R 'CIEBColorPicker.dcr'} +{$R 'CIELColorPicker.dcr'} +{$R 'GAxisColorPicker.dcr'} +{$R 'GColorPicker.dcr'} +{$R 'KColorPicker.dcr'} +{$R 'mbColorList.dcr'} +{$R 'mbColorTree.dcr'} +{$R 'MColorPicker.dcr'} +{$R 'RAxisColorPicker.dcr'} +{$R 'RColorPicker.dcr'} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'MXS -- mbColor Lib v2.0.2 (Color pickers)'} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + VclSmp, + vclx; + +contains + HexaColorPicker in 'HexaColorPicker.pas', + HSColorPicker in 'HSColorPicker.pas', + HSLColorPicker in 'HSLColorPicker.pas', + LColorPicker in 'LColorPicker.pas', + RGBHSLUtils in 'RGBHSLUtils.pas', + mbColorPreview in 'mbColorPreview.pas', + mbDeskPickerButton in 'mbDeskPickerButton.pas', + ScreenWin in 'ScreenWin.pas' {ScreenForm}, + OfficeMoreColorsDialog in 'OfficeMoreColorsDialog.pas' {OfficeMoreColorsWin}, + mbOfficeColorDialog in 'mbOfficeColorDialog.pas', + mbColorPalette in 'mbColorPalette.pas', + HTMLColors in 'HTMLColors.pas', + RGBHSVUtils in 'RGBHSVUtils.pas', + VColorPicker in 'VColorPicker.pas', + HColorPicker in 'HColorPicker.pas', + SColorPicker in 'SColorPicker.pas', + mbTrackBarPicker in 'mbTrackBarPicker.pas', + SLColorPicker in 'SLColorPicker.pas', + HRingPicker in 'HRingPicker.pas', + HSLRingPicker in 'HSLRingPicker.pas', + HSVColorPicker in 'HSVColorPicker.pas', + SLHColorPicker in 'SLHColorPicker.pas', + YColorPicker in 'YColorPicker.pas', + BAxisColorPicker in 'BAxisColorPicker.pas', + BColorPicker in 'BColorPicker.pas', + CColorPicker in 'CColorPicker.pas', + CIEAColorPicker in 'CIEAColorPicker.pas', + CIEBColorPicker in 'CIEBColorPicker.pas', + CIELColorPicker in 'CIELColorPicker.pas', + GAxisColorPicker in 'GAxisColorPicker.pas', + GColorPicker in 'GColorPicker.pas', + KColorPicker in 'KColorPicker.pas', + mbColorList in 'mbColorList.pas', + mbColorPickerControl in 'mbColorPickerControl.pas', + mbColorTree in 'mbColorTree.pas', + MColorPicker in 'MColorPicker.pas', + PalUtils in 'PalUtils.pas', + RAxisColorPicker in 'RAxisColorPicker.pas', + RColorPicker in 'RColorPicker.pas', + RGBCIEUtils in 'RGBCIEUtils.pas', + RGBCMYKUtils in 'RGBCMYKUtils.pas', + Scanlines in 'Scanlines.pas', + SelPropUtils in 'SelPropUtils.pas'; + +end. diff --git a/components/mbColorLib/mbColorLibD5.dpk b/components/mbColorLib/mbColorLibD5.dpk new file mode 100644 index 000000000..ff06f5f2e --- /dev/null +++ b/components/mbColorLib/mbColorLibD5.dpk @@ -0,0 +1,109 @@ +package mbColorLibD5; + +{$I mxs.inc} +{$R *.res} +{$R 'HexaColorPicker.dcr'} +{$R 'HSColorPicker.dcr'} +{$R 'HSLColorPicker.dcr'} +{$R 'LColorPicker.dcr'} +{$R 'mbColorPreview.dcr'} +{$R 'mbDeskPickerButton.dcr'} +{$R 'mbOfficeColorDialog.dcr'} +{$R 'mbColorPalette.dcr'} +{$R 'HColorPicker.dcr'} +{$R 'SColorPicker.dcr'} +{$R 'VColorPicker.dcr'} +{$R 'SLColorPicker.dcr'} +{$R 'HSVColorPicker.dcr'} +{$R 'HRingPicker.dcr'} +{$R 'HSLRingPicker.dcr'} +{$R 'SLHColorPicker.dcr'} +{$R 'MColorPicker.dcr'} +{$R 'YColorPicker.dcr'} +{$R 'CColorPicker.dcr'} +{$R 'KColorPicker.dcr'} +{$R 'BAxisColorPicker.dcr'} +{$R 'CIEAColorPicker.dcr'} +{$R 'CIEBColorPicker.dcr'} +{$R 'CIELColorPicker.dcr'} +{$R 'GAxisColorPicker.dcr'} +{$R 'RAxisColorPicker.dcr'} +{$R 'BColorPicker.dcr'} +{$R 'GColorPicker.dcr'} +{$R 'RColorPicker.dcr'} +{$R 'mbColorTree.dcr'} +{$R 'mbColorList.dcr'} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'MXS -- mbColor Lib v2.0.1 (Color pickers)'} +{$IMPLICITBUILD OFF} + +requires + vcl50, + VclSmp50{$IFDEF mbXP_Lib}, + mbXPLibD5{$ENDIF}; + +contains + HexaColorPicker in 'HexaColorPicker.pas', + HSColorPicker in 'HSColorPicker.pas', + HSLColorPicker in 'HSLColorPicker.pas', + LColorPicker in 'LColorPicker.pas', + RGBHSLUtils in 'RGBHSLUtils.pas', + mbColorPreview in 'mbColorPreview.pas', + mbDeskPickerButton in 'mbDeskPickerButton.pas', + ScreenWin in 'ScreenWin.pas' {ScreenForm}, + OfficeMoreColorsDialog in 'OfficeMoreColorsDialog.pas' {OfficeMoreColorsWin}, + mbOfficeColorDialog in 'mbOfficeColorDialog.pas', + mbColorPalette in 'mbColorPalette.pas', + HTMLColors in 'HTMLColors.pas', + RGBHSVUtils in 'RGBHSVUtils.pas', + VColorPicker in 'VColorPicker.pas', + HColorPicker in 'HColorPicker.pas', + SColorPicker in 'SColorPicker.pas', + mbTrackBarPicker in 'mbTrackBarPicker.pas', + SLColorPicker in 'SLColorPicker.pas', + HRingPicker in 'HRingPicker.pas', + HSLRingPicker in 'HSLRingPicker.pas', + HSVColorPicker in 'HSVColorPicker.pas', + SLHColorPicker in 'SLHColorPicker.pas', + PalUtils in 'PalUtils.pas', + RGBCMYKUtils in 'RGBCMYKUtils.pas', + SelPropUtils in 'SelPropUtils.pas', + mbColorPickerControl in 'mbColorPickerControl.pas', + RGBCIEUtils in 'RGBCIEUtils.pas', + CColorPicker in 'CColorPicker.pas', + MColorPicker in 'MColorPicker.pas', + YColorPicker in 'YColorPicker.pas', + KColorPicker in 'KColorPicker.pas', + mbColorTree in 'mbColorTree.pas', + RAxisColorPicker in 'RAxisColorPicker.pas', + GAxisColorPicker in 'GAxisColorPicker.pas', + BAxisColorPicker in 'BAxisColorPicker.pas', + RColorPicker in 'RColorPicker.pas', + CIELColorPicker in 'CIELColorPicker.pas', + CIEAColorPicker in 'CIEAColorPicker.pas', + CIEBColorPicker in 'CIEBColorPicker.pas', + GColorPicker in 'GColorPicker.pas', + BColorPicker in 'BColorPicker.pas', + Scanlines in 'Scanlines.pas', + mbColorList in 'mbColorList.pas'; + +end. diff --git a/components/mbColorLib/mbColorLibD7.dpk b/components/mbColorLib/mbColorLibD7.dpk new file mode 100644 index 000000000..d70cad922 --- /dev/null +++ b/components/mbColorLib/mbColorLibD7.dpk @@ -0,0 +1,110 @@ +package mbColorLibD7; + +{$I mxs.inc} +{$R *.res} +{$R 'HexaColorPicker.dcr'} +{$R 'HSColorPicker.dcr'} +{$R 'HSLColorPicker.dcr'} +{$R 'LColorPicker.dcr'} +{$R 'mbColorPreview.dcr'} +{$R 'mbDeskPickerButton.dcr'} +{$R 'mbOfficeColorDialog.dcr'} +{$R 'mbColorPalette.dcr'} +{$R 'HColorPicker.dcr'} +{$R 'SColorPicker.dcr'} +{$R 'VColorPicker.dcr'} +{$R 'SLColorPicker.dcr'} +{$R 'HSVColorPicker.dcr'} +{$R 'HRingPicker.dcr'} +{$R 'HSLRingPicker.dcr'} +{$R 'SLHColorPicker.dcr'} +{$R 'MColorPicker.dcr'} +{$R 'YColorPicker.dcr'} +{$R 'CColorPicker.dcr'} +{$R 'KColorPicker.dcr'} +{$R 'BAxisColorPicker.dcr'} +{$R 'CIEAColorPicker.dcr'} +{$R 'CIEBColorPicker.dcr'} +{$R 'CIELColorPicker.dcr'} +{$R 'GAxisColorPicker.dcr'} +{$R 'RAxisColorPicker.dcr'} +{$R 'BColorPicker.dcr'} +{$R 'GColorPicker.dcr'} +{$R 'RColorPicker.dcr'} +{$R 'mbColorTree.dcr'} +{$R 'mbColorList.dcr'} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'MXS -- mbColor Lib v2.0.1 (Color pickers)'} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl{$IFDEF mbXP_Lib}, + mbXPLibD7{$ENDIF}; + +contains + HexaColorPicker in 'HexaColorPicker.pas', + HSColorPicker in 'HSColorPicker.pas', + HSLColorPicker in 'HSLColorPicker.pas', + LColorPicker in 'LColorPicker.pas', + RGBHSLUtils in 'RGBHSLUtils.pas', + mbColorPreview in 'mbColorPreview.pas', + mbDeskPickerButton in 'mbDeskPickerButton.pas', + ScreenWin in 'ScreenWin.pas' {ScreenForm}, + OfficeMoreColorsDialog in 'OfficeMoreColorsDialog.pas' {OfficeMoreColorsWin}, + mbOfficeColorDialog in 'mbOfficeColorDialog.pas', + mbColorPalette in 'mbColorPalette.pas', + HTMLColors in 'HTMLColors.pas', + RGBHSVUtils in 'RGBHSVUtils.pas', + VColorPicker in 'VColorPicker.pas', + HColorPicker in 'HColorPicker.pas', + SColorPicker in 'SColorPicker.pas', + mbTrackBarPicker in 'mbTrackBarPicker.pas', + SLColorPicker in 'SLColorPicker.pas', + HRingPicker in 'HRingPicker.pas', + HSLRingPicker in 'HSLRingPicker.pas', + HSVColorPicker in 'HSVColorPicker.pas', + SLHColorPicker in 'SLHColorPicker.pas', + PalUtils in 'PalUtils.pas', + RGBCMYKUtils in 'RGBCMYKUtils.pas', + SelPropUtils in 'SelPropUtils.pas', + mbColorPickerControl in 'mbColorPickerControl.pas', + RGBCIEUtils in 'RGBCIEUtils.pas', + CColorPicker in 'CColorPicker.pas', + MColorPicker in 'MColorPicker.pas', + YColorPicker in 'YColorPicker.pas', + KColorPicker in 'KColorPicker.pas', + mbColorTree in 'mbColorTree.pas', + RAxisColorPicker in 'RAxisColorPicker.pas', + GAxisColorPicker in 'GAxisColorPicker.pas', + BAxisColorPicker in 'BAxisColorPicker.pas', + RColorPicker in 'RColorPicker.pas', + CIELColorPicker in 'CIELColorPicker.pas', + CIEAColorPicker in 'CIEAColorPicker.pas', + CIEBColorPicker in 'CIEBColorPicker.pas', + GColorPicker in 'GColorPicker.pas', + BColorPicker in 'BColorPicker.pas', + Scanlines in 'Scanlines.pas', + mbColorList in 'mbColorList.pas'; + +end. diff --git a/components/mbColorLib/mbColorLibD9.dpk b/components/mbColorLib/mbColorLibD9.dpk new file mode 100644 index 000000000..f38c9862f --- /dev/null +++ b/components/mbColorLib/mbColorLibD9.dpk @@ -0,0 +1,111 @@ +package mbColorLibD9; + +{$R *.res} +{$R 'HexaColorPicker.dcr'} +{$R 'HSColorPicker.dcr'} +{$R 'HSLColorPicker.dcr'} +{$R 'LColorPicker.dcr'} +{$R 'mbColorPreview.dcr'} +{$R 'mbDeskPickerButton.dcr'} +{$R 'mbOfficeColorDialog.dcr'} +{$R 'mbColorPalette.dcr'} +{$R 'HColorPicker.dcr'} +{$R 'SColorPicker.dcr'} +{$R 'VColorPicker.dcr'} +{$R 'SLColorPicker.dcr'} +{$R 'HSVColorPicker.dcr'} +{$R 'HRingPicker.dcr'} +{$R 'HSLRingPicker.dcr'} +{$R 'SLHColorPicker.dcr'} +{$R 'YColorPicker.dcr'} +{$R 'BAxisColorPicker.dcr'} +{$R 'BColorPicker.dcr'} +{$R 'CColorPicker.dcr'} +{$R 'CIEAColorPicker.dcr'} +{$R 'CIEBColorPicker.dcr'} +{$R 'CIELColorPicker.dcr'} +{$R 'GAxisColorPicker.dcr'} +{$R 'GColorPicker.dcr'} +{$R 'KColorPicker.dcr'} +{$R 'mbColorList.dcr'} +{$R 'mbColorTree.dcr'} +{$R 'MColorPicker.dcr'} +{$R 'RAxisColorPicker.dcr'} +{$R 'RColorPicker.dcr'} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'MXS -- mbColor Lib v2.0.1 (Color pickers)'} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + VclSmp, + vclx{$IFDEF mbXP_Lib}, + mbXPLibD9{$ENDIF}; + +contains + HexaColorPicker in 'HexaColorPicker.pas', + HSColorPicker in 'HSColorPicker.pas', + HSLColorPicker in 'HSLColorPicker.pas', + LColorPicker in 'LColorPicker.pas', + RGBHSLUtils in 'RGBHSLUtils.pas', + mbColorPreview in 'mbColorPreview.pas', + mbDeskPickerButton in 'mbDeskPickerButton.pas', + ScreenWin in 'ScreenWin.pas' {ScreenForm}, + OfficeMoreColorsDialog in 'OfficeMoreColorsDialog.pas' {OfficeMoreColorsWin}, + mbOfficeColorDialog in 'mbOfficeColorDialog.pas', + mbColorPalette in 'mbColorPalette.pas', + HTMLColors in 'HTMLColors.pas', + RGBHSVUtils in 'RGBHSVUtils.pas', + VColorPicker in 'VColorPicker.pas', + HColorPicker in 'HColorPicker.pas', + SColorPicker in 'SColorPicker.pas', + mbTrackBarPicker in 'mbTrackBarPicker.pas', + SLColorPicker in 'SLColorPicker.pas', + HRingPicker in 'HRingPicker.pas', + HSLRingPicker in 'HSLRingPicker.pas', + HSVColorPicker in 'HSVColorPicker.pas', + SLHColorPicker in 'SLHColorPicker.pas', + YColorPicker in 'YColorPicker.pas', + BAxisColorPicker in 'BAxisColorPicker.pas', + BColorPicker in 'BColorPicker.pas', + CColorPicker in 'CColorPicker.pas', + CIEAColorPicker in 'CIEAColorPicker.pas', + CIEBColorPicker in 'CIEBColorPicker.pas', + CIELColorPicker in 'CIELColorPicker.pas', + GAxisColorPicker in 'GAxisColorPicker.pas', + GColorPicker in 'GColorPicker.pas', + KColorPicker in 'KColorPicker.pas', + mbColorList in 'mbColorList.pas', + mbColorPickerControl in 'mbColorPickerControl.pas', + mbColorTree in 'mbColorTree.pas', + MColorPicker in 'MColorPicker.pas', + PalUtils in 'PalUtils.pas', + RAxisColorPicker in 'RAxisColorPicker.pas', + RColorPicker in 'RColorPicker.pas', + RGBCIEUtils in 'RGBCIEUtils.pas', + RGBCMYKUtils in 'RGBCMYKUtils.pas', + Scanlines in 'Scanlines.pas', + SelPropUtils in 'SelPropUtils.pas'; + +end. diff --git a/components/mbColorLib/mbColorList.dcr b/components/mbColorLib/mbColorList.dcr new file mode 100644 index 0000000000000000000000000000000000000000..1976a7541f7579df9b7d583e88e3a7b8b249f20c GIT binary patch literal 1856 zcmcgsF>b>!47_&e(k1BRDahEdW9D`W&>}#R9|Y)D<O>-x<x5@igghg^V9r)aQ;IDc za9n|uPZW7NLV^KcMi&WA7>&ylFlR*M5gUBr9UoZYlfL4-z?xAVZxcnpD`D~H4;2DV z<a&7yu9;Gv{4XXt?6?rHrGnp|DR=gW%tY?Kw`NQuR^GIWW*#jGg*FGynu;i|CrZsN zN*NVZ(34Be?s*>KA$E5?6n;1t-m<Mko4&76dF+Y<u&a;Mi1g88RIK&bQ}yBT`E5Ai zX-n&jdmiE;HpcsrBO>eUM-zNsWvq$E?kE7xT3vrTc@h#<TBK&Vc|VPMe1045)YDd& T#8aMRyZ6%b5Dzi?wGIbY^Sca| literal 0 HcmV?d00001 diff --git a/components/mbColorLib/mbColorList.pas b/components/mbColorLib/mbColorList.pas new file mode 100644 index 000000000..099dbbc9d --- /dev/null +++ b/components/mbColorLib/mbColorList.pas @@ -0,0 +1,447 @@ +unit mbColorList; + +interface + +{$I mxs.inc} +{$IFDEF FPC}{$MODE DELPHI}{$ENDIF} + +uses + SysUtils, + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + Classes, Controls, StdCtrls, Graphics, + {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} {$IFDEF DELPHI_6_UP}GraphUtil,{$ENDIF} + HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, Forms, + PalUtils; + +type + {$IFNDEF DELPHI_6_UP} + TScrollDirection = (sdLeft, sdRight, sdUp, sdDown); + {$ENDIF} + + TmbColor = record + name: string; + value: TColor; + end; + + TDrawCaptionEvent = procedure (Sender: TObject; AIndex: integer; AFont: TFont; var AText: string; Selected: boolean) of object; + TGetHintEvent = procedure (AIndex: integer; var AHint: string; var Handled: boolean) of object; + + TmbColorList = class(TCustomListBox) + private + FDraw: TDrawCaptionEvent; + mx, my: integer; + FGetHint: TGetHintEvent; + protected + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override; + public + Colors: array of TmbColor; + + constructor Create(AOwner: TComponent); override; + + procedure UpdateColors; + procedure AddColor(Name: string; Value: TColor; refresh: boolean = true); + procedure ClearColors; + procedure DeleteColor(Index: integer; refresh: boolean = true); + procedure DeleteColorByName(Name: string; All: boolean); + procedure DeleteColorByValue(Value: TColor; All: boolean); + procedure InsertColor(Index: integer; Name: string; Value: TColor); + function ColorCount: integer; + published + {$IFDEF DELPHI} + property BevelKind default bkNone; + property BevelEdges; + property BevelInner; + property BevelOuter; + property Ctl3D; + property ImeMode; + property ImeName; + property ParentCtl3D; + property TabWidth; + {$ENDIF} + property ParentColor default False; + property TabStop default True; + {$IFDEF DELPHI_7_UP} + {$IFDEF DELPHI} + property AutoComplete; + {$ENDIF} + property ScrollWidth; + {$ENDIF} + property Align; + property Anchors; + property BiDiMode; + property BorderStyle; + property Color; + property Columns; + property Constraints; + property DragCursor; + property DragKind; + property DragMode; + property Enabled; + property ExtendedSelect; + property Font; + property IntegralHeight default true; + property ItemHeight default 48; + //property Items; // wp: removed + property MultiSelect; + property ParentBiDiMode; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property Sorted; + property TabOrder; + property Visible; + + property OnDrawCaption: TDrawCaptionEvent read FDraw write FDraw; + property OnGetHint: TGetHintEvent read FGetHint write FGetHint; + property OnContextPopup; + {$IFDEF DELPHI_7_UP} + {$IFDEF DELPHI} + property OnData; + property OnDataFind; + property OnDataObject; + {$ENDIF} + {$ENDIF} + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnDrawItem; + property OnEndDock; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMeasureItem; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDock; + property OnStartDrag; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R mbColorList.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TmbColorList]); +end; + +//taken from GraphUtil, only for Delphi 5 +{$IFNDEF DELPHI_6_UP} + +procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection; + Location: TPoint; Size: Integer); +const + ArrowPts: array[TScrollDirection, 0..2] of TPoint = + (((X:1; Y:0), (X:0; Y:1), (X:1; Y:2)), + ((X:0; Y:0), (X:1; Y:1), (X:0; Y:2)), + ((X:0; Y:1), (X:1; Y:0), (X:2; Y:1)), + ((X:0; Y:0), (X:1; Y:1), (X:2; Y:0))); +var + I: Integer; + Pts: array[0..2] of TPoint; + OldWidth: Integer; + OldColor: TColor; +begin + if ACanvas = nil then exit; + OldColor := ACanvas.Brush.Color; + ACanvas.Brush.Color := ACanvas.Pen.Color; + Move(ArrowPts[Direction], Pts, SizeOf(Pts)); + for I := 0 to 2 do + Pts[I] := Point(Pts[I].x * Size + Location.X, Pts[I].y * Size + Location.Y); + with ACanvas do + begin + OldWidth := Pen.Width; + Pen.Width := 1; + Polygon(Pts); + Pen.Width := OldWidth; + Brush.Color := OldColor; + end; +end; + +{$ENDIF} + +constructor TmbColorList.Create(AOwner: TComponent); +begin + inherited; + MaxHue := 360; + MaxSat := 255; + MaxLum := 255; + style := lbOwnerDrawFixed; + SetLength(Colors, 0); + ItemHeight := 48; + IntegralHeight := true; + mx := -1; + my := -1; +end; + +procedure TmbColorList.UpdateColors; +var + i: integer; +begin + Items.Clear; + for i := 0 to Length(Colors) - 1 do + Items.Add(Colors[i].name); +end; + +procedure TmbColorList.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); +var + SR, TR, R: TRect; + itemText: string; +begin + if Length(Colors) = 0 then Exit; + R := Rect; + with Canvas do + begin + //background + Pen.Color := clWindow; + if odSelected in State then + Brush.Color := clHighlight + else + Brush.Color := self.Color; //clBtnFace; + FillRect(R); + MoveTo(R.Left, R.Bottom - 1); + LineTo(R.Right, R.Bottom - 1); + //swatches + SR := Classes.Rect(R.Left + 6, R.Top + 6, R.Left + ItemHeight - 6, R.Top + ItemHeight - 6); + Brush.Color := Self.Colors[Index].value; + if odSelected in State then + begin + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + begin + ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR); + InflateRect(SR, -2, -2); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 80); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Blend(self.Colors[Index].value, clBlack, 90); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Self.Colors[Index].value; + FillRect(SR); + end + else + //windows 9x + begin + {$ENDIF} + Pen.Color := clBackground; + Brush.Color := clWindow; + Rectangle(SR); + InflateRect(SR, -1, -1); + FillRect(SR); + InflateRect(SR, 1, 1); + InflateRect(SR, -2, -2); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 75); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 87); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Self.Colors[Index].value; + FillRect(SR); + {$IFDEF DELPHI_7_UP} + end; + {$ENDIF} + end + else + //not selected + begin + //windows XP + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + begin + ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR); + InflateRect(SR, -2, -2); + Brush.Color := Self.Colors[Index].value; + FillRect(SR); + end + else + //windows 9x + begin + {$ENDIF} + DrawEdge(Canvas.Handle, SR, BDR_SUNKENOUTER, BF_RECT); + InflateRect(SR, -2, -2); + Brush.Color := Self.Colors[Index].value; + Pen.Color := clBlack; + Rectangle(SR); + InflateRect(SR, -1, -1); + FillRect(SR); + InflateRect(SR, 1, 1); + {$IFDEF DELPHI_7_UP} + end; + {$ENDIF} + end; + //names + Font.Style := [fsBold]; + if odSelected in State then + begin + Brush.Color := clHighlight; + Pen.Color := clHighlightText; + Font.Color := clHighlightText; + end + else + begin + Brush.Color := clBtnFace; + Pen.Color := clWindowText; + Font.Color := clWindowText; + end; + itemText := Items.Strings[Index]; + Canvas.Brush.Style := bsClear; + TR := Classes.Rect(R.Left + ItemHeight, R.Top + (ItemHeight - TextHeight(itemText)) div 2, R.Right, R.Bottom - (ItemHeight - TextHeight(itemText)) div 2); + if Assigned(FDraw) then FDraw(Self, Index, Canvas.Font, itemText, odSelected in State); + DrawText(Canvas.Handle, PChar(itemText), Length(itemText), TR, DT_LEFT or DT_NOCLIP or DT_END_ELLIPSIS); + end; +end; + +procedure TmbColorList.AddColor(Name: string; Value: TColor; refresh: boolean = true); +var + l: integer; +begin + l := Length(Colors); + SetLength(Colors, l + 1); + Colors[l].name := Name; + Colors[l].value := Value; + if refresh then + UpdateColors; +end; + +procedure TmbColorList.ClearColors; +begin + SetLength(Colors, 0); + UpdateColors; +end; + +function TmbColorList.ColorCount: integer; +begin + Result := Length(Colors); +end; + +procedure TmbColorList.DeleteColor(Index: integer; refresh: boolean = true); +var + i: integer; +begin + if Length(Colors) = 0 then + begin + raise Exception.Create('There''s nothing to delete! The length of the array is 0.'); + Exit; + end; + + if Index > Length(Colors) - 1 then + begin + raise Exception.Create(Format('List index out of bounds (%d)', [Index])); + Exit; + end; + + for i := Index to Length(Colors) - 2 do + Colors[i] := Colors[i+1]; + SetLength(Colors, Length(Colors) - 1); + if refresh then + UpdateColors; +end; + +procedure TmbColorList.DeleteColorByName(Name: string; All: boolean); +var + i: integer; +begin + for i := Length(Colors) - 1 downto 0 do + if SameText(Colors[i].name, Name) then + begin + DeleteColor(i, false); + if not All then + begin + UpdateColors; + Exit; + end; + end; + UpdateColors; +end; + +procedure TmbColorList.DeleteColorByValue(Value: TColor; All: boolean); +var + i: integer; +begin + for i := Length(Colors) - 1 downto 0 do + if Colors[i].Value = Value then + begin + DeleteColor(i, false); + if not All then + begin + UpdateColors; + Exit; + end; + end; + UpdateColors; +end; + +procedure TmbColorList.InsertColor(Index: integer; Name: string; Value: TColor); +var + i: integer; +begin + if Index > Length(Colors) - 1 then + begin + raise Exception.Create(Format('List index out of bounds (%d)', [Index])); + Exit; + end; + + SetLength(Colors, Length(Colors) + 1); + for i := Length(Colors) - 1 downto Index do + Colors[i] := Colors[i-1]; + + Colors[Index].Name := Name; + Colors[Index].Value := Value; + + UpdateColors; +end; + +procedure TmbColorList.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + mx := x; + my := y; +end; + +procedure TmbColorList.CMHintShow(var Message: TCMHintShow); +var + Handled: boolean; + i: integer; +begin +if PtInRect(ClientRect, Point(mx, my)) and ShowHint then + begin + i := ItemAtPos(Point(mx, my), true); + if i > -1 then + with TCMHintShow(Message) do + if not ShowHint then + Message.Result := 1 + else + with HintInfo^ do + begin + Result := 0; + ReshowTimeout := 2000; + HideTimeout := 1000; + Handled := false; + if Assigned(FGetHint) then FGetHint(i, HintStr, Handled); + if Handled then + HintStr := FormatHint(HintStr, Colors[i].Value) + else + HintStr := Colors[i].Name; + end; + end; + inherited; +end; + +end. diff --git a/components/mbColorLib/mbColorPalette.dcr b/components/mbColorLib/mbColorPalette.dcr new file mode 100644 index 0000000000000000000000000000000000000000..11bd408b779ce8bc9eac802331cd8c2bd8586af1 GIT binary patch literal 1860 zcmeH_Ax{J`5QPhZoLqT9f#V!2FTqfPX&{gWwYIWyWo>0;Wo_lk%1!tM{0(p?M?Pk6 zxm-9w&mc&cyxF`oFJCt^6+(y$ZeVV<-|FK`h#NiuPQ{CO6jI!YC-K0o#k06&chBc9 z{GIE%IbZAmS8SGFeX?~zyfW{wFx~#IzdC_2`@NDM59P)*sk-7RV+Vwh^4s7$DPb)_ z0DHed+R(6}qd2igm(dqSWv5pwC^ez7Q~f(;RN+kR$(3lK5=@3GxtC3YwuRPU-@Rjt zq7rPK6HKz}pH+gXa(E6M5I}_}nHIZZAIT4tMk<^+f}_`f1tL*2s~raH9oaxWQyiSG zbDUlR66hJ#UG6#ErGe^U0y&;}m6LlF^zvtM<_L~N))*{`3%Vh4M46w=<a>|@#c6kS zj+KZKi8pP6Y6#to@@hc_Gm5ua<xH8dLR=#$FBgRMjGBCh8Fd_|P4>G?%S%5{^?&{Y HzchhQtLtTb literal 0 HcmV?d00001 diff --git a/components/mbColorLib/mbColorPalette.pas b/components/mbColorLib/mbColorPalette.pas new file mode 100644 index 000000000..53aa6dada --- /dev/null +++ b/components/mbColorLib/mbColorPalette.pas @@ -0,0 +1,1190 @@ +unit mbColorPalette; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} + Forms, HTMLColors, PalUtils, Dialogs; + +type + TMouseLoc = (mlNone, mlOver, mlDown); + TTransparentStyle = (tsPhotoshop, tsPhotoshop2, tsCorel, tsMicroangelo, tsNone); + TCellStyle = (csDefault, csCorel); + TColorCellState = (ccsNone, ccsOver, ccsDown, ccsChecked, ccsCheckedHover); + TMoveDirection = (mdLeft, mdRight, mdUp, mdDown); + TPaintCellEvent = procedure (ACanvas: TCanvas; ACellRect: TRect; AColor: TColor; Index: integer; AState: TColorCellState; var AStyle: TTransparentStyle; var PaintingHandled: boolean) of object; + TCellClickEvent = procedure (Button: TMouseButton; Shift: TShiftState; Index: integer; AColor: TColor; var DontCheck: boolean) of object; + TGetHintTextEvent = procedure (AColor: TColor; Index: integer; var HintStr: string; var Handled: boolean) of object; + TArrowKeyEvent = procedure (Key: Word; Shift: TShiftState) of object; + + TmbColorPalette = class(TCustomControl) + private + FMouseLoc: TMouseLoc; + FMouseOver, FMouseDown, FAutoHeight: boolean; + FColCount, FRowCount, FTop, FLeft, FIndex, FCheckedIndex, FCellSize, FTotalCells: integer; + FTempBmp, PBack: TBitmap; + FState: TColorCellState; + FColors, FNames: TStrings; + FPalette: TFileName; + FHintFormat: string; + FOnChange, FOnColorsChange: TNotifyEvent; + FMinColors, FMaxColors: integer; + FSort: TSortMode; + FOrder: TSortOrder; + FOld: TColor; + FOnPaintCell: TPaintCellEvent; + FTStyle: TTransparentStyle; + FOnCellClick: TCellClickEvent; + FOldIndex: integer; + FOnGetHintText: TGetHintTextEvent; + FCellStyle: TCellStyle; + FOnArrowKey: TArrowKeyEvent; + + function GetMoveCellIndex(move: TMoveDirection): integer; + function GetSelColor: TColor; + procedure SetCellStyle(s: TCellStyle); + procedure SetTStyle(s: TTransparentStyle); + procedure SetCellSize(s: integer); + procedure SetSortMode(s: TSortMode); + procedure SetSortOrder(s: TSortOrder); + procedure SetMinColors(m: integer); + procedure SetMaxColors(m: integer); + procedure SetAutoHeight(auto: boolean); + procedure LoadPalette(FileName: TFileName); + procedure SetStrings(s: TStrings); + procedure SetNames(n: TStrings); + procedure SetSelColor(k: TColor); + procedure SortColors; + procedure CalcAutoHeight; + function GetTotalRowCount: integer; + protected + procedure Paint; override; + procedure PaintTransparentGlyph(ACanvas: TCanvas; R: TRect); + procedure DrawCell(clr: string); + procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer); + procedure ColorsChange(Sender: TObject); + procedure Click; override; + procedure Resize; override; + procedure SelectCell(i: integer); + procedure PaintParentBack; + procedure CreateWnd; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + {$IFDEF DELPHI} + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; + procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; + procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; + procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; + procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER; + procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT; + procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; + procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; + {$ELSE} + procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND; + procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER; + procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE; + procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN; + procedure CMGotFocus(var Message: TLMessage); message CM_ENTER; + procedure CMLostFocus(var Message: TLMessage); message CM_EXIT; + procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED; + procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW; + {$ENDIF} + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function GetColorUnderCursor: TColor; + function GetSelectedCellRect: TRect; + function GetIndexUnderCursor: integer; + + property ColorUnderCursor: TColor read GetColorUnderCursor; + property VisibleRowCount: integer read FRowCount; + property RowCount: integer read GetTotalRowCount; + property ColCount: integer read FColCount; + property IndexUnderCursor: integer read GetIndexUnderCursor; + procedure SaveColorsAsPalette(FileName: TFileName); + procedure GeneratePalette(BaseColor: TColor); + procedure GenerateGradientPalette(Colors: array of TColor); + published + property Align; + property Anchors; + property Enabled; + property SortMode: TSortMode read FSort write SetSortMode default smNone; + property SortOrder: TSortOrder read FOrder write SetSortOrder default soAscending; + property MinColors: integer read FMinColors write SetMinColors default 0; + property MaxColors: integer read FMaxColors write SetMaxColors default 0; + property SelectedCell: integer read FCheckedIndex write SelectCell default -1; + property SelectedColor: TColor read GetSelColor write SetSelColor default clNone; + property Colors: TStrings read FColors write SetStrings; + property Palette: TFileName read FPalette write LoadPalette; + property HintFormat: string read FHintFormat write FHintFormat; + property AutoHeight: boolean read FAutoHeight write SetAutoHeight default false; + property CellSize: integer read FCellSize write SetCellSize default 18; + property TransparentStyle: TTransparentStyle read FTStyle write SetTStyle default tsNone; + property CellStyle: TCellStyle read FCellStyle write SetCellStyle default csDefault; + property ColorNames: TStrings read FNames write SetNames; + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF} {$ENDIF} + property TabStop default true; + property TabOrder; + property ShowHint default false; + property Constraints; + property Color; + property ParentColor; + property ParentShowHint default true; + property PopupMenu; + property Visible; + + property DragCursor; + property DragKind; + property DragMode; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnStartDock; + property OnStartDrag; + property OnSelColorChange: TNotifyEvent read FOnChange write FOnChange; + property OnColorsChange: TNotifyEvent read FOnColorsChange write FOnColorsChange; + property OnPaintCell: TPaintCellEvent read FOnPaintCell write FOnPaintCell; + property OnCellClick: TCellClickEvent read FOnCellClick write FOnCellClick; + property OnGetHintText: TGetHintTextEvent read FOnGetHintText write FOnGetHintText; + property OnArrowKey: TArrowKeyEvent read FOnArrowKey write FOnArrowKey; + property OnContextPopup; + property OnMouseMove; + property OnMouseDown; + property OnMouseUp; + property OnKeyDown; + property OnKeyUp; + property OnKeyPress; + property OnResize; + property OnClick; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R mbColorPalette.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TmbColorPalette]); +end; + +constructor TmbColorPalette.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; + DoubleBuffered := true; + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF} {$ENDIF} + TabStop := true; + ParentShowHint := true; + ShowHint := false; + Width := 180; + Height := 126; + FMouseLoc := mlNone; + FMouseOver := false; + FMouseDown := false; + FColCount := 0; + FRowCount := 0; + FIndex := -1; + FCheckedIndex := -1; + FTop := 0; + FLeft := 0; + FCellSize := 18; + FState := ccsNone; + FNames := TStringList.Create; + FColors := TStringList.Create; + (FColors as TStringList).OnChange := ColorsChange; + FTotalCells := 0; + FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: %hex'; + FAutoHeight := false; + FMinColors := 0; + FMaxColors := 0; + FSort := smNone; + FOrder := soAscending; + FOld := clNone; + FTStyle := tsNone; + FCellStyle := csDefault; +end; + +destructor TmbColorPalette.Destroy; +begin + PBack.Free; + FNames.Free; + FColors.Free; + inherited Destroy; +end; + +procedure TmbColorPalette.CalcAutoHeight; +begin + if Parent = nil then + exit; + FColCount := Width div FCellSize; + if FAutoHeight and (FColCount <> 0) then + begin + if FColors.Count mod FColCount > 0 then + Height := (FColors.Count div FColCount + 1) * FCellSize + else + Height := (FColors.Count div FColCount) * FCellSize; + end; + if Height = 0 then Height := FCellSize; + FRowCount := Height div FCellSize; + Width := FColCount * FCellSize; +end; + +function TmbColorPalette.GetTotalRowCount: integer; +begin +if FColCount <> 0 then + Result := FTotalCells div FColCount +else + Result := 0; +end; + +procedure TmbColorPalette.CreateWnd; +begin + inherited; + CalcAutoHeight; + Invalidate; +end; + +procedure TmbColorPalette.PaintParentBack; +{$IFDEF DELPHI_7_UP} +var + MemDC: HDC; + OldBMP: HBITMAP; +{$ENDIF} +begin + if PBack = nil then + begin + PBack := TBitmap.Create; + PBack.PixelFormat := pf32bit; + end; + PBack.Width := Width; + PBack.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + PBack.Canvas.Brush.Color := clForm + else + {$ENDIF} + PBack.Canvas.Brush.Color := Color; + PBack.Canvas.FillRect(PBack.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, PBack.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF} {$ENDIF} +end; + +procedure TmbColorPalette.Paint; +var + i: integer; +begin + PaintParentBack; + //make bmp + FTempBmp := TBitmap.Create; + try + FTempBmp.PixelFormat := pf32bit; + FTempBmp.Width := Width; + FTempBmp.Height := Height; + + {$IFDEF FPC} + if Color = clDefault then + FTempBmp.Canvas.Brush.Color := clForm + else + {$ENDIF} + FTempBmp.Canvas.Brush.Color := Color; + + {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} + if not ParentBackground then + {$ENDIF} {$ENDIF} + FTempBmp.Canvas.FillRect(FTempBmp.Canvas.ClipRect) + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + else + FTempBmp.Canvas.Draw(0, 0, PBack){$ENDIF} {$ENDIF}; + + FTotalCells := FColors.Count - 1; + //reset counters + FTop := 0; + FLeft := 0; + //draw the cells + for i := 0 to FColors.Count - 1 do + begin + if FColors.Strings[i] <> '' then + DrawCell(FColors.Strings[i]); + Inc(FLeft); + end; + //draw the result + Canvas.Draw(0, 0, FTempBmp); + //csDesiginng border + if csDesigning in ComponentState then + begin + Canvas.Brush.Style := bsClear; + Canvas.Pen.Style := psDot; + Canvas.Pen.Color := clBtnShadow; + Canvas.Rectangle(ClientRect); + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Style := psSolid; + end; + finally + FTempBmp.Free; + end; +end; + +procedure TmbColorPalette.DrawCell(clr: string); +var + R: Trect; + FCurrentIndex: integer; + c: TColor; + Handled: boolean; +begin + // set props + if (FLeft + 1) * FCellSize > FTempBmp.width then + begin + Inc(FTop); + FLeft := 0; + end; + FCurrentIndex := FTop * FColCount + FLeft; + R := Rect(FLeft * FCellSize, FTop * FCellSize, (FLeft + 1) * FCellSize, (FTop + 1) * FCellSize); + //start drawing + with FTempBmp.Canvas do + begin + {$IFDEF FPC} + if Color = clDefault then + Brush.Color := clForm else + {$ENDIF} + Brush.Color := Color; + //get current state + if FCurrentIndex = FCheckedIndex then + begin + if FCheckedIndex = FIndex then + begin + if FMouseDown then + FState := ccsDown + else + FState := ccsCheckedHover; + end + else + FState := ccsChecked; + end + else + if FIndex = FCurrentIndex then + case FMouseLoc of + mlNone: FState := ccsNone; + mlOver: FState := ccsOver; + end + else + FState := ccsNone; + + //paint + DrawCellBack(FTempBmp.Canvas, R, FCurrentIndex); + + // fire the event + Handled := false; + if Assigned(FOnPaintCell) then + case FCellStyle of + csDefault: FOnPaintCell(FTempBmp.Canvas, R, mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled); + csCorel: + if FColCount = 1 then + FOnPaintCell(FTempBmp.Canvas, R, mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled) + else + FOnPaintCell(FTempBmp.Canvas, Rect(R.Left, R.Top, R.Right + 1, R.Bottom), mbStringToColor(clr), FCurrentIndex, FState, FTStyle, Handled); + end; + if not Handled then + begin + // if standard colors draw the rect + if not SameText(clr, 'clCustom') and not SameText(clr, 'clTransparent') then + case FCellStyle of + csDefault: + begin + InflateRect(R, -3, -3); + c := mbStringToColor(clr); + if Enabled then + begin + Brush.Color := c; + Pen.Color := clBtnShadow; + end + else + begin + Brush.Color := clGray; + Pen.Color := clGray; + end; + Rectangle(R); + Exit; + end; + csCorel: + begin + if (FState <> ccsNone) then + InflateRect(R, -2, -2) + else + begin + Inc(R.Left); + Dec(R.Bottom); + if R.Top <= 1 then + Inc(R.Top); + if R.Right = Width then + Dec(R.Right); + end; + c := mbStringToColor(clr); + if Enabled then + Brush.Color := c + else + Brush.Color := clGray; + FillRect(R); + Exit; + end; + end; + + //if transparent draw the glyph + if SameText(clr, 'clTransparent') then PaintTransparentGlyph(FTempBmp.Canvas, R); + end; + end; +end; + +procedure TmbColorPalette.DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer); +begin + case FCellStyle of + csDefault: + begin + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + begin + with ThemeServices do + if Enabled then + case FState of + ccsNone: ACanvas.CopyRect(R, PBack.Canvas, R); + ccsOver: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonHot), R); + ccsDown: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonPressed), R); + ccsChecked: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonChecked), R); + ccsCheckedHover: DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonCheckedHot), R); + end + else + DrawElement(ACanvas.Handle, GetElementDetails(ttbButtonDisabled), R); + end + else + {$ENDIF} + if Enabled then + case FState of + ccsNone: ACanvas.FillRect(R); + ccsOver: DrawEdge(ACanvas.Handle, R, BDR_RAISEDINNER, BF_RECT); + ccsDown, ccsChecked, ccsCheckedHover: DrawEdge(ACanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT); + end + else + DrawFrameControl(ACanvas.Handle, R, DFC_BUTTON, 0 or DFCS_BUTTONPUSH or DFCS_FLAT or DFCS_INACTIVE); + end; + csCorel: + begin + if Enabled then + begin + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + case FState of + ccsNone: + begin + ACanvas.Brush.Color := clWhite; + ACanvas.Pen.Color := clBlack; + //left + ACanvas.MoveTo(R.Left, R.Top); + ACanvas.LineTo(R.Left, R.Bottom-1); + //bottom + ACanvas.MoveTo(R.Left, R.Bottom-1); + ACanvas.LineTo(R.Right, R.Bottom-1); + //top + if R.Top = 0 then + begin + ACanvas.MoveTo(R.Left, R.Top); + ACanvas.LineTo(R.Right, R.Top); + end; + //right + if (R.Right = Width) then + begin + ACanvas.MoveTo(R.Right-1, R.Top); + ACanvas.LineTo(R.Right-1, R.Bottom-1); + end + else + if (AIndex = FTotalCells) then + begin + ACanvas.MoveTo(R.Right, R.Top); + ACanvas.LineTo(R.Right, R.Bottom); + end; + end; + ccsOver: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonHot), R); + ccsDown: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonPressed), R); + ccsChecked: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonChecked), R); + ccsCheckedHover: ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonCheckedHot), R); + end + else + {$ENDIF} + case FState of + ccsNone: + begin + ACanvas.Brush.Color := clWhite; + ACanvas.Pen.Color := clBlack; + ACanvas.Brush.Color := clWhite; + ACanvas.Pen.Color := clBlack; + //left + ACanvas.MoveTo(R.Left, R.Top); + ACanvas.LineTo(R.Left, R.Bottom-1); + //bottom + ACanvas.MoveTo(R.Left, R.Bottom-1); + ACanvas.LineTo(R.Right, R.Bottom-1); + //top + if R.Top = 0 then + begin + ACanvas.MoveTo(R.Left, R.Top); + ACanvas.LineTo(R.Right, R.Top); + end; + //right + if (R.Right = Width) then + begin + ACanvas.MoveTo(R.Right-1, R.Top); + ACanvas.LineTo(R.Right-1, R.Bottom-1); + end + else + if (AIndex = FTotalCells) then + begin + ACanvas.MoveTo(R.Right, R.Top); + ACanvas.LineTo(R.Right, R.Bottom); + end; + end; + ccsOver: + begin + OffsetRect(R, 1,1); + DrawEdge(ACanvas.Handle, R, BDR_RAISED, BF_RECT); + end; + ccsDown, ccsChecked, ccsCheckedHover: DrawEdge(ACanvas.Handle, R, BDR_SUNKENOUTER, BF_RECT); + end; + end + else + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + ThemeServices.DrawElement(ACanvas.Handle, ThemeServices.GetElementDetails(ttbButtonDisabled), R) + else + {$ENDIF} + begin + ACanvas.Brush.Color := Color; + ACanvas.FillRect(R); + end; + end; + end; +end; + +procedure TmbColorPalette.PaintTransparentGlyph(ACanvas: TCanvas; R: TRect); +begin + InflateRect(R, -3, -3); + if FCellStyle = csCorel then + begin + if FState <> ccsNone then + InflateRect(R, -2, -2) + else + if FColCount > 1 then + Inc(R.Right); + end; + with ACanvas do + case FTStyle of + tsPhotoshop: + begin + if Enabled then + Pen.Color := clBtnShadow + else + Pen.Color := clGray; + Brush.Color := clWhite; + Rectangle(R); + Brush.Color := clSilver; + FillRect(Rect(R.Left + (R.Right - R.Left) div 2, R.Top + 1, R.Right - 1, R.Top + (R.Bottom - R.Top) div 2)); + FillRect(Rect(R.Left + 1, R.Top + (R.Bottom - R.Top) div 2, R.Left + (R.Right - R.Left) div 2, R.Bottom - 1)); + end; + tsPhotoshop2: + begin + InflateRect(R, -1, -1); + Brush.Color := clWhite; + Rectangle(R); + Pen.Color := clRed; + Pen.Width := 2; + InflateRect(R, 1, 1); + MoveTo(R.Left, R.Top); + LineTo(R.Right - 1, R.Bottom - 1); + Pen.Width := 1; + Pen.Color := clBlack; + end; + tsCorel: + begin + if FCellStyle = csCorel then + begin + Pen.Color := clBlack; + InflateRect(R, 3, 3); + Brush.Color := clWhite; + Rectangle(R); + //the \ line + MoveTo(R.Left, R.Top); + LineTo(R.Right, R.Bottom); + //the / line + MoveTo(R.Right-1, R.Top); + LineTo(R.Left-1, R.Bottom); + end + else + begin + if Enabled then + Pen.Color := clBtnShadow + else + Pen.Color := clGray; + Brush.Color := clWhite; + Rectangle(R); + MoveTo(R.Left, R.Top); + LineTo(R.Right, R.Bottom); + MoveTo(R.Right - 1, R.Top); + LineTo(R.Left - 1, R.Bottom); + end; + end; + tsMicroangelo: + begin + InflateRect(R, -1, -1); + Dec(R.Bottom); + Pen.Color := clBlack; + Brush.Color := clTeal; + Rectangle(R); + Pixels[R.Left + 2, R.Top + 2] := clWhite; + Pixels[R.Left + (R.Right - R.Left) div 2, R.Bottom] := clBlack; + MoveTo(R.Left + (R.Right - R.Left) div 2 - 2, R.Bottom + 1); + LineTo(R.Left + (R.Right - R.Left) div 2 + 3, R.Bottom + 1); + end; + end; +end; + +procedure TmbColorPalette.Resize; +begin + inherited; + CalcAutoHeight; + Invalidate; +end; + +procedure TmbColorPalette.CMMouseEnter( + var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} ); +begin + FMouseOver := true; + FMouseLoc := mlOver; + Invalidate; + inherited; +end; + +procedure TmbColorPalette.CMMouseLeave( + var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} ); +begin + FMouseOver := false; + FMouseLoc := mlNone; + FIndex := -1; + Invalidate; + inherited; +end; + +procedure TmbColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + if FIndex <> (y div FCellSize)* FColCount + (x div FCellSize) then + begin + FIndex := (y div FCellSize)* FColCount + (x div FCellSize); + if FIndex > FTotalCells then FIndex := -1; + Invalidate; + end; + inherited; +end; + +procedure TmbColorPalette.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin +if Button = mbLeft then + begin + SetFocus; + FMouseDown := true; + FMouseLoc := mlDown; + if (y div FCellSize)* FColCount + (x div FCellSize) <= FTotalCells then + if FCheckedIndex <> (y div FCellSize)* FColCount + (x div FCellSize) then + begin + FOldIndex := FCheckedIndex; + FCheckedIndex := (y div FCellSize)* FColCount + (x div FCellSize); + end; + Invalidate; + end; + inherited; +end; + +procedure TmbColorPalette.Click; +begin + inherited; +end; + +procedure TmbColorPalette.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + DontCheck: boolean; + AColor: TColor; +begin + FMouseDown := false; + if FMouseOver then + FMouseLoc := mlOver + else + FMouseLoc := mlNone; + DontCheck := false; + if (FCheckedIndex > -1) and (FCheckedIndex < FColors.Count) then + AColor := mbStringToColor(FColors.Strings[FCheckedIndex]) + else + AColor := clNone; + if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then + if Assigned(FOnCellClick) then + FOnCellClick(Button, Shift, FCheckedIndex, AColor, DontCheck); + if DontCheck then FCheckedIndex := FOldIndex; + Invalidate; + inherited; + if Assigned(FOnChange) then FOnChange(Self); +end; + +procedure TmbColorPalette.CMGotFocus( + var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} ); +begin + inherited; + Invalidate; +end; + +procedure TmbColorPalette.CMLostFocus( + var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} ); +begin + inherited; + if FMouseOver then + FMouseLoc := mlOver + else + FMouseLoc := mlNone; + Invalidate; +end; + +procedure TmbColorPalette.CMEnabledChanged( + var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} ); +begin + inherited; + Invalidate; +end; + +procedure TmbColorPalette.WMEraseBkgnd( + var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF}); +begin + Message.Result := 1; +end; + +procedure TmbColorPalette.SelectCell(i: integer); +begin + if i < FColors.Count - 1 then + FCheckedIndex := i + else + FCheckedIndex := -1; + Invalidate; + if Assigned(FOnChange) then FOnChange(Self); +end; + +function TmbColorPalette.GetSelColor: TColor; +begin +if (FCheckedIndex > -1) and (FCheckedIndex <= FTotalCells) then + Result := mbStringToColor(FColors.Strings[FCheckedIndex]) +else + Result := FOld; +end; + +function TmbColorPalette.GetColorUnderCursor: TColor; +begin + Result := clNone; + if FIndex > -1 then + if FIndex < FColors.Count then + Result := mbStringToColor(FColors.Strings[FIndex]); +end; + +function TmbColorPalette.GetIndexUnderCursor: integer; +begin + Result := -1; + if FIndex > -1 then + if FIndex < FColors.Count then + Result := FIndex; +end; + +procedure TmbColorPalette.SetTStyle(s: TTransparentStyle); +begin + if FTStyle <> s then + begin + FTStyle := s; + Invalidate; + end; +end; + +procedure TmbColorPalette.SetCellStyle(s: TCellStyle); +begin + if FCellStyle <> s then + begin + FCellStyle := s; + Invalidate; + end; +end; + +procedure TmbColorPalette.SetSelColor(k: TColor); +var + s: string; + i: integer; +begin + s := mbColorToString(k); + for i:= 0 to FColors.Count - 1 do + if SameText(s, FColors.Strings[i]) then + begin + FCheckedIndex := i; + Break; + end + else + FCheckedIndex := -1; + Invalidate; + FOld := k; + if Assigned(FOnChange) then FOnChange(Self); +end; + +procedure TmbColorPalette.SetStrings(s: TStrings); +var + i: integer; +begin + FColors.Clear; + FColors.AddStrings(s); + if FColors.Count < FMinColors then + for i := 0 to FMinColors - FColors.Count - 1 do + FColors.Add('clNone'); + if (FColors.Count > FMaxColors) and (FMaxColors > 0) then + for i := FColors.Count - 1 downto FMaxColors do + FColors.Delete(i); + CalcAutoHeight; + SortColors; + Invalidate; +end; + +procedure TmbColorPalette.SetNames(n: TStrings); +var + i: integer; +begin + FNames.Clear; + FNames.AddStrings(n); + if (FNames.Count > FMaxColors) and (FMaxColors > 0) then + for i := FNames.Count - 1 downto FMaxColors do + FNames.Delete(i); +end; + +function TmbColorPalette.GetMoveCellIndex(move: TMoveDirection): integer; +var + FBefore: integer; +begin + Result := -1; + case move of + mdLeft: + if FCheckedIndex -1 < 0 then + Result := FTotalCells + else + Result := FCheckedIndex - 1; + mdRight: + if FCheckedIndex + 1 > FTotalCells then + Result := 0 + else + Result := FCheckedIndex + 1; + mdUp: + if FCheckedIndex - FColCount < 0 then + begin + FBefore := (FTotalcells div FColCount) * FColCount; + if FBefore + FCheckedIndex - 1 > FTotalCells then Dec(FBefore, FColCount); + Result := FBefore + FCheckedIndex - 1; + end + else + Result := FCheckedIndex - FColCount; + mdDown: + if FCheckedIndex + FColCount > FTotalCells then + Result := FCheckedIndex mod FColCount + 1 + else + Result := FCheckedIndex + FColCount; + end; + if Result > FColors.Count - 1 then + Result := 0; +end; + +procedure TmbColorPalette.CNKeyDown( + var Message: {$IFDEF DELPHI}TWMKeyDown{$ELSE}TLMKeyDown{$ENDIF} ); +var + FInherited: boolean; + Shift: TShiftState; +begin + Shift := KeyDataToShiftState(Message.KeyData); + Finherited := false; + case Message.CharCode of + VK_LEFT: + begin + FCheckedIndex := GetMoveCellIndex(mdLeft); + if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift); + end; + VK_RIGHT: + begin + FCheckedIndex := GetMoveCellIndex(mdRight); + if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift); + end; + VK_UP: + begin + FCheckedIndex := GetMoveCellIndex(mdUp); + if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift); + end; + VK_DOWN: + begin + FCheckedIndex := GetMoveCellIndex(mdDown); + if Assigned(FOnArrowKey) then FOnArrowKey(Message.CharCode, Shift); + end; + VK_SPACE, VK_RETURN: if Assigned(FOnChange) then FOnChange(Self); + else + begin + FInherited := true; + inherited; + end; + end; + if not FInherited then + begin + Invalidate; + if Assigned(OnKeyDown) then OnKeyDown(Self, Message.CharCode, Shift); + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TmbColorPalette.CMHintShow( + var Message: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF} ); +var + clr: TColor; + Handled: boolean; +begin +if (Colors.Count > 0) and (FIndex > -1) then + with TCMHintShow(Message) do + begin + if not ShowHint then + Message.Result := 1 + else + begin + with HintInfo^ do + begin + // show that we want a hint + Result := 0; + ReshowTimeout := 1; + HideTimeout := 5000; + clr := GetColorUnderCursor; + //fire event + Handled := false; + if Assigned(FOnGetHintText) then FOnGetHintText(clr, GetIndexUnderCursor, HintStr, Handled); + if Handled then Exit; + //do default + if FIndex < FNames.Count then + HintStr := FNames.Strings[FIndex] + else + if SameText(FColors.Strings[GetIndexUnderCursor], 'clCustom') or SameText(FColors.Strings[GetIndexUnderCursor], 'clTransparent') then + HintStr := StringReplace(FColors.Strings[GetIndexUnderCursor], 'cl', '', [rfReplaceAll]) + else + HintStr := FormatHint(FHintFormat, GetColorUnderCursor); + end; + end; + end; +end; + +procedure TmbColorPalette.SetAutoHeight(auto: boolean); +begin + FAutoHeight := auto; + CalcAutoHeight; + Invalidate; +end; + +procedure TmbColorPalette.SetMinColors(m: integer); +var + i: integer; +begin + if (FMaxColors > 0) and (m > FMaxColors) then + m := FMaxColors; + FMinColors := m; + if FColors.Count < m then + for i := 0 to m - FColors.Count - 1 do + FColors.Add('clNone'); + CalcAutoHeight; + SortColors; + Invalidate; +end; + +procedure TmbColorPalette.SetMaxColors(m: integer); +var + i: integer; +begin + if m < 0 then m := 0; + FMaxColors := m; + if (m < FMinColors) and (m > 0) then + SetMinColors(m); + if (FColors.Count > FMaxColors) and (FMaxColors > 0) then + for i := FColors.Count - 1 downto FMaxColors do + FColors.Delete(i); + CalcAutoHeight; + SortColors; + Invalidate; +end; + +procedure TmbColorPalette.SetSortMode(s: TSortMode); +begin + if FSort <> s then + begin + FSort := s; + SortColors; + Invalidate; + end; +end; + +procedure TmbColorPalette.SetSortOrder(s: TSortOrder); +begin + if FOrder <> s then + begin + FOrder := s; + SortColors; + Invalidate; + end; +end; + +procedure TmbColorPalette.ColorsChange(Sender: TObject); +begin + if Assigned(FOnColorsChange) then FOnColorsChange(Self); + FTotalCells := FColors.Count - 1; + CalcAutoHeight; + Invalidate; +end; + +procedure TmbColorPalette.SetCellSize(s: integer); +begin + FCellSize := s; + CalcAutoHeight; + Invalidate; +end; + +function TmbColorPalette.GetSelectedCellRect: TRect; +var + row, fbottom, fleft: integer; +begin + if FCheckedIndex > -1 then + begin + if FCheckedIndex mod FColCount = 0 then + begin + row := FCheckedIndex div FColCount; + fleft := Width - FCellSize; + end + else + begin + row := FCheckedIndex div FColCount + 1; + fleft := (FCheckedIndex mod FColCount - 1) * FCellSize; + end; + fbottom := row * FCellSize; + Result := Rect(fleft, fbottom - FCellSize, fleft + FCellSize, fbottom); + end + else + Result := Rect(0, 0, 0, 0); +end; + +procedure TmbColorPalette.GeneratePalette(BaseColor: TColor); +begin + FColors.Text := MakePalette(BaseColor, FOrder); + CalcAutoHeight; + SortColors; + Invalidate; + if Assigned(FOnChange) then FOnChange(Self); +end; + +procedure TmbColorPalette.GenerateGradientPalette(Colors: array of TColor); +begin + FColors.Text := MakeGradientPalette(Colors); + CalcAutoHeight; + SortColors; + Invalidate; + if Assigned(FOnChange) then FOnChange(Self); +end; + +procedure TmbColorPalette.LoadPalette(FileName: TFileName); +var + supported: boolean; + a: AcoColors; + i: integer; +begin + supported := false; + if SameText(ExtractFileExt(FileName), '.pal') then + begin + supported := true; + FNames.Clear; + FColors.Text := ReadJASCPal(FileName); + end + else + if SameText(ExtractFileExt(FileName), '.aco') then + begin + supported := true; + a := ReadPhotoshopAco(FileName); + FColors.Clear; + for i := 0 to Length(a.Colors) - 1 do + FColors.Add(ColorToString(a.Colors[i])); + FNames.Clear; + if a.HasNames then + for i := 0 to Length(a.Names) - 1 do + FNames.Add(a.Names[i]); + end + else + if SameText(ExtractFileExt(FileName), '.act') then + begin + supported := true; + FNames.Clear; + FColors.Text := ReadPhotoshopAct(FileName); + end + else + Exception.Create('The file format you are trying to load is not supported in this version of the palette'#13'Please send a request to MXS along with the files of this format so'#13'loading support for this file can be added too'); + if supported then + begin + CalcAutoHeight; + SortColors; + Invalidate; + if Assigned(FOnChange) then FOnChange(Self); + end; +end; + +procedure TmbColorPalette.SaveColorsAsPalette(FileName: TFileName); +begin + if SameText(ExtractFileExt(FileName), '.pal') then + SaveJASCPal(FColors, FileName) + else + raise Exception.Create('The file extension specified does not identify a supported file format!'#13'Supported files formats are: .pal .aco .act'); +end; + +procedure TmbColorPalette.SortColors; +var + old: TColor; +begin + if FSort <> smNone then + begin + if FColors.Count = 0 then Exit; + old := GetSelColor; + SortPalColors(FColors, FSort, FOrder); + SetSelColor(old); + Invalidate; + end; +end; + +end. diff --git a/components/mbColorLib/mbColorPickerControl.pas b/components/mbColorLib/mbColorPickerControl.pas new file mode 100644 index 000000000..f30a3cc22 --- /dev/null +++ b/components/mbColorLib/mbColorPickerControl.pas @@ -0,0 +1,288 @@ +unit mbColorPickerControl; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + {$IFDEF DELPHI_7_UP} Themes,{$ENDIF} + RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors; + +type + TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc); + + TmbCustomPicker = class(TCustomControl) + private + FHintFormat: string; + FMarkerStyle: TMarkerStyle; + FWebSafe: boolean; + + procedure SetMarkerStyle(s: TMarkerStyle); + procedure SetWebSafe(s: boolean); + protected + mx, my, mdx, mdy: integer; + + function GetSelectedColor: TColor; virtual; + procedure SetSelectedColor(C: TColor); virtual; + procedure WebSafeChanged; dynamic; + procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); + message {$IFDEF FPC} LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF}; + procedure CMGotFocus(var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF}); + message CM_ENTER; + procedure CMLostFocus(var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMLostFocus{$ENDIF}); + message CM_EXIT; + procedure CMMouseLeave(var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF}); + message CM_MOUSELEAVE; + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure PaintParentBack(ACanvas: TCanvas); + procedure CreateWnd; override; + property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle; + public + constructor Create(AOwner: TComponent); override; + + function GetColorAtPoint(x, y: integer): TColor; dynamic; + function GetHexColorAtPoint(X, Y: integer): string; + function GetColorUnderCursor: TColor; + function GetHexColorUnderCursor: string; + + property ColorUnderCursor: TColor read GetColorUnderCursor; + published + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor; + property HintFormat: string read FHintFormat write FHintFormat; + property WebSafe: boolean read FWebSafe write SetWebSafe default false; + end; + + TmbColorPickerControl = class(TmbCustomPicker) + published + property Anchors; + property Align; + property ShowHint; + property ParentShowHint; + property Visible; + property Enabled; + property PopupMenu; + property TabOrder; + property TabStop default true; + property Color; + property ParentColor; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF}{$ENDIF} + property DragCursor; + property DragMode; + property DragKind; + property Constraints; + + property OnContextPopup; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnResize; + property OnStartDrag; + end; + +implementation + +uses PalUtils; + +constructor TmbCustomPicker.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle + [csOpaque] - [csAcceptsControls]; + DoubleBuffered := true; + TabStop := true; + ParentColor := true; + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF}{$ENDIF} + mx := 0; + my := 0; + mdx := 0; + mdy := 0; + FHintFormat := 'Hex #%hex'#10#13'RGB[%r, %g, %b]'#10#13'HSL[%hslH, %hslS, %hslL]'#10#13'HSV[%hsvH, %hsvS, %hsvV]'#10#13'CMYK[%c, %m, %y, %k]'#10#13'L*a*b*[%cieL, %cieA, %cieB]'#10#13'XYZ[%cieX, %cieY, %cieZ]'; + FWebSafe := false; +end; + +procedure TmbCustomPicker.CreateWnd; +begin + inherited; +end; + +procedure TmbCustomPicker.PaintParentBack(ACanvas: TCanvas); +var + OffScreen: TBitmap; + {$IFDEF DELPHI_7_UP} + MemDC: HDC; + OldBMP: HBITMAP; + {$ENDIF} +begin + Offscreen := TBitmap.Create; + Offscreen.Width := Width; + Offscreen.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + Offscreen.Canvas.Brush.Color := clForm else + {$ENDIF} + Offscreen.Canvas.Brush.Color := Color; + Offscreen.Canvas.FillRect(Offscreen.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, OffScreen.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF}{$ENDIF} + ACanvas.Draw(0, 0, Offscreen); + Offscreen.Free; +end; + +procedure TmbCustomPicker.CMGotFocus( + var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF} ); +begin + inherited; + Invalidate; +end; + +procedure TmbCustomPicker.CMLostFocus( + var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMLostFocus{$ENDIF} ); +begin + inherited; + Invalidate; +end; + +procedure TmbCustomPicker.WMEraseBkgnd( + var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); +begin + Message.Result := 1; +end; + +procedure TmbCustomPicker.CMMouseLeave( + var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF}); +begin + mx := 0; + my := 0; + inherited; +end; + +function TmbCustomPicker.GetSelectedColor: TColor; +begin + Result := clNone; + //handled in descendents +end; + +procedure TmbCustomPicker.SetSelectedColor(C: TColor); +begin + //handled in descendents +end; + +function TmbCustomPicker.GetColorAtPoint(x, y: integer): TColor; +begin + Result := clNone; + //handled in descendents +end; + +function TmbCustomPicker.GetHexColorAtPoint(X, Y: integer): string; +begin + Result := ColorToHex(GetColorAtPoint(x, y)); +end; + +function TmbCustomPicker.GetColorUnderCursor: TColor; +begin + Result := GetColorAtPoint(mx, my); +end; + +function TmbCustomPicker.GetHexColorUnderCursor: string; +begin + Result := ColorToHex(GetColorAtPoint(mx, my)); +end; + +procedure TmbCustomPicker.CMHintShow(var Message: TCMHintShow); +begin +if GetColorUnderCursor <> clNone then + with TCMHintShow(Message) do + if not ShowHint then + Message.Result := 1 + else + with HintInfo^ do + begin + Result := 0; + ReshowTimeout := 1; + HideTimeout := 5000; + HintStr := FormatHint(FHintFormat, GetColorUnderCursor);; + end; + inherited; +end; + +procedure TmbCustomPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + mx := x; + my := y; +end; + +procedure TmbCustomPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + mx := x; + my := y; +end; + +procedure TmbCustomPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + mx := x; + my := y; +end; + +procedure TmbCustomPicker.SetMarkerStyle(s: TMarkerStyle); +begin + if FMarkerStyle <> s then + begin + FMarkerStyle := s; + invalidate; + end; +end; + +procedure TmbCustomPicker.SetWebSafe(s: boolean); +begin + if FWebSafe <> s then + begin + FWebSafe := s; + WebSafeChanged; + end; +end; + +procedure TmbCustomPicker.WebSafeChanged; +begin + //handled in descendents +end; + +end. diff --git a/components/mbColorLib/mbColorPreview.dcr b/components/mbColorLib/mbColorPreview.dcr new file mode 100644 index 0000000000000000000000000000000000000000..edec47a424a04f824b645f6ca084b5c8cbe8dd4d GIT binary patch literal 1860 zcmeHGAxy(i5PcxXByvG9#~hVSP$dW&2;_%AQu}3P<t%ctvbM6a9yK|MoE>fw`FPiL zA<%8ff}}rp&Hq1l@7}wA1%Puoxpr-TtdA4mN;l*&o^X!{*Lc94+~HAvgJ<08`_g7z zo}LXh02kT}TR&=cz?<-XFIx59`VRcH16AhCCP{7Pzb*51mYAhUmAcBuW=T}aT-cqx zDvNpG+KN-AQ4G#(wpYZI7;^|t!4+nNCkFP{MPOwiB@u8Jj^aGHu($;=A%+}-g`I06 zHXNC=YE3Cg>*^}fP<#g9#3(3r-m(yd8lMdXwWA41!FQEXm$u;eP>cg`1m=dbX5lO~ z0q0n@YIT<2S8%xlCs3{sgd?=33mX<<nVDdz%}lMJBskZ@b@}AU_`v7lb{sbnRN;fd XhkCm*jWr4TCrabg<<sB%s}6htF}Y&a literal 0 HcmV?d00001 diff --git a/components/mbColorLib/mbColorPreview.pas b/components/mbColorLib/mbColorPreview.pas new file mode 100644 index 000000000..a504a7c8e --- /dev/null +++ b/components/mbColorLib/mbColorPreview.pas @@ -0,0 +1,251 @@ +unit mbColorPreview; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics; + +type + TmbColorPreview = class(TCustomControl) + private + FSelColor: TColor; + FOpacity: integer; + FOnColorChange: TNotifyEvent; + FOnOpacityChange: TNotifyEvent; + FBlockSize: integer; + FSwatchStyle: boolean; + + procedure SetSwatchStyle(Value: boolean); + procedure SetSelColor(c: TColor); + procedure SetOpacity(o: integer); + procedure SetBlockSize(s: integer); + function MakeBmp: TBitmap; + protected + procedure Paint; override; + procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); + message {$IFDEF FPC}LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF}; + public + constructor Create(AOwner: TComponent); override; + published + property Color: TColor read FSelColor write SetSelColor default clWhite; + property Opacity: integer read FOpacity write SetOpacity default 100; + property BlockSize: integer read FBlockSize write SetBlockSize default 6; + property SwatchStyle: boolean read FSwatchStyle write SetSwatchStyle default false; + property Anchors; + property Align; + property ShowHint; + property ParentShowHint; + property Visible; + property Enabled; + property PopupMenu; + property DragCursor; + property DragMode; + property DragKind; + property Constraints; + + property OnColorChange: TNotifyEvent read FOnColorChange write FOnColorChange; + property OnOpacityChange: TNotifyEvent read FOnOpacityChange write FOnOpacityChange; + property OnContextPopup; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnResize; + property OnStartDrag; + property OnDblClick; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R mbColorPreview.dcr} +{$ENDIF} + +uses + PalUtils; + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TmbColorPreview]); +end; + +constructor TmbColorPreview.Create(AOwner: TComponent); +begin + inherited; + DoubleBuffered := true; + ControlStyle := COntrolStyle - [csAcceptsControls] + [csOpaque]; + FSelColor := clWhite; + Width := 68; + Height := 32; + TabStop := false; + FOpacity := 100; + FBlockSize := 6; + FSwatchStyle := false; +end; + +function TmbColorPreview.MakeBmp: TBitmap; + begin + Result := TBitmap.Create; + Result.Width := FBlockSize; + Result.Height := FBlockSize; + if (FSelColor = clNone) or (FOpacity = 0) then + Result.Canvas.Brush.Color := clSilver + else + Result.Canvas.Brush.Color := Blend(FSelColor, clSilver, FOpacity); + Result.Canvas.FillRect(Result.Canvas.ClipRect); + end; + +procedure TmbColorPreview.Paint; +var + TempBMP, cBMP: TBitmap; + i, j: integer; + R: TRect; + rgn: HRgn; + c: TColor; +begin + TempBMP := TBitmap.Create; + cBMP := nil; + rgn := 0; + try + TempBMP.Width := Width + FBlockSize; + TempBMP.Height := Height + FBlockSize; + TempBMP.PixelFormat := pf24bit; + TempBmp.Canvas.Pen.Color := clBtnShadow; + TempBmp.Canvas.Brush.Color := FSelColor; + R := ClientRect; + with TempBmp.Canvas do + if (FSelColor <> clNone) and (FOpacity = 100) then + begin + if not FSwatchStyle then + Rectangle(R) + else + begin + Brush.Color := clWindow; + Rectangle(R); + InflateRect(R, -1, -1); + FillRect(R); + InflateRect(R, 1, 1); + InflateRect(R, -2, -2); + Brush.Color := Blend(FSelColor, clBlack, 75); + FillRect(R); + InflateRect(R, -1, -1); + Brush.Color := Blend(FSelColor, clBlack, 87); + FillRect(R); + InflateRect(R, -1, -1); + Brush.Color := FSelColor; + FillRect(R); + end; + end + else + begin + cBMP := MakeBmp; + if (FSelColor = clNone) or (FOpacity = 0) then + c := clWhite + else + c := Blend(FSelColor, clWhite, FOpacity); + Brush.Color := c; + Rectangle(R); + if FSwatchStyle then + begin + InflateRect(R, -1, -1); + FillRect(R); + InflateRect(R, 1, 1); + InflateRect(R, -2, -2); + Brush.Color := Blend(c, clBlack, 75); + FillRect(R); + InflateRect(R, -1, -1); + Brush.Color := Blend(c, clBlack, 87); + FillRect(R); + InflateRect(R, -1, -1); + Brush.Color := c; + FillRect(R); + end; + InflateRect(R, -1, -1); + rgn := CreateRectRgnIndirect(R); + SelectClipRgn(TempBmp.Canvas.Handle, rgn); + for i := 0 to (Height div FBlockSize) do + for j := 0 to (Width div FBlockSize) do + begin + if i mod 2 = 0 then + begin + if j mod 2 > 0 then + TempBmp.Canvas.Draw(j*FBlockSize, i*FBlockSize, cBMP); + end + else + begin + if j mod 2 = 0 then + TempBmp.Canvas.Draw(j*FBlockSize, i*FBlockSize, cBMP); + end; + end; + end; + Canvas.Draw(0, 0, TempBmp); + finally + DeleteObject(rgn); + cBMP.Free; + TempBMP.Free; + end; +end; + +procedure TmbColorPreview.WMEraseBkgnd( + var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); +begin + Message.Result := 1; +end; + +procedure TmbColorPreview.SetSelColor(c: TColor); +begin + if c <> FSelColor then + begin + FSelColor := c; + Invalidate; + if Assigned(FOnColorChange) then FOnColorChange(Self); + end; +end; + +procedure TmbColorPreview.SetOpacity(o: integer); +begin + if FOpacity <> o then + begin + FOpacity := o; + Invalidate; + if Assigned(FOnOpacityChange) then FOnOpacityChange(Self); + end; +end; + +procedure TmbColorPreview.SetBlockSize(s: integer); +begin + if (FBlockSize <> s) and (s > 0) then + begin + FBlockSize := s; + Invalidate; + end; +end; + +procedure TmbColorPreview.SetSwatchStyle(Value: boolean); +begin + if FSwatchStyle <> Value then + begin + FSwatchStyle := Value; + Invalidate; + end; +end; + +end. diff --git a/components/mbColorLib/mbColorTree.dcr b/components/mbColorLib/mbColorTree.dcr new file mode 100644 index 0000000000000000000000000000000000000000..e117cf0976dbe393841f14f37a1f145d63be765c GIT binary patch literal 1856 zcmchXv2MaJ5QhIUbm@YaGNFzg89Rfz6(OO%L8We0UxKNx#KI%+6rpe7{^q#Dam>Y1 zB+Om-?`(g*=#l`yGd%=x%Fg(E1YVg5VS*2=vBU}+ywkUgw|L`E$6~4qc%f`A{%}^n zfvnk+xULNG<hxkVVaG|rLKXY(xs}wmCz^#6KVP5B^sf=71QF!eUg5;Beke^iMi4<v zzlJO$N7?P%;#5}TbF%WBFy&MpU0jxNcE={Q;+A6aZX9-p#u`MJW=7uzwmj6-V<@9h z$RJ8Y4M#V5{~5<y>dvJc>M>^TmwVvAWLi&L`iqVY?7mLdaI9Zx>jiPEU!7uDn?5#0 h;XFTm&b4$`)!dg0xJ>4pnmwg8DTjKDWgqG>;Xk=28-)M> literal 0 HcmV?d00001 diff --git a/components/mbColorLib/mbColorTree.pas b/components/mbColorLib/mbColorTree.pas new file mode 100644 index 000000000..45e003db3 --- /dev/null +++ b/components/mbColorLib/mbColorTree.pas @@ -0,0 +1,686 @@ +unit mbColorTree; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC} + LCLIntf, LCLType, LMessages, + {$ELSE} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, ComCtrls, Graphics, + {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} {$IFDEF DELPHI_6_UP}GraphUtil,{$ENDIF} + ImgList, HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, + Forms; + +type + {$IFNDEF DELPHI_6_UP} + TScrollDirection = (sdLeft, sdRight, sdUp, sdDown); + {$ENDIF} + + TmbColor = record + name: string; + value: TColor; + end; + + TDrawCaptionEvent = procedure (Sender: TObject; AIndex: integer; AFont: TFont; var AText: string; Selected: boolean) of object; + TDrawLabelEvent = procedure (Sender: TObject; AIndex: integer; AFont: TFont; var AText: string) of object; + TGetHintEvent = procedure (AIndex: integer; var AHint: string; var Handled: boolean) of object; + + TmbColorTree = class(TCustomTreeView) + private + dummy: TCustomImageList; + FInfo1, FInfo2: string; + FInfoLabel: string; + FDraw: TDrawCaptionEvent; + FDraw1, FDraw2, FDraw3: TDrawLabelEvent; + mx, my: integer; + FGetHint: TGetHintEvent; + FOnStartDrag: TStartDragEvent; + FOnEndDrag: TEndDragEvent; + + procedure SetInfo1(Value: string); + procedure SetInfo2(Value: string); + procedure SetInfoLabel(Value: string); + protected + function CanChange(Node: TTreeNode): Boolean; override; + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; + Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override; + function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; {$IFDEF DELPHI_7_UP}override;{$ENDIF} + procedure DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean); dynamic; + procedure DrawInfoItem(R: TRect; Index: integer); dynamic; + procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean); + public + Colors: array of TmbColor; + + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure UpdateColors; + procedure AddColor(Name: string; Value: TColor; refresh: boolean = true); + procedure ClearColors; + procedure DeleteColor(Index: integer; refresh: boolean = true); + procedure DeleteColorByName(Name: string; All: boolean); + procedure DeleteColorByValue(Value: TColor; All: boolean); + procedure InsertColor(Index: integer; Name: string; Value: TColor); + function ColorCount: integer; + published + property InfoLabelText: string read FInfoLabel write SetInfoLabel; + property InfoDisplay1: string read FInfo1 write SetInfo1; + property InfoDisplay2: string read FInfo2 write SetInfo2; + property Align; + property Anchors; + property AutoExpand; + {$IFDEF DELPHI} + property BevelEdges; + property BevelInner; + property BevelOuter; + property BevelKind default bkNone; + property BevelWidth; + {$ENDIF} + property BorderStyle; + property BorderWidth; + {$IFDEF DELPHI} + property ChangeDelay; + property Ctl3D; + property ParentCtl3D; + {$ENDIF} + property Constraints; + property Color; + property DragKind; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property Indent; + {$IFDEF DELPHI_7_UP} + property MultiSelect; + property MultiSelectStyle; + {$ENDIF} + property ParentColor default False; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property RightClickSelect; + property ShowHint; + property SortType; + property TabOrder; + property TabStop default True; + property ToolTips; + property Visible; + + property OnGetHint: TGetHintEvent read FGetHint write FGetHint; + property OnDrawCaption: TDrawCaptionEvent read FDraw write FDraw; + property OnDrawInfoLabel: TDrawLabelEvent read FDraw1 write FDraw1; + property OnDrawInfoDisplay1: TDrawLabelEvent read FDraw2 write FDraw2; + property OnDrawInfoDisplay2: TDrawLabelEvent read FDraw3 write FDraw3; + {$IFDEF DELPHI_7_UP} + property OnAddition; + property OnCreateNodeClass; + {$ENDIF} + property OnAdvancedCustomDraw; + property OnAdvancedCustomDrawItem; + property OnChange; + property OnChanging; + property OnClick; + property OnCollapsed; + property OnCollapsing; + property OnCompare; + property OnContextPopup; + property OnCustomDraw; + property OnCustomDrawItem; + property OnDblClick; + property OnDeletion; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag; + property OnEnter; + property OnExit; + property OnExpanding; + property OnExpanded; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDock; + property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag; + property Items; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R mbColorTree.dcr} +{$ENDIF} + +uses + PalUtils; + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TmbColorTree]); +end; + +//taken from GraphUtil, only for Delphi 5 +{$IFNDEF DELPHI_6_UP} + +procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection; + Location: TPoint; Size: Integer); +const + ArrowPts: array[TScrollDirection, 0..2] of TPoint = + (((X:1; Y:0), (X:0; Y:1), (X:1; Y:2)), + ((X:0; Y:0), (X:1; Y:1), (X:0; Y:2)), + ((X:0; Y:1), (X:1; Y:0), (X:2; Y:1)), + ((X:0; Y:0), (X:1; Y:1), (X:2; Y:0))); +var + I: Integer; + Pts: array[0..2] of TPoint; + OldWidth: Integer; + OldColor: TColor; +begin + if ACanvas = nil then exit; + OldColor := ACanvas.Brush.Color; + ACanvas.Brush.Color := ACanvas.Pen.Color; + Move(ArrowPts[Direction], Pts, SizeOf(Pts)); + for I := 0 to 2 do + Pts[I] := Point(Pts[I].x * Size + Location.X, Pts[I].y * Size + Location.Y); + with ACanvas do + begin + OldWidth := Pen.Width; + Pen.Width := 1; + Polygon(Pts); + Pen.Width := OldWidth; + Brush.Color := OldColor; + end; +end; + +{$ENDIF} + +{ TmbColorTree } + +constructor TmbColorTree.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle + [csDisplayDragImage]; + MaxHue := 360; + MaxSat := 255; + MaxLum := 255; + ReadOnly := true; + ShowButtons := false; + ShowLines := false; + ShowRoot := true; + RowSelect := true; + HotTrack := false; + SetLength(Colors, 0); + dummy := TCustomImageList.Create(Self); + dummy.Width := 48; + dummy.Height := 48; + Images := dummy; + FInfoLabel := 'Color Values:'; + FInfo1 := 'RGB: %r.%g.%b'; + FInfo2 := 'HEX: #%hex'; +end; + +destructor TmbColorTree.Destroy; +begin + dummy.Free; + inherited; +end; + +procedure TmbColorTree.UpdateColors; +var + i: integer; + n: TTreeNode; +begin + Items.Clear; + for i := 0 to Length(Colors) - 1 do + begin + n := Items.Add(TopItem, Colors[i].name); + Items.AddChild(n, ''); + end; +end; + +function TmbColorTree.CanChange(Node: TTreeNode): Boolean; +begin + Result := Node.HasChildren; +end; + +procedure TmbColorTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + r: TRect; +begin + inherited; + if (ssShift in Shift) or (ssCtrl in Shift) then Exit; + if Selected <> nil then + r := Selected.DisplayRect(false) + else + Exit; + if (x > r.Right - 15) and (x < r.Right - 3) and (y > r.Top + 13) and (y < r.Top + 30) then + if (Selected.HasChildren) and PtInRect(r, Point(x, y)) then + begin + if selected.Expanded then + Selected.Collapse(false) + else + Selected.Expand(false); + Invalidate; + end; +end; + +procedure TmbColorTree.MouseMove(Shift: TShiftState; X, Y: Integer); +var + r: TRect; +begin + inherited; + mx := x; + my := y; + if GetNodeAt(x, y) <> nil then + r := GetNodeAt(x, y).DisplayRect(false) + else + begin + Cursor := crDefault; + Exit; + end; + + if (x > r.Right - 15) and (x < r.Right - 3) and (y > r.Top + 13) and (y < r.Top + 30) then + begin + if (GetNodeAt(x, y).HasChildren) and PtInRect(r, Point(x, y)) then + Cursor := crHandPoint + else + Cursor := crDefault; + end + else + Cursor := crDefault; +end; + +function TmbColorTree.CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; + Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; +begin + Result := true; + if Length(Colors) = 0 then Exit; + if Node.HasChildren then + DrawColorItem(Node.DisplayRect(false), cdsSelected in State, node.Index, node.Text, node.Expanded) + else + DrawInfoItem(Node.DisplayRect(false), node.Parent.Index); +end; + +procedure TmbColorTree.DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean); +var + b: TBitmap; +begin + b := TBitmap.Create; + try + b.Height := 12; + b.Width := 12; + if Sel then + begin + b.Canvas.Brush.Color := clHighlight; + b.Canvas.Pen.Color := clHighlightText; + end + else + begin + b.Canvas.Brush.Color := clBtnFace; + b.Canvas.Pen.Color := clWindowText; + end; + b.Canvas.FillRect(B.Canvas.ClipRect); + case dir of + sdDown: DrawArrow(b.Canvas, dir, Point(2, 3), 3); + sdRight: DrawArrow(b.Canvas, dir, Point(1, 2), 3); + end; + c.Draw(p.x, p.y, b); + finally + b.Free; + end; +end; + +procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean); +var + SR, TR: TRect; +begin + with Canvas do + begin + //background + Pen.Color := clWindow; + if Selected then + Brush.Color := clHighlight + else + Brush.Color := clBtnFace; + FillRect(R); + MoveTo(R.Left, R.Bottom - 1); + LineTo(R.Right, R.Bottom - 1); + //swatches + SR := Rect(R.Left + 6, R.Top + 6, R.Left + 42, R.Top + 42); + Brush.Color := Self.Colors[Index].value; + if Selected then + begin + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + begin + ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR); + InflateRect(SR, -2, -2); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 80); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 90); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Self.Colors[Index].value; + FillRect(SR); + end + else + //windows 9x + begin + {$ENDIF} + Pen.Color := clBackground; + Brush.Color := clWindow; + Rectangle(SR); + InflateRect(SR, -1, -1); + FillRect(SR); + InflateRect(SR, 1, 1); + InflateRect(SR, -2, -2); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 75); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Blend(Self.Colors[Index].value, clBlack, 87); + FillRect(SR); + InflateRect(SR, -1, -1); + Brush.Color := Self.Colors[Index].value; + FillRect(SR); + {$IFDEF DELPHI_7_UP} + end; + {$ENDIF} + end + else + //not selected + begin + //windows XP + {$IFDEF DELPHI_7_UP} + if ThemeServices.ThemesEnabled then + begin + ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR); + InflateRect(SR, -2, -2); + Brush.Color := Self.Colors[Index].value; + FillRect(SR); + end + else + //windows 9x + begin + {$ENDIF} + DrawEdge(Canvas.Handle, SR, BDR_SUNKENOUTER, BF_RECT); + InflateRect(SR, -2, -2); + Brush.Color := Self.Colors[Index].value; + Pen.Color := clBlack; + Rectangle(SR); + InflateRect(SR, -1, -1); + FillRect(SR); + InflateRect(SR, 1, 1); + {$IFDEF DELPHI_7_UP} + end; + {$ENDIF} + end; + //names + Font.Style := [fsBold]; + if Selected then + begin + Brush.Color := clHighlightText; + Pen.Color := clHighlightText; + end + else + begin + Brush.Color := clWindowText; + Pen.Color := clWindowText; + end; + TR := Rect(R.Left + 48, R.Top + (48 - TextHeight(itemText)) div 2, R.Right - 15, R.Bottom); + if Assigned(FDraw) then FDraw(Self, Index, Canvas.Font, itemText, Selected); + DrawText(Canvas.Handle, PChar(itemText), Length(itemText), TR, DT_LEFT or DT_NOCLIP or DT_END_ELLIPSIS); + if R.Right > 60 then + begin + if Expanded then + DoArrow(Canvas, sdDown, Point(R.Right - 13, R.Top + 20), selected) + else + DoArrow(Canvas, sdRight, Point(R.Right - 10, R.Top + 18), selected); + end; + end; +end; + +procedure TmbColorTree.DrawInfoItem(R: TRect; Index: integer); +var + b: TBitmap; + BR, TR: TRect; + i, fx: integer; + s: string; +begin + b := TBitmap.Create; + try + b.Width := R.Right - R.Left; + b.Height := R.Bottom - R.Top; + BR := b.Canvas.ClipRect; + b.Canvas.Font.Assign(Font); + with b.Canvas do + begin + Brush.Color := Blend(clBtnFace, clWindow, 30); + FillRect(BR); + BR := Rect(BR.Left + 42, BR.Top, BR.Right, BR.Bottom); + Brush.Color := clWindow; + FillRect(BR); + Inc(BR.Left, 6); + Font.Style := []; + Font.Size := 7; + + s := FInfoLabel; + TR := Rect(BR.Left, BR.Top + 2, BR.Right, BR.Top + 12); + if Assigned(FDraw1) then FDraw1(Self, Index, Canvas.Font, s); + DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP); + + fX := BR.Left; + for i := 0 to (BR.Right - 2 - BR.Left) div 2 do + begin + Pixels[fX, BR.Top + 4 + TextHeight(s)] := clGray; + fX := fX + 2; + end; + + s := FormatHint(FInfo1, Self.Colors[Index].value); + TR := Rect(BR.Left, BR.Top + (BR.Bottom - BR.Top) div 3 + 2, BR.Right, BR.Top + 12); + if Assigned(FDraw2) then FDraw2(Self, Index, Canvas.Font, s); + DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP); + + fX := BR.Left; + for i := 0 to (BR.Right - 2 - BR.Left) div 2 do + begin + Pixels[fX, BR.Top + (BR.Bottom - BR.Top) div 3 + 4 + TextHeight(s)] := clGray; + fX := fX + 2; + end; + + s := FormatHint(FInfo2, Self.Colors[Index].value); + TR := Rect(BR.Left, BR.Top + 2*((BR.Bottom - BR.Top) div 3) + 2, BR.Right, BR.Top + 12); + if Assigned(FDraw3) then FDraw3(Self, Index, Canvas.Font, s); + DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP); + end; + Canvas.Draw(R.Left, R.Top, b); + finally + b.Free; + end; +end; + +function TmbColorTree.IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; +begin + Result := true; +end; + +procedure TmbColorTree.SetInfoLabel(Value: string); +begin + if FInfoLabel <> Value then + begin + FInfoLabel := Value; + Invalidate; + end; +end; + +procedure TmbColorTree.SetInfo1(Value: string); +begin + if FInfo1 <> Value then + begin + FInfo1 := Value; + Invalidate; + end; +end; + +procedure TmbColorTree.SetInfo2(Value: string); +begin + if FInfo2 <> Value then + begin + FInfo2 := Value; + Invalidate; + end; +end; + +procedure TmbColorTree.AddColor(Name: string; Value: TColor; refresh: boolean = true); +var + l: integer; +begin + l := Length(Colors); + SetLength(Colors, l + 1); + Colors[l].name := Name; + Colors[l].value := Value; + if refresh then + UpdateColors; +end; + +procedure TmbColorTree.ClearColors; +begin + SetLength(Colors, 0); + UpdateColors; +end; + +function TmbColorTree.ColorCount: integer; +begin + Result := Length(Colors); +end; + +procedure TmbColorTree.DeleteColor(Index: integer; refresh: boolean = true); +var + i: integer; +begin + if Length(Colors) = 0 then + begin + raise Exception.Create('There''s nothing to delete! The length of the array is 0.'); + Exit; + end; + + if Index > Length(Colors) - 1 then + begin + raise Exception.Create(Format('List index out of bounds (%d)', [Index])); + Exit; + end; + + for i := Index to Length(Colors) - 2 do + Colors[i] := Colors[i+1]; + SetLength(Colors, Length(Colors) - 1); + if refresh then + UpdateColors; +end; + +procedure TmbColorTree.DeleteColorByName(Name: string; All: boolean); +var + i: integer; +begin + for i := Length(Colors) - 1 downto 0 do + if SameText(Colors[i].name, Name) then + begin + DeleteColor(i, false); + if not All then + begin + UpdateColors; + Exit; + end; + end; + UpdateColors; +end; + +procedure TmbColorTree.DeleteColorByValue(Value: TColor; All: boolean); +var + i: integer; +begin + for i := Length(Colors) - 1 downto 0 do + if Colors[i].Value = Value then + begin + DeleteColor(i, false); + if not All then + begin + UpdateColors; + Exit; + end; + end; + UpdateColors; +end; + +procedure TmbColorTree.InsertColor(Index: integer; Name: string; Value: TColor); +var + i: integer; +begin + if Index > Length(Colors) - 1 then + begin + raise Exception.Create(Format('List index out of bounds (%d)', [Index])); + Exit; + end; + + SetLength(Colors, Length(Colors) + 1); + for i := Length(Colors) - 1 downto Index do + Colors[i] := Colors[i-1]; + + Colors[Index].Name := Name; + Colors[Index].Value := Value; + + UpdateColors; +end; + +procedure TmbColorTree.CMHintShow(var Message: TCMHintShow); +var + Handled: boolean; + i: integer; + n: TTreeNode; +begin +if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then + begin + n := GetNodeAt(mx, my); + if n <> nil then + begin + if not n.HasChildren then + i := n.Parent.Index + else + i := n.Index; + with TCMHintShow(Message) do + if not ShowHint then + Message.Result := 1 + else + with HintInfo^ do + begin + Result := 0; + ReshowTimeout := 2000; + HideTimeout := 1000; + Handled := false; + if Assigned(FGetHint) then FGetHint(i, HintStr, Handled); + if Handled then + HintStr := FormatHint(HintStr, Colors[i].Value) + else + HintStr := Colors[i].Name; + end; + end; + end; + inherited; +end; + +end. diff --git a/components/mbColorLib/mbDeskPickerButton.dcr b/components/mbColorLib/mbDeskPickerButton.dcr new file mode 100644 index 0000000000000000000000000000000000000000..262e4b94d83bb7d1722c64a1d53569003712655c GIT binary patch literal 1868 zcmd6nEmOll5QY~7gRIP;sH2X^*gyqg_?S>k?8%cSV=E&gV<RIYGlS|+sH_FYPdMJq z<)h?6$xMeCZk}AWd%JJ%V=qKRmw2=`56o}v<BaGQ9<5JlMGxfT*OFf7o}THBZtz}G z2=6OKSM)@WP4@Nd;=C2Qg5fmJNo^6mL3h|R&*FbksE~=Hk`X;hlqzCmRLHOp0TcN- z2t9ihg$g!#QnTLV>k4Eb?nzbIBg<5d>g3W#3Z}$~sRC^lr!a{@lu5%uouHA*R0Vpq zPPR9&G<#i{^fpD3OV$CfLF&$oG1_C7Ms$R?t#Yg`R{;zF5v_IVI>2}a{SP|sZo7dF z`i|6dAjN8)(>Xf>2WQVGjTWEpy8)>;H#+DuZ$20u*9qs4%7mK<k5|VV#e0?cds6<K z>#D6Nl#@N51D?!Z^s@>U2O@tR$^*BPV*7~8$W_-iQ-Py(IOQ+6@Y;q$H%v*iWB81; z=Bv7g9X7>Nh>$OS%ajy5ro>sd4PO$29X7>-ZxNJGMW(OINlZz!V^EE7ma$~1SXMQ5 Z*mO^|R**u^#t}t@+$xE|ks^PT{sm-NXwCot literal 0 HcmV?d00001 diff --git a/components/mbColorLib/mbDeskPickerButton.pas b/components/mbColorLib/mbDeskPickerButton.pas new file mode 100644 index 000000000..99623a9e7 --- /dev/null +++ b/components/mbColorLib/mbDeskPickerButton.pas @@ -0,0 +1,113 @@ +unit mbDeskPickerButton; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, + {$ELSE} + Windows, + {$ENDIF} + SysUtils, Classes, Controls, StdCtrls, Graphics, Forms, ScreenWin; + +type + TmbDeskPickerButton = class(TButton) + private + FSelColor: TColor; + ScreenFrm: TScreenForm; + FOnColorPicked: TNotifyEvent; + FOnKeyDown: TKeyEvent; + FHintFmt: string; + FShowScreenHint: boolean; + OnWUp, OnWDown: TMouseWheelUpDownEvent; + protected + procedure StartPicking; + procedure ColorPicked(Sender: TObject); + procedure ScreenKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + public + constructor Create(AOwner: TComponent); override; + procedure Click; override; + + property SelectedColor: TColor read FSelColor; + published + property OnSelColorChange: TNotifyEvent read FOnColorPicked write FOnColorPicked; + property OnScreenKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; + property OnSelMouseWheelUp: TMouseWheelUpDownEvent read OnWUp write OnWUp; + property OnSelMouseWheelDown: TMouseWheelUpDownEvent read OnWDown write OnWDown; + property ScreenHintFormat: string read FHintFmt write FHintFmt; + property ShowScreenHint: boolean read FShowScreenHint write FShowScreenHint default false; + end; + +procedure Register; + + +implementation + +{$IFDEF FPC} + {$R mbDeskPickerButton.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TmbDeskPickerButton]); +end; + +constructor TmbDeskPickerButton.Create(AOwner: TComponent); +begin + inherited; + DoubleBuffered := true; + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}]; + FHintFmt := 'RGB(%r, %g, %b)'#13'Hex: %h'; + FShowScreenHint := false; +end; + +procedure TmbDeskPickerButton.Click; +begin + inherited; + StartPicking; +end; + +procedure TmbDeskPickerButton.StartPicking; +begin + ScreenFrm := TScreenForm.Create(Application); + try + ScreenFrm.OnSelColorChange := ColorPicked; + ScreenFrm.OnScreenKeyDown := ScreenKeyDown; + ScreenFrm.OnMouseWheelDown := WheelDown; + ScreenFrm.OnMouseWheelUp := WheelUp; + ScreenFrm.ShowHint := FShowScreenHint; + ScreenFrm.FHintFormat := FHintFmt; + ScreenFrm.ShowModal; + finally + ScreenFrm.Free; + end; +end; + +procedure TmbDeskPickerButton.ColorPicked(Sender: TObject); +begin + FSelColor := ScreenFrm.SelectedColor; + if Assigned(FOnColorPicked) then FOnColorPicked(Self); +end; + +procedure TmbDeskPickerButton.ScreenKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); +end; + +procedure TmbDeskPickerButton.WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + if Assigned(OnWUp) then OnWUp(Self, Shift, MousePos, Handled); +end; + +procedure TmbDeskPickerButton.WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + if Assigned(OnWDown) then OnWDown(Self, Shift, MousePos, Handled); +end; + +end. diff --git a/components/mbColorLib/mbOfficeColorDialog.dcr b/components/mbColorLib/mbOfficeColorDialog.dcr new file mode 100644 index 0000000000000000000000000000000000000000..aa894cca6074f52e77ac56f8b12e94000e3b5762 GIT binary patch literal 1872 zcmb`HEpWm>5QVoDoytn4s<_4#i7frkw8IQj6^le7u}EZOEE0*#OcfG|#HKFt<o4}t za+6C)OQ&7l!R2!K^7ignBBCoaW^L$t@p(q{j1lHjdZ#xU(2ySSd7(RcKpWC4+KBEk za%=lf?)jUG%k%Q$8l6tjPHd0p1MGURIQbvt+pTD`DU_x;v|g*sY9(4O3nht3ViQ{} z76zKn)rmk_!kFCr7(Qn(9v>-yISfTnBrloG3O~pw&jH~h0@H-k?~B5)jg#(EsK(R1 z(Lv<|0rz@B`jNBC@@0~!$tI`M;ciz@!kJEsys$gJ%u613(asq$N6c8T$)u8^9BS6Q z978&oWKW=+mWrPNbI2^H$Vats<Ymgikt;d9xYtkmkos6f*=n4vCz)Ix;>h?RP7ntW zXflC$8D>DWadeKDF8v@&-5PtV%N#J<eZ^rLAw?U$A7)dGI}ZLn9tZa=3g=^h)heUH z!An(g59?_C$ltKeDW7fp>V6&1aWk8pI@|d{O=$SR<JI}iOXbTPETHCPIT)zEx_K#& zl;LK|fX{)Y@1tZiezB+OM@n2$D{-iDC@iAsRD{C@Az26u0>K8Pg~)OII(ZmU;h6mf y5MVrxh2;Akr1jS0sFMl=X3Q=H2VR7OGiLqZTaqe^wg*8?P)=J$6^Nt#rSk>V1oe0T literal 0 HcmV?d00001 diff --git a/components/mbColorLib/mbOfficeColorDialog.pas b/components/mbColorLib/mbOfficeColorDialog.pas new file mode 100644 index 000000000..b31f8a20b --- /dev/null +++ b/components/mbColorLib/mbOfficeColorDialog.pas @@ -0,0 +1,84 @@ +unit mbOfficeColorDialog; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +uses + {$IFDEF FPC} + LCLIntf, LCLType, + {$ELSE} + Windows, + {$ENDIF} + SysUtils, Classes, Graphics, Forms, OfficeMoreColorsDialog; + +type + TmbOfficeColorDialog = class(TComponent) + private + FWin: TOfficeMoreColorsWin; + FSelColor: TColor; + FUseHint: boolean; + public + constructor Create(AOwner: TComponent); override; + function Execute: boolean; overload; + function Execute(AColor: TColor): boolean; overload; + published + property SelectedColor: TColor read FSelColor write FSelColor default clWhite; + property UseHints: boolean read FUseHint write FUseHint default false; + end; + +procedure Register; + +implementation + +{$IFDEF FPC} + {$R mbOfficeColorDialog.dcr} +{$ENDIF} + +procedure Register; +begin + RegisterComponents('mbColor Lib', [TmbOfficeColorDialog]); +end; + +constructor TmbOfficeColorDialog.Create(AOwner: TComponent); +begin + inherited; + FSelColor := clWhite; + FUseHint := false; +end; + +function TmbOfficeColorDialog.Execute: boolean; +begin + FWin := TOfficeMoreColorsWin.Create(Application); + try + FWin.OldSwatch.Color := FSelColor; + FWin.ShowHint := FUseHint; + Result := (FWin.ShowModal = IdOK); + if Result then + FSelColor := FWin.NewSwatch.Color + else + FSelColor := clNone; + finally + FWin.Free; + end; +end; + +function TmbOfficeColorDialog.Execute(AColor: TColor): boolean; +begin + FWin := TOfficeMoreColorsWin.Create(Application); + try + FWin.OldSwatch.Color := AColor; + FWin.ShowHint := FUseHint; + Result := (FWin.ShowModal = IdOK); + if Result then + FSelColor := FWin.NewSwatch.Color + else + FSelColor := clNone; + finally + FWin.Free; + end; +end; + +end. diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas new file mode 100644 index 000000000..2713e055b --- /dev/null +++ b/components/mbColorLib/mbTrackBarPicker.pas @@ -0,0 +1,843 @@ +unit mbTrackBarPicker; + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +interface + +{$I mxs.inc} + +uses + {$IFDEF FPC}LCLIntf, LCLType, LMessages, + {$ELSE} Windows, Messages, + {$ENDIF} + SysUtils, Classes, Controls, Graphics, Forms, + {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} ExtCtrls, PalUtils; + +const + TBA_Resize = 0; + TBA_Paint = 1; + TBA_MouseMove = 2; + TBA_MouseDown = 3; + TBA_MouseUp = 4; + TBA_WheelUp = 5; + TBA_WheelDown = 6; + TBA_VKUp = 7; + TBA_VKCtrlUp = 8; + TBA_VKDown = 9; + TBA_VKCtrlDown = 10; + TBA_VKLeft = 11; + TBA_VKCtrlLeft = 12; + TBA_VKRight = 13; + TBA_VKCtrlRight = 14; + TBA_RedoBMP = 15; + +type + TTrackBarLayout = (lyHorizontal, lyVertical); + TSliderPlacement = (spBefore, spAfter, spBoth); + TSelIndicator = (siArrows, siRect); + + TmbTrackBarPicker = class(TCustomControl) + private + mx, my: integer; + FOnChange: TNotifyEvent; + FIncrement: integer; + FHintFormat: string; + FLayout: TTrackBarLayout; + FPlacement: TSliderPlacement; + FNewArrowStyle: boolean; + Aw, Ah: integer; + FDoChange: boolean; + FSelIndicator: TSelIndicator; + FWebSafe: boolean; + FBevelInner: TBevelCut; + FBevelOuter: TBevelCut; + FBevelWidth: TBevelWidth; + FBorderStyle: TBorderStyle; + + procedure SetBevelInner(Value: TBevelCut); + procedure SetBevelOuter(Value: TBevelCut); + procedure SetBevelWidth(Value: TBevelWidth); + procedure SetBorderStyle(Value: TBorderStyle); + procedure SetWebSafe(s: boolean); + function XToArrowPos(p: integer): integer; + function YToArrowPos(p: integer): integer; + procedure SetLayout(Value: TTrackBarLayout); + procedure SetNewArrowStyle(s: boolean); + procedure SetPlacement(Value: TSliderPlacement); + procedure DrawMarker(p: integer); + procedure SetSelIndicator(Value: TSelIndicator); + procedure PaintParentBack; + procedure CalcPickRect; + protected + FArrowPos: integer; + FManual: boolean; + FChange: boolean; + FPickRect: TRect; + FLimit: integer; + + procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); + procedure WMEraseBkgnd(var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); + message {$IFDEF FPC} LM_ERASEBKGND{$ELSE}WM_ERASEBKGND{$ENDIF}; + procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); message CN_KEYDOWN; + 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 CMGotFocus(var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF}); message CM_ENTER; + procedure CMLostFocus(var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMLostFocus{$ENDIF}); message CM_EXIT; + procedure Paint; override; + procedure DrawFrames; dynamic; + procedure Resize; override; + procedure CreateWnd; override; + procedure Execute(tbaAction: integer); dynamic; + function GetArrowPos: integer; dynamic; + function GetHintStr: string; + function GetSelectedValue: integer; virtual; abstract; + public + constructor Create(AOwner: TComponent); override; + property Manual: boolean read FManual; + published + property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone; + property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone; + property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; + + property HintFormat: string read FHintFormat write FHintFormat; + property Increment: integer read FIncrement write FIncrement default 1; + property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal; + property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter; + property NewArrowStyle: boolean read FNewArrowStyle write SetNewArrowStyle default false; + property SelectionIndicator: TSelIndicator read FSelIndicator write SetSelIndicator default siArrows; + property WebSafe: boolean read FWebSafe write SetWebSafe default false; + property TabStop default true; + property ShowHint; + property Color; + property ParentColor default true; + {$IFDEF DELPHI_7_UP} + {$IFDEF DELPHI} + property ParentBackground default true; + {$ENDIF} + {$ENDIF} + property ParentShowHint default true; + property Anchors; + property Align; + property Visible; + property Enabled; + property PopupMenu; + property TabOrder; + property DragCursor; + property DragMode; + property DragKind; + property Constraints; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + 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; + +implementation + +const + { 3D border styles } + BDR_RAISEDOUTER = 1; + BDR_SUNKENOUTER = 2; + BDR_RAISEDINNER = 4; + BDR_SUNKENINNER = 8; + + BDR_OUTER = 3; + BDR_INNER = 12; + BDR_RAISED = 5; + BDR_SUNKEN = 10; + + { Border flags } + BF_LEFT = 1; + BF_TOP = 2; + BF_RIGHT = 4; + BF_BOTTOM = 8; + + BF_TOPLEFT = (BF_TOP or BF_LEFT); + BF_TOPRIGHT = (BF_TOP or BF_RIGHT); + BF_BOTTOMLEFT = (BF_BOTTOM or BF_LEFT); + BF_BOTTOMRIGHT = (BF_BOTTOM or BF_RIGHT); + BF_RECT = (BF_LEFT or BF_TOP or BF_RIGHT or BF_BOTTOM); + + BF_DIAGONAL = $10; + + +{TmbTrackBarPicker} + +constructor TmbTrackBarPicker.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; + DoubleBuffered := true; + ParentColor := true; + {$IFDEF DELPHI_7_UP} + {$IFDEF DELPHI} + ParentBackground := true; + {$ENDIF} + {$ENDIF} + Width := 267; + Height := 22; + TabStop := true; + ParentShowHint := true; + mx := 0; + my := 0; + FIncrement := 1; + FArrowPos := GetArrowPos; + FHintFormat := ''; + OnMouseWheelUp := WheelUp; + OnMouseWheelDown := WheelDown; + FManual := false; + FChange := true; + FLayout := lyHorizontal; + FNewArrowStyle := false; + Aw := 6; + Ah := 10; + FPlacement := spAfter; + FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah); + FDoChange := false; + FSelIndicator := siArrows; + FLimit := 7; + FWebSafe := false; + FBevelInner:= bvNone; + FBevelOuter:= bvNone; + FBevelWidth:= 1; + FBorderStyle:= bsNone; +end; + +procedure TmbTrackBarPicker.CreateWnd; +begin + inherited; + CalcPickRect; +end; + +procedure TmbTrackBarPicker.CalcPickRect; +var + f: integer; +begin + case FSelIndicator of + siArrows: + if not FNewArrowStyle then + begin + f := 0; + Aw := 6; + Ah := 10; + FLimit := 7; + end + else + begin + Aw := 8; + Ah := 9; + f := 2; + FLimit := 7; + end; + siRect: + begin + f := 0; + Aw := 4; + Ah := 5; + FLimit := 3; + end + else + f := 0; + end; + case FLayout of + lyHorizontal: + case FSelIndicator of + siArrows: + case FPlacement of + spAfter: FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah - f); + spBefore: FPickRect := Rect(Aw, Ah + f, Width - Aw, Height); + spBoth: FPickRect := Rect(Aw, Ah + f, Width - Aw, Height - Ah - f); + end; + siRect: FPickRect := Rect(Aw, Ah, width - 2*Aw + 1, height - Ah); + end; + lyVertical: + case FSelIndicator of + siArrows: + case FPlacement of + spAfter: FPickRect := Rect(0, Aw, Width - Ah - f, Height - Aw); + spBefore: FPickRect := Rect(Ah + f, Aw, Width, Height - Aw); + spBoth: FPickRect := Rect(Ah + f, Aw, Width - Ah - f, Height - Aw); + end; + siRect: FPickRect := Rect(Ah, Aw, width - 5, height - 2*Aw + 1); + end; + end; +end; + +procedure TmbTrackBarPicker.Paint; +begin + CalcPickRect; + PaintParentBack; + FArrowPos := GetArrowPos; + Execute(TBA_Paint); + if FBorderStyle <> bsNone then + DrawFrames; + DrawMarker(FArrowPos); + if FDoChange then + begin + if Assigned(FOnChange) then FOnChange(Self); + FDoChange := false; + end; +end; + +procedure TmbTrackBarPicker.DrawFrames; +var + flags: cardinal; + R: TRect; + i: integer; +begin + flags := 0; + if (FBorderStyle = bsNone) or (FBevelWidth = 0) then Exit; + case FBevelInner of + bvNone: flags := 0; + bvRaised: flags := BDR_RAISEDINNER; + bvLowered: flags := BDR_SUNKENINNER; + bvSpace: flags := BDR_INNER; + end; + case FBevelOuter of + bvRaised: flags := flags or BDR_RAISEDOUTER; + bvLowered: flags := flags or BDR_SUNKENOUTER; + bvSpace: flags := flags or BDR_OUTER; + end; + R := FPickRect; + InflateRect(R, -FBevelWidth + 1, -FBevelWidth + 1); + for i := 0 to FBevelWidth do + begin + DrawEdge(Canvas.Handle, R, flags, BF_RECT); + InflateRect(R, 1, 1); + end; +end; + +procedure TmbTrackBarPicker.DrawMarker(p: integer); +var + x, y: integer; + R: TRect; +begin + case FSelIndicator of + siRect: + begin + case FLayout of + lyHorizontal: + begin + p := p + Aw; + R := Rect(p - 2, 2, p + 3, Height - 2); + end; + lyVertical: + begin + p := p + Aw; + R := Rect(2, p - 2, Width - 2, p + 3); + end; + end; + Canvas.Pen.Mode := pmNot; + Canvas.Brush.Style := bsClear; + Canvas.Rectangle(R); + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Mode := pmCopy; + end; + siArrows: + begin + if not FNewArrowStyle then + begin + if Focused or (csDesigning in ComponentState)then + begin + Canvas.Brush.Color := clBlack; + Canvas.Pen.Color := clBlack; + end + else + begin + Canvas.Brush.Color := clGray; + Canvas.Pen.Color := clGray; + end; + end + else + begin + Canvas.Brush.Color := clWindow; + Canvas.Pen.Color := clBtnShadow; + end; + if FLayout = lyHorizontal then + begin + x := p + Aw; + if x < Aw then x := Aw; + if x > Width - Aw then x := Width - Aw; + case FPlacement of + spAfter: + begin + y := Height - Aw - 1; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x - 4, y + 6), Point(x + 4, y + 6)]) + else + Canvas.Polygon([Point(x, y), Point(x - 4, y + 4), Point(x - 4, y + 6), + Point(x - 3, y + 7), Point(x + 3, y + 7), + Point(x + 4, y + 6), Point(x + 4, y + 4)]); + end; + spBefore: + begin + y := Aw; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x - 4, y - 6), Point(x +4, y - 6)]) + else + Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 4, y - 6), + Point(x + 3, y - 7), Point(x - 3, y - 7), + Point(x - 4, y - 6), Point(x - 4, y - 4)]); + end; + spBoth: + begin + y := Height - Aw - 1; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x -4, y +6), Point(x +4, y + 6)]) + else + Canvas.Polygon([Point(x, y), Point(x - 4, y + 4), Point(x - 4, y + 6), + Point(x - 3, y + 7), Point(x + 3, y + 7), + Point(x + 4, y + 6), Point(x + 4, y + 4)]); + y := Aw; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x - 4, y - 6), Point(x +4, y - 6)]) + else + Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 4, y - 6), + Point(x + 3, y - 7), Point(x - 3, y - 7), + Point(x - 4, y - 6), Point(x - 4, y - 4)]); + end; + end; + end + else + begin + if not FNewArrowStyle then + y := p + Aw + else + y := p + Aw - 1; + if y < Aw then y := Aw; + if y > Height - Aw - 1 then y := Height - Aw - 1; + case FPlacement of + spAfter: + begin + x := width - Aw - 1; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x + 6, y - 4), Point(x + 6, y + 4)]) + else + Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 6, y - 4), + Point(x + 7, y - 3), Point(x + 7, y + 3), + Point(x + 6, y + 4), Point(x + 4, y + 4)]); + end; + spBefore: + begin + x := Aw; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x - 6, y - 4), Point(x - 6, y + 4)]) + else + Canvas.Polygon([Point(x, y), Point(x - 4, y - 4), Point(x - 6, y - 4), + Point(x - 7, y + 1 - 4), Point(x - 7, y + 3), + Point(x - 6, y + 4), Point(x - 4, y + 4)]); + end; + spBoth: + begin + x := width - Aw - 1; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x + 6, y - 4), Point(x + 6, y + 4)]) + else + Canvas.Polygon([Point(x, y), Point(x + 4, y - 4), Point(x + 6, y - 4), + Point(x + 7, y - 3), Point(x + 7, y + 3), + Point(x + 6, y + 4), Point(x + 4, y + 4)]); + x := Aw; + if not FNewArrowStyle then + Canvas.Polygon([Point(x, y), Point(x - 6, y - 4), Point(x - 6, y + 4)]) + else + Canvas.Polygon([Point(x, y), Point(x - 4, y - 4), Point(x - 6, y - 4), + Point(x - 7, y + 1 - 4), Point(x - 7, y + 3), + Point(x - 6, y + 4), Point(x - 4, y + 4)]); + end; + end; + end; + end; + end; +end; + +procedure TmbTrackBarPicker.Resize; +begin + inherited; + FChange := false; + Execute(TBA_Resize); + FChange := true; +end; + +procedure TmbTrackBarPicker.PaintParentBack; +var + c: TColor; + OffScreen: TBitmap; +{$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + MemDC: HDC; + OldBMP: HBITMAP; + {$ENDIF}{$ENDIF} +begin + Offscreen := TBitmap.Create; + Offscreen.Width := Width; + Offscreen.Height := Height; + {$IFDEF FPC} + if Color = clDefault then + Offscreen.Canvas.Brush.Color := clForm else + {$ENDIF} + Offscreen.Canvas.Brush.Color := Color; + Offscreen.Canvas.FillRect(Offscreen.Canvas.ClipRect); + {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI} + if ParentBackground then + with ThemeServices do + if ThemesEnabled then + begin + MemDC := CreateCompatibleDC(0); + OldBMP := SelectObject(MemDC, OffScreen.Handle); + DrawParentBackground(Handle, MemDC, nil, False); + if OldBMP <> 0 then SelectObject(MemDC, OldBMP); + if MemDC <> 0 then DeleteDC(MemDC); + end; + {$ENDIF}{$ENDIF} + Canvas.Draw(0, 0, Offscreen); + Offscreen.Free; +end; + +function TmbTrackBarPicker.XToArrowPos(p: integer): integer; +var + pos: integer; +begin + pos := p - Aw; + if pos < 0 then pos := 0; + if pos > Width - Aw - 1 then pos := Width - Aw - 1; + Result := pos; +end; + +function TmbTrackBarPicker.YToArrowPos(p: integer): integer; +var + pos: integer; +begin + pos := p - Aw; + if pos < 0 then pos := 0; + if pos > Height - Aw - 1 then pos := Height - Aw - 1; + Result := pos; +end; + +procedure TmbTrackBarPicker.MouseMove(Shift: TShiftState; X, Y: Integer); +var + R: TRect; +begin + if ssLeft in shift then + begin + R := ClientRect; + R.TopLeft := ClientToScreen(R.TopLeft); + R.BottomRight := ClientToScreen(R.BottomRight); + {$IFDEF DELPHI} + ClipCursor(@R); + {$ENDIF} + mx := x; + my := y; + if FLayout = lyHorizontal then + FArrowPos := XToArrowPos(x) + else + FArrowPos := YToArrowPos(y); + Execute(TBA_MouseMove); + FManual := true; + FDoChange := true; + Invalidate; + end; + inherited; +end; + +procedure TmbTrackBarPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if Button <> mbLeft then Exit; + mx := x; + my := y; + SetFocus; + if FLayout = lyHorizontal then + FArrowPos := XToArrowPos(x) + else + FArrowPos := YToArrowPos(y); + Execute(TBA_MouseDown); + FManual := true; + FDoChange := true; + Invalidate; + inherited; +end; + +procedure TmbTrackBarPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + {$IFDEF DELPHI} + ClipCursor(nil); + {$ENDIF} + if Button <> mbLeft then Exit; + mx := x; + my := y; + if FLayout = lyHorizontal then + FArrowPos := XToArrowPos(x) + else + FArrowPos := YToArrowPos(y); + Execute(TBA_MouseUp); + FManual := true; + FDoChange := true; + Invalidate; + inherited; +end; + +procedure TmbTrackBarPicker.CNKeyDown( + var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF}); +var + Shift: TShiftState; + FInherited: boolean; +begin + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + case Message.CharCode of + VK_UP: + begin + if FLayout = lyHorizontal then + begin + inherited; + Exit; + end; + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKUp) + else + Execute(TBA_VKCtrlUp); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_LEFT: + begin + if FLayout = lyVertical then + begin + inherited; + Exit; + end; + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKLeft) + else + Execute(TBA_VKCtrlLeft); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + begin + if FLayout = lyVertical then + begin + inherited; + Exit; + end; + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKRight) + else + Execute(TBA_VKCtrlRight); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + begin + if FLayout = lyHorizontal then + begin + inherited; + Exit; + end; + FChange := false; + if not (ssCtrl in Shift) then + Execute(TBA_VKDown) + else + Execute(TBA_VKCtrlDown); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); + end + else + begin + FInherited := true; + inherited; + end; + end; + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); +end; + +procedure TmbTrackBarPicker.CMHintShow(var Message: TCMHintShow); +begin + with TCMHintShow(Message) do + if not ShowHint then + Message.Result := 1 + else + with HintInfo^ do + begin + Result := 0; + ReshowTimeout := 1; + HideTimeout := 5000; + if FLayout = lyHorizontal then + HintPos := ClientToScreen(Point(CursorPos.X - 8, Height + 2)) + else + HintPos := ClientToScreen(Point(Width + 2, CursorPos.Y - 8)); + HintStr := GetHintStr; + end; + inherited; +end; + +procedure TmbTrackBarPicker.CMGotFocus( + var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF}); +begin + inherited; + Invalidate; +end; + +procedure TmbTrackBarPicker.CMLostFocus( + var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMLostFocus{$ENDIF}); +begin + inherited; + Invalidate; +end; + +procedure TmbTrackBarPicker.WMEraseBkgnd( + var Message: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF}); +begin + Message.Result := 1; +end; + +procedure TmbTrackBarPicker.WheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); +begin + Handled := true; + FChange := false; + Execute(TBA_WheelUp); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); +end; + +procedure TmbTrackBarPicker.WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); +begin + Handled := true; + FChange := false; + Execute(TBA_WheelDown); + FManual := true; + FChange := true; + if Assigned(FOnChange) then FOnChange(Self); +end; + +procedure TmbTrackBarPicker.SetLayout(Value: TTrackBarLayout); +begin + if FLayout <> Value then + begin + FLayout := Value; + Execute(TBA_RedoBMP); + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetPlacement(Value: TSliderPlacement); +begin + if FPlacement <> Value then + begin + FPlacement := Value; + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetNewArrowStyle(s: boolean); +begin + if FNewArrowStyle <> s then + begin + FNewArrowStyle := s; + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetSelIndicator(Value: TSelIndicator); +begin + if FSelIndicator <> Value then + begin + FSelIndicator := Value; + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetWebSafe(s: boolean); +begin + if FWebSafe <> s then + begin + FWebSafe := s; + Execute(TBA_RedoBMP); + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.Execute(tbaAction: integer); +begin + //handled in descendants +end; + +function TmbTrackBarPicker.GetArrowPos: integer; +begin + Result := 0; + //handled in descendants +end; + +function TmbTrackBarPicker.GetHintStr: string; +begin + Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c', + '%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue); +end; + +procedure TmbTrackBarPicker.SetBevelInner(Value: TBevelCut); +begin + if FBevelInner <> Value then + begin + FBevelInner := Value; + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetBevelOuter(Value: TBevelCut); +begin + if FBevelOuter <> Value then + begin + FBevelOuter := Value; + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetBevelWidth(Value: TBevelWidth); +begin + if FBevelWidth <> Value then + begin + FBevelWidth := Value; + Invalidate; + end; +end; + +procedure TmbTrackBarPicker.SetBorderStyle(Value: TBorderStyle); +begin + if FBorderStyle <> Value then + begin + FBorderStyle := Value; + Invalidate; + end; +end; + +end. diff --git a/components/mbColorLib/mbcolorliblaz.lpk b/components/mbColorLib/mbcolorliblaz.lpk new file mode 100644 index 000000000..d09168577 --- /dev/null +++ b/components/mbColorLib/mbcolorliblaz.lpk @@ -0,0 +1,234 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <Package Version="4"> + <PathDelim Value="\"/> + <Name Value="mbColorLibLaz"/> + <Type Value="RunAndDesignTime"/> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Files Count="43"> + <Item1> + <Filename Value="PalUtils.pas"/> + <UnitName Value="PalUtils"/> + </Item1> + <Item2> + <Filename Value="HTMLColors.pas"/> + <UnitName Value="HTMLColors"/> + </Item2> + <Item3> + <Filename Value="RGBCIEUtils.pas"/> + <UnitName Value="RGBCIEUtils"/> + </Item3> + <Item4> + <Filename Value="RGBCMYKUtils.pas"/> + <UnitName Value="RGBCMYKUtils"/> + </Item4> + <Item5> + <Filename Value="RGBHSLUtils.pas"/> + <UnitName Value="RGBHSLUtils"/> + </Item5> + <Item6> + <Filename Value="RGBHSVUtils.pas"/> + <UnitName Value="RGBHSVUtils"/> + </Item6> + <Item7> + <Filename Value="mbColorList.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mbColorList"/> + </Item7> + <Item8> + <Filename Value="mbTrackBarPicker.pas"/> + <UnitName Value="mbTrackBarPicker"/> + </Item8> + <Item9> + <Filename Value="BColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="BColorPicker"/> + </Item9> + <Item10> + <Filename Value="GColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="GColorPicker"/> + </Item10> + <Item11> + <Filename Value="RColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="RColorPicker"/> + </Item11> + <Item12> + <Filename Value="HColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HColorPicker"/> + </Item12> + <Item13> + <Filename Value="KColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="KColorPicker"/> + </Item13> + <Item14> + <Filename Value="LColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="LColorPicker"/> + </Item14> + <Item15> + <Filename Value="MColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="MColorPicker"/> + </Item15> + <Item16> + <Filename Value="VColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="VColorPicker"/> + </Item16> + <Item17> + <Filename Value="YColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="YColorPicker"/> + </Item17> + <Item18> + <Filename Value="mbColorPreview.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mbColorPreview"/> + </Item18> + <Item19> + <Filename Value="Scanlines.pas"/> + <UnitName Value="Scanlines"/> + </Item19> + <Item20> + <Filename Value="mbColorPickerControl.pas"/> + <UnitName Value="mbColorPickerControl"/> + </Item20> + <Item21> + <Filename Value="BAxisColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="BAxisColorPicker"/> + </Item21> + <Item22> + <Filename Value="GAxisColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="GAxisColorPicker"/> + </Item22> + <Item23> + <Filename Value="RAxisColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="RAxisColorPicker"/> + </Item23> + <Item24> + <Filename Value="CIEAColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="CIEAColorPicker"/> + </Item24> + <Item25> + <Filename Value="CIEBColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="CIEBColorPicker"/> + </Item25> + <Item26> + <Filename Value="CIELColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="CIELColorPicker"/> + </Item26> + <Item27> + <Filename Value="HRingPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HRingPicker"/> + </Item27> + <Item28> + <Filename Value="HexaColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HexaColorPicker"/> + </Item28> + <Item29> + <Filename Value="HSColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HSColorPicker"/> + </Item29> + <Item30> + <Filename Value="SLColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="SLColorPicker"/> + </Item30> + <Item31> + <Filename Value="SLHColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="SLHColorPicker"/> + </Item31> + <Item32> + <Filename Value="HSVColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HSVColorPicker"/> + </Item32> + <Item33> + <Filename Value="SelPropUtils.pas"/> + <UnitName Value="SelPropUtils"/> + </Item33> + <Item34> + <Filename Value="mbOfficeColorDialog.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mbOfficeColorDialog"/> + </Item34> + <Item35> + <Filename Value="OfficeMoreColorsDialog.pas"/> + <UnitName Value="OfficeMoreColorsDialog"/> + </Item35> + <Item36> + <Filename Value="HSLColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HSLColorPicker"/> + </Item36> + <Item37> + <Filename Value="mbColorPalette.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mbColorPalette"/> + </Item37> + <Item38> + <Filename Value="CColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="CColorPicker"/> + </Item38> + <Item39> + <Filename Value="SColorPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="SColorPicker"/> + </Item39> + <Item40> + <Filename Value="mbDeskPickerButton.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mbDeskPickerButton"/> + </Item40> + <Item41> + <Filename Value="ScreenWin.pas"/> + <UnitName Value="ScreenWin"/> + </Item41> + <Item42> + <Filename Value="mbColorTree.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="mbColorTree"/> + </Item42> + <Item43> + <Filename Value="HSLRingPicker.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="HSLRingPicker"/> + </Item43> + </Files> + <RequiredPkgs Count="2"> + <Item1> + <PackageName Value="LCLBase"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + </Item2> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + </Package> +</CONFIG> diff --git a/components/mbColorLib/mxs.inc b/components/mbColorLib/mxs.inc new file mode 100644 index 000000000..fe0f1e6a9 --- /dev/null +++ b/components/mbColorLib/mxs.inc @@ -0,0 +1,44 @@ +{$IFDEF FPC} + {$DEFINE VER150} // Lazarus --> at least Delphi 7 } +{$ENDIF} + + {$ifdef VER180} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$define DELPHI_8_UP} + {$define DELPHI_9_UP} + {$define DELPHI_10_UP} + {$endif} + + {$ifdef VER170} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$define DELPHI_8_UP} + {$define DELPHI_9_UP} + {$endif} + + {$ifdef VER160} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$define DELPHI_8_UP} + {$endif} + + {$ifdef VER150} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$endif} + + {$ifdef VER140} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$endif} + + {$ifdef VER130} + {$define DELPHI_5_UP} + {$endif} + + {.$DEFINE mbXP_Lib}