{ $Id$ This file is part of the Free Pascal run time library. Copyright (c) 2003 by the Free Pascal development team Implementation of TFPCanvasHelper See the file COPYING.FPC, 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. **********************************************************************} { TFPCanvasHelper } constructor TFPCanvasHelper.Create; begin inherited create; FCanvas := nil; FFixedCanvas := false; FAllocated := false; end; destructor TFPCanvasHelper.destroy; begin if Allocated then DeAllocateResources; inherited; end; procedure TFPCanvasHelper.SetFixedCanvas (AValue : boolean); begin FFixedCanvas := AValue; end; procedure TFPCanvasHelper.NotifyCanvas; begin FCanvas.CheckHelper (self); end; procedure TFPCanvasHelper.CheckAllocated (ValueNeeded:boolean); begin if (Allocated <> ValueNeeded) then Raise TFPFontException.CreateFmt (ErrAllocation, [EFont, ErrAlloc[ValueNeeded]]); end; procedure TFPCanvasHelper.SetFPColor (AValue:TFPColor); begin FFPColor := AValue; end; procedure TFPCanvasHelper.Changing; begin if Assigned(FOnChanging) then FOnChanging(Self); end; procedure TFPCanvasHelper.Changed; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TFPCanvasHelper.Lock; begin end; procedure TFPCanvasHelper.UnLock; begin end; procedure TFPCanvasHelper.SetFlags (index:integer; AValue:boolean); begin if AValue then FFlags := FFlags or (1 shl index) else FFlags := FFlags and not (1 shl index); end; function TFPCanvasHelper.GetFlags (index:integer) : boolean; begin result := (FFlags and (1 shl index)) <> 0; end; function TFPCanvasHelper.GetAllocated : boolean; begin if FFixedCanvas then result := assigned(FCanvas) else result := FAllocated; end; procedure TFPCanvasHelper.AllocateResources (ACanvas : TFPCustomCanvas); begin if FFixedCanvas and FAllocated then DeallocateResources; try FCanvas := ACanvas; DoAllocateResources; FAllocated := True; except FCanvas := nil; FAllocated := False; end; end; procedure TFPCanvasHelper.DeallocateResources; begin if FAllocated then try DoDeallocateResources; finally FAllocated := false; NotifyCanvas; FCanvas := nil; end; end; procedure TFPCanvasHelper.DoCopyProps (From:TFPCanvasHelper); begin FCanvas := nil; FPColor := from.FPColor; end; procedure TFPCanvasHelper.DoAllocateResources; begin end; procedure TFPCanvasHelper.DoDeallocateResources; begin end;