【控件功能】我来做练习-第49课-Direct2D drawing example

文章目录

• • Direct2D drawing example
  • 核心源码

Direct2D drawing example

提示：这里可以添加技术概要

核心源码

TMyKind = (enCursor, enLine, enEllipse, enRectangle);
TMyState = (Nothing, Drawing, Selecting);

TMyShape = record
Kind: TMyKind;
Box: TD2D1RectF;
Width: Single;
Color: TColor;
end;

var
Form1: TForm1;
MyList: TList;
TempState: TMyState = Nothing;
TempKind: TMyKind = enCursor;
TempBox: TD2D1RectF;
TempShape: TMyShape;
IsMouseDown: Boolean = False;

implementation

{$R *.dfm}

procedure TForm1.AdjustPixels(var ARect: TD2D1RectF; AWidth: Single);
begin
if Odd(Round(AWidth)) then
ARect := D2D1RectF(ARect.Left - 0.5, ARect.Top - 0.5, ARect.Right - 0.5,
ARect.Bottom - 0.5)
end;

procedure TForm1.DrawEllipses(ARect: TD2D1RectF; AWidth: Single;
AColor: TColor);
begin
AdjustPixels(ARect, AWidth);
FBrush.SetColor(D2D1ColorF(AColor));
FCanvas.RenderTarget.DrawEllipse
(D2D1Ellipse(D2D1PointF(ARect.Left + (ARect.Right - ARect.Left) / 2,
ARect.Top + (ARect.Bottom - ARect.Top) / 2), (ARect.Right - ARect.Left) / 2,
(ARect.Bottom - ARect.Top) / 2), FBrush, AWidth);
end;

procedure TForm1.DrawGrid(ASize: TD2DSizeF; AStep: Single);
var
X, Y: Single;
begin
X := 0;
Y := 0;
FBrush.SetColor(D2D1ColorF(clSkyBlue));
while X < ASize.Width do
begin
FCanvas.RenderTarget.DrawLine(D2D1PointF(X + 0.5, 0 + 0.5),
D2D1PointF(X + 0.5, ASize.height + 0.5), FBrush, 1);
X := X + AStep;
end;

while Y < ASize.height do
begin
FCanvas.RenderTarget.DrawLine(D2D1PointF(0 + 0.5, Y + 0.5),
D2D1PointF(ASize.Width + 0.5, Y + 0.5), FBrush, 1);
Y := Y + AStep;
end;

end;

procedure TForm1.DrawRectanges(ARect: TD2D1RectF; AWidth: Single;
AColor: TColor);
begin
AdjustPixels(ARect, AWidth);
FBrush.SetColor(D2D1ColorF(AColor));
FCanvas.RenderTarget.DrawRectangle(ARect, FBrush, AWidth);
end;

procedure TForm1.DrawLines(ARect: TD2D1RectF; AWidth: Single; AColor: TColor);
begin
AdjustPixels(ARect, AWidth);
FBrush.SetColor(D2D1ColorF(AColor));
FCanvas.RenderTarget.DrawLine(D2D1PointF(ARect.Left, ARect.Top),
D2D1PointF(ARect.Right, ARect.Bottom), FBrush, AWidth);
end;

procedure TForm1.DrawObjects;
var
I: Integer;
TempSize: TD2DSizeF;
begin
if FShowGrid then
begin
FCanvas.RenderTarget.GetSize(TempSize);
DrawGrid(TempSize, 20);
end;
for I := 0 to MyList.Count - 1 do
begin
case MyList[I].Kind of
enLine:
DrawLines(MyList[I].Box, MyList[I].Width, MyList[I].Color);
enEllipse:
DrawEllipses(MyList[I].Box, MyList[I].Width, MyList[I].Color);
enRectangle:
DrawRectanges(MyList[I].Box, MyList[I].Width, MyList[I].Color);
end;
end;
end;

procedure TForm1.DrawTempObject;
begin
if (TempState = Drawing) and (IsMouseDown = True) then
begin
case TempKind of
enLine:
DrawLines(TempShape.Box, TempShape.Width, ColorBox1.Selected);
enEllipse:
DrawEllipses(TempShape.Box, TempShape.Width, TempShape.Color);
enRectangle:
DrawRectanges(TempShape.Box, TempShape.Width, ColorBox1.Selected);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MyList := TList.Create;
TempState := Nothing;
FAntiAlias := 0;
FShowGrid := True;
TempState := Drawing;
TempKind := enLine;
Cursor := crCross;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
MyList.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
PaintBox1.Repaint;
end;

procedure TForm1.LoadFromFile(AFileName: string);
var
AFile: TFileStream;
MyReader: TBinaryReader;
NoOfShapes, I: Integer;
begin
AFile := TFileStream.Create(AFileName, fmOpenRead);
MyReader := TBinaryReader.Create(AFile, TEncoding.Unicode, False);
try
MyList.Clear;
MyList.TrimExcess;
NoOfShapes := MyReader.ReadInteger;
for I := 0 to NoOfShapes - 1 do
begin
TempShape.Kind := TMyKind(MyReader.ReadSmallInt);
// coordinates
TempShape.Box.Left := MyReader.ReadSingle;
TempShape.Box.Top := MyReader.ReadSingle;
TempShape.Box.Right := MyReader.ReadSingle;
TempShape.Box.Bottom := MyReader.ReadSingle;
// Width
TempShape.Width := MyReader.ReadSingle;
// Color
TempShape.Color := MyReader.ReadInteger;
MyList.Add(TempShape);
end;
MyReader.Close;
finally
MyReader.Free;
AFile.Free;
end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown := True;
if TempState = Drawing then
begin
TempBox.Left := X;
TempBox.Top := Y;
end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (TempState = Drawing) and (IsMouseDown) then
begin
TempShape.Kind := TempKind;
TempShape.Box := D2D1RectF(TempBox.Left, TempBox.Top, X, Y);
TempShape.Width := UpDown1.Position;
TempShape.Color := ColorBox1.Selected;
end;
PaintBox1.Repaint;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown := False;
if TempState = Drawing then
begin
MyList.Add(TempShape);
PaintBox1.Repaint;
end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
if TDirect2DCanvas.Supported then
begin
FCanvas := TDirect2DCanvas.Create(PaintBox1.Canvas, PaintBox1.ClientRect);
try
FCanvas.BeginDraw;
FCanvas.RenderTarget.Clear(D2D1ColorF(clWhite));
FCanvas.RenderTarget.CreateSolidColorBrush(D2D1ColorF(clWhite),
nil, FBrush);
FCanvas.RenderTarget.SetAntialiasMode(FAntiAlias);
DrawObjects;
DrawTempObject;
finally
FCanvas.EndDraw;
FCanvas.Free;
end;
end
else
ShowMessage
(‘Direct 2D not supported. Are you running on Windows XP? Please run this example on Windows 7 or Windows 8.’);
end;

procedure TForm1.SaveToFile(AFileName: string);
var
AFile: TFileStream;
MyWriter: TBinaryWriter;
I: Integer;
TempSingle: Single;
begin
AFile := TFileStream.Create(AFileName, fmOpenWrite or fmCreate);
MyWriter := TBinaryWriter.Create(AFile, TEncoding.Unicode, False);
try
// Write the number of shapes
MyWriter.Write(MyList.Count);
for I := 0 to MyList.Count - 1 do
begin
// Write bounding box
MyWriter.Write(SmallInt(MyList[I].Kind));
TempSingle := MyList[I].Box.Left;
MyWriter.Write(TempSingle);
TempSingle := MyList[I].Box.Top;
MyWriter.Write(TempSingle);
TempSingle := MyList[I].Box.Right;
MyWriter.Write(TempSingle);
TempSingle := MyList[I].Box.Bottom;
MyWriter.Write(TempSingle);
// write width
TempSingle := MyList[I].Width;
MyWriter.Write(TempSingle);
// Write color
MyWriter.Write(Integer(MyList[I].Color));
end;
MyWriter.Close;
finally
MyWriter.Free;
AFile.Free;
end;
end;

procedure TForm1.ToolButton14Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to 49 do
begin
TempShape.Kind := TMyKind(Random(1 + Ord(High(TMyKind))));
TempShape.Box.Left := Random(PaintBox1.ClientWidth);
TempShape.Box.Top := Random(PaintBox1.ClientHeight);
TempShape.Box.Bottom := Random(PaintBox1.ClientHeight);
TempShape.Box.Right := Random(PaintBox1.ClientWidth);
TempShape.Width := Random(10);
TempShape.Color := TColor(Random(1 + Ord(High(TColor) - 1)));
MyList.Add(TempShape);
PaintBox1.Repaint;
end;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
TempState := Drawing;
TempKind := enLine;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
TempState := Drawing;
TempKind := enEllipse;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
MyList.Clear;
PaintBox1.Repaint;
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
SaveToFile(SaveDialog1.FileName);
PaintBox1.Repaint;
end;
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
LoadFromFile(OpenDialog1.FileName);
PaintBox1.Repaint;
end;
end;

procedure TForm1.ToolButton7Click(Sender: TObject);
begin
if FAntiAlias = 0 then
FAntiAlias := 1
else
FAntiAlias := 0;
PaintBox1.Repaint;
end;

procedure TForm1.ToolButton8Click(Sender: TObject);
begin
TempState := Drawing;
TempKind := enRectangle;
end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
FShowGrid := not FShowGrid;
PaintBox1.Repaint;
end;

procedure TForm1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;