PaintBox. Рисование

[antikhrist]

Да теперь всё отлично, и надеюсь финальная поправка и уточнение к задаче (сорри за сумбур и неточности), но прямоугольники эти должны размещаться как матрица то есть х х х х
х х х х
х х х х
и так далее %) и тогда один мышкой перетаскиваем, на его месте пустое место остаётся, а на другом появляется только один тот который удерживаем левой кнопкой мышки... и ещё как бы видеть границы этого поля где прорисовываются прямоугольники, то есть эти PaintBox имеют границы и их видно на форме, ну и если больше не влазят эти прямоугольники типа сообщение выдать %) типа - "переполнено"
ЗЫ - mflat, у тебя есть аська, может в там пообщаемся - всё же проще %)

[mflat]

unit ModuleAmeba;

interface

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

type
  TForm1 = class(TForm)
    pb1: TPaintBox;
    pb2: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure pb1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pb1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;

var
  Form1: TForm1;
  x1, y1, x2, y2: integer;
  buf: TBitmap;
  clicked: boolean;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
pb1.Enabled := true;
 with pb1.Canvas do
  begin
    MoveTo(0,0);
    LineTo(200, 0);
    MoveTo(0, 200);
    LineTo(0, 0);
  end;
  with pb2.Canvas do
  begin
    MoveTo(0,0);
    LineTo(200, 0);
    MoveTo(0, 200);
    LineTo(0, 0);
  end;
  pb1.Canvas.Rectangle(x1, y1, x2, y2);
  Dec(x1); Dec(x2); Dec(y1); Dec(y2);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  x1 := 100;
  x2 := 200;
  y1 := 100;
  y2 := 200;
  pb1.Canvas.Brush.Style := bsClear;
  buf := TBitmap.Create;
  buf.Width := 200;
  buf.Height := 200;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  pb2.Canvas.CopyRect(pb2.ClientRect, pb1.Canvas, pb1.ClientRect);
  pb1.Canvas.FillRect(Rect(0,0,200, 200));
end;

procedure TForm1.pb1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  clicked := true;
end;

procedure TForm1.pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Clicked = false then exit;
  if X > pb1.Width - 5 then
   begin
    Button2Click(Self);
    Clicked := false;
    pb1.Enabled := false;
  end;
end;

procedure TForm1.pb1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  clicked := false;
end;

end.

Это в дополнение к старой задачи. А новую насчёт матрицы, попробую решить. Можно без PaintBox?

[mflat]

unit ModuleAmeba;

interface

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

type
  TForm1 = class(TForm)
    pb1: TPaintBox;
    pb2: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure pb1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pb1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;

var
  Form1: TForm1;
  x1, y1, x2, y2: integer;
  buf: TBitmap;
  clicked: boolean;
  x,y: integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j: byte;
begin
pb1.Enabled := true;
 with pb1.Canvas do
  begin
    MoveTo(0,0);
    LineTo(200, 0);
    MoveTo(0, 200);
    LineTo(0, 0);
  end;
  with pb2.Canvas do
  begin
    MoveTo(0,0);
    LineTo(200, 0);
    MoveTo(0, 200);
    LineTo(0, 0);
  end;
 for i := 0 to 3 do
  for j := 0 to 3 do
   pb1.Canvas.Rectangle(i * 50, j * 50, i * 50 + 50, j * 50 + 50);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  x := 0;
  y := 0;
  x1 := 100;
  x2 := 200;
  y1 := 100;
  y2 := 200;
  pb1.Canvas.Brush.Style := bsClear;
  buf := TBitmap.Create;
  buf.Width := 200;
  buf.Height := 200;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  pb1.Canvas.FillRect(Rect(x * 50,y * 50,x * 50 +50, y*50+50));
  pb2.Canvas.Rectangle(x * 50, y * 50, x * 50 + 50, y * 50 + 50);
  Inc(x);
  if x > 3 then begin x := 0; Inc(y) end;
end;

procedure TForm1.pb1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  clicked := true;
end;

procedure TForm1.pb1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Clicked = false then exit;
  if X > pb1.Width - 5 then
   begin
    Button2Click(Self);
    Clicked := false;
  end;
end;

procedure TForm1.pb1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  clicked := false;
end;

end.

Всё работает.Нажми на весы, пожалуйста. Спасибо.

[antikhrist]

Да, теперь всё отлично работает, тока внесу , надеюсь, финальные коррективы к задаче, прямоугольники должны размещаться как жэлементы матрицы - х х х х
х х х х
х х х х
и тогда мы удерживая левую кнопку мыши берём один прямоугольник и перетаскиваем на другую "область" , в первой прямоугольник пропадает , в другой области при отпускании мыши он появляется, и перетаскиваться они естественно по одному должны. Ну и ещё как бы должны быть границы у PaintBox'ов что б их и на форме было видно, и также ограниченное количество этих прямоугольников, так что б они чётко заполняли PaintBox , а если будут превышать количество то что б выдавалась сообщение типа "невозможно добавить", а када перетащили один, то уже можно было добавить, если 2 перетащили то 2 и можно добавить (это в том случае когда полностью заполнен PaintBox) ....
ЗЫ: mflat, у тебя есть аська, может в ней пообщаемся, так проще будет Заранее огромное спасибо

[Stilet]

Прощу прощения. я спутал BitBtn и BitBlt

[antikhrist]

Что то у меня задублировались сообщения последние, но последний код тоже так и не перетаскивает мышью(((( и рисоваться прямоугольники тоже должны по одному а не все сразу %)

[mflat]

unit ModuleNewAmeba;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;

var
  Form1: TForm1;
  buf1, buf2: TBitmap;
  m1, m2: array [0..3, 0..3] of 0..1;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  W = 200;
  H = 200;
var  
  i,j: byte;
begin
  buf1 := TBitmap.Create; buf2 := Tbitmap.Create;
  buf1.Width := W; buf1.Height := H;
  buf2.Width := W; buf2.Height := H;
  for i := 0 to 3 do
   for j := 0 to 3 do
   begin
    m1[i,j] := 1;
    m2[i,j] := 0;
   end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
 i,j: byte;
begin
buf1.Canvas.FillRect(Rect(0,0,200,200));
buf2.Canvas.FillRect(Rect(0,0,200,200));
 for i := 0 to 3 do
  for j := 0 to 3 do begin
   case m1[i,j] of
     1: buf1.Canvas.Rectangle(i * 50, j * 50, i * 50 + 50, j * 50 + 50);
   end;
   case m2[i,j] of
     1: buf2.Canvas.Rectangle(i * 50, j * 50, i * 50 + 50, j * 50 + 50);
   end; end;
  Canvas.Draw(0,0,buf1);
  Canvas.Draw(210, 0, buf2) 
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (x > buf1.Width) or (Y > buf1.Height) then exit;
  if m1[X div 50, Y div 50] = 0 then exit;
  m2[X div 50, Y div 50] := m1[X div 50, Y div 50];
  m1[X div 50, Y div 50] := 0;
  Repaint;
end;

end.

Вот решение... Короче, здесь нужно нажать на квадрат, и он переместиться. Ну?

[antikhrist]

Сорри уже разобрался чего там и как... Вот к последней версии кода , было б ещё не плохо добавить кнопку при нажатии которой будет рисоваться квадрат, только один шт., при нажатии второй раз кнопки добавиться ещё один и тд пока не заполниться область, и тут как бы или переместить их нужно или удалить (скажем у квадрата по правой кнопке будет меню - и там типа удалить) а по левой тока перетягивание . а по перемещению, так же если получиться что б можно было перемещать из одного в другой ну и при нажатии конечно левой кнопки ....
mflat, очень сильно надеюсь на твою помощь , на весы нажимал Может всё таки в аське поговорим %)

[mflat]

ICQ не использую. Если разобраться в коде, то ты всё можешь понять и переделать под себя. Насчёт перетаскивания. Мой метод неплохой. Попробую сегодня доделать твой проект.

unit ModuleNewAmeba;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;
  buf1, buf2: TBitmap;
  m1, m2: array [0..3, 0..3] of 0..1;
  ii,jj: byte;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
const
  W = 200;
  H = 200;
var
  i,j: byte;
begin
  buf1 := TBitmap.Create; buf2 := Tbitmap.Create;
  buf1.Width := W; buf1.Height := H;
  buf2.Width := W; buf2.Height := H;
  for i := 0 to 3 do
   for j := 0 to 3 do
   begin
    m1[i,j] := 0;
    m2[i,j] := 0;
   end;
 ii := 0; jj := 0;  
end;

procedure TForm1.FormPaint(Sender: TObject);
var
 i,j: byte;
begin
buf1.Canvas.FillRect(Rect(0,0,200,200));
buf2.Canvas.FillRect(Rect(0,0,200,200));
 for i := 0 to 3 do
  for j := 0 to 3 do begin
   case m1[i,j] of
     1: buf1.Canvas.Rectangle(i * 50, j * 50, i * 50 + 50, j * 50 + 50);
   end;
   case m2[i,j] of
     1: buf2.Canvas.Rectangle(i * 50, j * 50, i * 50 + 50, j * 50 + 50);
   end; end;
  Canvas.Draw(0,0,buf1);
  Canvas.Draw(210, 0, buf2) 
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (x > buf1.Width) or (Y > buf1.Height) then exit;
  if m1[X div 50, Y div 50] = 0 then exit;
  if Button = mbLeft then
  begin
    m2[X div 50, Y div 50] := m1[X div 50, Y div 50];
    m1[X div 50, Y div 50] := 0;
    ii := 0;
    jj := 0;
  end
  else
   if Button = mbRight then
      m1[X div 50, Y div 50] := 0;
  Repaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  m1[ii,jj] := 1;
  Repaint;
  Inc(ii); if ii = 4 then begin ii := 0; Inc(jj) end;
  if jj > 3 then jj := 0;
end;

end.

Вот новый код...ух

[antikhrist]

Ты уже близок к решению этой задачи, за что тебе опять же огромное спасибо, но всё же внесу и уточню задачу, не всё так просто ....
На форме должна быть кнопка, по нажатии которой появляется небольшой прямоугольник в определённой ограниченной области формы, с запросом присвоить ему уникальный номер, идентификатор(на нём что б отображались эти цифры к примеру "1","2","3" и тому подобное) (так же в откомпилированном виде это должно быть видно что границы места куда добавляються прямоугольники ограничены). Затем при нажатии снова на ту же кнопку появляеться рядом с первым ещё один прямоугольник, не пересекаясь с уже созданным и тд... прямоугольники размещаються как элементы матрицы то есть
х х х х
х х х х
х х х х
таким образом, затем мы берём и из одной области перетаскиваем мышкой, тока по левой кнопке в другую область, подобной первой, только один прямоугольник, тот которой удерживаем мышью, при чём с первой области он конечно же пропадает.
1-я обл 2-я обл
х х х х х
х х х х
х х х
х х х х

и так далее, на форме должно быть 4-ре области таких, тоесть схематически выше я показал, что взяв любой прямоугольник, он перетаскиваеться во вторую область и становиться там сначала так же со 2-й и 3-й
Так же области ограничены по количеству прямоугольников их может быть 15 в каждой области, тоесть одновременно всего 15 используються одновременно , если в 1-й области 10, то во 2-й уже тока 5. Или к примеру в первой 10, во 2-й - 2, в 3-й - 3... и тд, Добавляються только на первую область прямоугольники, и так же по правой кнопке было б меню в котором были пункты типа переместить в 2-ю, или 3-ю область, или просто удалить....
Надеюсь тут подробно описал задачу...
Заранее огромное спасибо!!!
Конечно немного требовательно, но это основа только, а дальше в проекте ещё будут доработки...
Было б очень неплохо в аськью общаться