mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-04 07:18:14 +02:00
105 lines
3.8 KiB
ObjectPascal
105 lines
3.8 KiB
ObjectPascal
{ $Id: qtwsdesigner.pp 11897 2007-09-01 02:46:24Z marc $}
|
|
{
|
|
*****************************************************************************
|
|
* QtWSDesigner.pp *
|
|
* ------------ *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
unit QtWSDesigner;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
////////////////////////////////////////////////////
|
|
// I M P O R T A N T
|
|
////////////////////////////////////////////////////
|
|
// 1) Only class methods allowed
|
|
// 2) Class methods have to be published and virtual
|
|
// 3) To get as little as posible circles, the uses
|
|
// clause should contain only those LCL units
|
|
// needed for registration. WSxxx units are OK
|
|
// 4) To improve speed, register only classes in the
|
|
// initialization section which actually
|
|
// implement something
|
|
// 5) To enable your XXX widgetset units, look at
|
|
// the uses clause of the XXXintf.pp
|
|
////////////////////////////////////////////////////
|
|
uses
|
|
// Bindings
|
|
{$ifdef USE_QT_4_3}
|
|
qt43,
|
|
{$else}
|
|
qt4,
|
|
{$endif}
|
|
qtwidgets,
|
|
// LCL
|
|
Classes, Controls, RubberBand, LCLType,
|
|
// Widgetset
|
|
WsLCLClasses, WsControls, WsDesigner, WsProc;
|
|
|
|
type
|
|
{ TWsCustomRubberBand }
|
|
|
|
{ TQtWsCustomRubberBand }
|
|
|
|
TQtWsCustomRubberBand = class(TWsCustomRubberBand)
|
|
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
|
class procedure SetShape(ARubberBand: TCustomRubberBand; AShape: TRubberBandShape); override;
|
|
end;
|
|
|
|
implementation
|
|
const
|
|
RubberBandShapeMap: array[TRubberBandShape] of QRubberBandShape =
|
|
(
|
|
QRubberBandLine,
|
|
QRubberBandRectangle
|
|
);
|
|
|
|
{ TQtWsCustomRubberBand }
|
|
|
|
class function TQtWsCustomRubberBand.CreateHandle(
|
|
const AWinControl: TWinControl; const AParams: TCreateParams
|
|
): TLCLIntfHandle;
|
|
var
|
|
QtRubberBand: TQtRubberBand;
|
|
begin
|
|
QtRubberBand := TQtRubberBand.Create(AWinControl, AParams);
|
|
QtRubberBand.AttachEvents;
|
|
QtRubberBand.setShape(RubberBandShapeMap[TCustomRubberBand(AWinControl).Shape]);
|
|
|
|
Result := THandle(QtRubberBand);
|
|
end;
|
|
|
|
class procedure TQtWsCustomRubberBand.SetShape(ARubberBand: TCustomRubberBand;
|
|
AShape: TRubberBandShape);
|
|
begin
|
|
if not WSCheckHandleAllocated(ARubberBand, 'SetShape') then
|
|
Exit;
|
|
TQtRubberBand(ARubberBand.Handle).setShape(RubberBandShapeMap[AShape]);
|
|
end;
|
|
|
|
initialization
|
|
|
|
////////////////////////////////////////////////////
|
|
// To improve speed, register only classes
|
|
// which actually implement something
|
|
////////////////////////////////////////////////////
|
|
RegisterWSComponent(TCustomRubberBand, TQtWSCustomRubberBand);
|
|
////////////////////////////////////////////////////
|
|
end.
|