diff --git a/ide/main.pp b/ide/main.pp index 8dea266741..bd1396508d 100644 --- a/ide/main.pp +++ b/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, - MainIDEBar.Top+MainIDEBar.Height+80, - 400,300)); + new_x, new_y, 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 diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 91cf875223..fe4da8fe5a 100644 --- a/lcl/graphics.pp +++ b/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 diff --git a/lcl/include/brush.inc b/lcl/include/brush.inc index dd56e61a53..038448f525 100644 --- a/lcl/include/brush.inc +++ b/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 - then begin + if Style <> Value 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 diff --git a/lcl/include/font.inc b/lcl/include/font.inc index 744afd76cf..df4c000996 100644 --- a/lcl/include/font.inc +++ b/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 diff --git a/lcl/include/pen.inc b/lcl/include/pen.inc index 3a2a00a14b..773b8cce26 100644 --- a/lcl/include/pen.inc +++ b/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 Style := psSolid; - inherited Mode := pmCopy; + inherited SetWidth(1); + inherited SetStyle(psSolid); + 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 diff --git a/lcl/postscriptprinter.pas b/lcl/postscriptprinter.pas index 26fd06b75d..750ae3a7b7 100644 --- a/lcl/postscriptprinter.pas +++ b/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;