Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 07-10-2012
ConejitaKatrina ConejitaKatrina is offline
Registrado
NULL
 
Registrado: may 2011
Posts: 3
Poder: 0
ConejitaKatrina Va por buen camino
Dibujarr elipse

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
    { Private declarations }
  public
    { Public declarations }
  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
  //drawing:= False;
  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  //rectangle tool
  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; {remember this spot}
  holdingArea := Tbitmap.create;
  holdingArea.width := abs(x2-x1) + 2;
  holdingArea.height := abs(y2-y1) + 2;

  With R1 do
   begin
    {find left & right sides of rectangle to capture}
    if x1 < x2 then begin left := x1; right := x2+1 end
               else begin left := x2; right := x1+1 end;
    {find top & bottom of rectangle to capture}
    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

Última edición por Casimiro Notevi fecha: 07-10-2012 a las 23:19:25.
Responder Con Cita
  #2  
Antiguo 07-10-2012
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.043
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo?, gracias por tu colaboración

Recuerda poner los tags al código fuente, ejemplo:



Gracias
Responder Con Cita
  #3  
Antiguo 07-10-2012
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.043
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Por favor, no repitas hilos, gracias.

pd: he borrado el otro.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Dibujar Elipse y Parábola pixel a pixel Deiv Gráficos 9 28-11-2016 10:19:41
Ayuda con dibujo de elipse lol Gráficos 0 23-04-2008 05:08:46
pintar Elipse transparente franc28 Gráficos 4 04-05-2004 22:03:57
Botones de forma de elipse PTW Varios 6 19-04-2004 21:32:22


La franja horaria es GMT +2. Ahora son las 08:41:43.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi