From 87417bdd620b37dbed00b9f82d0ccaab7e3cf574 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 8 Apr 2018 14:42:41 +0000 Subject: [PATCH] jvcllaz: Add JvGradient git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6296 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvMM/images/images.txt | 1 + .../design/JvMM/images/tjvgradient.bmp | Bin 0 -> 1654 bytes components/jvcllaz/design/JvMM/jvmmreg.pas | 3 +- components/jvcllaz/packages/jvmmlazr.lpk | 8 +- components/jvcllaz/resource/jvmmreg.res | Bin 1740 -> 3432 bytes components/jvcllaz/run/JvCore/JvTypes.pas | 4 + components/jvcllaz/run/JvMM/JvGradient.pas | 430 ++++++++++++++++++ 7 files changed, 443 insertions(+), 3 deletions(-) create mode 100644 components/jvcllaz/design/JvMM/images/tjvgradient.bmp create mode 100644 components/jvcllaz/run/JvMM/JvGradient.pas diff --git a/components/jvcllaz/design/JvMM/images/images.txt b/components/jvcllaz/design/JvMM/images/images.txt index ca2b43a66..9d167721e 100644 --- a/components/jvcllaz/design/JvMM/images/images.txt +++ b/components/jvcllaz/design/JvMM/images/images.txt @@ -1 +1,2 @@ +tjvgradient.bmp tjvspecialprogress.bmp diff --git a/components/jvcllaz/design/JvMM/images/tjvgradient.bmp b/components/jvcllaz/design/JvMM/images/tjvgradient.bmp new file mode 100644 index 0000000000000000000000000000000000000000..cae245052cb8d03574e6f10c2c0af05303973130 GIT binary patch literal 1654 zcmcK2F^UvX5XSLuMHa!#$go0BU|blP2y=uwg>fCjumbTMl?k4~phCmVM`rwYzY%sv z5mwmh{>}HgX6T;x`n~(`@m71ieJ;IW^!nmPFZRAalU}`CbVF;iS4y19T)`(pb+`I^ z>+ahZ$s7T`utH-b7YqzMkSH`p3c=vuA`*qhT%K#BBakRGMq;QkI0A`6WB8MT!4XIl z8Y6LP430pe&=|S+n=))iAW>+{nwlBu2qX%PS<`kS9f3rlF>6V}NJk)1Xv|u!G|~}B z6dJRZvW#>D5{1UBWo{!KfkdG(`z!D<(h*1$8lzeCa~?IUX*SwEhl?*6}iuj_UG0-L6*p8x;= literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvMM/jvmmreg.pas b/components/jvcllaz/design/JvMM/jvmmreg.pas index 83783f5f8..b330b8ffa 100644 --- a/components/jvcllaz/design/JvMM/jvmmreg.pas +++ b/components/jvcllaz/design/JvMM/jvmmreg.pas @@ -16,11 +16,12 @@ implementation uses Classes, JvDsgnConsts, PropEdits, Controls, - JvSpecialProgress; + JvGradient, JvSpecialProgress; procedure Register; begin RegisterComponents(RsPaletteJvcl, [ + TJvGradient, TJvSpecialProgress ]); end; diff --git a/components/jvcllaz/packages/jvmmlazr.lpk b/components/jvcllaz/packages/jvmmlazr.lpk index 0782cc5a8..5ad98a6a4 100644 --- a/components/jvcllaz/packages/jvmmlazr.lpk +++ b/components/jvcllaz/packages/jvmmlazr.lpk @@ -9,17 +9,21 @@ - + - + + + + + diff --git a/components/jvcllaz/resource/jvmmreg.res b/components/jvcllaz/resource/jvmmreg.res index 9ccb7bab84aa2692dabe0dc277e80548101db62c..99db723d5a264c6da73f2da4531c9dbfad8b9350 100644 GIT binary patch delta 642 zcmX@Z`$B4himV9(1H=FSObj6mUJPLj?hHW;jtnjgo(!%GeheWK1GV{txEUBgn1K<5 zH+C_z)B_pF;NKqzKo$eBf#Sb^1EnyA81hI+(4M7sG2kQ$62mo6QlmIeO z0A6vRStyEuoPSU-gE&x6oH8t`*hmBqu!4H5qF})nv;ZH_fHN8&9~Tz1==4T~HEaNI CvvOnr delta 11 ScmaDMb%u9>%H{)XE7$-ZN(8q6 diff --git a/components/jvcllaz/run/JvCore/JvTypes.pas b/components/jvcllaz/run/JvCore/JvTypes.pas index 469fdae9d..111c0e58e 100644 --- a/components/jvcllaz/run/JvCore/JvTypes.pas +++ b/components/jvcllaz/run/JvCore/JvTypes.pas @@ -239,7 +239,11 @@ type {$ENDIF COMPILER5} + *********************) + TJvGradientStyle = (grFilled, grEllipse, grHorizontal, grVertical, grPyramid, grMount); + +(******************** // TOnDelete = procedure(Sender: TObject; Path: string) of object; TJvParentEvent = procedure(Sender: TObject; ParentWindow: THandle) of object; // TOnImage = procedure(Sender: TObject; Image: TBitmap) of object; // JvClipboardViewer diff --git a/components/jvcllaz/run/JvMM/JvGradient.pas b/components/jvcllaz/run/JvMM/JvGradient.pas new file mode 100644 index 000000000..99aa9283d --- /dev/null +++ b/components/jvcllaz/run/JvMM/JvGradient.pas @@ -0,0 +1,430 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing Rights and limitations under the License. + +The Original Code is: JvGradient.PAS, released on 2001-02-28. + +The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com] +Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse. +All Rights Reserved. + +Contributor(s): Michael Beck [mbeck att bigfoot dott com]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvGradient; + +{$mode objfpc}{$H+} + +interface + +uses + LclIntf, Graphics, Controls, + SysUtils, Classes, JvTypes, JvComponent; + +type + TJvGradientPaintEvent = procedure(Sender: TObject; Canvas: TCanvas) of object; + + TJvGradient = class(TJvGraphicControl) + private + FStyle: TJvGradientStyle; + FStartColor: TColor; + FEndColor: TColor; + FSteps: Word; + FBuffer: TBitmap; + FBufferWidth: Integer; + FBufferHeight: Integer; + FLoadedLeft: Integer; + FLoadedTop: Integer; + FLoadedWidth: Integer; + FLoadedHeight: Integer; + FOnPaint: TJvGradientPaintEvent; + procedure SetSteps(Value: Word); + procedure SetStartColor(Value: TColor); + procedure SetEndColor(Value: TColor); + procedure SetStyle(Value: TJvGradientStyle); + function GetLeft: Integer; + function GetTop: Integer; + function GetWidth: Integer; + procedure SetLeft(const Value: Integer); + procedure SetTop(const Value: Integer); + procedure SetWidth(const Value: Integer); + function GetHeight: Integer; + procedure SetHeight(const Value: Integer); + protected + procedure Paint; override; + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Align default alClient; + property Anchors; + property BorderSpacing; + property Constraints; + property DragCursor; + property DragKind; + property DragMode; + property Left: Integer read GetLeft write SetLeft; + property Top: Integer read GetTop write SetTop; + property Width: Integer read GetWidth write SetWidth; + property Height: Integer read GetHeight write SetHeight; + property ShowHint; + property Visible; + property ParentShowHint; + property Enabled; + property PopupMenu; + property Style: TJvGradientStyle read FStyle write SetStyle default grHorizontal; + property StartColor: TColor read FStartColor write SetStartColor default clBlue; + property EndColor: TColor read FEndColor write SetEndColor default clBlack; + property Steps: Word read FSteps write SetSteps default 100; + + property OnClick; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnPaint: TJvGradientPaintEvent read FOnPaint write FOnPaint; + property OnStartDock; + property OnStartDrag; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JVCL\run' + ); +{$ENDIF UNITVERSIONING} + +implementation + + +constructor TJvGradient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ControlStyle := ControlStyle + [csOpaque]; + FBufferWidth := 0; + FBufferHeight := 0; + FSteps := 100; + FBuffer := TBitmap.Create; + FStyle := grHorizontal; + FEndColor := clBlack; + FStartColor := clBlue; + Align := alClient; +end; + +destructor TJvGradient.Destroy; +begin + FBuffer.Free; + inherited Destroy; +end; + +function TJvGradient.GetHeight: Integer; +begin + Result := inherited Height; +end; + +function TJvGradient.GetLeft: Integer; +begin + Result := inherited Left; +end; + +function TJvGradient.GetTop: Integer; +begin + Result := inherited Top; +end; + +function TJvGradient.GetWidth: Integer; +begin + Result := inherited Width; +end; + +procedure TJvGradient.Loaded; +begin + inherited Loaded; + if not (Align in [alLeft, alTop, alRight, alBottom]) then + begin + inherited Left := FLoadedLeft; + inherited Top := FLoadedTop; + end; + if Align <> alClient then + begin + inherited Width := FLoadedWidth; + inherited Height := FLoadedHeight; + end; +end; + +procedure TJvGradient.Paint; +var + I: Integer; + J, K: Real; + Deltas: array [0..2] of Double; // R,G,B + R: TRect; + LStartRGB, LEndRGB: TColor; + LSteps: Word; +begin + if csDestroying in ComponentState then + Exit; + if (FBufferWidth <> Width) or (FBufferHeight <> Height) then + begin + LSteps := FSteps; + LStartRGB := ColorToRGB(FStartColor); + LEndRGB := ColorToRGB(FEndColor); + + FBufferWidth := Width; + FBufferHeight := Height; + if (FBufferWidth = 0) or (FBufferHeight = 0) then + Exit; + + FBuffer.Width := FBufferWidth; + FBuffer.Height := FBufferHeight; + case FStyle of + grFilled: + begin + FBuffer.Canvas.Brush.Color := LStartRGB; + FBuffer.Canvas.Brush.Style := bsSolid; + FBuffer.Canvas.FillRect(Rect(0, 0, Width, Height)); + end; + grEllipse: + begin + FBuffer.Canvas.Brush.Color := LStartRGB; + FBuffer.Canvas.Brush.Style := bsSolid; + FBuffer.Canvas.FillRect(Rect(0, 0, Width, Height)); + if LSteps > (Width div 2) then + LSteps := Trunc(Width / 2); + if LSteps > (Height div 2) then + LSteps := Trunc(Height / 2); + if LSteps < 1 then + LSteps := 1; + Deltas[0] := (GetRValue(LEndRGB) - GetRValue(LStartRGB)) / LSteps; + Deltas[1] := (GetGValue(LEndRGB) - GetGValue(LStartRGB)) / LSteps; + Deltas[2] := (GetBValue(LEndRGB) - GetBValue(LStartRGB)) / LSteps; + FBuffer.Canvas.Brush.Style := bsSolid; + J := (Width / LSteps) / 2; + K := (Height / LSteps) / 2; + for I := 0 to LSteps do + begin + R.Top := Round(I * K); + R.Bottom := Height - R.Top; + R.Right := Round(I * J); + R.Left := Width - R.Right; + FBuffer.Canvas.Brush.Color := RGB( + Round(GetRValue(LStartRGB) + I * Deltas[0]), + Round(GetGValue(LStartRGB) + I * Deltas[1]), + Round(GetBValue(LStartRGB) + I * Deltas[2])); + FBuffer.Canvas.Pen.Color := FBuffer.Canvas.Brush.Color; + FBuffer.Canvas.Ellipse(R.Right, R.Top, R.Left, R.Bottom); + end; + end; + grHorizontal: + begin + if LSteps > Width then + LSteps := Width; + if LSteps < 1 then + LSteps := 1; + Deltas[0] := (GetRValue(LEndRGB) - GetRValue(LStartRGB)) / LSteps; + Deltas[1] := (GetGValue(LEndRGB) - GetGValue(LStartRGB)) / LSteps; + Deltas[2] := (GetBValue(LEndRGB) - GetBValue(LStartRGB)) / LSteps; + FBuffer.Canvas.Brush.Style := bsSolid; + J := Width / LSteps; + for I := 0 to LSteps do + begin + R.Top := 0; + R.Bottom := Height; + R.Left := Round(I * J); + R.Right := Round((I + 1) * J); + FBuffer.Canvas.Brush.Color := RGB( + Round(GetRValue(LStartRGB) + I * Deltas[0]), + Round(GetGValue(LStartRGB) + I * Deltas[1]), + Round(GetBValue(LStartRGB) + I * Deltas[2])); + FBuffer.Canvas.FillRect(R); + end; + end; + grVertical: + begin + if LSteps > Height then + LSteps := Height; + if LSteps < 1 then + LSteps := 1; + Deltas[0] := (GetRValue(LEndRGB) - GetRValue(LStartRGB)) / LSteps; + Deltas[1] := (GetGValue(LEndRGB) - GetGValue(LStartRGB)) / LSteps; + Deltas[2] := (GetBValue(LEndRGB) - GetBValue(LStartRGB)) / LSteps; + FBuffer.Canvas.Brush.Style := bsSolid; + J := Height / LSteps; + for I := 0 to LSteps do + begin + R.Left := Width; + R.Right := 0; + R.Top := Round(I * J); + R.Bottom := Round((I + 1) * J); + FBuffer.Canvas.Brush.Color := RGB( + Round(GetRValue(LStartRGB) + I * Deltas[0]), + Round(GetGValue(LStartRGB) + I * Deltas[1]), + Round(GetBValue(LStartRGB) + I * Deltas[2])); + FBuffer.Canvas.FillRect(R); + end; + end; + grMount: + begin + FBuffer.Canvas.Brush.Color := LStartRGB; + FBuffer.Canvas.Brush.Style := bsSolid; + FBuffer.Canvas.FillRect(Rect(0, 0, Width, Height)); + if LSteps > (Width div 2) then + LSteps := Trunc(Width / 2); + if LSteps > (Height div 2) then + LSteps := Trunc(Height / 2); + if LSteps < 1 then + LSteps := 1; + Deltas[0] := (GetRValue(LEndRGB) - GetRValue(LStartRGB)) / LSteps; + Deltas[1] := (GetGValue(LEndRGB) - GetGValue(LStartRGB)) / LSteps; + Deltas[2] := (GetBValue(LEndRGB) - GetBValue(LStartRGB)) / LSteps; + FBuffer.Canvas.Brush.Style := bsSolid; + J := (Width / LSteps) / 2; + K := (Height / LSteps) / 2; + for I := 0 to LSteps do + begin + R.Top := Round(I * K); + R.Bottom := Height - R.Top; + R.Right := Round(I * J); + R.Left := Width - R.Right; + FBuffer.Canvas.Brush.Color := RGB( + Round(GetRValue(LStartRGB) + I * Deltas[0]), + Round(GetGValue(LStartRGB) + I * Deltas[1]), + Round(GetBValue(LStartRGB) + I * Deltas[2])); + FBuffer.Canvas.Pen.Color := FBuffer.Canvas.Brush.Color; + FBuffer.Canvas.RoundRect(R.Right, R.Top, R.Left, R.Bottom, + ((R.Left - R.Right) div 2), ((R.Bottom - R.Top) div 2)); + end; + end; + grPyramid: + begin + FBuffer.Canvas.Brush.Color := LStartRGB; + FBuffer.Canvas.Brush.Style := bsSolid; + FBuffer.Canvas.FillRect(Rect(0, 0, Width, Height)); + if LSteps > (Width div 2) then + LSteps := Trunc(Width / 2); + if LSteps > (Height div 2) then + LSteps := Trunc(Height / 2); + if LSteps < 1 then + LSteps := 1; + Deltas[0] := (GetRValue(LEndRGB) - GetRValue(LStartRGB)) / LSteps; + Deltas[1] := (GetGValue(LEndRGB) - GetGValue(LStartRGB)) / LSteps; + Deltas[2] := (GetBValue(LEndRGB) - GetBValue(LStartRGB)) / LSteps; + FBuffer.Canvas.Brush.Style := bsSolid; + J := (Width / LSteps) / 2; + K := (Height / LSteps) / 2; + for I := 0 to LSteps do + begin + R.Top := Round(I * K); + R.Bottom := Height - R.Top; + R.Right := Round(I * J); + R.Left := Width - R.Right; + FBuffer.Canvas.Brush.Color := RGB( + Round(GetRValue(LStartRGB) + I * Deltas[0]), + Round(GetGValue(LStartRGB) + I * Deltas[1]), + Round(GetBValue(LStartRGB) + I * Deltas[2])); + FBuffer.Canvas.Pen.Color := FBuffer.Canvas.Brush.Color; + FBuffer.Canvas.FillRect(Rect(R.Right, R.Top, R.Left, R.Bottom)); + end; + end; + end; + if Assigned(FOnPaint) then + FOnPaint(Self, FBuffer.Canvas); + end; + Canvas.Draw(0, 0, FBuffer); +end; + +procedure TJvGradient.SetStyle(Value: TJvGradientStyle); +begin + if FStyle <> Value then + begin + FStyle := Value; + FBufferWidth := 0; + Invalidate; + end; +end; + +procedure TJvGradient.SetTop(const Value: Integer); +begin + FLoadedTop := Value; + inherited Top := Value; +end; + +procedure TJvGradient.SetWidth(const Value: Integer); +begin + FLoadedWidth := Value; + inherited Width := Value; +end; + +procedure TJvGradient.SetStartColor(Value: TColor); +begin + if FStartColor <> Value then + begin + FStartColor := Value; + FBufferWidth := 0; + Invalidate; + end; +end; + +procedure TJvGradient.SetSteps(Value: Word); +begin + if FSteps <> Value then + begin + FSteps := Value; + FBufferWidth := 0; + Invalidate; + end; +end; + +procedure TJvGradient.SetEndColor(Value: TColor); +begin + if FEndColor <> Value then + begin + FEndColor := Value; + FBufferWidth := 0; + Invalidate; + end; +end; + +procedure TJvGradient.SetHeight(const Value: Integer); +begin + FLoadedHeight := Value; + inherited Height := Value; +end; + +procedure TJvGradient.SetLeft(const Value: Integer); +begin + FLoadedLeft := Value; + inherited Left := Value; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end.