Hola a todos, necesito ayuda en esto, quiero terminar este simple programa en delphi que su autor empezo y dejo a medias. Quiero que se pueda crear una elipse al igual que se hizo con el rectangulo. Se que puede ser una tonteria pero solo quiero terminarlo para ver como seria.
Por favor no me juzguen, no me gusta la programacion, solo trato de entenderla.
Código Delphi
[-]unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Buttons, ExtCtrls, StdCtrls;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
FileMenu: TMenuItem;
Exit1: TMenuItem;
Panel1: TPanel;
Pencil: TSpeedButton;
Image1: TImage;
SaveAs1: TMenuItem;
SaveDialog1: TSaveDialog;
Open1: TMenuItem;
OpenDialog1: TOpenDialog;
ColorDialog1: TColorDialog;
ColorBtn: TBitBtn;
Boxtool: TSpeedButton;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
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);
procedure SaveAs1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure ColorBtnClick(Sender: TObject);
procedure Capture(x1,y1,x,y: integer);
private
public
end;
var
MainForm: TMainForm;
drawing: Boolean;
filename: string;
x1,y1,x2,y2,toolinUse: integer;
holdingArea: Tbitmap;
holdingSomething : Boolean;
r1,r2: Trect;
implementation
{$R *.dfm}
procedure TMainForm.ColorBtnClick(Sender: TObject);
begin
ColorDialog1.Execute;
Image1.Canvas.Pen.Color:= ColorDialog1.Color;
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
MainForm.Close;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
holdingSomething := false;
end;
procedure TMainForm.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.MoveTo(x,y);
x1:= x;
y1:= y;
toolinUse:= 0;
if Pencil.Down then
toolinUse:=1;
if boxtool.Down then
begin
toolinUse:=2;
Image1.Canvas.Brush.Style:= bsclear;
end;
end;
procedure TMainForm.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if toolinUse= 1 then
with Image1.Canvas do lineto(x,y);
if toolinUse= 2 then begin
if holdingSomething then
begin
with Image1.Canvas do
copyrect(r1,holdingArea.Canvas,r2);
holdingArea.Free;
end;
capture(x1,y1,x,y);
Image1.Canvas.Rectangle(x1,y1,x2,y2);
end;
end;
procedure TMainForm.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if toolInUse = 2 then
begin
if holdingSomething then
begin
with image1.canvas do
copyrect(R1,holdingArea.canvas,R2);
holdingArea.free; holdingsomething := false;
end;
Image1.canvas.rectangle(x1,y1,x2,y2);
end;
toolInUse := 0;
end;
procedure TMainForm.Open1Click(Sender: TObject);
begin
OpenDialog1.DefaultExt:='BMP';
if OpenDialog1.Execute then
begin
OpenDialog1.Filter:='Bitmap(*.bmp)|*.BMP';
Image1.Picture.LoadFromFile(filename);
end;
end;
procedure TMainForm.SaveAs1Click(Sender: TObject);
begin
SaveDialog1.DefaultExt:='BMP';
if SaveDialog1.Execute then
begin
filename:= SaveDialog1.Filename;
Image1.Picture.SaveToFile(filename)
end;
end;
procedure TMainForm.Capture(x1,y1,x,y: integer);
begin
x2 := x; y2 := y;
holdingArea := Tbitmap.create;
holdingArea.width := abs(x2-x1) + 2;
holdingArea.height := abs(y2-y1) + 2;
With R1 do
begin
if x1 < x2 then begin left := x1; right := x2+1 end
else begin left := x2; right := x1+1 end;
if y1 < y2 then begin top:=y1-1; bottom := y2+1 end
else begin top := y2-1; bottom := y1+1 end;
end;
With R2 do
begin
left := 0; top := 0; right := R1.right-R1.left;
bottom := R1.bottom-R1.top
end;
With holdingArea.canvas do
copyrect(R2,Image1.canvas,R1);
holdingSomething := true;
end;
end.
No me dejan colocar enlaces pero la pagina del autor la pueden encontrar asi
Create your own Paint Program