paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 18:08:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: remove TPen.Geometric property and add TPen.Cosmetic. TPen.Cosmetic is a read only property. It setups when TPen.Width is changed

Browse Source 
examples: change Pen and Brush example

git-svn-id: trunk@17360 -
This commit is contained in:
paul 2008-11-13 01:37:19 +00:00
parent 2d1f0ad35d
commit 4e63b11c8e
5 changed files with 102 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
examples/pen_brush/unit1.lfm
View File

@ -218,6 +218,7 @@ object Form1: TForm1
'6'
'7'
)
MaxLength = -1
OnChange = PenChange
Style = csDropDownList
TabOrder = 1
@ -240,6 +241,7 @@ object Form1: TForm1
'Square'
'Flat'
)
MaxLength = -1
OnChange = PenChange
Style = csDropDownList
TabOrder = 2
@ -262,26 +264,12 @@ object Form1: TForm1
'Bevel'
'Mitter'
)
MaxLength = -1
OnChange = PenChange
Style = csDropDownList
TabOrder = 3
Text = 'Round'
end
object GeometricCheck: TCheckBox
AnchorSideLeft.Control = WidthCombo
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = WidthCombo
AnchorSideTop.Side = asrCenter
Left = 217
Height = 19
Top = 261
Width = 74
BorderSpacing.Left = 7
Caption = 'Geometric'
OnChange = PenChange
ParentBidiMode = False
TabOrder = 4
end
object PenColorBox: TColorBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = WidthCombo
@ -295,7 +283,7 @@ object Form1: TForm1
BorderSpacing.Top = 7
ItemHeight = 16
OnChange = PenChange
TabOrder = 5
TabOrder = 4
end
object PenStyleCombo: TComboBox
AnchorSideLeft.Control = Owner
@ -308,9 +296,10 @@ object Form1: TForm1
BorderSpacing.Left = 100
BorderSpacing.Top = 7
ItemHeight = 13
MaxLength = -1
OnChange = PenChange
Style = csDropDownList
TabOrder = 6
TabOrder = 5
end
object BrushStyleCombo: TComboBox
AnchorSideLeft.Control = Owner
@ -323,10 +312,9 @@ object Form1: TForm1
BorderSpacing.Left = 100
BorderSpacing.Top = 7
ItemHeight = 13
MaxLength = -1
OnChange = BrushChange
Style = csDropDownList
TabOrder = 7
TabOrder = 6
end
object BrushColorBox: TColorBox
AnchorSideLeft.Control = Owner
@ -342,7 +330,7 @@ object Form1: TForm1
BorderSpacing.Top = 7
ItemHeight = 16
OnChange = BrushChange
TabOrder = 8
TabOrder = 7
end
object FigureCombo: TComboBox
AnchorSideLeft.Control = Owner
@ -363,9 +351,26 @@ object Form1: TForm1
'Rectangle'
'Triangle'
)
MaxLength = -1
OnChange = FigureComboChange
Style = csDropDownList
TabOrder = 9
TabOrder = 8
Text = 'Line'
end
object cbCosmetic: TCheckBox
AnchorSideLeft.Control = WidthCombo
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = WidthCombo
AnchorSideTop.Side = asrCenter
Left = 217
Height = 19
Top = 261
Width = 69
BorderSpacing.Left = 7
Caption = 'Cosmetic'
Checked = True
OnChange = PenChange
State = cbChecked
TabOrder = 9
end
end

92
examples/pen_brush/unit1.lrs
View File

@ -69,51 +69,53 @@ LazarusResources.Add('TForm1','FORMDATA',[
+'eTop.Control'#7#13'PenStyleCombo'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'L'
+'eft'#2'd'#6'Height'#2#21#3'Top'#3#4#1#5'Width'#2'n'#18'BorderSpacing.Left'#2
+'d'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#9'ItemIndex'#2#0#13'Items.'
+'Strings'#1#6#1'1'#6#1'2'#6#1'3'#6#1'4'#6#1'5'#6#1'6'#6#1'7'#0#8'OnChange'#7
+#9'PenChange'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#1#4'Text'#6#1'1'#0
+#0#9'TComboBox'#9'CapsCombo'#22'AnchorSideLeft.Control'#7#5'Owner'#21'Anchor'
+'SideTop.Control'#7#11'PenColorBox'#18'AnchorSideTop.Side'#7#9'asrBottom'#4
+'Left'#2'd'#6'Height'#2#21#3'Top'#3'='#1#5'Width'#2'n'#18'BorderSpacing.Left'
+#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#9'ItemIndex'#2#0#13'Item'
+'s.Strings'#1#6#5'Round'#6#6'Square'#6#4'Flat'#0#8'OnChange'#7#9'PenChange'#5
+'Style'#7#14'csDropDownList'#8'TabOrder'#2#2#4'Text'#6#5'Round'#0#0#9'TCombo'
+'Box'#9'JoinCombo'#22'AnchorSideLeft.Control'#7#5'Owner'#21'AnchorSideTop.Co'
+'ntrol'#7#9'CapsCombo'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#2'd'#6
+'Height'#2#21#3'Top'#3'Y'#1#5'Width'#2'n'#18'BorderSpacing.Left'#2'd'#17'Bor'
+'derSpacing.Top'#2#7#10'ItemHeight'#2#13#9'ItemIndex'#2#0#13'Items.Strings'#1
+#6#5'Round'#6#5'Bevel'#6#6'Mitter'#0#8'OnChange'#7#9'PenChange'#5'Style'#7#14
+'csDropDownList'#8'TabOrder'#2#3#4'Text'#6#5'Round'#0#0#9'TCheckBox'#14'Geom'
+'etricCheck'#22'AnchorSideLeft.Control'#7#10'WidthCombo'#19'AnchorSideLeft.S'
+'ide'#7#9'asrBottom'#21'AnchorSideTop.Control'#7#10'WidthCombo'#18'AnchorSid'
+'eTop.Side'#7#9'asrCenter'#4'Left'#3#217#0#6'Height'#2#19#3'Top'#3#5#1#5'Wid'
+'th'#2'J'#18'BorderSpacing.Left'#2#7#7'Caption'#6#9'Geometric'#8'OnChange'#7
+#9'PenChange'#14'ParentBidiMode'#8#8'TabOrder'#2#4#0#0#9'TColorBox'#11'PenCo'
+'lorBox'#22'AnchorSideLeft.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#10
+'WidthCombo'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#2'd'#6'Height'#2
+#22#3'Top'#3' '#1#5'Width'#2'n'#5'Style'#11#16'cbStandardColors'#16'cbExtend'
+'edColors'#14'cbSystemColors'#13'cbCustomColor'#13'cbPrettyNames'#0#18'Borde'
+'rSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#16#8'OnChang'
+'e'#7#9'PenChange'#8'TabOrder'#2#5#0#0#9'TComboBox'#13'PenStyleCombo'#22'Anc'
+'horSideLeft.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#6'Label1'#18'An'
+'chorSideTop.Side'#7#9'asrBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3#232#0
+#5'Width'#2'n'#18'BorderSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'Item'
+'Height'#2#13#8'OnChange'#7#9'PenChange'#5'Style'#7#14'csDropDownList'#8'Tab'
+'Order'#2#6#0#0#9'TComboBox'#15'BrushStyleCombo'#22'AnchorSideLeft.Control'#7
+'Strings'#1#6#1'1'#6#1'2'#6#1'3'#6#1'4'#6#1'5'#6#1'6'#6#1'7'#0#9'MaxLength'#2
+#255#8'OnChange'#7#9'PenChange'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#1
+#4'Text'#6#1'1'#0#0#9'TComboBox'#9'CapsCombo'#22'AnchorSideLeft.Control'#7#5
+'Owner'#21'AnchorSideTop.Control'#7#11'PenColorBox'#18'AnchorSideTop.Side'#7
+#9'asrBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3'='#1#5'Width'#2'n'#18'Bor'
+'derSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#9'ItemI'
+'ndex'#2#0#13'Items.Strings'#1#6#5'Round'#6#6'Square'#6#4'Flat'#0#9'MaxLengt'
+'h'#2#255#8'OnChange'#7#9'PenChange'#5'Style'#7#14'csDropDownList'#8'TabOrde'
+'r'#2#2#4'Text'#6#5'Round'#0#0#9'TComboBox'#9'JoinCombo'#22'AnchorSideLeft.C'
+'ontrol'#7#5'Owner'#21'AnchorSideTop.Control'#7#9'CapsCombo'#18'AnchorSideTo'
+'p.Side'#7#9'asrBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3'Y'#1#5'Width'#2
+'n'#18'BorderSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13
+#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Round'#6#5'Bevel'#6#6'Mitter'#0#9
+'MaxLength'#2#255#8'OnChange'#7#9'PenChange'#5'Style'#7#14'csDropDownList'#8
+'TabOrder'#2#3#4'Text'#6#5'Round'#0#0#9'TColorBox'#11'PenColorBox'#22'Anchor'
+'SideLeft.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#10'WidthCombo'#18
+'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#2'd'#6'Height'#2#22#3'Top'#3' '#1
+#5'Width'#2'n'#5'Style'#11#16'cbStandardColors'#16'cbExtendedColors'#14'cbSy'
+'stemColors'#13'cbCustomColor'#13'cbPrettyNames'#0#18'BorderSpacing.Left'#2
+'d'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#16#8'OnChange'#7#9'PenChange'
+#8'TabOrder'#2#4#0#0#9'TComboBox'#13'PenStyleCombo'#22'AnchorSideLeft.Contro'
+'l'#7#5'Owner'#21'AnchorSideTop.Control'#7#6'Label1'#18'AnchorSideTop.Side'#7
+#9'asrBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3#232#0#5'Width'#2'n'#18'Bo'
+'rderSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#9'MaxL'
+'ength'#2#255#8'OnChange'#7#9'PenChange'#5'Style'#7#14'csDropDownList'#8'Tab'
+'Order'#2#5#0#0#9'TComboBox'#15'BrushStyleCombo'#22'AnchorSideLeft.Control'#7
+#5'Owner'#21'AnchorSideTop.Control'#7#6'Label2'#18'AnchorSideTop.Side'#7#9'a'
+'srBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3#138#1#5'Width'#2'n'#18'Borde'
+'rSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#9'MaxLeng'
+'th'#2#255#8'OnChange'#7#11'BrushChange'#5'Style'#7#14'csDropDownList'#8'Tab'
+'Order'#2#7#0#0#9'TColorBox'#13'BrushColorBox'#22'AnchorSideLeft.Control'#7#5
+'Owner'#21'AnchorSideTop.Control'#7#15'BrushStyleCombo'#18'AnchorSideTop.Sid'
+'e'#7#9'asrBottom'#4'Left'#2'd'#6'Height'#2#22#3'Top'#3#166#1#5'Width'#2'n'#8
+'Selected'#7#9'clBtnFace'#5'Style'#11#16'cbStandardColors'#16'cbExtendedColo'
+'rs'#14'cbSystemColors'#13'cbCustomColor'#13'cbPrettyNames'#0#18'BorderSpaci'
+'ng.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#16#8'OnChange'#7#11
+'BrushChange'#8'TabOrder'#2#8#0#0#9'TComboBox'#11'FigureCombo'#22'AnchorSide'
+'Left.Control'#7#5'Owner'#21'AnchorSideTop.Control'#7#8'PaintBox'#18'AnchorS'
+'ideTop.Side'#7#9'asrBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3#183#0#5'Wi'
+'dth'#2'n'#18'BorderSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeig'
+'ht'#2#13#9'ItemIndex'#2#0#13'Items.Strings'#1#6#4'Line'#6#8'PolyLine'#6#7'E'
+'llipse'#6#9'Rectangle'#6#8'Triangle'#0#8'OnChange'#7#17'FigureComboChange'#5
+'Style'#7#14'csDropDownList'#8'TabOrder'#2#9#4'Text'#6#4'Line'#0#0#0
+'rSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#8'OnChang'
+'e'#7#11'BrushChange'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#6#0#0#9'TC'
+'olorBox'#13'BrushColorBox'#22'AnchorSideLeft.Control'#7#5'Owner'#21'AnchorS'
+'ideTop.Control'#7#15'BrushStyleCombo'#18'AnchorSideTop.Side'#7#9'asrBottom'
+#4'Left'#2'd'#6'Height'#2#22#3'Top'#3#166#1#5'Width'#2'n'#8'Selected'#7#9'cl'
+'BtnFace'#5'Style'#11#16'cbStandardColors'#16'cbExtendedColors'#14'cbSystemC'
+'olors'#13'cbCustomColor'#13'cbPrettyNames'#0#18'BorderSpacing.Left'#2'd'#17
+'BorderSpacing.Top'#2#7#10'ItemHeight'#2#16#8'OnChange'#7#11'BrushChange'#8
+'TabOrder'#2#7#0#0#9'TComboBox'#11'FigureCombo'#22'AnchorSideLeft.Control'#7
+#5'Owner'#21'AnchorSideTop.Control'#7#8'PaintBox'#18'AnchorSideTop.Side'#7#9
+'asrBottom'#4'Left'#2'd'#6'Height'#2#21#3'Top'#3#183#0#5'Width'#2'n'#18'Bord'
+'erSpacing.Left'#2'd'#17'BorderSpacing.Top'#2#7#10'ItemHeight'#2#13#9'ItemIn'
+'dex'#2#0#13'Items.Strings'#1#6#4'Line'#6#8'PolyLine'#6#7'Ellipse'#6#9'Recta'
+'ngle'#6#8'Triangle'#0#9'MaxLength'#2#255#8'OnChange'#7#17'FigureComboChange'
+#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#8#4'Text'#6#4'Line'#0#0#9'TChec'
+'kBox'#10'cbCosmetic'#22'AnchorSideLeft.Control'#7#10'WidthCombo'#19'AnchorS'
+'ideLeft.Side'#7#9'asrBottom'#21'AnchorSideTop.Control'#7#10'WidthCombo'#18
+'AnchorSideTop.Side'#7#9'asrCenter'#4'Left'#3#217#0#6'Height'#2#19#3'Top'#3#5
+#1#5'Width'#2'E'#18'BorderSpacing.Left'#2#7#7'Caption'#6#8'Cosmetic'#7'Check'
+'ed'#9#8'OnChange'#7#9'PenChange'#5'State'#7#9'cbChecked'#8'TabOrder'#2#9#0#0
+#0
]);

12
examples/pen_brush/unit1.pas
View File

@ -16,6 +16,7 @@ type
Bevel1: TBevel;
Bevel2: TBevel;
Button1: TBitBtn;
cbCosmetic: TCheckBox;
FigureCombo: TComboBox;
Label10: TLabel;
Label7: TLabel;
@ -26,7 +27,6 @@ type
Label1: TLabel;
Label2: TLabel;
PenColorBox: TColorBox;
GeometricCheck: TCheckBox;
Label6: TLabel;
BrushStyleCombo: TComboBox;
WidthCombo: TComboBox;
@ -176,11 +176,17 @@ procedure TForm1.PenChange(Sender: TObject);
var
Dashes: array[0..3] of DWord = (1, 1, 1, 1);
begin
cbCosmetic.Enabled := WidthCombo.ItemIndex = 0;
if PenStyleCombo.ItemIndex <> -1 then
PaintBox.Canvas.Pen.Style := TPenStyle(PenStyleCombo.ItemIndex);
PaintBox.Canvas.Pen.Color := PenColorBox.Selected;
PaintBox.Canvas.Pen.Width := StrToInt(WidthCombo.Text);
PaintBox.Canvas.Pen.Geometric := GeometricCheck.Checked;
if cbCosmetic.Enabled and cbCosmetic.Checked then
PaintBox.Canvas.Pen.Width := 0
else
PaintBox.Canvas.Pen.Width := StrToInt(WidthCombo.Text);
PaintBox.Canvas.Pen.EndCap := TPenEndCap(CapsCombo.ItemIndex);
PaintBox.Canvas.Pen.JoinStyle := TPenJoinStyle(JoinCombo.ItemIndex);
PaintBox.Canvas.Pen.SetPattern(Dashes);

5
lcl/graphics.pp
View File

@ -586,7 +586,7 @@ type
private
FColor: TColor;
FEndCap: TPenEndCap;
FGeometric: Boolean;
FCosmetic: Boolean;
FJoinStyle: TPenJoinStyle;
FPattern: TPenPattern;
FPenHandleCached: boolean;
@ -604,7 +604,6 @@ type
procedure SetFPColor(const AValue: TFPColor); override;
procedure SetColor(Value: TColor);
procedure SetEndCap(const AValue: TPenEndCap);
procedure SetGeometric(const AValue: Boolean);
procedure SetJoinStyle(const AValue: TPenJoinStyle);
procedure SetMode(Value: TPenMode); override;
procedure SetStyle(Value: TPenStyle); override;
@ -620,7 +619,7 @@ type
procedure SetPattern(APattern: TPenPattern); reintroduce;
published
property Color: TColor read FColor write SetColor default clBlack;
property Geometric: Boolean read FGeometric write SetGeometric default False;
property Cosmetic: Boolean read FCosmetic;
property EndCap: TPenEndCap read FEndCap write SetEndCap default pecRound;
property JoinStyle: TPenJoinStyle read FJoinStyle write SetJoinStyle default pjsRound;
property Mode default pmCopy;

35
lcl/include/pen.inc
View File

@ -193,9 +193,16 @@ end;
------------------------------------------------------------------------------}
procedure TPen.SetWidth(Value : Integer);
begin
if Width <> Value then
// Cosmetic pen is a pen which has width = 0. FCL does not allow pens < 1.
// FCosmetic field contains a knowledge about passed value
if (Value = 0) and (Width = 1) and Cosmetic then
Exit;
if (Width <> Value) or ((Width = 1) and Cosmetic) then
begin
FreeReference;
FCosmetic := Value = 0;
inherited SetWidth(Value);
Changed;
end;
@ -214,7 +221,7 @@ begin
DelayAllocate := True;
FEndCap := pecRound;
FJoinStyle := pjsRound;
FGeometric := False;
FCosmetic := True;
FPattern := nil;
inherited SetWidth(1);
inherited SetStyle(psSolid);
@ -249,11 +256,15 @@ var
begin
if Source is TPen then
begin
Width := APen.Width;
if APen.Cosmetic then
Width := 0
else
Width := APen.Width;
SetColor(APen.Color, TFPCanvasHelper(Source).FPColor);
Style := APen.Style;
Mode := APen.Mode;
Geometric := APen.Geometric;
JoinStyle := APen.JoinStyle;
EndCap := APen.EndCap;
end
@ -372,8 +383,8 @@ begin
FillChar(AExtPen, SizeOf(AExtPen), 0);
with AExtPen do
begin
elpPenStyle := PEN_STYLES[Style] or PEN_GEOMETRIC[Geometric];
if Geometric then
elpPenStyle := PEN_STYLES[Style] or PEN_GEOMETRIC[not Cosmetic];
if not Cosmetic then
elpPenStyle := elpPenStyle or PEN_ENDCAP[EndCap] or PEN_JOIN[JoinStyle];
elpWidth := Width;
elpBrushStyle := BS_SOLID;
@ -433,16 +444,6 @@ begin
end;
end;
procedure TPen.SetGeometric(const AValue: Boolean);
begin
if Geometric <> AValue then
begin
FreeReference;
FGeometric := AValue;
Changed;
end;
end;
{------------------------------------------------------------------------------
Method: TPen.FreeReference
Params: none
@ -485,7 +486,7 @@ begin
begin
FreeReference;
inherited DoCopyProps(From);
FGeometric := APen.Geometric;
FCosmetic := APen.Cosmetic;
FEndCap := APen.EndCap;
FJoinStyle := APen.JoinStyle;
//TODO: query new parameters