Модераторы: Snowy, Alexeis, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Графический редактор типа Paint'a 
:(
    Опции темы
furious
  Дата 28.10.2009, 22:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
Вобщем есть задача сделать граф. редактор, типа паинта, пока получилось только так:
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ExtDlgs, StdCtrls, Buttons, Spin, ColorGrd;

type
  TForm1 = class(TForm)

    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ColorDialog1: TColorDialog;
    PrintDialog1: TPrintDialog;
    N10: TMenuItem;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    N11: TMenuItem;
    f1: TMenuItem;
    SpinEdit1: TSpinEdit;
    N4: TMenuItem;
    N12: TMenuItem;
    ColorGrid1: TColorGrid;
    SpeedButton5: TSpeedButton;
    ControlBar1: TControlBar;
    procedure  PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
    Shift:TShiftState; x,y:Integer);
    procedure  PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
    procedure N9Click(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure f1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure ColorGrid1Change(Sender: TObject);







  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  Form1: TForm1;
  drag:boolean;
  Start: TPoint;
  a:integer;

implementation

{$R *.dfm}



procedure  TForm1.PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin

drag:=false;
end;

procedure TForm1.PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin
Start.X:=X;
Start.Y:=Y;
drag:=true;

end;



procedure TForm1.N9Click(Sender: TObject);
begin
Form1.Close;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer );
begin
 

 if speedbutton1.Down then
 begin
   if drag=true then
   begin
      
      paintbox1.Canvas.Pen.Width:=1;
      paintbox1.Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     paintbox1.Canvas.MoveTo(x,y);
   end;
  end;

  if speedbutton2.Down then
  begin
    if drag=true then
       begin
       a:=spinedit1.Value;
       paintbox1.Canvas.Pen.Width:=a;

       PaintBox1.Canvas.Rectangle(x,y,x+n,y+n);

       end;
    end;
   if speedbutton3.Down then
   begin
     if drag=true then
      begin
      a:=spinedit1.Value;
      paintbox1.Canvas.Pen.Width:=a;
      paintbox1.Canvas.Ellipse(start.X,start.Y,x,y);

      end;
   end;
   if speedbutton4.Down then
   begin
     if drag=true then
   begin
      a:=spinedit1.Value;
      paintbox1.Canvas.Pen.Width:=a;
      paintbox1.Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     paintbox1.Canvas.MoveTo(x,y);
   end;
   end;
   if speedbutton5.Down then
    begin
     if drag=true then
      begin
      paintbox1.Canvas.MoveTo(start.X,start.Y);
      paintbox1.Canvas.LineTo(x,y);
      end;

    end;
end;




procedure TForm1.N10Click(Sender: TObject);
begin
paintbox1.Canvas.Pen.Width:=0;
paintbox1.Repaint;
paintbox1.Canvas.Rectangle(0,0,width,height);
end;



procedure TForm1.N11Click(Sender: TObject);
begin
panel1.Visible:=false;
  if panel1.Visible=false then

  begin
   n11.Checked:=false;
   end
   else
   begin
   n11.Checked:=true;
   end ;
  if panel1.Visible=false then

end;

procedure TForm1.f1Click(Sender: TObject);
begin
 panel1.Visible:=false or true
end;



procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
if spinedit1.Value<0 then
 begin
 spinedit1.Value:=0;
 MessageDlg('Are you noob?',mtConfirmation,[mbYes],0);
 end;
if speedbutton1.Down=true then
 begin
 spinedit1.Value:=1;
 end;

end;



procedure TForm1.N12Click(Sender: TObject);
begin
colordialog1.Execute;
paintbox1.Canvas.Pen.Color:=colordialog1.Color;
end;



procedure TForm1.ColorGrid1Change(Sender: TObject);
begin
paintbox1.Canvas.pen.Color:=ColorGrid1.ForeGroundColor;
colordialog1.Color:=ColorGrid1.ForeGroundColor;;
end;



end.

Вопрос: как сделать чтоб фигуры рисовались нормально?
PM MAIL   Вверх
Alexeis
Дата 28.10.2009, 23:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Что значит нормально?


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 28.10.2009, 23:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
ну там типа следы остаются после увеличения/уменьшения фигуры


дописал вот так

      paintbox1.refresh;
      a:=spinedit1.Value;
      paintbox1.Canvas.Pen.Width:=a;
      paintbox1.Canvas.Ellipse(start.X,start.Y,x,y);

ток потом если нарисовать еще  один круг, то предыдущий стирается

я в панике  smile 

Это сообщение отредактировал(а) furious - 28.10.2009, 23:37

Присоединённый файл ( Кол-во скачиваний: 22 )
Присоединённый файл  delphi.JPG 66,01 Kb
PM MAIL   Вверх
Alexeis
Дата 28.10.2009, 23:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
  Так нужно стирать все и рисовать заново при каждом изменении.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 28.10.2009, 23:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
дописал вот так

      paintbox1.refresh;
      a:=spinedit1.Value;
      paintbox1.Canvas.Pen.Width:=a;
      paintbox1.Canvas.Ellipse(start.X,start.Y,x,y);

только потом если нарисовать еще  один круг, то предыдущий стирается
PM MAIL   Вверх
Alexeis
Дата 28.10.2009, 23:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(furious @  28.10.2009,  22:38 Найти цитируемый пост)
только потом если нарисовать еще  один круг, то предыдущий стирается 

  Правильно, потому что предыдущее изображение нужно хранить и восстанавливать. Либо векторно, как набор примитивов, либо как картинку, т.е. битмап.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 28.10.2009, 23:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
а можно это в виде кода, потому что я мало что понял - нубас (
PM MAIL   Вверх
Alexeis
Дата 28.10.2009, 23:49 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Класс TBitmap умеет хранить картинку. Каждый новый кадр, рисуется так. Сначала на канву рисуется содержимое TBitmap затем новый примитив. Когда примитив закончили рисовать, его повторно рисуют, но уже на битмап, так чтобы в следующий раз его можно было восстановить нарисовав битмап на канве.
  
Цитата(furious @  28.10.2009,  22:43 Найти цитируемый пост)
а можно это в виде кода

Спать хоцца  smile . Время позднее.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 28.10.2009, 23:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
ну напишите плиз когда сможете, я то попробуй, но не думаю что что-то из этого выйдет
PM MAIL   Вверх
Alexeis
Дата 29.10.2009, 11:19 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    PaintBox1: TPaintBox;
    SpeedButton5: TSpeedButton;
    SpinEdit1: TSpinEdit;
    procedure  PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
    Shift:TShiftState; x,y:Integer);
    procedure  PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure DrawImg(Canvas : TCanvas; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  //  procedure ERACEBKG(msg : ) message WM_ERASEBKG;
  private
    { Private declarations }
  public
    { Public declarations }
    BackImage : TBitmap;
  end;

var
  Form1 : TForm1;
  drag  : boolean;
  Start : TPoint;
  a     : integer;

implementation

{$R *.dfm}

procedure  TForm1.PaintBox1MouseUp(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin
  DrawImg(BackImage.Canvas, x, y);
  PaintBox1.Canvas.Draw(0, 0, BackImage);
  drag := false;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, BackImage);
end;

procedure TForm1.DrawImg(Canvas: TCanvas; X, Y: Integer);
begin
 PaintBox1.Canvas.Brush.Color := clWhite;
 if speedbutton1.Down then
 begin
   if drag=true then
   begin
      Canvas.Pen.Width:=1;
      Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     Canvas.MoveTo(x,y);
   end;
  end;
  if speedbutton2.Down then
  begin
    if drag=true then
       begin
         a:=spinedit1.Value;
         Canvas.Pen.Width:=a;
   //    PaintBox1.Canvas.Rectangle(x,y,x+n,y+n);
       end;
    end;
   if speedbutton3.Down then
   begin
     if drag=true then
      begin
        a:=spinedit1.Value;
        Canvas.Pen.Width := a;
        Canvas.Ellipse(start.X, start.Y, x,y);
      end;
   end;
   if speedbutton4.Down then
   begin
     if drag=true then
   begin
      a:=spinedit1.Value;
      Canvas.Pen.Width:=a;
      Canvas.LineTo(x,y);
   end;
   if drag=false then
   begin
     paintbox1.Canvas.MoveTo(x,y);
   end;
   end;
   if speedbutton5.Down then
    begin
     if drag=true then
      begin
        Canvas.MoveTo(start.X,start.Y);
        Canvas.LineTo(x,y);
      end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BackImage := TBitmap.Create;
end;

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

procedure TForm1.FormResize(Sender: TObject);
var
  tmp : TBitmap;
begin
  tmp := TBitmap.Create;
  tmp.SetSize(ClientWidth, ClientHeight);
  tmp.Canvas.Draw(0, 0, BackImage);

  BackImage.Free;
  BackImage := tmp;
end;

procedure TForm1.PaintBox1MouseDown(Sender:TObject; Button: TMouseButton;
Shift:TShiftState; x,y:Integer);
begin
  Start.X:=X;
  Start.Y:=Y;
  drag:=true;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer );
begin
   PaintBox1.Canvas.Draw(0, 0, BackImage);
   DrawImg(PaintBox1.Canvas, x, y);
end;


end.




--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 29.10.2009, 13:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
undeclared identifier: "SetSize"

Это сообщение отредактировал(а) furious - 29.10.2009, 13:18
PM MAIL   Вверх
Alexeis
Дата 29.10.2009, 13:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Думаю невелика проблема поправить smile .

Добавлено через 35 секунд
  Этого метода нет в старых версиях Delphi 7 и ниже...


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 29.10.2009, 13:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
а как поправит-то?

delphi 7
как версия хз
можно как-нибудь без этого? и за что setsize отвечает ?

Это сообщение отредактировал(а) furious - 29.10.2009, 13:36
PM MAIL   Вверх
Alexeis
Дата 29.10.2009, 13:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(furious @  29.10.2009,  12:34 Найти цитируемый пост)
можно как-нибудь без этого? и за что setsize отвечает ?

  Наверное она делает, что-то невероятно заумное и сложное, но никак не меняет ширину и высоту Битмапа. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
furious
Дата 29.10.2009, 14:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 28.10.2009

Репутация: нет
Всего: нет
 smile 
кароче как было так все и осталось  smile 
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0966 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.