paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 21:42:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

TFont, TBrush, TPen can now be used with fpCanvas

Browse Source 
git-svn-id: trunk@6502 -
This commit is contained in:
mattias 2005-01-07 21:02:59 +00:00
parent bf75b72edd
commit a9010971e6
6 changed files with 164 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
ide/main.pp
View File

@ -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

38
lcl/graphics.pp
View File

@ -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

70
lcl/include/brush.inc
View File

@ -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

19
lcl/include/font.inc
View File

@ -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

47
lcl/include/pen.inc
View File

@ -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

1
lcl/postscriptprinter.pas
View File

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