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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 08.12.2011, 20:29   #1
Stev
 
Регистрация: 08.12.2011
Сообщений: 3
Восклицание Скриншот рисунка

Кто может сделать скриншот рисунка в делфи? Пожалуйста помогите!
Код:
unit ship_;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations } public
{ Public declarations } end;
var
Form1: TForm1;
x,y: integer; 
implementation
{$R *.DFM}
procedure Titanik(x,y: integer; color: TColor); const dx = 5; dy = 5;
var
buf: TColor;
begin
with form1.canvas do begin
buf:=pen.Color; 
pen.Color:=color;
MoveTo(x,y);
LineTo(x,y-2*dy) ;
LineTo (x+10*dx, y-2*dy) ;
LineTo (x+ll*dx, y-3*dy) ;
LineTo (x+17*dx,y-3*dy) ;
LineTo (x+14*dx, y) ;
LineTo (x,y) ;
MoveTo(x+3*dx,y-2*dy) ;
LineTo (x+4*dx, y-3*dy) ;
LineTo (x+4*dx, y-4*dy) ;
LineTo (x+13*dx,y-4*dy) ;
LineTo (x+13*dx, y-3*dy) ;
MoveTo(x+5*dx,y-3*dy) ;
LineTo (x+9*dx, y-3*dy) ;
Rectangle (x+8*dx, y-4*dy, x+ll*dx, y-5*dy)
Rectangle (x+7*dx, y-4*dy, x+8*dx, y-7*dy) ;
Ellipse (x+ll*dx,y-2*dy,x+12*dx,y-l*dy) ;
Ellipse (x+13*dx, y-2*dy, x+14*dx, y-l*dy) ;
MoveTo(.x+10*dx,y-5*dy) ; LineTo(x+10*dx,y-10*dy);
MoveTo(x+17*dx,y-3*dy);
LineTo(x+10*dx,y-10*dy);
LineTo(x,y-2*dy);
pen.Color:=buf; 
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Titanik(x,y,form1.color); 
if x < Form1.ClientWidth
then x := x+5
else begin // новый рейс x := 0;
у := Random(50) + 100;
end;
Titanik(x,у,clWhite); 
end;
procedure TForml.FormActivate(Sender: TObject);
begin
x:=0; y:=100;
Form1.Color:=clNavy;
Timerl.Interval := 50; 
end;
end.

Последний раз редактировалось rpy3uH; 08.12.2011 в 21:00.
Stev вне форума Ответить с цитированием
Старый 08.12.2011, 20:36   #2
Mad_Cat
Made In USSR!
Старожил
 
Аватар для Mad_Cat
 
Регистрация: 01.09.2010
Сообщений: 3,657
По умолчанию

тут exe файл есть
"...В жизни я встречал друзей и врагов.В жизни много всего перевидал.Солнце тело мое жгло, ветер волосы трепал,но я смысла жизни так и не узнал..."
(c) Юрий Клинских aka "Хой"
Mad_Cat вне форума Ответить с цитированием
Старый 08.12.2011, 21:34   #3
Stev
 
Регистрация: 08.12.2011
Сообщений: 3
По умолчанию

Цитата:
Сообщение от Mad_Cat Посмотреть сообщение
У меня просто Делфи не работает Можеш сделать скрин с етого кода?
unit ship_;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations } public
{ Public declarations } end;
var
Form1: TForm1;
x,y: integer;
implementation
{$R *.DFM}
procedure Titanik(x,y: integer; color: TColor); const dx = 5; dy = 5;
var
buf: TColor;
begin
with form1.canvas do begin
buf:=pen.Color;
pen.Color:=color;
MoveTo(x,y);
LineTo(x,y-2*dy) ;
LineTo (x+10*dx, y-2*dy) ;
LineTo (x+ll*dx, y-3*dy) ;
LineTo (x+17*dx,y-3*dy) ;
LineTo (x+14*dx, y) ;
LineTo (x,y) ;
MoveTo(x+3*dx,y-2*dy) ;
LineTo (x+4*dx, y-3*dy) ;
LineTo (x+4*dx, y-4*dy) ;
LineTo (x+13*dx,y-4*dy) ;
LineTo (x+13*dx, y-3*dy) ;
MoveTo(x+5*dx,y-3*dy) ;
LineTo (x+9*dx, y-3*dy) ;
Rectangle (x+8*dx, y-4*dy, x+ll*dx, y-5*dy)
Rectangle (x+7*dx, y-4*dy, x+8*dx, y-7*dy) ;
Ellipse (x+ll*dx,y-2*dy,x+12*dx,y-l*dy) ;
Ellipse (x+13*dx, y-2*dy, x+14*dx, y-l*dy) ;
MoveTo(.x+10*dx,y-5*dy) ; LineTo(x+10*dx,y-10*dy);
MoveTo(x+17*dx,y-3*dy);
LineTo(x+10*dx,y-10*dy);
LineTo(x,y-2*dy);
pen.Color:=buf;
end;
end;
Stev вне форума Ответить с цитированием
Старый 08.12.2011, 21:36   #4
Stev
 
Регистрация: 08.12.2011
Сообщений: 3
По умолчанию

Вот такое нужно http://www.realcoding.net/images/d7/Glava%2010/17.gif
Stev вне форума Ответить с цитированием
Старый 10.12.2011, 03:03   #5
Willer55
Пользователь
 
Регистрация: 17.08.2011
Сообщений: 35
По умолчанию

var
bitMap : TBitMap;
x,y : integer;
begin
bitMap := TBitMap.Create;
for x := 0 to Width do
for y := 0 to Height do
bitMAp.Canvas.Pixels[x,y] := Canvas.Pixels[x,y]; //переносим по пикселю
bitMap.SaveToFile('тут путь к файлу');//сохраняем в файл


Сохраняет только в *.bmp файл. Но можно спросить у гугла, как сохранить в *.jpg.

Последний раз редактировалось Willer55; 10.12.2011 в 03:05.
Willer55 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Скриншот в игре Marsik Общие вопросы Delphi 17 14.01.2014 03:03
Скриншот Andrey770 Паскаль, Turbo Pascal, PascalABC.NET 5 05.06.2011 17:47
Скриншот форм XeruH Общие вопросы Delphi 10 13.04.2011 23:47
Скриншот из word'а Kib Общие вопросы Delphi 4 16.08.2010 20:42
Скриншот ForzaJuve Win Api 13 05.10.2008 21:27