lazarus/examples/pen_brush/unit1.pas

315 lines
9.4 KiB
ObjectPascal

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons,
ColorBox,
LCLIntf, LCLType, FPCanvas;
type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
BgColorBox: TColorBox;
cbOpaque: TCheckBox;
FontColorBox: TColorBox;
Button1: TBitBtn;
cbCosmetic: TCheckBox;
cbAntialiasing: TCheckBox;
FigureCombo: TComboBox;
Label10: TLabel;
Label11: TLabel;
LblBgColor: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
BrushColorBox: TColorBox;
LblBgColor1: TLabel;
PenStyleCombo: TComboBox;
Label1: TLabel;
Label2: TLabel;
PenColorBox: TColorBox;
Label6: TLabel;
BrushStyleCombo: TComboBox;
PenStyleInfoBtn: TSpeedButton;
BrushStyleInfoBtn: TSpeedButton;
WidthCombo: TComboBox;
CapsCombo: TComboBox;
JoinCombo: TComboBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
PaintBox: TPaintBox;
procedure BrushChange(Sender: TObject);
procedure cbAntialiasingChange(Sender: TObject);
procedure cbOpaqueChange(Sender: TObject);
procedure FigureComboChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBoxPaint(Sender: TObject);
procedure PenChange(Sender: TObject);
procedure BrushStyleInfoBtnClick(Sender: TObject);
procedure PenStyleInfoBtnClick(Sender: TObject);
private
FPattern: TCustomBitmap;
FImage: TCustomBitmap;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
TypInfo;
const
BK_MODE: array[boolean] of Integer = (TRANSPARENT, OPAQUE);
{ TForm1 }
procedure TForm1.cbAntialiasingChange(Sender: TObject);
const
AntialiasingMode: array[TCheckBoxState] of TAntialiasingMode =
(
amOff,
amOn,
amDontCare
);
begin
PaintBox.Canvas.AntialiasingMode := AntialiasingMode[cbAntialiasing.State];
PaintBox.Invalidate;
end;
procedure TForm1.cbOpaqueChange(Sender: TObject);
begin
Paintbox.Invalidate;
end;
procedure TForm1.FigureComboChange(Sender: TObject);
begin
PaintBox.Invalidate;
end;
procedure TForm1.BrushChange(Sender: TObject);
begin
PaintBox.Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
const
//LineBitsDotted: array[0..7] of Word = ($55, $AA, $55, $AA, $55, $AA, $55, $AA);
LineBitsCheckerboard: array[0..7] of Word = ($3C, $3C, $3C, $3C, $C3, $C3, $C3, $C3);
var
ps: TPenStyle;
bs: TBrushStyle;
begin
case PaintBox.Canvas.AntialiasingMode of
amDontCare: cbAntialiasing.State := cbGrayed;
amOn: cbAntialiasing.State := cbChecked;
amOff: cbAntialiasing.State := cbUnchecked;
end;
FImage := TPortableNetworkGraphic.Create;
FImage.LoadFromFile('image.png');
FPattern := TBitmap.Create;
FPattern.SetHandles(CreateBitmap(8, 8, 1, 1, @LineBitsCheckerboard), 0);
PenStyleCombo.Items.BeginUpdate;
for ps := Low(ps) to High(ps) do
PenStyleCombo.Items.Add(GetEnumName(TypeInfo(TPenStyle), Ord(ps)));
PenStyleCombo.Items.EndUpdate;
PenStyleCombo.ItemIndex := 0;
BrushStyleCombo.Items.BeginUpdate;
for bs := Low(bs) to High(bs) do
BrushStyleCombo.Items.Add(GetEnumName(TypeInfo(TBrushStyle), Ord(bs)));
BrushStyleCombo.Items.EndUpdate;
BrushStyleCombo.ItemIndex := 0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FPattern.Free;
FImage.Free;
end;
procedure TForm1.PaintBoxPaint(Sender: TObject);
function RandomPoint(R: TRect): TPoint;
begin
Result.x := Random(R.Right - R.Left) + R.Left;
Result.y := Random(R.Bottom - R.Top) + R.Top;
end;
procedure DrawFigure(R: TRect); inline;
var
Points: array of TPoint = nil;
txt: String;
begin
inflateRect(R, -10, -10);
case FigureCombo.ItemIndex of
0: // Line
PaintBox.Canvas.Line(R.TopLeft, R.BottomRight);
1: // PolyLine
begin
SetLength(Points, 4);
Points[0] := R.TopLeft;
Points[1] := RandomPoint(R);
Points[2] := RandomPoint(R);
Points[3] := R.BottomRight;
PaintBox.Canvas.Polyline(Points);
end;
2: // Ellipse
PaintBox.Canvas.Ellipse(R);
3: // Rectangle
begin
PaintBox.Canvas.FillRect(R);
PaintBox.Canvas.Rectangle(R);
end;
4: // Triangle
begin
SetLength(Points, 4);
Points[0] := Point(R.Left, R.Bottom);
Points[3] := Points[0];
Points[1] := Point((R.Left + R.Right) div 2, R.Top);
Points[2] := R.BottomRight;
PaintBox.Canvas.Polygon(Points);
end;
5: // Text
begin
txt := 'Text';
SetLength(Points, 1);
Points[0].X := (R.Left + R.Right - Paintbox.Canvas.TextWidth(txt)) div 2;
Points[0].Y := (R.Top + R.Bottom - Paintbox.Canvas.TextHeight(txt)) div 2;
SetBkMode(Paintbox.Canvas.Handle, BK_MODE[cbOpaque.Checked]);
Paintbox.Canvas.Font.Color := FontColorBox.Selected;
Paintbox.Canvas.TextOut(Points[0].X, Points[0].Y, txt);
end;
end;
end;
var
i, j: integer;
ColWidth, RowHeight: Integer;
Dashes: Graphics.TPenPattern = (3, 7, 8, 6);
R: TRect;
begin
// Draw background
Paintbox.Canvas.Pen.Style := psSolid;
Paintbox.Canvas.GradientFill(Rect(0, 0, Paintbox.Width, Paintbox.Height), clSkyBlue, clWhite, gdVertical);
if not (Paintbox.Canvas.Brush.Style in [bsPattern, bsImage]) then
begin
SetBkMode(Paintbox.Canvas.Handle, BK_MODE[cbOpaque.Checked]);
SetBkColor(Paintbox.Canvas.Handle, BgColorBox.Selected);
end;
// Set pen parameters
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.Cosmetic := cbCosmetic.Checked;
PaintBox.Canvas.Pen.EndCap := TPenEndCap(CapsCombo.ItemIndex);
PaintBox.Canvas.Pen.JoinStyle := TPenJoinStyle(JoinCombo.ItemIndex);
if PaintBox.Canvas.Pen.Style = psPattern then
PaintBox.Canvas.Pen.SetPattern(Dashes);
// Must be called before setting Brush.Bitmap since that will reset Style to bsSolid
PaintBox.Canvas.Brush.Color := BrushColorBox.Selected;
if BrushStyleCombo.ItemIndex <> -1 then
PaintBox.Canvas.Brush.Style := TBrushStyle(BrushStyleCombo.ItemIndex);
if PaintBox.Canvas.Brush.Style in [bsPattern, bsImage] then
begin
if Paintbox.Canvas.Brush.Style = bsPattern then
PaintBox.Canvas.Brush.Bitmap := FPattern
else
Paintbox.Canvas.Brush.Bitmap := FImage;
SetBkColor(Paintbox.Canvas.Handle, BgColorBox.Selected);
Paintbox.Canvas.Font.Color := BrushColorBox.Selected;
end
else begin
PaintBox.Canvas.Brush.Bitmap := nil;
end;
SetBkMode(Paintbox.Canvas.Handle, BK_MODE[cbOpaque.Checked]);
if cbOpaque.Checked then
begin
SetBkColor(Paintbox.Canvas.Handle, BgColorBox.Selected);
Paintbox.Canvas.Font.Color := FontColorBox.Selected; // Any color is sufficient for transparent Brush background here.
end;
ColWidth := PaintBox.Width div 3;
RowHeight := PaintBox.Height div 2;
for i := 0 to 2 do
for j := 0 to 2 do
begin
R := Rect(i * ColWidth, j * RowHeight, (i + 1) * ColWidth, (j + 1) * RowHeight);
DrawFigure(R);
end;
end;
procedure TForm1.PenChange(Sender: TObject);
begin
PaintBox.Invalidate;
end;
procedure TForm1.BrushStyleInfoBtnClick(Sender: TObject);
const
INFO = 'The background of non-solid brushes can be filled by activating ' +
'opaque text background. The background color is defined by the ' +
'text background color. ' +
LineEnding + LineEnding +
'On Windows, the foreground and background colors of user-defined '+
'patterns can be changed if the pattern bitmap is monochrome. The '+
'foreground color is defined by the Brush.Color, the background color '+
'by the text background color (SetBkColor).' +
LineEnding + LineEnding +
'The user-defined brush styles, bsImage and bsPicture, work in the same '+
'way. A bitmap must be assigned to the Brush.Bitmap property. '+
'A standard 24- or 32-bpp bitmap is rendered in color while a monochrome '+
'bitmap is rendered such that white is replaced by the '+
'text foreground color (Canvas.Font.Color), and black is replaced by '+
'the text background color (SetBkColor). Note that this color '+
'replacement is working only on Windows, and that user-defined brushes ' +
'cannot be rendered transparently (unless the bitmap has 32 bpp on Linux).';
begin
MessageDlg(INFO, mtInformation, [mbOK], 0);
end;
procedure TForm1.PenStyleInfoBtnClick(Sender: TObject);
const
INFO = 'The gaps of dashed/dotted pen styles can be filled by activating '+
'opaque text background. ' +
'The gaps are filled by the text background color.' +
'This does not work for user-defined patterns, though.' +
'On Windows, this requires a "cosmetic" pen of line width 1.' +
LineEnding + LineEnding +
'A user-defined pattern is defined by an integer array assigned to the ' +
'Pen.Pattern property. The 1st, 3rd, 5th etc array elements define the '+
'lengths of the strokes, the 2nd, 4th, 6th etc elements the lengths of '+
'the spacings between the strokes.';
begin
MessageDlg(INFO, mtInformation, [mbOK], 0);
end;
end.