diff --git a/lcl/lclclasses.pp b/lcl/lclclasses.pp index ae38bb980e..bfbef9ffb7 100644 --- a/lcl/lclclasses.pp +++ b/lcl/lclclasses.pp @@ -29,7 +29,7 @@ unit LCLClasses; interface uses - Classes, LCLProc, WSLCLClasses; + Classes, WSLCLClasses, LCLType, LCLProc; type @@ -47,6 +47,27 @@ type procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual; property WidgetSetClass: TWSLCLComponentClass read FWidgetSetClass; end; + + { TLCLHandleComponent } + // A base class for all components having a handle + + TLCLHandleComponent = class(TLCLComponent) + private + FHandle: TLCLIntfHandle; + FCreating: Boolean; // Set if we are creating the handle + function GetHandle: TLCLIntfHandle; + procedure HandleNeeded; + protected + procedure CreateHandle; + 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 + protected + property Handle: TLCLIntfHandle read GetHandle; + public + function HandleAllocated: Boolean; + end; implementation @@ -84,7 +105,72 @@ end; procedure TLCLComponent.RemoveAllHandlersOfObject(AnObject: TObject); begin - end; -end. \ No newline at end of file +{ TLCLHandleComponent } + +function TLCLHandleComponent.GetHandle: TLCLIntfHandle; +begin + if FHandle = 0 then HandleNeeded; + Result := FHandle; +end; + +procedure TLCLHandleComponent.HandleNeeded; +begin + if FHandle <> 0 then Exit; + if FCreating + then begin + // raise some error ? + DebugLn('TLCLHandleComponent: Circulair handle creation'); + Exit; + end; + + FCreating := True; + try + CreateHandle; + if FHandle = 0 + then begin + // raise some error ? + DebugLn('TLCLHandleComponent: Handle creation failed'); + Exit; + end; + finally + FCreating := False; + end; + HandleCreated; +end; + +procedure TLCLHandleComponent.CreateHandle; +var + Params: TCreateParams; +begin + CreateParams(Params); + // TODO: some WScall here +end; + +procedure TLCLHandleComponent.CreateParams(var AParams: TCreateParams); +begin +end; + +procedure TLCLHandleComponent.DestroyHandle; +begin + HandleDestroying; + // TODO: some WScall here + FHandle := 0; +end; + +procedure TLCLHandleComponent.HandleCreated; +begin +end; + +procedure TLCLHandleComponent.HandleDestroying; +begin +end; + +function TLCLHandleComponent.HandleAllocated: Boolean; +begin + Result := FHandle <> 0; +end; + +end. + diff --git a/lcl/widgetset/wsimglist.pp b/lcl/widgetset/wsimglist.pp index b0456e709c..2edf126ef3 100644 --- a/lcl/widgetset/wsimglist.pp +++ b/lcl/widgetset/wsimglist.pp @@ -40,29 +40,86 @@ interface // the uses clause of the XXXintf.pp //////////////////////////////////////////////////// uses -//////////////////////////////////////////////////// -// To get as little as posible circles, -// uncomment only when needed for registration -//////////////////////////////////////////////////// -// ImgList, -//////////////////////////////////////////////////// + Classes, ImgList, Graphics, LCLType, WSLCLClasses; type { TWSCustomImageList } - TWSCustomImageList = class(TWSLCLComponent) + TWSCustomImageList = class(TWSLCLHandleComponent) + class procedure Clear(AList: TCustomImageList); virtual; +// class function CreateBitmap(AList: TCustomImageList; AIndex: Integer; const ABounds: TRect; AEnabled: Boolean; AStyle: TDrawingStyle); + class function CreateHandle(AList: TCustomImageList; ACount, AGrow: Integer; const AParams: TCreateParams): TLCLIntfHandle; virtual; + + class procedure Delete(AList: TCustomImageList; AIndex: Integer); virtual; + class procedure Draw(AList: TCustomImageList; ACanvas: TCanvas; ABounds: TRect; AEnabled: Boolean; AStyle: TDrawingStyle); virtual; + + class procedure Insert(AList: TCustomImageList; AIndex: Integer; AImage, AMask: TBitmap); virtual; + class procedure InsertIcon(AList: TCustomImageList; AIndex: Integer; AImage: TIcon); virtual; + class procedure InsertMasked(AList: TCustomImageList; Index: Integer; Image: TBitmap; MaskColor: TColor); virtual; + + class procedure Move(AList: TCustomImageList; ACurIndex, ANewIndex: Integer); virtual; + + class procedure Replace(AList: TCustomImageList; AIndex: Integer; AImage, AMask: TBitmap); virtual; + class procedure ReplaceIcon(AList: TCustomImageList; AIndex: Integer; AImage: TIcon); virtual; + class procedure ReplaceMasked(AList: TCustomImageList; AIndex: Integer; ANewImage: TBitmap; AMaskColor: TColor); virtual; end; implementation +{ TWSCustomImageList } + +class procedure TWSCustomImageList.Clear(AList: TCustomImageList); +begin +end; + +class function TWSCustomImageList.CreateHandle(AList: TCustomImageList; ACount, AGrow: Integer; const AParams: TCreateParams): TLCLIntfHandle; +begin +end; + +class procedure TWSCustomImageList.Delete(AList: TCustomImageList; AIndex: Integer); +begin +end; + +class procedure TWSCustomImageList.Draw(AList: TCustomImageList; ACanvas: TCanvas; ABounds: TRect; AEnabled: Boolean; AStyle: TDrawingStyle); +begin +end; + +class procedure TWSCustomImageList.Insert(AList: TCustomImageList; AIndex: Integer; AImage, AMask: TBitmap); +begin +end; + +class procedure TWSCustomImageList.InsertIcon(AList: TCustomImageList; AIndex: Integer; AImage: TIcon); +begin +end; + +class procedure TWSCustomImageList.InsertMasked(AList: TCustomImageList; Index: Integer; Image: TBitmap; MaskColor: TColor); +begin +end; + +class procedure TWSCustomImageList.Move(AList: TCustomImageList; ACurIndex, ANewIndex: Integer); +begin +end; + +class procedure TWSCustomImageList.Replace(AList: TCustomImageList; AIndex: Integer; AImage, AMask: TBitmap); +begin +end; + +class procedure TWSCustomImageList.ReplaceIcon(AList: TCustomImageList; AIndex: Integer; AImage: TIcon); +begin +end; + +class procedure TWSCustomImageList.ReplaceMasked(AList: TCustomImageList; AIndex: Integer; ANewImage: TBitmap; AMaskColor: TColor); +begin +end; + initialization //////////////////////////////////////////////////// // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// -// RegisterWSComponent(TCustomImageList, TWSCustomImageList); + RegisterWSComponent(TCustomImageList, TWSCustomImageList); //////////////////////////////////////////////////// end. \ No newline at end of file diff --git a/lcl/widgetset/wslclclasses.pp b/lcl/widgetset/wslclclasses.pp index e8d3558140..99b0d765e6 100644 --- a/lcl/widgetset/wslclclasses.pp +++ b/lcl/widgetset/wslclclasses.pp @@ -62,9 +62,13 @@ type class function WSPrivate: TWSPrivateClass; //inline; end; {$M-} - TWSLCLComponentClass = class of TWSLCLComponent; + { TWSLCLHandleComponent } + + TWSLCLHandleComponent = class(TWSLCLComponent) + end; + function FindWSComponentClass(const AComponent: TComponentClass): TWSLCLComponentClass; procedure RegisterWSComponent(const AComponent: TComponentClass;