Rysowanie figur w "czasie rzeczywistym".

0

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ColorDialog1: TColorDialog;
    ComboBox1: TComboBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  kolor:tcolor;
  grubosc,xg,yg:integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
image1.Picture.LoadFromFile(opendialog1.FileName);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
colordialog1.Execute;
kolor:=colordialog1.Color;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
savedialog1.Execute;
image1.Picture.SaveToFile(savedialog1.FileName);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
grubosc:=strtoint(combobox1.Items[combobox1.itemindex]);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
xg:=x;
yg:=y;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if ssleft in shift then
begin
  image1.canvas.MoveTo(xg,yg);
  image1.canvas.pen.Width:=grubosc;
  image1.canvas.Pen.Color:=kolor;
  image1.canvas.LineTo(x,y);
  xg:=x;
  yg:=y;
end;
end;

end.

problem polega na tym ze nie mam pojecia jak zrobic rysowanie figur tak aby kliknac myszka przeciagnac upuscic...
prosze o pomoc i z gory dziekuje

0

Canvas.Draw?

0

dokladnie chodzi mi o to aby zrobic buttona lub speed buttona i przypisac do niego procedure ze jesli jest wcisniety to dalo sie rysowac np. kwadrat w stylu kliknij przeciagnij upusc

0

Najprościej:

Zapisywać listę figur do jakieś tablicy
Wyświetlać w PaintBox'ie

Inny wariant:

Rysować na dwóch bitmapach, na jednej to co dotychczas narysowano, na drugiej kopia pierwszej plus "aktualne pociągnięcie"
Wyświetlać w PaintBox'ie lub przez image1.Graphics.Assign(Bitmap2);

0

Chyba nie do konca sie rozumiemy mam na mysli zrobienie czegos takiego jak ma windowsowski paint ze klikamy na buttona i na timage mozemy rysowac kwadrat o dowolnych rozmiarach przeciagajac myszka

0

Skoro masz współrzędne punktu wciśnięcia myszy (xg,yg), potrzebujesz też współrzędne zwolnienia przycisku myszy (tu musisz uzyć zdarzenia OnMouseUp) i zamiast użyć LineTo(x, y), użyj metody FrameRect (malowanie prostokąta) lub np. metody Ellipse (malowanie okręgu bądź elipsy). Wystarczy odpowiednio podstawić współrzędne.

0

Zrób sobie panel z przyciskami wykorzystując kontrolkę TToolBar, połuż na nim tyle przycisków, ile masz różnych opcji; Przyciski z klasy TToolButton mają właściwość Down - w ten sposób będziesz miał dokładnie to samo, co jest w MS Paint; Po wciśnięciu jednego przycisku ustaw Down na True a poprzednio wciśniętego na False i włącz obsługę rysowania kwadratu.

0

kod wyglada teraz tak program dziala prawie ze dobrze zostaly tylko te powtorzenia przy figurach jak ktos moglby poprawic bylbym wdzieczny

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ColorDialog1: TColorDialog;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Button4: TButton;
    Button5: TButton;
    GroupBox1: TGroupBox;
    Image1: TImage;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  kolor:tcolor;
  grubosc,xg,yg,a,b:integer;
implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
image1.Picture.LoadFromFile(opendialog1.FileName);
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
colordialog1.Execute;
kolor:=colordialog1.Color;
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
image1.Canvas.Pen.color:=clWhite;
end;

procedure TForm2.Button5Click(Sender: TObject);
begin
Image1.Picture:=nil;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
savedialog1.Execute;
image1.Picture.SaveToFile(savedialog1.FileName);
end;



procedure TForm2.ComboBox1Change(Sender: TObject);
begin
grubosc:=strtoint(combobox1.Items[combobox1.itemindex]);
end;



procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
xg:=x;
yg:=y;

end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if ssleft in shift then
begin
      if radiobutton1.checked then
      begin
  image1.canvas.MoveTo(x,y);
  image1.canvas.pen.Width:=grubosc;
  image1.canvas.Pen.Color:=kolor;
  image1.canvas.ellipse(xg,yg,x,y);


      end
      else if radiobutton2.Checked then
      begin
  image1.canvas.MoveTo(xg,yg);
  image1.canvas.pen.Width:=grubosc;
  image1.canvas.Pen.Color:=kolor;
  image1.canvas.lineto(x,y);
  xg:=x;
  yg:=y;


      end;


end;

end;
end.

1

W związku z tym, że ktoś mundry usunął post z obrazkiem - dołączam go z powrotem:

Odpowiadając na ten problem - podczas przesuwania kursora myszy czyść kanwę i rysuj nową figurę - unikniesz nakładania kolejnych figur na siebie.

2

Tu masz prosty przykładzik:

Var
 x1,y1:integer;
 DoDraw: Boolean;
 BMP: TBitmap;


procedure TForm1.FormCreate(Sender: TObject);
begin
  BMP:=TBitmap.Create;  //stworzenie bitmapy pomocniczej
  BMP.Width:=Image1.Width;
  BMP.Height:=Image1.Height;
  BMP.PixelFormat:=pf24bit;
  Image1.Canvas.Draw(0, 0, BMP); //"inicjalizacja" tła Image'a
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  x1:=x;
  y1:=y;
  DoDraw:=true; //rozpoczęcie malowania
  Image1.Canvas.Draw(0, 0, BMP); //namalowanie bitmapy (zawierającej dotychczasowe bazgroły) na Image'u
end;


procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 Var
  r: TRect;
begin
  If DoDraw then //jeśli ma być malowanie
  Begin
    Image1.Canvas.Draw(0, 0, BMP); //najpierw odmalowanie bitmapy (zawierającej dotychczasowe bazgroły) na Image'u

    //malowanie nowych bazgroł
    Image1.Canvas.Brush.Color:=clWhite;
    Image1.canvas.Pen.Width:=1;
    Image1.canvas.Pen.Color:=clRed;

    r.Left:=x1;
    r.Top:=y1;
    r.Right:=x;
    r.Bottom:=y;
    Image1.Canvas.Brush.Color:=clWhite;
    Image1.canvas.Ellipse(x1,y1,x, y); //malowanie elipsy/okręgu

    Image1.Canvas.Brush.Color:=clBlue;
    Image1.canvas.FrameRect(r); //malowanie prostokąta/kwadratu
    Image1.canvas.MoveTo(x1,y1);
    Image1.canvas.LineTo(x,y); //malowanie linii
  End;
end;


procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DoDraw:=false; //zakończenie malowania
  BMP.Canvas.Draw(0, 0, Image1.Picture.Graphic); //zachowanie nowej treści Image'a w bitmapie pomocniczej
end;

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

0

kod poprawiony na podstawie kodu od marogo niestety program zachowuje sie tak jak by nie czytal MouseUp nie wiem co dalej z tym zrobic

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ColorDialog1: TColorDialog;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Button4: TButton;
    Button5: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1Change(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 FormDestroy(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  kolor:tcolor;
  grubosc,xg,yg:integer;
   DoDraw: Boolean;
 BMP: TBitmap;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
image1.Picture.LoadFromFile(opendialog1.FileName);
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
colordialog1.Execute;
kolor:=colordialog1.Color;
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
image1.Canvas.Pen.color:=clWhite;
end;

procedure TForm2.Button5Click(Sender: TObject);
begin
Image1.Picture:=nil;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
savedialog1.Execute;
image1.Picture.SaveToFile(savedialog1.FileName);
end;



procedure TForm2.ComboBox1Change(Sender: TObject);
begin
grubosc:=strtoint(combobox1.Items[combobox1.itemindex]);
end;



procedure TForm2.FormCreate(Sender: TObject);
begin
BMP:=TBitmap.Create;  //stworzenie bitmapy pomocniczej
  BMP.Width:=Image1.Width;
  BMP.Height:=Image1.Height;
  BMP.PixelFormat:=pf24bit;
  Image1.Canvas.Draw(0, 0, BMP); //"inicjalizacja" tła Image'a
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
 TShiftState; X, Y: Integer);
begin
  xg:=x;
  yg:=y;
  DoDraw:=true; //rozpoczęcie malowania
   image1.canvas.draw(0, 0, BMP);//namalowanie bitmapy (zawierającej dotychczasowe bazgroły) na Image'u
end;



procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Var
  r: TRect;
begin
  If DoDraw then //jeśli ma być malowanie
  Begin
    Image1.Canvas.Draw(0, 0, BMP); //najpierw odmalowanie bitmapy (zawierającej dotychczasowe bazgroły) na Image'u


    //malowanie nowych bazgroł
    Image1.Canvas.Brush.Color:=clWhite;
    Image1.canvas.Pen.Width:=1;
    Image1.canvas.Pen.Color:=kolor;

    r.Left:=xg;
    r.Top:=yg;
    r.Right:=x;
    r.Bottom:=y;
               
    Image1.Canvas.Brush.Color:=clWhite;
    Image1.canvas.Ellipse(xg,yg,x, y); //malowanie elipsy/okręgu
    Image1.canvas.rectangle(xg,yg,x,y); //malowanie prostokąta/kwadratu
    Image1.canvas.MoveTo(xg,yg);
    Image1.canvas.LineTo(x,y); //malowanie linii
  end;
end;
  procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift:
   TShiftState; X , Y: Integer);
begin
  DoDraw:=false; //zakończenie malowania
  
  BMP.Canvas.Draw(0, 0, Image1.Picture.Graphic); //zachowanie nowej treści Image'a w bitmapie pomocniczej
end;

 
procedure TForm2.FormDestroy(Sender: TObject);
begin
  BMP.Free;
end;
end.

0

Spróbuj wcisnąć anuluj, gdy wyskoczy okienko.

Można to naprawić przez zmianę

OpenDialog1.Execute;
Image1.LoadFromFile(OpenDialog1.FileName);

na

if OpenDialog1.Execute then
  Image1.LoadFromFile(OpenDialog1.FileName);

Rysowanie figur w "czasie rzeczywistym".

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami