Przesuwanie obrazka po canvas

0

Hej!
Mam do Was prosbe.
Chcialbym narysowac na canvasie jakis obrazek a potem moc zlapac go kursorem i przesuwac. Wiem jak narysowac ale mam problem z drag&drop bo wszedzie znajduje tylko opisy jak to zrobic w przypadku przesuwania z jakies listy w Edita ;)

Rysowanie obrazka (przyklad):

procedure TForm1.Button1Click(Sender: TObject);
var
  Points: array of TPoint;
begin
  SetLength(Points, 3);
  Points[0] := Point(5, 5);
  Points[1] := Point(55, 5);
  Points[2] := Point(30, 30);
  Canvas.Pen.Width := 2;
  Canvas.Pen.Color := clRed;
  Canvas.Brush.Color := clYellow;
  Canvas.Polygon(Points);
end;

Pewnie trzebaby to zrobic w jakis inny sposob. Zrobic z tego jakis objekt? how? :)

Docelowo chcialbym podzielic canvas na 4 czesci i moc przesuwac ten obrazek w wybrana czesc np tylko w dozwolona za pomoca jakies zmiennej.

Mozecie mi pomoc albo chociaz naprowadzic?

Znalazlem na 4p jak robic przesuwanie ale dalej nie do konca to jest to co chcialem..

var
  drag  : boolean = false;
  dx,dy : word;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  drag := true;
  dx := x;
  dy := y;
end;
 
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  drag := false;
end;
 
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  p : tpoint;
begin
  if drag then
  begin
    image1.Left := image1.Left+x-dx;
    image1.top := image1.top+y-dy;
  end;
end;

pozdrawiam!

0

Nie wiem czy dobrze zrozumiałęm ale chodzi Ci o to, że masz canvas na nim robisz mousedown przesuwasz o 50% canvasa w prawo mysz i chcesz od połowy canvasa narysować tylko połowę obrazu tak?

2

Na Canvas czego chcesz to rysować? Osobiście polecam do tego celu PaintBox;

Problem w tym, że jesli coś narysujesz na kanwie to nie jest to osobny fragment całości, więc nie możesz z tego zrobić obiektu, tym bardziej do przesuwania; Można by przesuwać, jeśli cały oraz byłby zbudowany z kilku przezroczystych komponentów, stanowiących warstwy - wtedy wystarczyło by przesuwać czy rozciągać cały komponent; Jednak to nie jest rozwiązanie - potrzebna jest inna technika;


Załóżmy, że potrzebujesz jednokolowe tło oraz możliwość narysowania i przesuwania prostokątów; Komponent PaintBox służyć będzie za "ekran" do wyświetlania całości oraz obsługi komunikatów myszy; W jego metodzie Paint rysujesz wszystko - tło oraz ewentualne obiekty (prostokąty);

Następnie zdefiniuj sobie klasę obiektu - tu prostokąta; Niech zawiera podstawowe informacje, takie jak obszar typu TRect oraz kolor typu TColor; Aby móc posiadać większą liczbę obiektów niż jeden, a także móc nimi zarządzać - potrzebujesz kontenera na te obiekty; Taki kontener to może być zwykła lista generyczna, ewentualnie dla testów (lub jeśli nie znasz czy nie lubisz generyków) może nim być lista typu TObjectList;

Lista po pierwsze będzie przechowywać obiekty i zarządzać ich pamięcią (OwnsObject na True), a po drugie kolejność elementów w liście będzie odpowiadać tzw. Z-Order, z czego korzystać będzie metoda Paint w PaintBox, aby wiedzieć w jakiej kolejności rysować obiekty; Co więcej, kolejność elementów przyda się także do obsługi myszy i wyszukania obiektu znajdującego się wizualnie na samej górze;


W teorii to tyle - potem pozostanie tylko dorobić Drag & Drop, czyli obsłużyć komunikaty WM_LBUTTONDOWN, WM_MOUSEMOVE i WM_MOUSEUP i gotowe; Kodu wyjdzie trochę, a ja niestety nie mam czasu napisać całości i coś pokazać, więc to pozostawiam Tobie; Pisz powoli i z głową, w razie czego pokazuj kod i pytaj, jeśli coś będzie niejasne;

PS: Tajemniczy prostokąt to po prostu fragment obrazu.

0
furious programming napisał(a):

W teorii to tyle - potem pozostanie tylko dorobić Drag & Drop, czyli obsłużyć komunikaty WM_LBUTTONDOWN, WM_MOUSEMOVE i WM_MOUSEUP i gotowe; Kodu wyjdzie trochę, a ja niestety nie mam czasu napisać całości i coś pokazać, więc to pozostawiam Tobie; Pisz powoli i z głową, w razie czego pokazuj kod i pytaj, jeśli coś będzie niejasne;

Ja zrobiłem kiedyś takie google maps dla ubogich. Mapa to była po prostu bitmapa wczytana z zasobów o wielkości 3-4x większej niż PaintBox (akurat taka mapa była mi potrzebna) oraz bez zmiennego zoomu. Całość zakodowałem w zdarzeniu OnPaint. Z tym, że ja miałem jeszcze dodawanie markerów (kilka rodzajów) oraz ich przesuwanie po mapie. Raz dodany marker można było usunąć. Po najechaniu na niego myszką pokazywał się opis pobrany z bazy. Pozycje markerów też były zapisywane w bazie (współrzędne są względem punktu (0,0) na bitmapie). Wykorzystałem do tego takie zdarzenia jak:

  • OnMouseDown
  • OnMouseMove
  • OnMouseUp
  • OnPaint

Co ważne rysowanie odbywało się w pamięci w tymczasowym elemencie typu TBitmap, po wykonaniu całości rysowania kopiowałem bitmapę na Canvas Paintbox'a. Dzięki czemu uniknąłem migotania obrazu.

7

@karpov - narzekasz, że znajdujesz tylko opisy, a żadnego kodu, który by implementował przeciąganie i upuszczanie własnych, wirtualnych elementów, znajdujących się na jednym, ręcznie obsługiwanym komponencie; Napisałem więc prostą aplikację, która taką rzecz posiada; Kodu wyszło za dużo, aby wkleić go do posta, więc wrzucam tu same nagłówki, a cały projekt dorzucam w załączniku rectangles.zip

Wspomniane nagłówki:

type
  TAreaPositionKind  = (apkLeft, apkTop);
  TAreaDimensionKind = (adkWidth, adkHeight);

type
  TAreaPosition   = array [TAreaPositionKind] of Integer;
  TAreaDimensions = array [TAreaDimensionKind] of Integer;

type
  TArea = record
    Position: TAreaPosition;
    Dimensions: TAreaDimensions;
  end;

type
  TRectangleObject = class;

type
  TRectangleDragInfo = record
    Dragging: Boolean;
    RectangleObj: TRectangleObject;
    CursorPos: TPoint;
    Diff: TPoint;
  end;

type
  TRectangleObject = class(TObject)
  private
    FArea: TArea;
    FColor: TColor;
  private
    function GetPosition(AKind: TAreaPositionKind): Integer;
    function GetDimension(AKind: TAreaDimensionKind): Integer;
  private
    procedure SetPosition(AKind: TAreaPositionKind; APosition: Integer);
    procedure SetDimension(AKind: TAreaDimensionKind; ADimension: Integer);
  private
    procedure SetColor(AColor: TColor);
  public
    constructor Create(AArea: TArea; AColor: TColor); overload;
    constructor Create(ALeft, ATop, AWidth, AHeight: Integer; AColor: TColor); overload;
  public
    function ClipRect(): TRect;
  public
    property Left: Integer index apkLeft read GetPosition write SetPosition;
    property Top: Integer index apkTop read GetPosition write SetPosition;
    property Width: Integer index adkWidth read GetDimension write SetDimension;
    property Height: Integer index adkHeight read GetDimension write SetDimension;
    property Color: TColor read FColor write SetColor;
  end;

type
  TRectanglesList = class(TObject)
  private
    FList: TObjectList;
  private
    function GetItem(AIndex: Integer): TRectangleObject;
    procedure SetItem(AIndex: Integer; ARectangleObject: TRectangleObject);
  private
    function GetItemsCount(): Integer;
  public
    constructor Create();
    destructor Destroy(); override;
  public
    procedure Add(ARectangleObject: TRectangleObject);
    procedure Delete(AIndex: Integer);
  public
    function RectangleAtPoint(APoint: TPoint): Integer;
  public
    property Items[AIndex: Integer]: TRectangleObject read GetItem write SetItem; default;
    property ItemsCount: Integer read GetItemsCount;
  end;

type
  TPaintBox = class(ExtCtrls.TPaintBox)
  private
    FRectangles: TRectanglesList;
    FDragInfo: TRectangleDragInfo;
  protected
    procedure WMLButtonDown(var AMessage: TLMLButtonDown); message LM_LBUTTONDOWN;
    procedure WMLButtonUp(var AMessage: TLMLButtonUp); message LM_LBUTTONUP;
    procedure WMMouseMove(var AMessage: TLMMouseMove); message LM_MOUSEMOVE;
  protected
    procedure Paint(); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  public
    property Rectangles: TRectanglesList read FRectangles;
  end;

type
  TMainForm = class(TForm)
    pbEditor: TPaintBox;
    procedure FormCreate(Sender: TObject);
  end;

Trochę się zagalopowałem, bo zachciało mi się klepania kodu metodą Bottom Up i zacząłem od podstaw - czyli od prymitywów jak typ TArea, który można zastąpić typem TRect; Ale mniejsza z tym - masz wszystko przedstawione; Teraz opiszę po kolei o co chodzi;

Typ TArea zawiera informacje o położeniu obiektu oraz o jego wymiarach; Zawiera dwie indeksowane enumami macierze liczb, głównie po to, aby wygodnie było napisać akcesory i mutatory dla właściwości obiektu; Te macierze można zamienić po prostu na cztery zmienne, jednak przyczyni się to do spuchnięcia klasy obiektu;

Typ TRectangleDragInfo zawiera informacje o przeciąganym obiekcie; Dragging określa czy jakiś obiekt jest przeciągany i jeśli tak, w polu RectangleObj znajduje się jego referencja; CursorPos zawiera współrzędne kursora w oknie, a Diff - te liczby zostają nadane po wciśnięciu LPM i przydają się do obliczeń podczas rysowania na ekranie; Oznaczają odległość w poziomie i pionie, pomiędzy lewym górnym rogiem obiektu a kursorem;

Typ TRectangleObject zawiera informacje o pojedynczym obiekcie; Jego obszar typu TArea przechowywany jest w polu FArea, a kolor ramki w polu FColor; Pozostała część klasy to konstruktory, destruktor, akcesory i mutatory oraz właściwości - służą do modyfikacji wartości pól oraz pośredniczą w dostępie do nich; W klasie znajduje się metoda ClipRect - dokonuje ona translacji typu TArea na TRect;

Typ TRectanglesList to wrapper na klasę TObjectList - służy do przechowywania obiektów typu TRectangleObject; Ma kilka metod, Add i Delete wiadomo do czego służą; RectangleAtPoint zwraca indeks obiektu z listy, nad którym znajduje się punkt z argumentu; Obiekty sprawdza od końca, aby zachować Z-Order; Ma też właściwość Items, która umożliwia dostęp do konkretnego obiektu; Z własnych klas to tyle;

Edytorem jest komponent klasy TPaintBox; Jak z nagłówka widać, do obsługi myszy nie użyłem jego zdarzeń OnMouseDown, OnMouseMove i OnMouseUp; W zamian za to, skorzystałem z subclassingu i obsługę myszy wbudowałem w standardowy komponent; Dlaczego? Bo mogę bezpośrednio przechwytywać komunikaty, które zawierają m.in. współrzędne myszy w komponencie; Taki PaintBox zawiera w sobie listę obiektów w polu FRectangles oraz rekord z informacjami o przeciąganiu w polu FDragInfo;

Teraz jak działa przeciąganie i upuszczanie:

  1. Po odebraniu komunikatu LM_LBUTTONDOWN sprawdzamy czy pod kursorem znajduje się obiekt, za pomocą metody RectangleAtPoint; Jeśli jakiś znajduje się, uzupełniamy strukturę FDragInfo; Pole Dragging ustawiamy na True, bo rozpoczynamy przeciąganie, następnie do pola RectangleObj wpisujemy referencję znalezionego obiektu (mamy jego indeks z poprzedniego kroku); Współrzędne kursora wpisujemy do pola CursorPos; Różnicę współrzędnych kursora i lewego górnego rogu obiektu obliczamy prostym odejmowaniem i wpisujemy do pola Diff; Ostatnim krokiem jest zmiana kursora na crDrag i wywołanie metody Invalidate, która wykona "bezpieczne" przemalowanie komponentu;
  2. Obsługa komunikatu LM_MOUSEMOVE wymaga sprawdzenia, czy obiekt w danej chwili jest przeciągany; Jeśli nie jest - nic nie robimy; Natomiast jeśli przeciągany jest obiekt, to wykonujemy dwa kroki - do pola CursorPos wpisujemy aktualne współrzędne kursora, pobrane z parametru AMessage oraz wywołujemy Invalidate w celu przemalowania komponentu;
  3. Po odebraniu komunikatu LM_LBUTTONUP musimy sprawdzić, czy obiekt jest przesuwany (to ważne, bo kliknąć można na pusty obszar komponentu i nic się nie powinno dziać); Jeśli obiekt jest przeciągany, musimy to przeciąganie zakończyć; Aktualizujemy pozycję obiektu, wpisując nowe wartości do RectangleObj.Left i RectangleObj.Top, używając pól CursorPos i Diff; Dzięki temu obiekt można przesuwać o pojedynczy piksel, a samo przeciąganie jest zgodne z położeniem kursora - nic nie przeskakuje; Pozostałe kroki to wpisanie False do pola Dragging, bo przeciąganie dobiegło końca, przywrócenie kursora oraz przemalowanie komponentu;
  4. Malowanie komponentu jest dość proste - najpierw wypełnienie tła kolorem białym, następnie namalowanie w pętli wszystkich obiektów (od pierwszego do ostatniego, aby ten o najwyższym indeksie był na samej górze); Ostatnim krokiem jest sprawdzenie, czy obiekt jest przeciągany i jeśli jest, obliczamy jego nowy obszar na podstawie informacji ze struktury FDragInfo oraz rysujemy standardową ramkę fokusa metodą DrawFocusRect; Efekt jest dokładnie taki sam, jak w oknie eksploratora Windows, gdy pokazywanie zawartości podczas przeciągania jest wyłączone;
    To w sumie tyle; Niestety kod pisałem na szybko, bo mało czasu miałem, więc niektóre elementy wymagają uzupełnienia; Na przykład metody TRectanglesList.Add i TRectanglesList.Delete powinny wywoływać Invalidate; Wymaga też dodania kilku zabezpieczeń, np. przed przesunięciem obiektu poza formularz; Ale mniejsza o to - to kod testowy, nie produkcyjny; Do tego pisany na pałę :]

Jeżeli taki efekt przeciągania Cię nie satysfakcjonuje, bo wolałbyś aktualizowanie zawartości na bieżąco zamiast ramki fokusa, to kod trzeba będzie lekko zmodyfikować; W każdym razie sam kod działa na tyle szybko, że interfejs nie miga, mimo nieużywania podwójnego buforowania; Podejrzewam, że przesuwanie fragmentów obrazu 24-bitowego także będzie działać szybko;

rectangles.png

No, to tyle; W razie czego pytaj, a postaram się coś poradzić.

0

Postawa godna naśladowania !
Przydało by się umieścić ten przykład gdzieś w jakimś miejscu na przykładowy kod :) bo jako post w watku to zaginie

1

@Adamek Adam - to tylko przykład ręcznej obsługi przeciągania w obrębie jednego komponentu; W sumie tylko przeciągania, bo reszta jest nieco do d**y; Nie jest to gotowiec dla @karpova, bo aby móc załadować obrazek i bawić się jego fragmentami, potrzeba kilku znaczących zmian; Ale o to właśnie chodzi - przykład przykładem, jednak pytacz musi sam przystosować kod dla własnych potrzeb, więc i czegoś się nauczy;

Gdybym zdecydował się napisać na ten temat artykuł to kod pisałbym od nowa, tym razem z głową i bez pośpiechu; I nie jako subklasowanie PaintBoxa, a jako osobny komponent, dziedziczący po wymienionym; Do niego można wbudować wymagane funkcje i udostępnić je w jakiś sensowny sposób; Całość napisać tak, aby komponent był uniwersalny;

Jednak do tego będzie potrzeba dużo większej ilości czasu.

0

O mój Boże! dzięki :) Nie spodziewałem się aż takiego odzewu :)

Przyznam szczerze, że nie pisałem na razie nic tutaj bo sam zabrałem się za pisanie na podstawie Twoich wskazówek z poprzedniego posta. Jak dobrze pójdzie to dzisiaj pokaże co udało mi się wyklepać i poproszę o ocenę.

Nawet nie wiem co napisać więc napiszę po prostu dzięki, rewelacja!

Ja zrealizowałem to w trochę inny sposób i kodu wyszło mi o wiele mniej ale patrząc na Twój przykład moje dzieło wydaje się wręcz prostackie chociaż w czasie przesuwanie widoczny jest cały element :)

Wieczorem wkleje i poproszę o ocenę.

P.S.
Oczywiście na końcu zdecydowanie dam V-kę przy Twoim poście ale chciałbym jeszcze chwilę pociągnąć temat :)

0

A ciągnij go ile chcesz - byle rozwiązać problem i stworzyć coś ciekawego :]

1
furious programming napisał(a):

Edytorem jest komponent klasy TPaintBox; Jak z nagłówka widać, do obsługi myszy nie użyłem jego zdarzeń OnMouseDown, OnMouseMove i OnMouseUp; W zamian za to, skorzystałem z subclassingu i obsługę myszy wbudowałem w standardowy komponent; Dlaczego? Bo mogę bezpośrednio przechwytywać komunikaty, które zawierają m.in. współrzędne myszy w komponencie;

Ja pisałem w C++ Builderze i w zdarzeniach OnMouseDown mam dostęp bezpośrednio do współrzędnych X oraz Y względem komponentu. W Lazarusie jest inaczej?

Ogólnie to widzę, że zrobiłeś to bardzo podobnie. Z tym, że ja musiałem na bieżąco doczytywać punkty oraz ich opisy z bazy danych. U mnie sprawa była nawet prostsza, ponieważ ja musiałem rysować tylko ikonki wraz z ewentualnym podpisem, więc nie musiałem niczego rysować, a jedynie kopiowałem z tablicy ikon, coś w tym stylu:

  Graphics::TBitmap *temp = new Graphics::TBitmap;

  for (int i = 0; i < Markers->Count; i++)
  {
    temp->Canvas->Draw(Markers[i]->X - MapX, Markers[i]->Y - MapY,Icons[Markers[i]->Type]);
    temp->Canvas->TextOut(Markers[i]->X - MapX, Markers[i]->Y - MapY + Icons[Markers[i]->Type]->Height,Markers[i]->Info);
  }

Gdzie Markers zawierają widoczne markery (X,Y - współrzędne, Type - typ ikony jaką mam rysować, Info - symbol)

Icons to są załadowane ikony jakie mam do rysowania w postaci elementów TBitmap.
MapX oraz MapY to współrzędne krawędzi mapy, bo punkty mają ustalone współrzędne względem rogu mapki.

Ale tak ogólnie to wielki plus za napisanie tego kodu tylko dla posta :)

1

Ja pisałem w C++ Builderze i w zdarzeniach OnMouseDown mam dostęp bezpośrednio do współrzędnych X oraz Y względem komponentu. W Lazarusie jest inaczej?

Tzn. są argumenty X i Y ze współrzędnymi, ale wolałem wszystko wpakować do komponentu, niż do formularza; No i trzeba by przy okazji sprawdzić też Button aby wyłonić LPM, a także Shift, aby upewnić się, że zbiór jest pusty; Nawet gdybym miał napisać dużo więcej różnych funkcji, sprawdzających również klawisze Shift czy Ctrl, to i tak wpakowałbym wszystko do komponentu; A żeby sprawdzić stan klawiszy specjalnych, wystarczy skorzystać m.in. z KeyToShiftState itd.;

Z tym, że ja musiałem na bieżąco doczytywać punkty oraz ich opisy z bazy danych. U mnie sprawa była nawet prostsza, ponieważ ja musiałem rysować tylko ikonki wraz z ewentualnym podpisem, więc nie musiałem niczego rysować, a jedynie kopiowałem z tablicy ikon

To co podałem to tylko przykład imeplementacji przeciągania; @karpov w swoim programie także potrzebuje gotowych grafik (fragmentów obrazu), więc rysowanie będzie miał prostsze; Chociaż ja też mam proste, bo wystarczy ustawić Pen.Color i wywołać metodę Rectangle :]

Ogólnie to taka funkcjonalność jest dość prosta w implementacji; Dla testów można pisać nawet byle jak, jednak gotowy kod powinien być napisany z głową i lepiej zaprojektowany (albo w ogóle zaprojektowany, bo ja nic sobie nie rozrysowałem);

Ale tak ogólnie to wielki plus za napisanie tego kodu tylko dla posta :)

Nie tylko dla posta - poćwiczyłem trochę i zrobiłem coś, czego wcześniej nie robiłem :P

0
furious programming napisał(a):

Tzn. są argumenty X i Y ze współrzędnymi, ale wolałem wszystko wpakować do komponentu, niż do formularza; No i trzeba by przy okazji sprawdzić też Button aby wyłonić LPM, a także Shift, aby upewnić się, że zbiór jest pusty; Nawet gdybym miał napisać dużo więcej różnych funkcji, sprawdzających również klawisze Shift czy Ctrl, to i tak wpakowałbym wszystko do komponentu; A żeby sprawdzić stan klawiszy specjalnych, wystarczy skorzystać m.in. z KeyToShiftState itd.;

To faktycznie jeśli chciałeś mieć komponent to lepsze rozwiązanie. Moje rozwiązanie też nie było wpakowane do formatki, ale zamknięte w klasie do której przekazywałem TPictureBox'a oraz parę innych rzeczy. No i miałem łatwiejszą sprawę ponieważ nie musiałem sprawdzać Shifta czy innych kombinacji klawiszy.

furious programming napisał(a):

To co podałem to tylko przykład imeplementacji przeciągania; @karpov w swoim programie także potrzebuje gotowych grafik (fragmentów obrazu), więc rysowanie będzie miał prostsze; Chociaż ja też mam proste, bo wystarczy ustawić Pen.Color i wywołać metodę Rectangle :]

W sumie racja. Chociaż ja i tak wolę kopiowanie grafik :)

furious programming napisał(a):

Ogólnie to taka funkcjonalność jest dość prosta w implementacji; Dla testów można pisać nawet byle jak, jednak gotowy kod powinien być napisany z głową i lepiej zaprojektowany (albo w ogóle zaprojektowany, bo ja nic sobie nie rozrysowałem);

Na początku jak to dostałem do napisania myślałem, że nie uda mi się tego zrobić. Dopiero jak napisałem całość wyszło, że nie taki diabeł straszny :) Ogólnie to się teraz zacząłem zastanawiać czy nie napisać sobie takiego prywatnego projektu gdzie mapa nie znajduje się w całym pliku bmp, ale w kawałkach oraz do tego w różnych zoomach, coś jak mapy Googla czy OpenStreetMap. Przy tych drugich można by było się pokusić nawet o pobieranie kafelków online z serwerów. Tylko nie wiem czy znajdę na to czas...

Nie tylko dla posta - poćwiczyłem trochę i zrobiłem coś, czego wcześniej nie robiłem :P

Ja z kolei z chęcią pokazałbym swój kod, ale nie mogę. Nie wolno mi udostępniać kodu napisanego w pracy :P

0

Udalo mi sie napisac cos takiego. Oczywiscie tutaj jest tylko jeden kwadrat ale pierwszy raz w zyciu takie cos pisalem. Za chwile bede dorabiac obsluge wiekszej ilosci ale powiedzcie mi juz na wstepie czy dobrze kombinuje.
Na pewno musialbym obudowac te zmienne globalne.

var
  Form1: TForm1;
  kwadrat:TKwadrat;
  punkt:TPoint;      {wspolrzedne kursora w momencie MouseDown}

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
   with PaintBox1.Canvas do
   begin
        brush.Color := kwadrat.srodek;
        rectangle(kwadrat.boki);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  tmp:TRect;
begin
  tmp.Left   := 0;
  tmp.Top    := 0;
  tmp.Right  := 100;
  tmp.Bottom := 100;

  Kwadrat:=TKwadrat.Create;

  kwadrat.boki:=tmp;
  kwadrat.srodek:=clYellow;
  kwadrat.dad:=false;

end;


procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

   if (X>kwadrat.boki.Left)and(X<kwadrat.boki.Right)and(Y<kwadrat.boki.Bottom)and(Y>kwadrat.boki.Top) then
   begin
   kwadrat.dad:=true;        {jezeli klikniecie w obszarze kwadratu to rozpoczynamy przeciaganie}
   punkt.x:=X;
   punkt.y:=y;
   end;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
          if (kwadrat.dad) then
         begin


         if X>punkt.X then
         begin
              kwadrat.boki.Left   := kwadrat.boki.left+(X-punkt.x);
              kwadrat.boki.Right  := kwadrat.boki.right+(X-punkt.x);
              punkt.X:=X;
         end;
         if X<punkt.X then
         begin
         kwadrat.boki.Left   := kwadrat.boki.left-(punkt.x-X);
         kwadrat.boki.Right  := kwadrat.boki.right-(punkt.x-X);
         punkt.X:=X;
         end;
         if Y<punkt.Y then
         begin
              kwadrat.boki.Top    := kwadrat.boki.Top-(punkt.Y-Y);
              kwadrat.boki.Bottom := kwadrat.boki.Bottom-(punkt.Y-Y);
              punkt.y:=Y;
         end;
         if Y>punkt.Y then
         begin
              kwadrat.boki.Top    := kwadrat.boki.Top+(Y-punkt.Y);
              kwadrat.boki.Bottom := kwadrat.boki.Bottom+(Y-punkt.Y);
              punkt.Y:=Y;
         end;

         PaintBox1.Invalidate;
         end;

end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  kwadrat.dad:=false;
end;                   
2

Udalo mi sie napisac cos takiego.

A to kwestia przypadku? Jeśli nie to nie pisz udało się tylko zrobiłem;

Za chwile bede dorabiac obsluge wiekszej ilosci ale powiedzcie mi juz na wstepie czy dobrze kombinuje.

Nie ilości tylko liczby - kwadraty są policzalne; Dobrze kombinujesz, chociaż kod można skrócić i sprawić, aby był czytelniejszy; Na przykład metoda PaintBox1MouseDown nie musi posiadać tak rozbudowanego warunku - wystarczy użyć funkcji PtInRect oraz Point, obie z modułu Types:

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ptCursorPos: TPoint;
begin
  ptCursorPos := Point(X, Y);

  if PtInRect(Kwadrat.Boki, ptCursorPos) then
  begin
    Kwadrat.DaD := True;
    Punkt := ptCursorPos;
  end;
end;

Teraz konstruktor:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Kwadrat := TKwadrat.Create;
  Kwadrat.Boki := Rect(0, 0, 100, 100);
  Kwadrat.Srodek := clYellow;
  Kwadrat.DaD := False;
end;

To tylko podpowiedź, jeśli chodzi o upraszczanie kodu za pomocą wbudowanych funkcji; Co do całości, a przede wszystkim do metody PaintBox1MouseMove - o wiele za dużo kodu; Zobacz jak proste są te operacje w moim kodzie; Wiadome - mój kod implementuje przeciąganie nieco inaczej, bo wyświetla focusa zamiast odświeżania na bieżąco;

W takim razie mój kod obsługujący przeciąganie prostokąta i odświeżanie na bieżąco:

type
  TRectangleDragInfo = record
    Dragging: Boolean;
    RectangleObj: TRectangleObject;
    Diff: TPoint;
    // CursorPos jest już niepotrzebny, więc usuwamy go
  end;

{...}

procedure TPaintBox.WMLButtonDown(var AMessage: TLMLButtonDown);
var
  ptCursor: TPoint;
  intRectObjIdx: Integer;
begin
  inherited WMLButtonDown(AMessage);

  ptCursor := SmallPointToPoint(AMessage.Pos);
  intRectObjIdx := FRectangles.RectangleAtPoint(ptCursor);

  if intRectObjIdx <> -1 then
  begin
    FDragInfo.Dragging := True;
    FDragInfo.RectangleObj := FRectangles[intRectObjIdx];
    FDragInfo.Diff.X := ptCursor.X - FDragInfo.RectangleObj.Left;
    FDragInfo.Diff.Y := ptCursor.Y - FDragInfo.RectangleObj.Top;

    Screen.Cursor := crDrag;
    Invalidate();
  end;
end;

procedure TPaintBox.WMLButtonUp(var AMessage: TLMLButtonUp);
begin
  inherited WMLButtonUp(AMessage);

  if FDragInfo.Dragging then
  begin
    FDragInfo.Dragging := False;
    Screen.Cursor := crDefault;
  end;
end;

procedure TPaintBox.WMMouseMove(var AMessage: TLMMouseMove);
var
  ptCursorPos: TPoint;
begin
  inherited WMMouseMove(AMessage);

  if FDragInfo.Dragging then
  begin
    ptCursorPos := SmallPointToPoint(AMessage.Pos);

    FDragInfo.RectangleObj.Left := ptCursorPos.X - FDragInfo.Diff.X;
    FDragInfo.RectangleObj.Top  := ptCursorPos.Y - FDragInfo.Diff.Y;

    Invalidate();
  end;
end;

procedure TPaintBox.Paint();
var
  roCurrent: TRectangleObject;
  intRectObjIdx: Integer;
begin
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);

  for intRectObjIdx := 0 to FRectangles.ItemsCount - 1 do
  begin
    roCurrent := FRectangles[intRectObjIdx];

    Canvas.Pen.Color := roCurrent.Color;
    Canvas.Rectangle(roCurrent.ClipRect());
  end;
end;

Proste? Proste, a w dodatku mniej kodu niż poprzednio, bo odpada przechowywanie pozycji kursora w strukturze FDragInfo, a także malowanie ramki fokusa czy Invalidate w WMLButtonUp; Program wygląda tak samo, jednak przeciąganie zaimplementowane jest zupełnie inaczej;

Projekt ze zmienionym przeciąganiem masz w załączniku rectangles.zip

1 użytkowników online, w tym zalogowanych: 0, gości: 1