mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-12 15:49:49 +02:00
43 lines
1.1 KiB
PHP
43 lines
1.1 KiB
PHP
{%MainUnit ../RubberBand.pas}
|
|
|
|
{******************************************************************************
|
|
TCustomRubberBand
|
|
******************************************************************************
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
|
|
{ TCustomRubberBand }
|
|
|
|
function TCustomRubberBand.GetShape: TRubberBandShape;
|
|
begin
|
|
Result := FShape;
|
|
end;
|
|
|
|
procedure TCustomRubberBand.SetShape(const AValue: TRubberBandShape);
|
|
begin
|
|
if FShape = AValue then
|
|
Exit;
|
|
FShape := AValue;
|
|
if HandleAllocated then
|
|
TWsCustomRubberBandClass(WidgetsetClass).SetShape(Self, FShape);
|
|
end;
|
|
|
|
class procedure TCustomRubberBand.WSRegisterClass;
|
|
begin
|
|
inherited WSRegisterClass;
|
|
RegisterCustomRubberBand;
|
|
end;
|
|
|
|
constructor TCustomRubberBand.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FShape := rbsLine;
|
|
end;
|
|
|