mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-15 11:49:55 +02:00
* Start handle rework. Splitup of internal WS referencedata and public widgetsetspecific references (handle/pointer/XID/...)
git-svn-id: trunk@13178 -
This commit is contained in:
marc
parent
6910f76cfd
commit
425f7eb912
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -3277,6 +3277,7 @@ lcl/widgetset/wsmaskedit.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wsmenus.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wspairsplitter.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wsproc.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wsreferences.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wsspin.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wsstdctrls.pp svneol=native#text/pascal
|
||||
lcl/widgetset/wstoolwin.pp svneol=native#text/pascal
|
||||
|
||||
@ -51,7 +51,8 @@ interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, FPCAdds, LCLStrConsts, LCLIntf, LResources, LCLType,
|
||||
LCLProc, Graphics, GraphType, LCLClasses, IntfGraphics, FPReadBMP;
|
||||
LCLProc, Graphics, GraphType, LCLClasses, IntfGraphics, FPReadBMP,
|
||||
WSReferences;
|
||||
|
||||
type
|
||||
TImageIndex = type integer;
|
||||
@ -105,8 +106,9 @@ type
|
||||
TDrawingStyle = (dsFocus, dsSelected, dsNormal, dsTransparent);
|
||||
TImageType = (itImage, itMask);
|
||||
|
||||
TCustomImageList = class(TLCLHandleComponent)
|
||||
TCustomImageList = class(TLCLReferenceComponent)
|
||||
private
|
||||
FReference: TWSCustomImageListReference;
|
||||
FDrawingStyle: TDrawingStyle;
|
||||
FData: array of TRGBAQuad;
|
||||
FImageType: TImageType;
|
||||
@ -125,11 +127,13 @@ type
|
||||
FUpdateCount: integer;
|
||||
|
||||
procedure AllocData(ACount: Integer);
|
||||
function GetReference: TWSCustomImageListReference;
|
||||
|
||||
procedure InternalInsert(AIndex: Integer; AImage, AMask: HBitmap;
|
||||
AWidth, AHeight: Integer);
|
||||
procedure InternalMove(ACurIndex, ANewIndex: Cardinal; AIgnoreCurrent: Boolean);
|
||||
procedure InternalReplace(AIndex: Integer; AImage, AMask: HBitmap);
|
||||
function InternalSetImage(AIndex: Integer; AImage: TRawImage): PRGBAQuad;
|
||||
function InternalSetImage(AIndex: Integer; AImage: TRawImage): PRGBAQuad;
|
||||
procedure NotifyChangeLink;
|
||||
procedure SetBkColor(const Value: TColor);
|
||||
procedure SetDrawingStyle(const AValue: TDrawingStyle);
|
||||
@ -140,11 +144,13 @@ type
|
||||
protected
|
||||
procedure CheckIndex(AIndex: Integer; AForInsert: Boolean = False);
|
||||
procedure GetImages(Index: Integer; const Image, Mask: TBitmap);
|
||||
function GetReferenceHandle: THandle; override;
|
||||
procedure Initialize; virtual;
|
||||
procedure DefineProperties(Filer: TFiler); override;
|
||||
procedure SetWidthHeight(NewWidth,NewHeight: integer); virtual;
|
||||
|
||||
function WSCreateHandle(AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
function WSCreateReference(AParams: TCreateParams): PWSReference; override;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
@ -205,6 +211,7 @@ type
|
||||
property Bitmap: TBitmap read FBitmap;
|
||||
property MaskBitmap: TBitmap read FMaskBitmap;
|
||||
{$endif}
|
||||
property Reference: TWSCustomImageListReference read GetReference;
|
||||
property ShareImages: Boolean read FShareImages write SetShareImages;
|
||||
property ImageType: TImageType read FImageType write FImageType default itImage;
|
||||
end;
|
||||
|
||||
@ -463,7 +463,7 @@ procedure TCustomImageList.Draw(ACanvas: TCanvas; AX, AY, AIndex: Integer;
|
||||
begin
|
||||
if (FCount = 0) or (AIndex >= FCount) then Exit;
|
||||
|
||||
HandleNeeded;
|
||||
ReferenceNeeded;
|
||||
TWSCustomImageListClass(WidgetSetClass).Draw(Self, AIndex, ACanvas, Rect(AX, AY, FWidth, FHeight),
|
||||
BkColor, BlendColor, ADrawEffect, DrawingStyle, ImageType);
|
||||
end;
|
||||
@ -567,6 +567,17 @@ begin
|
||||
Image.Data := @FData[Index * FWidth * FHeight];
|
||||
end;
|
||||
|
||||
function TCustomImageList.GetReference: TWSCustomImageListReference;
|
||||
begin
|
||||
if not FReference.Allocated then ReferenceNeeded;
|
||||
Result := FReference;
|
||||
end;
|
||||
|
||||
function TCustomImageList.GetReferenceHandle: THandle;
|
||||
begin
|
||||
Result := FReference.Handle;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TCustomImageList.GetInternalImage(Index: integer; var Image,
|
||||
Mask: TBitmap);
|
||||
@ -1347,9 +1358,10 @@ end;
|
||||
|
||||
Instructs the widgtset to create an imagelist
|
||||
------------------------------------------------------------------------------}
|
||||
function TCustomImageList.WSCreateHandle(AParams: TCreateParams): TLCLIntfHandle;
|
||||
function TCustomImageList.WSCreateReference(AParams: TCreateParams): PWSReference;
|
||||
begin
|
||||
Result := TWSCustomImageListClass(WidgetSetClass).CreateHandle(Self, FCount, FAllocBy, FWidth, FHeight, @FData[0]);
|
||||
FReference := TWSCustomImageListClass(WidgetSetClass).CreateReference(Self, FCount, FAllocBy, FWidth, FHeight, @FData[0]);
|
||||
Result := @FReference;
|
||||
end;
|
||||
|
||||
{******************************************************************************
|
||||
|
||||
@ -527,7 +527,7 @@ class function TWin32WSDragImageList.BeginDrag(
|
||||
begin
|
||||
// No check to Handle should be done, because if there is no handle (no needed)
|
||||
// we must create it here. This is normal for imagelist (we can never need handle)
|
||||
Result := ImageList_BeginDrag(ADragImageList.Handle, AIndex, X, Y);
|
||||
Result := ImageList_BeginDrag(ADragImageList.Reference.Handle, AIndex, X, Y);
|
||||
end;
|
||||
|
||||
class function TWin32WSDragImageList.DragMove(const ADragImageList: TDragImageList;
|
||||
|
||||
@ -737,7 +737,7 @@ begin
|
||||
then Exit;
|
||||
|
||||
if AValue <> nil then
|
||||
SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], AValue.Handle)
|
||||
SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], AValue.Reference._Handle)
|
||||
else
|
||||
SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], 0);
|
||||
end;
|
||||
|
||||
@ -441,7 +441,7 @@ begin
|
||||
Result := Params.Window;
|
||||
|
||||
if TCustomNoteBook(AWinControl).Images <> nil then
|
||||
SendMessage(Result, TCM_SETIMAGELIST, 0, TCustomNoteBook(AWinControl).Images.Handle);
|
||||
SendMessage(Result, TCM_SETIMAGELIST, 0, TCustomNoteBook(AWinControl).Images.Reference._Handle);
|
||||
|
||||
// although we may be child of tabpage, cut the paint chain
|
||||
// to improve speed and possible paint anomalities
|
||||
@ -635,7 +635,7 @@ begin
|
||||
Exit;
|
||||
|
||||
if AImageList <> nil then
|
||||
SendMessage(ANoteBook.Handle, TCM_SETIMAGELIST, 0, AImageList.Handle)
|
||||
SendMessage(ANoteBook.Handle, TCM_SETIMAGELIST, 0, AImageList.Reference._Handle)
|
||||
else
|
||||
SendMessage(ANoteBook.Handle, TCM_SETIMAGELIST, 0, 0);
|
||||
end;
|
||||
|
||||
@ -36,7 +36,7 @@ uses
|
||||
Windows, SysUtils, Classes, ImgList, GraphType, Graphics, LCLType,
|
||||
Win32Extra, Win32Int, Win32Proc, InterfaceBase,
|
||||
////////////////////////////////////////////////////
|
||||
WSImgList, WSLCLClasses, WSProc;
|
||||
WSImgList, WSLCLClasses, WSProc, WSReferences;
|
||||
|
||||
type
|
||||
|
||||
@ -48,10 +48,10 @@ type
|
||||
class procedure AddData(AListHandle: TLCLIntfHandle; ACount, AReplaceIndex, AWidth, AHeight: Integer; AData: PRGBAQuad);
|
||||
public
|
||||
class procedure Clear(AList: TCustomImageList); override;
|
||||
class function CreateHandle(AList: TCustomImageList; ACount, AGrow, AWidth,
|
||||
AHeight: Integer; AData: PRGBAQuad): TLCLIntfHandle; override;
|
||||
class function CreateReference(AList: TCustomImageList; ACount, AGrow, AWidth,
|
||||
AHeight: Integer; AData: PRGBAQuad): TWSCustomImageListReference; override;
|
||||
class procedure Delete(AList: TCustomImageList; AIndex: Integer); override;
|
||||
class procedure DestroyHandle(AComponent: TComponent); override;
|
||||
class procedure DestroyReference(AComponent: TComponent); override;
|
||||
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
|
||||
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); override;
|
||||
class procedure DrawToDC(AList: TCustomImageList; AIndex: Integer; ADC: HDC;
|
||||
@ -220,13 +220,13 @@ end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.Clear(AList: TCustomImageList);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Clear')
|
||||
if not WSCheckReferenceAllocated(AList, 'Clear')
|
||||
then Exit;
|
||||
ImageList_SetImageCount(HImageList(AList.Handle), 0);
|
||||
ImageList_SetImageCount(AList.Reference._Handle, 0);
|
||||
end;
|
||||
|
||||
class function TWin32WSCustomImageList.CreateHandle(AList: TCustomImageList;
|
||||
ACount, AGrow, AWidth, AHeight: Integer; AData: PRGBAQuad): TLCLIntfHandle;
|
||||
class function TWin32WSCustomImageList.CreateReference(AList: TCustomImageList;
|
||||
ACount, AGrow, AWidth, AHeight: Integer; AData: PRGBAQuad): TWSCustomImageListReference;
|
||||
var
|
||||
Flags: DWord;
|
||||
begin
|
||||
@ -245,30 +245,30 @@ begin
|
||||
FLAGS := ILC_COLOR or ILC_MASK;
|
||||
end;
|
||||
end;
|
||||
Result := ImageList_Create(AWidth, AHeight, Flags, ACount, AGrow);
|
||||
if Result <> 0
|
||||
then AddData(Result, ACount, -1, AWidth, AHeight, AData);
|
||||
Result._Init(ImageList_Create(AWidth, AHeight, Flags, ACount, AGrow));
|
||||
if Result.Allocated
|
||||
then AddData(Result._Handle, ACount, -1, AWidth, AHeight, AData);
|
||||
end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.Delete(AList: TCustomImageList;
|
||||
AIndex: Integer);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Delete')
|
||||
if not WSCheckReferenceAllocated(AList, 'Delete')
|
||||
then Exit;
|
||||
ImageList_Remove(HImageList(AList.Handle), AIndex);
|
||||
ImageList_Remove(AList.Reference._Handle, AIndex);
|
||||
end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.DestroyHandle(AComponent: TComponent);
|
||||
class procedure TWin32WSCustomImageList.DestroyReference(AComponent: TComponent);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(TCustomImageList(AComponent), 'DestroyHandle')
|
||||
if not WSCheckReferenceAllocated(TCustomImageList(AComponent), 'DestroyReference')
|
||||
then Exit;
|
||||
ImageList_Destroy(TCustomImageList(AComponent).Handle);
|
||||
ImageList_Destroy(TCustomImageList(AComponent).Reference._Handle);
|
||||
end;
|
||||
|
||||
class procedure TWin32WSCustomImageList.Draw(AList: TCustomImageList; AIndex: Integer;
|
||||
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Draw')
|
||||
if not WSCheckReferenceAllocated(AList, 'Draw')
|
||||
then Exit;
|
||||
DrawToDC(AList, AIndex, ACanvas.Handle, ABounds, ABkColor, ABlendColor, ADrawEffect, AStyle, AImageType);
|
||||
end;
|
||||
@ -286,7 +286,7 @@ var
|
||||
begin
|
||||
if ADrawEffect = gdeNormal then
|
||||
begin
|
||||
ImageList_DrawEx(HImageList(AList.Handle), AIndex, ADC, ABounds.Left,
|
||||
ImageList_DrawEx(AList.Reference._Handle, AIndex, ADC, ABounds.Left,
|
||||
ABounds.Top, ABounds.Right, ABounds.Bottom, ColorToImagelistColor(ABkColor),
|
||||
ColorToImagelistColor(ABlendColor), DRAWINGSTYLEMAP[AStyle] or IMAGETPYEMAP[AImageType]);
|
||||
end
|
||||
@ -296,7 +296,7 @@ begin
|
||||
// if it is manifested exe then use winXP algoriphm of gray painting
|
||||
FillChar(DrawParams, SizeOf(DrawParams), 0);
|
||||
DrawParams.cbSize := SizeOf(DrawParams);
|
||||
DrawParams.himlL := HImageList(AList.Handle);
|
||||
DrawParams.himlL := AList.Reference._Handle;
|
||||
DrawParams.i := AIndex;
|
||||
DrawParams.hdcDst := ADC;
|
||||
DrawParams.x := ABounds.Left;
|
||||
@ -346,10 +346,10 @@ var
|
||||
ImageList: HImageList;
|
||||
Count: Integer;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Insert')
|
||||
if not WSCheckReferenceAllocated(AList, 'Insert')
|
||||
then Exit;
|
||||
|
||||
ImageList := HImageList(AList.Handle);
|
||||
ImageList := AList.Reference._Handle;
|
||||
Count := ImageList_GetImageCount(ImageList);
|
||||
|
||||
if (AIndex <= Count) and (AIndex >= 0) then
|
||||
@ -366,13 +366,13 @@ var
|
||||
n: integer;
|
||||
Handle: THandle;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Move')
|
||||
if not WSCheckReferenceAllocated(AList, 'Move')
|
||||
then Exit;
|
||||
|
||||
if ACurIndex = ANewIndex
|
||||
then Exit;
|
||||
|
||||
Handle := AList.Handle;
|
||||
Handle := AList.Reference._Handle;
|
||||
if ACurIndex < ANewIndex
|
||||
then begin
|
||||
for n := ACurIndex to ANewIndex - 1 do
|
||||
@ -390,10 +390,10 @@ var
|
||||
ImageList: HImageList;
|
||||
Count: Integer;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Replace')
|
||||
if not WSCheckReferenceAllocated(AList, 'Replace')
|
||||
then Exit;
|
||||
|
||||
ImageList := HImageList(AList.Handle);
|
||||
ImageList := AList.Reference._Handle;
|
||||
Count := ImageList_GetImageCount(ImageList);
|
||||
|
||||
if (AIndex < Count) and (AIndex >= 0)
|
||||
|
||||
@ -29,7 +29,7 @@ unit LCLClasses;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, WSLCLClasses, LCLType, LCLProc;
|
||||
Classes, WSLCLClasses, WSReferences, LCLType, LCLProc;
|
||||
|
||||
type
|
||||
|
||||
@ -51,25 +51,30 @@ type
|
||||
{ TLCLHandleComponent }
|
||||
// A base class for all components having a handle
|
||||
|
||||
TLCLHandleComponent = class(TLCLComponent)
|
||||
{ TLCLReferenceComponent }
|
||||
|
||||
TLCLReferenceComponent = class(TLCLComponent)
|
||||
private
|
||||
FHandle: TLCLIntfHandle;
|
||||
FReferencePtr: PWSReference;
|
||||
|
||||
FCreating: Boolean; // Set if we are creating the handle
|
||||
function GetHandle: TLCLIntfHandle;
|
||||
function GetHandleAllocated: Boolean;
|
||||
function GetHandle: THandle;
|
||||
function GetReferenceAllocated: Boolean;
|
||||
protected
|
||||
procedure CreateParams(var AParams: TCreateParams); virtual;
|
||||
procedure DestroyHandle;
|
||||
procedure HandleCreated; virtual; // gets called after the Handle is created
|
||||
procedure HandleDestroying; virtual; // gets called before the Handle is destroyed
|
||||
procedure HandleNeeded;
|
||||
function WSCreateHandle(AParams: TCreateParams): TLCLIntfHandle; virtual;
|
||||
procedure WSDestroyHandle; virtual;
|
||||
procedure DestroyReference;
|
||||
function GetReferenceHandle: THandle; virtual; abstract;
|
||||
procedure ReferenceCreated; virtual; // gets called after the Handle is created
|
||||
procedure ReferenceDestroying; virtual; // gets called before the Handle is destroyed
|
||||
procedure ReferenceNeeded;
|
||||
function WSCreateReference(AParams: TCreateParams): PWSReference; virtual;
|
||||
procedure WSDestroyReference; virtual;
|
||||
protected
|
||||
public
|
||||
destructor Destroy; override;
|
||||
property Handle: TLCLIntfHandle read GetHandle;
|
||||
property HandleAllocated: Boolean read GetHandleAllocated;
|
||||
property Handle: TLCLIntfHandle read GetHandle; deprecated;
|
||||
property HandleAllocated: Boolean read GetReferenceAllocated;
|
||||
property ReferenceAllocated: Boolean read GetReferenceAllocated;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -110,85 +115,86 @@ procedure TLCLComponent.RemoveAllHandlersOfObject(AnObject: TObject);
|
||||
begin
|
||||
end;
|
||||
|
||||
{ TLCLHandleComponent }
|
||||
{ TLCLReferenceComponent }
|
||||
|
||||
procedure TLCLHandleComponent.CreateParams(var AParams: TCreateParams);
|
||||
procedure TLCLReferenceComponent.CreateParams(var AParams: TCreateParams);
|
||||
begin
|
||||
end;
|
||||
|
||||
destructor TLCLHandleComponent.Destroy;
|
||||
destructor TLCLReferenceComponent.Destroy;
|
||||
begin
|
||||
DestroyHandle;
|
||||
DestroyReference;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TLCLHandleComponent.DestroyHandle;
|
||||
procedure TLCLReferenceComponent.DestroyReference;
|
||||
begin
|
||||
if FHandle <> 0 then
|
||||
if ReferenceAllocated then
|
||||
begin
|
||||
HandleDestroying;
|
||||
WSDestroyHandle;
|
||||
FHandle := 0;
|
||||
ReferenceDestroying;
|
||||
WSDestroyReference;
|
||||
FReferencePtr^._Clear;
|
||||
FReferencePtr := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLCLHandleComponent.GetHandle: TLCLIntfHandle;
|
||||
function TLCLReferenceComponent.GetHandle: THandle;
|
||||
begin
|
||||
if FHandle = 0 then HandleNeeded;
|
||||
Result := FHandle;
|
||||
ReferenceNeeded;
|
||||
Result := GetReferenceHandle;
|
||||
end;
|
||||
|
||||
function TLCLHandleComponent.GetHandleAllocated: Boolean;
|
||||
function TLCLReferenceComponent.GetReferenceAllocated: Boolean;
|
||||
begin
|
||||
Result := FHandle <> 0;
|
||||
Result := (FReferencePtr <> nil) and FReferencePtr^.Allocated;
|
||||
end;
|
||||
|
||||
procedure TLCLHandleComponent.HandleCreated;
|
||||
procedure TLCLReferenceComponent.ReferenceCreated;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TLCLHandleComponent.HandleDestroying;
|
||||
procedure TLCLReferenceComponent.ReferenceDestroying;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TLCLHandleComponent.HandleNeeded;
|
||||
procedure TLCLReferenceComponent.ReferenceNeeded;
|
||||
var
|
||||
Params: TCreateParams;
|
||||
begin
|
||||
if FHandle <> 0 then Exit;
|
||||
if ReferenceAllocated then Exit;
|
||||
|
||||
if FCreating
|
||||
then begin
|
||||
// raise some error ?
|
||||
DebugLn('TLCLHandleComponent: Circulair handle creation');
|
||||
DebugLn('TLCLReferenceComponent: Circulair reference creation');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
CreateParams(Params);
|
||||
FCreating := True;
|
||||
try
|
||||
FHandle := WSCreateHandle(Params);
|
||||
if FHandle = 0
|
||||
FReferencePtr := WSCreateReference(Params);
|
||||
if not ReferenceAllocated
|
||||
then begin
|
||||
// raise some error ?
|
||||
DebugLn('TLCLHandleComponent: Handle creation failed');
|
||||
DebugLn('TLCLHandleComponent: Reference creation failed');
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
FCreating := False;
|
||||
end;
|
||||
HandleCreated;
|
||||
ReferenceCreated;
|
||||
end;
|
||||
|
||||
function TLCLHandleComponent.WSCreateHandle(AParams: TCreateParams): TLCLIntfHandle;
|
||||
function TLCLReferenceComponent.WSCreateReference(AParams: TCreateParams): PWSReference;
|
||||
begin
|
||||
// this function should be overriden in derrived class
|
||||
Result := 0;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TLCLHandleComponent.WSDestroyHandle;
|
||||
procedure TLCLReferenceComponent.WSDestroyReference;
|
||||
begin
|
||||
TWSLCLHandleComponentClass(WidgetSetClass).DestroyHandle(Self);
|
||||
TWSLCLReferenceComponentClass(WidgetSetClass).DestroyReference(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -41,18 +41,18 @@ interface
|
||||
////////////////////////////////////////////////////
|
||||
uses
|
||||
Classes, Contnrs, GraphType, Graphics, IntfGraphics, ImgList, LCLType, LCLIntf,
|
||||
WSLCLClasses, WSProc;
|
||||
WSLCLClasses, WSProc, WSReferences;
|
||||
|
||||
type
|
||||
{ TWSCustomImageList }
|
||||
|
||||
TWSCustomImageList = class(TWSLCLHandleComponent)
|
||||
TWSCustomImageList = class(TWSLCLReferenceComponent)
|
||||
class procedure Clear(AList: TCustomImageList); virtual;
|
||||
class function CreateHandle(AList: TCustomImageList; ACount, AGrow, AWidth,
|
||||
AHeight: Integer; AData: PRGBAQuad): TLCLIntfHandle; virtual;
|
||||
class function CreateReference(AList: TCustomImageList; ACount, AGrow, AWidth,
|
||||
AHeight: Integer; AData: PRGBAQuad): TWSCustomImageListReference; virtual;
|
||||
|
||||
class procedure Delete(AList: TCustomImageList; AIndex: Integer); virtual;
|
||||
class procedure DestroyHandle(AComponent: TComponent); override;
|
||||
class procedure DestroyReference(AComponent: TComponent); override;
|
||||
class procedure Draw(AList: TCustomImageList; AIndex: Integer; ACanvas: TCanvas;
|
||||
ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType); virtual;
|
||||
|
||||
@ -145,18 +145,21 @@ end;
|
||||
|
||||
class procedure TWSCustomImageList.Clear(AList: TCustomImageList);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Clear')
|
||||
if not WSCheckReferenceAllocated(AList, 'Clear')
|
||||
then Exit;
|
||||
TDefaultImageListImplementor(AList.Handle).Clear;
|
||||
TDefaultImageListImplementor(AList.Reference.Ptr).Clear;
|
||||
end;
|
||||
|
||||
class function TWSCustomImageList.CreateHandle(AList: TCustomImageList; ACount,
|
||||
AGrow, AWidth, AHeight: Integer; AData: PRGBAQuad): TLCLIntfHandle;
|
||||
class function TWSCustomImageList.CreateReference(AList: TCustomImageList; ACount,
|
||||
AGrow, AWidth, AHeight: Integer; AData: PRGBAQuad): TWSCustomImageListReference;
|
||||
var
|
||||
impl: TDefaultImageListImplementor;
|
||||
|
||||
ABitmap: TBitmap;
|
||||
i: integer;
|
||||
begin
|
||||
Result := TLCLIntfHandle(TDefaultImageListImplementor.Create(AList));
|
||||
impl := TDefaultImageListImplementor.Create(AList);
|
||||
Result._Init(impl);
|
||||
|
||||
if AData <> nil then
|
||||
begin
|
||||
@ -164,7 +167,7 @@ begin
|
||||
for i := 0 to ACount - 1 do
|
||||
begin
|
||||
ABitmap := InternalCreateBitmap(AList, AWidth, AHeight, @AData[AWidth * AHeight * i]);
|
||||
TDefaultImageListImplementor(Result).Add(ABitmap);
|
||||
impl.Add(ABitmap);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -172,25 +175,25 @@ end;
|
||||
class procedure TWSCustomImageList.Delete(AList: TCustomImageList;
|
||||
AIndex: Integer);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Delete')
|
||||
if not WSCheckReferenceAllocated(AList, 'Delete')
|
||||
then Exit;
|
||||
TDefaultImageListImplementor(AList.Handle).Delete(AIndex);
|
||||
TDefaultImageListImplementor(AList.Reference.Ptr).Delete(AIndex);
|
||||
end;
|
||||
|
||||
class procedure TWSCustomImageList.DestroyHandle(AComponent: TComponent);
|
||||
class procedure TWSCustomImageList.DestroyReference(AComponent: TComponent);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(TCustomImageList(AComponent), 'DestroyHandle')
|
||||
if not WSCheckReferenceAllocated(TCustomImageList(AComponent), 'DestroyReference')
|
||||
then Exit;
|
||||
TDefaultImageListImplementor(TCustomImageList(AComponent).Handle).Free;
|
||||
TObject(TCustomImageList(AComponent).Reference.Ptr).Free;
|
||||
end;
|
||||
|
||||
class procedure TWSCustomImageList.Draw(AList: TCustomImageList; AIndex: Integer;
|
||||
ACanvas: TCanvas; ABounds: TRect; ABkColor, ABlendColor: TColor; ADrawEffect: TGraphicsDrawEffect; AStyle: TDrawingStyle; AImageType: TImageType);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Draw')
|
||||
if not WSCheckReferenceAllocated(AList, 'Draw')
|
||||
then Exit;
|
||||
|
||||
TDefaultImageListImplementor(AList.Handle).Draw(AIndex, ACanvas, ABounds, ADrawEffect, AStyle);
|
||||
TDefaultImageListImplementor(AList.Reference.Ptr).Draw(AIndex, ACanvas, ABounds, ADrawEffect, AStyle);
|
||||
end;
|
||||
|
||||
class procedure TWSCustomImageList.Insert(AList: TCustomImageList;
|
||||
@ -200,10 +203,10 @@ var
|
||||
ACount: Integer;
|
||||
ABitmap: TBitmap;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Insert')
|
||||
if not WSCheckReferenceAllocated(AList, 'Insert')
|
||||
then Exit;
|
||||
|
||||
AImageList := TDefaultImageListImplementor(AList.Handle);
|
||||
AImageList := TDefaultImageListImplementor(AList.Reference.Ptr);
|
||||
ACount := AImageList.Count;
|
||||
|
||||
if (AIndex <= ACount) and (AIndex >= 0) then
|
||||
@ -218,13 +221,13 @@ end;
|
||||
class procedure TWSCustomImageList.Move(AList: TCustomImageList; ACurIndex,
|
||||
ANewIndex: Integer);
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Move')
|
||||
if not WSCheckReferenceAllocated(AList, 'Move')
|
||||
then Exit;
|
||||
|
||||
if ACurIndex = ANewIndex
|
||||
then Exit;
|
||||
|
||||
TDefaultImageListImplementor(AList.Handle).Move(ACurIndex, ANewIndex);
|
||||
TDefaultImageListImplementor(AList.Reference.Ptr).Move(ACurIndex, ANewIndex);
|
||||
end;
|
||||
|
||||
class procedure TWSCustomImageList.Replace(AList: TCustomImageList;
|
||||
@ -232,11 +235,11 @@ class procedure TWSCustomImageList.Replace(AList: TCustomImageList;
|
||||
var
|
||||
ABitmap: TBitmap;
|
||||
begin
|
||||
if not WSCheckHandleAllocated(AList, 'Replace')
|
||||
if not WSCheckReferenceAllocated(AList, 'Replace')
|
||||
then Exit;
|
||||
|
||||
ABitmap := InternalCreateBitmap(AList, AList.Width, AList.Height, AData);
|
||||
TDefaultImageListImplementor(AList.Handle)[AIndex] := ABitmap;
|
||||
TDefaultImageListImplementor(AList.Reference.Ptr)[AIndex] := ABitmap;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -68,10 +68,10 @@ type
|
||||
|
||||
{ TWSLCLHandleComponent }
|
||||
|
||||
TWSLCLHandleComponent = class(TWSLCLComponent)
|
||||
class procedure DestroyHandle(AComponent: TComponent); virtual;
|
||||
TWSLCLReferenceComponent = class(TWSLCLComponent)
|
||||
class procedure DestroyReference(AComponent: TComponent); virtual;
|
||||
end;
|
||||
TWSLCLHandleComponentClass = class of TWSLCLHandleComponent;
|
||||
TWSLCLReferenceComponentClass = class of TWSLCLReferenceComponent;
|
||||
|
||||
|
||||
function FindWSComponentClass(const AComponent: TComponentClass): TWSLCLComponentClass;
|
||||
@ -411,7 +411,7 @@ end;
|
||||
|
||||
{ TWSLCLHandleComponent }
|
||||
|
||||
class procedure TWSLCLHandleComponent.DestroyHandle(AComponent: TComponent);
|
||||
class procedure TWSLCLReferenceComponent.DestroyReference(AComponent: TComponent);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
@ -32,23 +32,23 @@ uses
|
||||
LCLClasses, LCLProc, Controls;
|
||||
|
||||
|
||||
function WSCheckHandleAllocated(const AComponent: TLCLHandleComponent;
|
||||
const AProcName: String): Boolean;
|
||||
function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent;
|
||||
const AProcName: String): Boolean;
|
||||
|
||||
function WSCheckHandleAllocated(const AWincontrol: TWinControl;
|
||||
const AProcName: String): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
function WSCheckHandleAllocated(const AComponent: TLCLHandleComponent;
|
||||
function WSCheckReferenceAllocated(const AComponent: TLCLReferenceComponent;
|
||||
const AProcName: String): Boolean;
|
||||
|
||||
procedure Warn;
|
||||
begin
|
||||
DebugLn('[WARNING] %s called without handle for %s(%s)', [AProcName, AComponent.Name, AComponent.ClassName]);
|
||||
DebugLn('[WARNING] %s called without reference for %s(%s)', [AProcName, AComponent.Name, AComponent.ClassName]);
|
||||
end;
|
||||
begin
|
||||
Result := AComponent.HandleAllocated;
|
||||
Result := AComponent.ReferenceAllocated;
|
||||
if Result then Exit;
|
||||
Warn;
|
||||
end;
|
||||
|
||||
97
lcl/widgetset/wsreferences.pp
Normal file
97
lcl/widgetset/wsreferences.pp
Normal file
@ -0,0 +1,97 @@
|
||||
{ $Id$}
|
||||
{
|
||||
*****************************************************************************
|
||||
* wsreferences.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 WSReferences;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
//uses
|
||||
// Types;
|
||||
|
||||
|
||||
type
|
||||
{ TWSReference }
|
||||
{
|
||||
Abstract (temporary) base object for all references to WS classes.
|
||||
This reference replaces the functionality of a Handle.
|
||||
An object is choosen to disallow assignments of different types of handles
|
||||
}
|
||||
PWSReference = ^TWSReference;
|
||||
TWSReference = object
|
||||
private
|
||||
function GetAllocated: Boolean; inline;
|
||||
protected
|
||||
FRef: record
|
||||
case Byte of
|
||||
0: (Ptr: Pointer);
|
||||
1: (Handle: THandle);
|
||||
end;
|
||||
public
|
||||
// NOTE: These _Methods are temporary and for widgetset use only.
|
||||
// They can be removed anytime, without notice
|
||||
procedure _Clear;
|
||||
procedure _Init(APtr: Pointer);
|
||||
procedure _Init(AHandle: THandle);
|
||||
property _Handle: THandle read FRef.Handle;
|
||||
//----
|
||||
|
||||
property Allocated: Boolean read GetAllocated;
|
||||
property Ptr: Pointer read FRef.Ptr;
|
||||
end;
|
||||
|
||||
|
||||
TWSCustomImageListReference = object(TWSReference)
|
||||
public
|
||||
property Handle: Thandle read FRef.Handle;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TWSReference }
|
||||
|
||||
procedure TWSReference._Clear;
|
||||
begin
|
||||
FRef.Ptr := nil;
|
||||
end;
|
||||
|
||||
procedure TWSReference._Init(APtr: Pointer);
|
||||
begin
|
||||
FRef.Ptr := APtr;
|
||||
end;
|
||||
|
||||
procedure TWSReference._Init(AHandle: THandle);
|
||||
begin
|
||||
FRef.Handle := AHandle;
|
||||
end;
|
||||
|
||||
function TWSReference.GetAllocated: Boolean;
|
||||
begin
|
||||
Result := FRef.Ptr <> nil;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user