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

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

Вернуться   Форум программистов > Операционные системы > Софт
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 15.12.2009, 09:11   #1
Ooops
Пользователь
 
Регистрация: 08.12.2009
Сообщений: 12
По умолчанию Рисовать попиксельно

Народ скажите что мне надо добавить в мой скрипт что бы рисовалось по пиксельно , очень прошу помогите
Ooops вне форума Ответить с цитированием
Старый 15.12.2009, 09:11   #2
Ooops
Пользователь
 
Регистрация: 08.12.2009
Сообщений: 12
По умолчанию

Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    ColorBox1: TColorBox;
    ColorBox2: TColorBox;
    Label1: TLabel;
    Label2: TLabel;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure N5Click(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 N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TShape = (sPen, sRect, sEllipse, sPoly, sFill);
var
  Form1: TForm1;
  img, buffer: TBitmap;
  x0,y0: integer;
  nowdrawing: TShape;
  dwn: boolean;
  FileName : string;
  implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Img:=TBitmap.Create;
 buffer:=TBitmap.Create;
 img.Width:=Image1.ClientWidth;
 buffer.Width:=Image1.ClientWidth;
 img.Height:=Image1.ClientHeight;
 buffer.Height:=Image1.ClientHeight;
 nowdrawing:=sPen;
 dwn:=false;
end;

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

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then begin
 img.assign(buffer);
 x0:=x; y0:=y;
 if SpeedButton1.Down then
 begin
 nowdrawing:=sPen;
 img.canvas.MoveTo(x,y);
 end else
 if SpeedButton2.Down then
 nowdrawing:=sEllipse else
 if SpeedButton3.Down then
 nowdrawing:=sRect else
 if SpeedButton4.Down then
 nowdrawing:=sPoly else
 if SpeedButton5.Down then
 nowdrawing:=sFill;
 dwn:=true;
 img.Canvas.Pen.Color:=ColorBox1.Selected;
 img.Canvas.Brush.Color:=ColorBox2.Selected;

 if nowdrawing=sFill then
 begin
 img.Canvas.FloodFill(x0,y0,img.Canvas.Pixels[x,y],fsSurface);
 buffer.Assign(img);
 dwn:=false;
 end
 end else
 begin
 if (dwn)and(nowdrawing=sPoly) then begin
 x0:=x;
 y0:=y;
 buffer.Assign(img);
 end;
 end;

 Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if not dwn then exit;
 img.assign(buffer);
 case nowdrawing of
 sPen:begin
 img.Canvas.LineTo(x,y);
 buffer.Assign(img);
 end;
 sRect:begin
 img.Canvas.Rectangle(x0,y0,x,y);
 end;
 sEllipse:begin
 img.Canvas.Ellipse(x0,y0,x,y);
 end;
 sPoly:begin
 img.Canvas.MoveTo(x0,y0);
 img.Canvas.LineTo(x,y);
 end;
 sFill:begin
 //nothing.
 end;
 end;

 Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then dwn:=false;
 buffer.Assign(img);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  If OpenPictureDialog1.Execute then begin
  Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
 end;
procedure TForm1.N3Click(Sender: TObject);
begin
  SavePictureDialog1.Execute;
  Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.ico');
end;

end.

Последний раз редактировалось Stilet; 15.12.2009 в 09:59.
Ooops вне форума Ответить с цитированием
Старый 15.12.2009, 10:00   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Добавить??
Да тут нужно кучу всего писать. Функции рассчета координат точек линий, эллипсов...
Вот хотя бы img.Canvas.LineTo(x,y);
придется заменять на процедуру в цикле вычисляющую следующую точку отрезка и рисующуюю ее по формуле.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вывод картинки попиксельно SmilingBull Мультимедиа в Delphi 6 11.01.2011 02:01
Сравнение попиксельно зоны рабочего стола с указанным *.bmp Travolta Общие вопросы .NET 1 02.12.2008 13:01
Как из .BMP считать попиксельно OrdJONY Мультимедиа в Delphi 7 17.08.2008 15:46
Нужно решить и объяснить задачу "В режиме точечной графики попиксельно вывести фразу" Eyeless Фриланс 3 10.01.2008 10:56
Рисовать на видео Tmt Общие вопросы Delphi 5 07.02.2007 11:31