From 6ccc026deb986c639afa1bca39514399ea9085a0 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 11 Mar 2018 14:55:36 +0000 Subject: [PATCH] jvcllaz: Add TJvMovableBevel git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6232 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvCore/JvDsgnConsts.pas | 2 + .../jvcllaz/design/JvCtrls/JvCtrlsReg.pas | 16 +- components/jvcllaz/packages/JvCtrlsLazR.lpk | 6 +- .../jvcllaz/run/JvCtrls/JvMovableBevel.pas | 407 ++++++++++++++++++ 4 files changed, 422 insertions(+), 9 deletions(-) create mode 100644 components/jvcllaz/run/JvCtrls/JvMovableBevel.pas diff --git a/components/jvcllaz/design/JvCore/JvDsgnConsts.pas b/components/jvcllaz/design/JvCore/JvDsgnConsts.pas index b827b7d31..9d8119b6b 100644 --- a/components/jvcllaz/design/JvCore/JvDsgnConsts.pas +++ b/components/jvcllaz/design/JvCore/JvDsgnConsts.pas @@ -61,6 +61,8 @@ resourcestring //=== JVCL IDE palettes ====================================================== resourcestring + RsPaletteJvcl = 'Jvcl'; + RsPaletteJvclDB = 'Jvcl DB'; RsPaletteSystem = 'Jv System'; RsPaletteDialog = 'Jv Dialogs'; RsPaletteButton = 'Jv Buttons'; diff --git a/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas b/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas index 7bb69c104..f8eaefe06 100644 --- a/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas +++ b/components/jvcllaz/design/JvCtrls/JvCtrlsReg.pas @@ -11,25 +11,25 @@ procedure Register; implementation -{$R ../../resource/JvHTControlsReg.res} +{$R ../../resource/jvctrlsreg.res} uses Classes, JvDsgnConsts, - JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm, + JvHtControls, {JvDBHTLabel,} JvHint, JvHTHintForm, JvMovableBevel, PropEdits, Controls; procedure Register; begin + RegisterComponents(RsPaletteJvcl, [ + TJvMovableBevel, TJvHint, TJvHTLabel, TJvHTListbox, TJvHTCombobox + ]); + { + RegisterComponents(RsPaletteBarPanel, [TJvMovableBevel]); RegisterComponents(RsPaletteLabel, [TJvHTLabel]); RegisterComponents(RsPaletteListComboTree, [TJvHTListBox, TJvHTComboBox]); RegisterComponents(RsPaletteNonVisual, [TJvHint]); - + } RegisterPropertyEditor(TypeInfo(TCaption), TJvHTLabel, 'Caption', TJvHintProperty); - - (* - RegisterComponents('JvHTControls', [TJvHTLabel, TJvHTComboBox, TJvHTListBox, - TJvDBHTLabel, TJvHint]); - *) end; end. diff --git a/components/jvcllaz/packages/JvCtrlsLazR.lpk b/components/jvcllaz/packages/JvCtrlsLazR.lpk index 8f51ee1d8..5ef0c1757 100644 --- a/components/jvcllaz/packages/JvCtrlsLazR.lpk +++ b/components/jvcllaz/packages/JvCtrlsLazR.lpk @@ -19,7 +19,7 @@ - Listboxes, Comboboxes, TreeViews"/> - + @@ -28,6 +28,10 @@ + + + + diff --git a/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas b/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas new file mode 100644 index 000000000..1bed5045e --- /dev/null +++ b/components/jvcllaz/run/JvCtrls/JvMovableBevel.pas @@ -0,0 +1,407 @@ +{----------------------------------------------------------------------------- +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: JvMovableBevel.PAS, released on 2002-07-03. + +The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com] +Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos. +All Rights Reserved. + +Contributor(s): + +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 JvMovableBevel; + +{$mode objfpc}{$H+} +//{$I jvcl.inc} + +interface + +uses + SysUtils, Classes, + //Windows, Messages, + Controls, Forms, ExtCtrls, + JvExExtCtrls; + +type + TJvBevelScrollTextDirection = (tdNone, tdUpToDown, tdDownToUp, tdLeftToRight, + tdRightToLeft, tdTopLeftToBottomRight, tdTopRightToBottomLeft, + tdBottomLeftToTopRight, tdBottomRightToTopLeft); + +// {$IFDEF RTL230_UP} +// [ComponentPlatformsAttribute(pidWin32 or pidWin64)] +// {$ENDIF RTL230_UP} + TJvMovableBevel = class(TBevel) //TJvExBevel) + private + FStartX: Integer; + FStartY: Integer; + FStartPoint: TPoint; + FMinSize: Integer; + FMoving: Boolean; // If True then we are moving the object around. + FSizing: Boolean; // if True then we are sizing the object; + FDirection: TJvBevelScrollTextDirection; + FBorderSize: Byte; + FOnMoving: TNotifyEvent; + FOnMoved: TNotifyEvent; + FOnSizing: TNotifyEvent; + FOnSized: TNotifyEvent; + protected + procedure DoMove(Shift: TShiftState; DeltaX, DeltaY: Integer); + procedure DoSize(Shift: TShiftState; DeltaX, DeltaY: Integer); + procedure SelectCursor(X, Y: Integer); + 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 MouseEnter; override; + procedure MouseLeave; override; +// procedure MouseEnter(Control: TControl); override; +// procedure MouseLeave(Control: TControl); override; + public + constructor Create(AOwner: TComponent); override; + published + property BorderSize: Byte read FBorderSize write FBorderSize default 4; + property OnMoving: TNotifyEvent read FOnMoving write FOnMoving; + property OnSizing: TNotifyEvent read FOnSizing write FOnSizing; + property OnMoved: TNotifyEvent read FOnMoved write FOnMoved; + property OnSized: TNotifyEvent read FOnSized write FOnSized; + end; + + +implementation + +constructor TJvMovableBevel.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Shape := bsFrame; + Style := bsRaised; + FBorderSize := 4; + FMinSize := 8; +end; + +procedure TJvMovableBevel.DoMove(Shift: TShiftState; DeltaX, DeltaY: Integer); +begin + // Must work on it in order to make expand and shrink the way coreldraw does when + // shift and ctrl keys are pressed. + { If ssCtrl in shift then + begin + if Abs(FStartPoint.X - Left) < Abs(FStartPoint.Y - Top) then + begin + Top := Top + DeltaY; + Left:=FStartX; + end; + if Abs(FStartPoint.X - Left) > Abs(FStartPoint.Y - Top) then + begin + Left := Left + DeltaX; + Top := FStartY; + end; + if Abs(FStartPoint.X - Left) = Abs(FStartPoint.Y - Top) then + begin + Top := Top + DeltaY; + Left := Left + DeltaX; + end + end + else + begin } + Top := Top + DeltaY; + Left := Left + DeltaX; + // end +end; + +procedure TJvMovableBevel.DoSize(Shift: TShiftState; DeltaX, DeltaY: Integer); +begin + case FDirection of + tdUpToDown: + begin + Height := Height + DeltaY; + Top := Top - DeltaY; + end; + tdDownToUp: + Height := FStartY - DeltaY; + tdLeftToRight: + begin + Width := Width + DeltaX; + Left := Left - DeltaX; + end; + tdRightToLeft: + Width := FStartX - DeltaX; + tdTopLeftToBottomRight: + begin + Top := Top - DeltaY; + Left := Left - DeltaX; + Height := Height + DeltaY; + Width := Width + DeltaX; + end; + tdTopRightToBottomLeft: + begin + Height := Height + DeltaY; + Width := FStartX - DeltaX; + Top := Top - DeltaY; + end; + tdBottomLeftToTopRight: + begin + Left := Left - DeltaX; + Height := FStartY - DeltaY; + Width := Width + DeltaX; + end; + tdBottomRightToTopLeft: + begin + Height := FStartY - DeltaY; + Width := FStartX - DeltaX; + end; + end; +end; + +procedure TJvMovableBevel.SelectCursor(X, Y: longint); +begin + if (Y > 0) and (Y <= FBorderSize) then + begin + if (X > 0) and (X <= FBorderSize) then + begin + Screen.Cursor := crSizeNWSE; + FDirection := tdTopLeftToBottomRight; + end + else + if (X >= Width - FBorderSize) and (X < Width) then + begin + Screen.Cursor := crSizeNESW; + FDirection := tdTopRightToBottomLeft; + end + else + begin + Screen.Cursor := crSizeNS; + FDirection := tdUpToDown; + end; + end + else + if (Y >= Height - FBorderSize) and (Y < Height) then + begin + if (X > 0) and (X <= FBorderSize) then + begin + Screen.Cursor := crSizeNESW; + FDirection := tdBottomLeftToTopRight; + end + else + if (X >= Width - FBorderSize) and (X < Width) then + begin + Screen.Cursor := crSizeNWSE; + FDirection := tdBottomRightToTopLeft; + end + else + begin + Screen.Cursor := crSizeNS; + FDirection := tdDownToUp; + end; + end + else + if (X >= 1) and (X <= FBorderSize) then + begin + Screen.Cursor := crSizeWE; + FDirection := tdLeftToRight; + end + else + if (X >= Width - FBorderSize) and (X < Width) then + begin + Screen.Cursor := crSizeWE; + FDirection := tdRightToLeft; + end + else + begin + Screen.Cursor := crDefault; + FDirection := tdNone; + end +end; + +procedure TJvMovableBevel.MouseMove(Shift: TShiftState; X, Y: Integer); +//const +// WM_MOVE = $0003; +begin + if FMoving then + DoMove(Shift, X - FStartX, Y - FStartY) + else + if FSizing then + DoSize(Shift, FStartX - X, FStartY - Y) + else + SelectCursor(X, Y); + inherited MouseMove(Shift, X, Y); +end; + +procedure TJvMovableBevel.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if FDirection > tdNone then + begin + FSizing := True; + if Assigned(FOnSizing) then + FOnSizing(Self); + end + else + begin + FMoving := True; + if Assigned(FOnMoving) then + FOnMoving(Self); + end; + FStartPoint := Point(Left, Top); + FStartX := X; + FStartY := Y; + inherited MouseDown(Button, Shift, X, Y); +end; + + +procedure TJvMovableBevel.MouseUp(Button: TMouseButton; Shift: TShiftState; +X, Y: Integer); +begin + SelectCursor(X, Y); + FStartX := 0; + FStartY := 0; + if Height < 0 then + begin + Top := Top + Height; + Height := Abs(Height); + end; + if Width < 0 then + begin + Left := Left + Width; + Width := Abs(Width); + end; + inherited MouseUp(Button, Shift, X, Y); + if FMoving and Assigned(FOnMoved) then + FOnMoved(Self); + if FSizing and Assigned(FOnSized) then + FOnSized(Self); + FMoving := False; + FSizing := False; +end; + + +//Procedure TJvMovableBevel.SelectCursor(X, Y: Longint); +//begin +// if Y in [0..FBorderSize] then +// begin +// If X in [0..FBorderSize] then +// begin +// Screen.Cursor:= crsizenwse; +// FDirection := tdTopLeftToBottomRight; +// end +// else +// if X in [Width-FBorderSize..Width] then +// begin +// Screen.Cursor := crsizenesw; +// FDirection := tdTopRightToBottomLeft; +// end +// else +// begin +// Screen.Cursor := crsizens; +// FDirection := tdUpToDown; +// end; +// end +// else +// if Y in [Height-FBorderSize..Height] then +// begin +// If X in [0..FBorderSize] then +// begin +// Screen.Cursor:= crsizenesw; +// FDirection := tdBottomLeftToTopRight; +// end +// else +// if X in [Width-FBorderSize..Width] then +// begin +// Screen.Cursor := crsizenwse; +// FDirection := tdBottomRightToTopLeft; +// end +// else +// begin +// Screen.Cursor := crSizeNS; +// FDirection := tdDownToUp; +// end; +// end +// else +// if (X in [1..FBorderSize]) then +// begin +// Screen.Cursor := crsizeWE; +// FDirection := tdLeftToRight; +// end +// else +// if (X in [Width-FBorderSize..Width]) then +// begin +// Screen.Cursor := crsizeWE; +// FDirection := tdRightToLeft; +// end +// else +// begin +// Screen.Cursor := crdefault; +// FDirection := tdNone; +// end +//end;{} + +procedure TJvMovableBevel.MouseEnter; +var + Pos: TPoint; +begin + if csDesigning in ComponentState then + Exit; + Pos := ScreenToClient(Mouse.CursorPos); + SelectCursor(Pos.X, Pos.Y); + inherited MouseEnter; +end; + +(* +procedure TJvMovableBevel.MouseEnter(Control: TControl); +var + Pos: TPoint; +begin + if csDesigning in ComponentState then + Exit; + Pos := ScreenToClient(Mouse.CursorPos); + SelectCursor(Pos.X, Pos.Y); + inherited MouseEnter(Control); +end; + +procedure TJvMovableBevel.MouseLeave(Control: TControl); +begin + if csDesigning in ComponentState then + Exit; + if (not FMoving) and (not FSizing) then + begin + Screen.Cursor := crDefault; + FDirection := tdNone; + end; + inherited MouseLeave(Control); +end; + *) + +procedure TJvMovableBevel.MouseLeave; +begin + if csDesigning in ComponentState then + Exit; + if (not FMoving) and (not FSizing) then + begin + Screen.Cursor := crDefault; + FDirection := tdNone; + end; + inherited MouseLeave; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end.