Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.07.2014, 21:08   #1
elviss77
Пользователь
 
Регистрация: 22.06.2014
Сообщений: 22
По умолчанию рисовать на фото

помогите создать программу,которая позволит рисовать,писать на фото.вот код рисунка на компоненте image
Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    img1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure img1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  draw:Boolean;


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
draw:=False;
img1.Canvas.Rectangle(0,0,img1.Width,img1.Height);
end;

procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
draw:=True;
img1.Canvas.Pixels[x,y]:=clBlack;
img1.Canvas.MoveTo(x,y);
end;

procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
draw:=False;
end;

procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if draw then
img1.Canvas.LineTo(x,y);
end;

end.
рисовать получилось... как загрузить jpeg на поле где рисую?

Последний раз редактировалось Stilet; 06.07.2014 в 08:47.
elviss77 вне форума Ответить с цитированием
Старый 05.07.2014, 22:38   #2
doktor255
Заблокирован
 
Регистрация: 31.03.2011
Сообщений: 976
По умолчанию

Код:
Uses Jpeg;
Img1.Picture.LoadFromFile...
doktor255 вне форума Ответить с цитированием
Старый 06.07.2014, 00:39   #3
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,885
По умолчанию

Можно погуглить и найти такое, например
http://www.delphisources.ru/pages/so...aintbrush.html
phomm вне форума Ответить с цитированием
Старый 07.07.2014, 13:10   #4
elviss77
Пользователь
 
Регистрация: 22.06.2014
Сообщений: 22
По умолчанию

Цитата:
Сообщение от doktor255 Посмотреть сообщение
Код:
Uses Jpeg;
Img1.Picture.LoadFromFile...
спасибо!смог добиться,что бы рисовал на jpeg незадача с совмещением jpeg и image ны форме,получается фото не во всю форму.и сама фотография не вся,а левый верхний квадрат от фото
Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    img1: TImage;
    btn1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure img1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure img1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  draw:Boolean;
  jpg:TJPEGImage;
  bmp:TBitmap;


implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
draw:=False;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
bmp:= TBitMap.Create;
jpg:= TJpegImage.Create;
jpg.LoadFromFile('J:\Recoverd_jpg_file(7815).jpg');
bmp.Assign(jpg);
img1.Canvas.Draw(0, 0, bmp);
bmp.Destroy;
jpg.Destroy;
end;
procedure TForm1.img1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
draw:=True;
img1.Canvas.Pixels[x,y]:=clBlack;
img1.Canvas.MoveTo(x,y);
end;
procedure TForm1.img1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
draw:=False;
end;
procedure TForm1.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if draw then
img1.Canvas.LineTo(x,y);
end;
end.

Последний раз редактировалось Stilet; 07.07.2014 в 15:40.
elviss77 вне форума Ответить с цитированием
Старый 07.07.2014, 22:52   #5
doktor255
Заблокирован
 
Регистрация: 31.03.2011
Сообщений: 976
По умолчанию

Цитата:
Сообщение от elviss77 Посмотреть сообщение
получается фото не во всю форму.и сама фотография не вся,а левый верхний квадрат от фото
Код:
Img1.AutoSize := true
P.S. столько кода написал, а простых свойств не знаешь. Изучай свойства объекта, перед работой с ним, и проблем не будет.
doktor255 вне форума Ответить с цитированием
Старый 08.07.2014, 10:23   #6
elviss77
Пользователь
 
Регистрация: 22.06.2014
Сообщений: 22
По умолчанию

Цитата:
Сообщение от doktor255 Посмотреть сообщение
Код:
Img1.AutoSize := true
P.S. столько кода написал, а простых свойств не знаешь. Изучай свойства объекта, перед работой с ним, и проблем не будет.
пробовал я все эти махинации с autosize и в инспекторе объектов с stretch,align-безрезультатно
elviss77 вне форума Ответить с цитированием
Старый 08.07.2014, 23:00   #7
DIONISKA
Форумчанин
 
Регистрация: 07.11.2011
Сообщений: 163
По умолчанию

Цитата:
Сообщение от elviss77 Посмотреть сообщение
пробовал я все эти махинации с autosize и в инспекторе объектов с stretch,align-безрезультатно
попробуй махинации с stretchblt, в общем виде можно сделать так:
Код:
 uses 
...winapi.windows,jpeg;
...
var
 bmp:TBitmap;
 jpg:TJpegimage;
begin
  jpg:=tjpegimage.create;
  jpg.LoadFromFile('c:\1.jpg');
  bmp:=tbitmap.Create; 
  bmp.Width:=jpg.Width;
  bmp.Height:=jpg.Height; 
  bmp.Canvas.Draw(0,0,jpg);
  SetStretchBltMode(image1.Canvas.Handle,4);// сглаживание при ресайзе
  stretchblt(image1.Canvas.Handle,0,0,image1.Width,image1.Height,bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,SRCCOPY);  
  bmp.Free;
  jpg.Free;
end;
DIONISKA вне форума Ответить с цитированием
Старый 09.07.2014, 00:31   #8
doktor255
Заблокирован
 
Регистрация: 31.03.2011
Сообщений: 976
По умолчанию

Цитата:
Сообщение от elviss77 Посмотреть сообщение
пробовал я все эти махинации с autosize и в инспекторе объектов с stretch,align-безрезультатно
Это уже к экстрасенсам, ибо у простых смертных всё работает. Не я конечно могу поковырять код, но реально лень. Тем более когда юзеры вместо проблемных участков кода выкладывают целые простыни. Мол, вот всё что я накодил, разбирайтесь где тут ошибка.
doktor255 вне форума Ответить с цитированием
Старый 09.07.2014, 09:50   #9
Speeker
Форумчанин
 
Аватар для Speeker
 
Регистрация: 01.12.2006
Сообщений: 241
По умолчанию

А свойство proportional в True
Програмисты - единственные люди, которым платят за исправления их же ошибок
Speeker вне форума Ответить с цитированием
Старый 13.07.2014, 18:51   #10
elviss77
Пользователь
 
Регистрация: 22.06.2014
Сообщений: 22
По умолчанию

ну вроде с рисованием разобрался.Вот задачка-ластик.рисую на фотографии,сохраняю,все нормально,решил ластик сделать(стирать то что нарисовал),перекопал все уроки и форумы-вариант нашел задать кнопке"стирать" рисование белым цветом,но это не вариант на канве залитой белым цветом-это работает,а на изображениии япег это новый рисунок белого цвета.Как задать кнопке именно стирание нарисованных линий?
elviss77 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
А рисовать то не умею.. Saintpatrick38 Microsoft Office Excel 2 04.04.2013 17:23
Рисовать график grafgrial Мультимедиа в Delphi 1 19.10.2011 11:42
Рисовать попиксельно Ooops Софт 2 15.12.2009 10:00
Рисовать на видео Tmt Общие вопросы Delphi 5 07.02.2007 11:31