unit StylesTestFrm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ExtCtrls,
System.Generics.Collections,
Vcl.Themes,
Vcl.ImgList;
type
TLineState = (Start, Move, Stop);
TPainter =
class
strict private
FIsLineStarted : Boolean;
FCanvas : TCanvas;
FImageIndex : Integer;
FImageList : TImageList;
FPoints : TList<TPoint>;
public
procedure Clear;
function PaintLine(LineState : TLineState; X, Y : Integer) : Boolean;
procedure Paint;
constructor Create(ACanvas : TCanvas; AImageList : TImageList);
destructor Destroy;
override;
property IsLineStarted : Boolean
read FIsLineStarted
write FIsLineStarted;
end;
TForm2 =
class(TForm)
PaintBox1 : TPaintBox;
ilSystem : TImageList;
ilStyle : TImageList;
procedure FormCreate(Sender : TObject);
procedure PaintBox1MouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
procedure PaintBox1MouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
procedure PaintBox1Paint(Sender : TObject);
procedure PaintBox1MouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
procedure FormDestroy(Sender: TObject);
private
FPainter : TPainter;
public
end;
var
Form2 : TForm2;
implementation
uses
System.Math;
{$R *.dfm}
procedure TForm2.FormCreate(Sender : TObject);
var
LCurrentImageList : TImageList;
begin
LCurrentImageList := ilStyle;
if StyleServices.IsSystemStyle
then
begin
LCurrentImageList := ilSystem;
end;
FPainter := TPainter.Create(PaintBox1.Canvas, LCurrentImageList);
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FPainter.Free;
end;
procedure TForm2.PaintBox1MouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
begin
case Button
of
TMouseButton.mbLeft :
begin
if FPainter.PaintLine(TLineState.Start, X, Y)
then
PaintBox1.Repaint;
end;
end;
end;
procedure TForm2.PaintBox1MouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
begin
if FPainter.PaintLine(TLineState.Move, X, Y)
then
PaintBox1.Repaint;
end;
procedure TForm2.PaintBox1MouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
begin
case Button
of
TMouseButton.mbLeft :
begin
if FPainter.PaintLine(TLineState.Stop, X, Y)
then
PaintBox1.Repaint;
end;
TMouseButton.mbRight :
begin
FPainter.Clear;
PaintBox1.Repaint;
end;
end;
end;
procedure TForm2.PaintBox1Paint(Sender : TObject);
begin
if Assigned(FPainter)
then
begin
FPainter.Paint;
end;
end;
procedure TPainter.Clear;
begin
FCanvas.FillRect(FCanvas.ClipRect);
FPoints.Clear;
FImageIndex := 0;
end;
constructor TPainter.Create(ACanvas : TCanvas; AImageList : TImageList);
begin
FCanvas := ACanvas;
FImageList := AImageList;
FPoints := TList<TPoint>.Create;
FCanvas.Pen.Width := 5;
FCanvas.Pen.Color := StyleServices.GetSystemColor(clHighlight);
FCanvas.Brush.Color := StyleServices.GetSystemColor(clBackground);
end;
destructor TPainter.Destroy;
begin
FPoints.Free;
inherited;
end;
procedure TPainter.Paint;
var
LPoints : TArray<TPoint>;
LLastPosition : TPoint;
begin
LPoints := FPoints.ToArray;
FCanvas.Polyline(LPoints);
if InRange(FImageIndex, 0, FImageList.Count - 1)
then
begin
Inc(FImageIndex)
end
else
begin
FImageIndex := 0;
end;
if FPoints.Count > 0
then
begin
LLastPosition := FPoints.Last;
FImageList.Draw(FCanvas, LLastPosition.X + 3, LLastPosition.Y + 3, FImageIndex);
end;
end;
function TPainter.PaintLine(LineState : TLineState; X, Y : Integer) : Boolean;
var
LPosition : TPoint;
begin
LPosition := TPoint.Create(X, Y);
case LineState
of
Start :
begin
FPoints.Add(LPosition);
IsLineStarted := True;
end;
Move :
begin
if IsLineStarted
then
begin
if LPosition <> FPoints.Last
then
begin
FPoints.Add(LPosition);
end;
end;
end;
Stop :
begin
if IsLineStarted
then
begin
FPoints.Clear;
IsLineStarted := False;
end;
end;
end;
Result := IsLineStarted;
end;
end.