TFont, TBrush, TPen can now be used with fpCanvas

git-svn-id: trunk@6502 -

ide/main.pp

@@ -3156,6 +3156,7 @@ function TMainIDE.CreateNewForm(NewUnitInfo: TUnitInfo;
 var
   CInterface: TComponentInterface;
   NewComponent: TComponent;
+  new_x, new_y: integer;
 begin
   if not AncestorType.InheritsFrom(TComponent) then
     RaiseException('TMainIDE.CreateNewForm invalid AncestorType');
@@ -3176,12 +3177,16 @@ begin
     FormEditor1 := TFormEditor.Create;
   FormEditor1.ClearSelection;
 
+  // Figure out where we want to put the new form
+  new_x:=ObjectInspector1.Left+ObjectInspector1.Width; //+60;
+  new_y:=MainIDEBar.Top+MainIDEBar.Height; //+80;
+  if screen.width-new_x>=ObjectInspector1.left then inc(new_x, 60) else new_x:=16;
+  if screen.height-new_y>=MainIDEBar.top then inc(new_y, 80) else new_y:=24;
+  
   // create jit component
   CInterface := TComponentInterface(
     FormEditor1.CreateComponent(nil,TComponentClass(AncestorType),
-      ObjectInspector1.Left+ObjectInspector1.Width+60,
+      new_x, new_y, 400,300));
-      MainIDEBar.Top+MainIDEBar.Height+80,
-      400,300));
   FormEditor1.SetComponentNameAndClass(CInterface,
     NewUnitInfo.ComponentName,'T'+NewUnitInfo.ComponentName);
   NewComponent:=CInterface.Component;
@@ -11325,6 +11330,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.822  2005/01/07 21:02:59  mattias
+  TFont, TBrush, TPen can now be used with fpCanvas
+
   Revision 1.821  2005/01/07 17:40:59  mattias
   fixed TTabSheet.SetPageControl
 

lcl/graphics.pp

@@ -494,9 +494,9 @@ type
     procedure DoDeAllocateResources; override;
     procedure DoCopyProps(From: TFPCanvasHelper); override;
     procedure SetFlags(Index: integer; AValue: boolean); override;
-    procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
     procedure SetName(AValue: string); override;
     procedure SetSize(AValue: integer); override;
+    procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
     procedure SetFPColor(const AValue: TFPColor); override;
     {$ELSE}
     procedure SetName(const AValue: string);
@@ -582,6 +582,8 @@ type
     procedure DoAllocateResources; override;
     procedure DoDeAllocateResources; override;
     procedure DoCopyProps(From: TFPCanvasHelper); override;
+    procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
+    procedure SetFPColor(const AValue: TFPColor); override;
     {$ENDIF}
     function GetHandle: HPEN;
     procedure SetHandle(const Value: HPEN);
@@ -596,9 +598,15 @@ type
     property Handle: HPEN read GetHandle write SetHandle;
   published
     property Color: TColor read FColor write SetColor default clBlack;
+    {$IFDEF UseFPCanvas}
+    property Mode default pmCopy;
+    property Style default psSolid;
+    property Width default 1;
+    {$ELSE}
     property Mode: TPenMode read FMode write SetMode default pmCopy;
     property Style: TPenStyle read FStyle write SetStyle default psSolid;
     property Width: Integer read FWidth write SetWidth default 1;
+    {$ENDIF}
   end;
 
 
@@ -618,29 +626,48 @@ type
     constructor Create;
   end;
 
+  {$IFDEF UseFPCanvas}
+  TBrush = class(TFPCustomBrush)
+  {$ELSE}
   TBrush = class(TGraphicsObject)
+  {$ENDIF}
   private
     FHandle: HBrush;
+    FBrushHandleCached: boolean;
     FColor: TColor;
     FBitmap: TBitmap;
+    {$IFDEF UseFPCanvas}
+    {$ELSE}
     FStyle: TBrushStyle;
-    FBrushHandleCached: boolean;
+    {$ENDIF}
     procedure FreeHandle;
+    Procedure DoChange(var Msg); message LM_CHANGED;
   protected
+    {$IFDEF UseFPCanvas}
+    procedure DoAllocateResources; override;
+    procedure DoDeAllocateResources; override;
+    procedure DoCopyProps(From: TFPCanvasHelper); override;
+    procedure SetColor(const NewColor: TColor; const NewFPColor: TFPColor); virtual;
+    procedure SetFPColor(const AValue: TFPColor); override;
+    {$ENDIF}
     function GetHandle: HBRUSH;
     procedure SetBitmap(Value: TBitmap);
     procedure SetColor(Value: TColor);
     procedure SetHandle(const Value: HBRUSH);
-    Procedure SetStyle(Value: TBrushStyle);
+    Procedure SetStyle(Value: TBrushStyle); {$IFDEF UseFPCanvas}override;{$ENDIF}
   public
     procedure Assign(Source: TPersistent); override;
-    constructor Create;
+    constructor Create; {$IFDEF UseFPCanvas}override;{$ENDIF}
     destructor Destroy; override;
     property Bitmap: TBitmap read FBitmap write SetBitmap;
     property Handle: HBRUSH read GetHandle write SetHandle;
   published
     property Color: TColor read FColor write SetColor default clWhite;
+    {$IFDEF UseFPCanvas}
+    property Style default bsSolid;
+    {$ELSE}
     property Style: TBrushStyle read FStyle write SetStyle default bsSolid;
+    {$ENDIF}
   end;
 
 
@@ -1875,6 +1902,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.168  2005/01/07 21:02:59  mattias
+  TFont, TBrush, TPen can now be used with fpCanvas
+
   Revision 1.167  2005/01/07 18:40:10  mattias
   clean up, added GetRGBValues
 

lcl/include/brush.inc

@@ -45,8 +45,12 @@ begin
   if FColor <> Value
   then begin
     FreeHandle;
+    {$IFDEF UseFPCanvas}
+    SetColor(Value,TColorToFPColor(Value));
+    {$ELSE}
     FColor := Value;
     Changed;
+    {$ENDIF}
   end;
 end;
 
@@ -59,10 +63,13 @@ end;
  ------------------------------------------------------------------------------}
 Procedure TBrush.SetStyle(Value : TBrushStyle);
 begin
-  if FStyle <> Value
+  if Style <> Value then begin
-  then begin
     FreeHandle;
+    {$IFDEF UseFPCanvas}
+    inherited SetStyle(Value);
+    {$ELSE}
     FStyle := Value;
+    {$ENDIF}
     Changed;
   end;
 end;
@@ -97,7 +104,11 @@ begin
   FBitmap := nil;
   FHandle := 0;
   FColor := clWhite;
+  {$IFDEF UseFPCanvas}
+  inherited SetStyle(bsSolid);
+  {$ELSE}
   FStyle := bsSolid;
+  {$ENDIF}
 end;
 
 {------------------------------------------------------------------------------
@@ -125,7 +136,11 @@ begin
   if Source is TBrush
   then begin
     Bitmap := TBrush(Source).Bitmap;
+    {$IFDEF UseFPCanvas}
+    SetColor(TFPCanvasHelper(Source).Color,TFPCanvasHelper(Source).FPColor);
+    {$ELSE}
     Color := TBrush(Source).Color;
+    {$ENDIF}
     Style := TBrush(Source).Style;
   end
   else
@@ -175,12 +190,12 @@ begin
       end else
       begin
         lbHatch := 0;
-        case FStyle of
+        case Style of
           bsSolid: lbStyle := BS_SOLID;
           bsClear: lbStyle := BS_HOLLOW;
         else
           lbStyle := BS_HATCHED;
-          lbHatch := Ord(FStyle) - Ord(bsHorizontal);
+          lbHatch := Ord(Style) - Ord(bsHorizontal);
         end;
       end;
       lbColor := ColorRef(FColor);
@@ -219,9 +234,56 @@ begin
   end;
 end;
 
+procedure TBrush.DoChange(var Msg);
+begin
+  Changed;
+end;
+
+{$IFDEF UseFPCanvas}
+procedure TBrush.DoAllocateResources;
+begin
+  inherited DoAllocateResources;
+  GetHandle;
+end;
+
+procedure TBrush.DoDeAllocateResources;
+begin
+  FreeHandle;
+  inherited DoDeAllocateResources;
+end;
+
+procedure TBrush.DoCopyProps(From: TFPCanvasHelper);
+begin
+  if From is TBrush then begin
+    FreeHandle;
+    inherited DoCopyProps(From);
+    //TODO: query new parameters
+    Changed;
+  end else
+    inherited DoCopyProps(From);
+end;
+
+procedure TBrush.SetColor(const NewColor: TColor; const NewFPColor: TFPColor);
+begin
+  if (NewColor=Color) and (NewFPColor=FPColor) then exit;
+  FColor:=NewColor;
+  inherited SetFPColor(NewFPColor);
+  Changed;
+end;
+
+procedure TBrush.SetFPColor(const AValue: TFPColor);
+begin
+  if FPColor=AValue then exit;
+  SetColor(FPColorToTColor(AValue),AValue);
+end;
+{$ENDIF}
+
 { =============================================================================
 
   $Log$
+  Revision 1.14  2005/01/07 21:02:59  mattias
+  TFont, TBrush, TPen can now be used with fpCanvas
+
   Revision 1.13  2004/12/22 23:54:21  mattias
   started TControl.AnchorSide
 

lcl/include/font.inc

@@ -535,6 +535,7 @@ begin
   FCharSet:=DefFontData.CharSet;
   {$IFDEF UseFPCanvas}
   inherited SetName(DefFontData.Name);
+  inherited SetFPColor(colBlack);
   {$ELSE}
   FFontName:=DefFontData.Name;
   {$ENDIF}
@@ -557,7 +558,11 @@ begin
         BeginUpdate;
         try
           CharSet:= TFont(Source).CharSet;
+          {$IFDEF UseFPCanvas}
+          SetColor(TFPCanvasHelper(Source).Color,TFPCanvasHelper(Source).FPColor);
+          {$ELSE}
           Color := TFont(Source).Color;
+          {$ENDIF}
           Height := TFont(Source).Height;
           Name := TFont(Source).Name;
           Pitch := TFont(Source).Pitch;
@@ -758,7 +763,7 @@ procedure TFont.SetColor(Value : TColor);
 begin
   if FColor <> Value then begin
     {$IFDEF UseFPCanvas}
-    SetColor(Value,FPColorToTColor(Value));
+    SetColor(Value,TColorToFPColor(Value));
     {$ELSE}
     FColor := Value;
     Changed;
@@ -1046,14 +1051,15 @@ begin
     FCharSet:=FontData.CharSet;
     {$IFDEF UseFPCanvas}
     inherited SetName(FontData.Name);
+    bold;
     if (fsBold in OldStyle)<>(fsBold in FStyle) then
-      inherited Bold:=fsBold in FStyle;
+      inherited SetFlags(5,fsBold in FStyle);
     if (fsItalic in OldStyle)<>(fsItalic in FStyle) then
-      inherited Italic:=fsItalic in FStyle;
+      inherited SetFlags(6,fsItalic in FStyle);
     if (fsUnderline in OldStyle)<>(fsUnderline in FStyle) then
-      inherited Underline:=fsUnderline in FStyle;
+      inherited SetFlags(7,fsUnderline in FStyle);
     if (fsStrikeOut in OldStyle)<>(fsStrikeOut in FStyle) then
-      inherited StrikeTrough:=fsStrikeOut in FStyle;
+      inherited SetFlags(8,fsStrikeOut in FStyle);
     {$ELSE}
     FFontName:=FontData.Name;
     {$ENDIF}
@@ -1093,6 +1099,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.26  2005/01/07 21:02:59  mattias
+  TFont, TBrush, TPen can now be used with fpCanvas
+
   Revision 1.25  2005/01/07 18:40:10  mattias
   clean up, added GetRGBValues
 

lcl/include/pen.inc

@@ -46,8 +46,12 @@ begin
   if FColor <> value
   then begin
     FreeHandle;
-    FColor := value;
+    {$IFDEF UseFPCanvas}
+    SetColor(Value,TColorToFPColor(Value));
+    {$ELSE}
+    FColor := Value;
     Changed;
+    {$ENDIF}
   end;
 end;
 
@@ -64,7 +68,7 @@ begin
   then begin
     FreeHandle;
     {$IFDEF UseFPCanvas}
-    inherited Style := Value;
+    inherited SetStyle(Value);
     {$ELSE}
     FStyle:=Value;
     {$ENDIF}
@@ -85,7 +89,7 @@ begin
   then begin
     FreeHandle;
     {$IFDEF UseFPCanvas}
-    inherited Mode := Value;
+    inherited SetMode(Value);
     {$ELSE}
     FMode:=Value;
     {$ENDIF}
@@ -106,7 +110,7 @@ begin
   then begin
     FreeHandle;
     {$IFDEF UseFPCanvas}
-    inherited Width := Value;
+    inherited SetWidth(Value);
     {$ELSE}
     FWidth:=Value;
     {$ENDIF}
@@ -126,9 +130,10 @@ begin
   inherited Create;
   FHandle := 0;
   {$IFDEF UseFPCanvas}
-  inherited Width := 1;
+  inherited SetWidth(1);
-  inherited Style := psSolid;
+  inherited SetStyle(psSolid);
-  inherited Mode := pmCopy;
+  inherited SetMode(pmCopy);
+  inherited SetFPColor(colBlack);
   {$ELSE}
   FWidth := 1;
   FStyle := psSolid;
@@ -162,7 +167,11 @@ begin
   if Source is TPen
   then begin
     Width := TPen(Source).Width;
+    {$IFDEF UseFPCanvas}
+    SetColor(TFPCanvasHelper(Source).Color,TFPCanvasHelper(Source).FPColor);
+    {$ELSE}
     Color := TPen(Source).Color;
+    {$ENDIF}
     Style := TPen(Source).Style;
   end
   else
@@ -197,7 +206,11 @@ end;
 function TPen.GetHandle: HPEN;
 const
   PEN_STYLES: array[TPenStyle] of Word = (
-    PS_SOLID,PS_DASH,PS_DOT,PS_DASHDOT,PS_DASHDOTDOT,PS_NULL,PS_INSIDEFRAME);
+    PS_SOLID,PS_DASH,PS_DOT,PS_DASHDOT,PS_DASHDOTDOT,PS_NULL,PS_INSIDEFRAME
+    {$IFDEF UseFPCanvas}
+    ,PS_DOT // TODO psPattern
+    {$ENDIF}
+    );
 var
   LogPen: TLogPen;
   CachedPen: TBlockResourceCacheDescriptor;
@@ -270,11 +283,29 @@ begin
   end else
     inherited DoCopyProps(From);
 end;
+
+procedure TPen.SetColor(const NewColor: TColor; const NewFPColor: TFPColor);
+begin
+  if (NewColor=Color) and (NewFPColor=FPColor) then exit;
+  FColor:=NewColor;
+  inherited SetFPColor(NewFPColor);
+  Changed;
+end;
+
+procedure TPen.SetFPColor(const AValue: TFPColor);
+begin
+  if FPColor=AValue then exit;
+  SetColor(FPColorToTColor(AValue),AValue);
+end;
+
 {$ENDIF}
 
 { =============================================================================
 
   $Log$
+  Revision 1.17  2005/01/07 21:02:59  mattias
+  TFont, TBrush, TPen can now be used with fpCanvas
+
   Revision 1.16  2004/12/23 22:38:18  mattias
   implemented TIElementName of link of RTTI controls for set elements
 

lcl/postscriptprinter.pas

@@ -861,7 +861,6 @@ end;
 
 procedure TPSObject.Changed;
 begin
-  //Assert(False, Format('Trace:[TgraphicsObject.Changed] %s', [ClassName]));
   if Assigned(FOnChange) then FOnChange(Self);
 end;