Форум: "Прочее";
Текущий архив: 2007.02.04;
Скачать: [xml.tar.bz2];

Вниз

Забыл, как...   Найти похожие ветки 

← →
vasIzmax ©   (2007-01-16 02:44) [0]

Подскажите, как это реализовать: на форме я рисую сетку, на MouseDown навесил чтобы по щелчку заливался квадратик. не могу никак додуматься как сделать чтобы можно было, например, получившуюся конфигурацию, перемещать по форме не нарушая конструкции сетки.
ЗЫ. Если честно, задача была в прошлом семестре - щас вот наткнулся, решил до делать)))

---

← →
Gero ©   (2007-01-16 03:18) [1]

Ты написал какую-то несуразицу.

---

← →
vasIzmax ©   (2007-01-16 03:24) [2]

Ладно, может кто на коде поймет

unit Unit1;
interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
const
 MaxInd=5000;
 MaxIX=300;
 MaxIY=300;
type
ptm=^tm;
tm=record
x,y,prcolr:integer;
pnext:ptm;
end;
type
 TForm1 = class(TForm)
   Button1: TButton;
   Edit1: TEdit;
   procedure Button1Click(Sender: TObject);
   procedure Tablica;
   procedure FormCreate(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
 public
    fon,cvetlin,cvet_1,cvet_2,cvet_3:Longint;
    razmercletki,hor,vert,xnach,ynach,xend,yend,k,ink, mouseX,mouseY,xi,yj,
    lx,ly,nx,ny,nachXpriam,nachYpriam,endXpriam,endYpriam,xc,yc,tag:integer;
    XMass,YMass: array [-1..200] of longint;
    FileOut,FileIn:file of Tm;
    ew:array [0..MaxInd] of longint;
    ptmp,pbeg:ptm;
      rdrag:boolean;
     r,rc:trect;
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure tform1.Tablica;
var
i,j:longint;
begin
form1.fon:=canvas.Brush.Color;
canvas.Brush.Color:=clbtnface;
canvas.FillRect(rect(0,0,Width,height));
canvas.Brush.Color:=fon;
razmercletki:=strtoint(edit1.Text);
hor:=strtoint(edit1.Text);
vert:=strtoint(edit1.Text);
xnach:=hor+20;
ynach:=vert+40;
xend:=form1.Width-5;
yend:=form1.Height-54;
lx:=xend-xnach;
ly:=yend-ynach;
nx:=lx div (hor+1);
ny:=ly div (vert+1);
for i:=-1 to nx-1 do
Xmass[i]:=xnach+i*(hor+1);
for i:=-1 to ny-1 do
Ymass[i]:=ynach+i*(vert+1);
nachXpriam:=xnach-1-hor;
nachYpriam:=ynach-1-vert;
endXpriam:=nx*(hor+1)+xnach;
endYpriam:=ny*(vert+1)+ynach;
fon:=canvas.Brush.Color;
canvas.Brush.Color:=cvetlin;
canvas.FillRect(rect(nachXpriam,nachYpriam,endXpriam,endYpriam));
canvas.Brush.Color:=clblack;
for i:=0 to nx-1 do
begin
canvas.FillRect(rect(Xmass[i],Ymass[-1],Xmass[i]+hor,Ymass[-1]+vert));
canvas.TextOut(Xmass[i]+2,Ymass[-1]+2,inttostr(i));
end;
for j:=0 to ny-1 do
begin
canvas.FillRect(rect(Xmass[-1],Ymass[j],Xmass[-1]+hor,Ymass[j]+vert));
end;
canvas.Brush.Color:=cvet_1;
for i:=0 to nx-1 do
for j:=0 to ny-1 do
canvas.FillRect(rect(Xmass[i],Ymass[j],Xmass[i]+hor,Ymass[j]+vert));
canvas.Brush.Color:=fon;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Tablica
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i,j:longint;
begin
cvet_1:=clgreen;
cvet_2:=clyellow;
cvet_3:=clBlue;
canvas.Brush.Color:=cvet_1;
canvas.Pen.Color:=clwhite;
for i:=0 to MaxInd do
ew[i]:=0;
pbeg:=nil;
k:=0;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 MouseX := X;
 MouseY := Y;
 if ((x>=xnach) and (x<=endxpriam) and (y<=EndYpriam) and (y>=ynach))  then
 begin
   if Button = mbLeft then
   begin
     xi := (MouseX-xnach)div (Hor+1);
     yj := (MouseY-ynach) div (vert+1);
     INk:=xi*Nx+yj;
     new (ptmp);
     ptmp^.pnext:=pbeg;
     pbeg:=ptmp;
     pbeg^.x:=xi;
     pbeg^.y:=yj;

       Canvas.Brush.Color := cvet_2;
       canvas.FillRect(rect(Xmass[xi], Ymass[yj], Xmass[xi]+hor, Ymass[yj]+vert));
       ew[INk]:=1;
       pbeg^.prcolr:=1;
       k:=k+1;
      end        end;        end;
end.


---

← →
kaZaNoVa ©   (2007-01-16 03:26) [3]

наверное никак ... тока полная перерисовка

---

← →
vasIzmax ©   (2007-01-16 03:28) [4]

По нажатию кнопки рисуется сетка. Потом если просто щелкать по форме мышкой, то ячейки этой сетки будут закрашиваться другим цветом.

Таким образом можно че-нить нарисовать.

Вот, как мне этот самый рисунок по форме перемещать.
Пробовал CopyRect - не то.

---

← →
vasIzmax ©   (2007-01-16 03:40) [5]

Я вот такое извращение уже придумал от безвыходности.

Кинул на форму два листбокса (для того чтоб видеть координаты) и PopupMenu,в к-рые записываются координаты точек когда мы щелкаем по форме.

Потом в PopupMenu сделал 2 раздела: копи и Paste.
Когда нажимаю копи, то перерисовка чистой таблицы (т.е. без закрашенных ячеек).
Затем нажимаю Paste - и на основании листбоксов пытаюсь восстановить нарисованную картинку, но уже со сдвигом(т.е. с разницей между считываемых координат и координатами, где была нажата правая кнопка).

Не выходит. Когда рисую например крест - то получается одна горизонтальная линия.
ЗЫ. ???

---

← →
Zeqfreed ©   (2007-01-16 04:40) [6]

> vasIzmax ©   (16.01.07 03:40) [5]
Кетмар бы подсказал, в какому направлении идти.
Рисовать на форме - моветон. Если у тебя есть сетка, то у тебя должен быть массив, который ты будешь отрисовывать на битмап и затем копировать на форму уже в любое место.

---

Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2007.02.04;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.039 c