Hola
Dibujando encima de un TImage lineas rectas, tambien se pueden hacer otras figuras.
Código Delphi
[-]
unit Unit1;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus;
type
TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
public
BrushStyle: TBrushStyle;
PenStyle: TPenStyle;
PenWide: Integer;
Drawing: Boolean;
Origin, MovePt: TPoint;
DrawingTool: TDrawingTool;
CurrentFile: string;
procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
AnteriorBkMode: integer;
begin
Drawing := True;
Image1.Canvas.MoveTo(X, Y);
Origin := Point(X, Y);
MovePt := Origin;
with Image1.Canvas do begin
Brush.Color := clBlack;
AnteriorBkMode := SetBkMode(Handle, TRANSPARENT);
SetBkMode(Handle, AnteriorBkMode);
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Drawing then
begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
end;
procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
with Image1.Canvas do
begin
Pen.Mode := AMode;
case DrawingTool of
dtLine:
begin
Image1.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
Image1.Canvas.LineTo(BottomRight.X, BottomRight.Y);
end;
dtRectangle: Image1.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y);
dtEllipse: Image1.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y);
dtRoundRect: Image1.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
(TopLeft.Y - BottomRight.Y) div 2);
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Drawing then
begin
DrawShape(Origin, Point(X, Y), pmCopy);
Drawing := False;
end;
end;
end.
Saludos