На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...
Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.
Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Как сделать столкновения объектов краями?
Katerina1993
Сообщ. #1 ,
    Member
    **
    Профиль · PM
    Рейтинг (т): 1
    Мне нужно сделать столкновения объектами краями и чтобы при столкновении толщина линии увеличивалась.
    Пример ниже,
    user posted image
    Нужные классы уже написаны. Сейчас у меня толщина линий увеличивается когда маленький квадрат полностью находиться внутри большого квадрата. Пример в гифке.
    user posted image
    За столкновение объектов отвечает этот код:
    ExpandedWrap disabled
      pt := rect1.localToLocal(rect1.x1-shape1.x1,rect1.y1-shape1.y1);
       
                   if shape1.hitTest(pt.x, pt.y,Form1) then
                   begin
                     shape1.lineWidth:=5;
                   end
                   else
                     shape1.lineWidth:=1;

    Как изменить параметры передаваемых значений hitTest (в скобках), чтобы столкновения происходила границами как на первой гифке?
    Полностью код + исходники Прикреплённый файлПрикреплённый файл2hitTest.zip (12,63 Кбайт, скачиваний: 13)
    ExpandedWrap disabled
      unit Unit1;
       
      interface
       
      uses
        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
        Dialogs, ExtCtrls, AppEvnts, StdCtrls;
       
      type
        pRGB = ^TRGB;
        TRGB = record
          B, G, R: Byte;
        end;
        TMatrix=record a,b,c,d,tx,ty:Currency  ; end;
        TForm1 = class(TForm)
          Timer1: TTimer;
          ApplicationEvents1: TApplicationEvents;
          procedure FormPaint(Sender: TObject);
          procedure ApplicationEvents1Message(var Msg: tagMSG;
            var Handled: Boolean);
          procedure Timer1Timer(Sender: TObject);
        private
          { Private declarations }
        public
          { Public declarations }
        end;
         TRect = class
        private
            x0, y0, x1,y1: Integer;
            width, height: Integer;
            color : TColor;
            dragok : Boolean;
            Cs:TCanvas;
        public
          constructor Create(_Cs:TCanvas;_x0, _y0,_x1,_y1, w1, h1: Integer; _Color:TColor; _dragok:Boolean);
          Procedure Draw(); //Прорисовка
          function localToLocal (x, y:Integer):TPoint;
          function globalToLocal (x, y:Integer):TPoint;
        end;
        TShape = class
        private
          x0,y0,x1,y1: Integer;
          width, height: Integer;
          color,color1: TColor;
          lineWidth:Integer;
          dragok : Boolean;
          Cs:TCanvas;
        public
          constructor Create(_Cs:TCanvas;_x0, _y0,_x1,_y1,_lineWidth, w1, h1: Integer; _Color,_Color1:TColor; _dragok:Boolean);
          Procedure Draw(); //Прорисовка
          function hitTest(x, y:Integer;fr:TForm1):Boolean;
          function _testHit(x,y:Integer;fr:TForm1):Boolean;
        end;
      var
        Form1: TForm1;
       
        rect1 :  TRect;
        shape1: TShape;
        a1:Integer = 1;
        b1:Integer = 0;
        c1:Integer = 0;
        d1:Integer = 1;
        //tx1:Integer = 0;
       // ty1:Integer = 0;
        HDC3,HDC2:THandle;
        StartX:Integer;
        StartY:Integer;
      implementation
       
      {$R *.dfm}
      constructor TShape.Create(_Cs:TCanvas;_x0,_y0,_x1,_y1,_lineWidth,w1,h1: Integer; _Color, _Color1: TColor; _dragok:Boolean);
       
      begin
        inherited Create;
        x0 := _x0;
        y0 := _y0;
        x1 := _x1;
        y1 := _y1;
        width := w1;
        height := h1;
        color := _Color;
        color1 := _Color1;
        dragok := _dragok;
        lineWidth := _lineWidth;
        Cs := _Cs;
      end;
       
       
      procedure TShape.Draw();
      var M:TXFORM;tx1,ty1:Integer;
      begin
         hDc2 := Cs.Handle;
         SetGraphicsMode(hDc2, GM_ADVANCED);
       
       
       //  SetWorldTransform(hDc, M);
       
       
       
        tx1 := a1*x1+c1*y1+0;
        ty1 := b1*x1+d1*y1+0;
         //fillChar(M, sizeOf(M), 0);
         SaveDC(hDc3);
         M.eM11 := a1;
         M.eM12 := b1;
         M.eM21 := c1;
         M.eM22 := d1;
         M.eDx := tx1;
         M.eDy := ty1;
       
         ModifyWorldTransform(hDc2, M, MWT_LEFTMULTIPLY);
       
        Form1.Canvas.Pen.Color:=color1;
        Form1.Canvas.Pen.Width := lineWidth;
        Form1.Canvas.Brush.Color:=color;
       
        Cs.Rectangle(0,0,width,height);
        RestoreDC(HDC2,1)
      end;
       
      function TShape.hitTest(x,y:Integer;fr:TForm1):Boolean;
      var M:TXFORM;hit:Boolean;
      begin
         M.eM11 := a1;
         M.eM12 := b1;
         M.eM21 := c1;
         M.eM22 := d1;
         M.eDx := -x;
         M.eDy := -y;
       
         SetWorldTransform(Cs.Handle, M);
       
         Draw();
         hit := _testHit(x,y,fr);
       
         M.eM11 := a1;
         M.eM12 := b1;
         M.eM21 := c1;
         M.eM22 := d1;
         M.eDx := 0;
         M.eDy := 0;
         SetWorldTransform(Cs.Handle, M);
           result:=hit;
       
      end;
       
      function TShape._testHit(x,y:Integer;fr:TForm1):Boolean;
      begin
       
      if (-x+150 < 0) and (0 <= -x+width+150) and (-y+150 < 0) and (0 <= -y+height+150) then begin
        result:=True;
      end
      else
         result:=False;
       
       
      end;
       
      function TRect.localToLocal (x, y:Integer):TPoint;
      var tx1,ty1:Integer;pt1:TPoint;
      begin
           tx1 := 1*x1+0*y1+0;
           ty1 := 0*x1+1*y1+0;
           pt1.x := x1*1+y1*0+tx1;
           pt1.y := x1*0+y1*1+ty1;
       
           result := globalToLocal(pt1.x, pt1.y);
          //result := 10;
      end;
      function TRect.globalToLocal (x, y:Integer):TPoint;
      var mtx1:TMatrix;pt1:TPoint;
      begin
          mtx1.a:=1;
          mtx1.b:=0;
          mtx1.c:=0;
          mtx1.d:=1;
          mtx1.tx:=-150;
          mtx1.ty:=-150;
       
          pt1.x := x*1+y*0+Round(mtx1.tx);
          pt1.y := x*0+y*1+Round(mtx1.ty);
       
          result.X := pt1.x;
          result.Y := pt1.y;
      end;
      constructor TRect.Create(_Cs:TCanvas;_x0,_y0,_x1,_y1,w1,h1: Integer; _Color: TColor; _dragok:Boolean);
      begin
        inherited Create;
        x0 := _x0;
        y0 := _y0;
        x1 := _x1;
        y1 := _y1;
        Cs := _Cs;
        width := w1;
        height := h1;
        color := _Color;
        dragok := _dragok;
      end;
       
      procedure TRect.Draw();
      var M:TXFORM;tx1,ty1:Integer;
      begin
        hDc3 := Cs.Handle;
        SetGraphicsMode(hDc3, GM_ADVANCED);
       
        tx1 := a1*x1+c1*y1+0;
        ty1 := b1*x1+d1*y1+0;
        SaveDC(HDC3);
        
         M.eM11 := a1;
         M.eM12 := b1;
         M.eM21 := c1;
         M.eM22 := d1;
         M.eDx := tx1;
         M.eDy := ty1;
       
         ModifyWorldTransform(hDc3, M, MWT_LEFTMULTIPLY);
       
         Form1.Canvas.Brush.Color:=color;
         Cs.Rectangle(0,0,width,height);
         RestoreDC(HDC3,1)
      end;
      procedure TForm1.FormPaint(Sender: TObject);
      begin
         shape1:=TShape.Create(Form1.Canvas,0,0,150,150,2,100,100,clGreen,clBlue,false);
         shape1.Draw();
       
         rect1 := TRect.Create(Form1.Canvas,0,0,10,170,50,50,clBlue,false);
         rect1.Draw();
      end;
       
      procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
        var Handled: Boolean);
      var
         dx,dy:Integer;
         P : TPoint;
         pt:TPoint;
      begin
       
         if Msg.message = WM_LBUTTONDOWN then
         begin
             P:=Form1.ScreenToClient(Mouse.CursorPos);
       
             if (rect1.x1 < P.X) and
             (rect1.x1+rect1.width > P.X)
             and (rect1.y1 < P.Y) and
             (rect1.y1+rect1.height > P.Y)
              then
              begin
                rect1.dragok:=true;
                StartX:=P.X;
                StartY:=P.Y;
              end;
          
          end;
          if Msg.message = WM_LBUTTONUP then
          begin
            rect1.dragok:=false;
          end;
          if Msg.message = WM_MOUSEMOVE then
          begin
              P:=Form1.ScreenToClient(Mouse.CursorPos);
              dx:=P.X-startX;
              dy:=P.Y-startY;
       
                if rect1.dragok then
                begin
                   rect1.x1:=rect1.x1+dx;
                   rect1.y1:=rect1.y1+dy;
       
                   pt := rect1.localToLocal(rect1.x1-shape1.x1,rect1.y1-shape1.y1);
       
                   if shape1.hitTest(pt.x, pt.y,Form1) then
                   begin
                     shape1.lineWidth:=5;
                   end
                   else
                     shape1.lineWidth:=1;
                end;
                startX:=P.X;
                startY:=P.Y;
       
          end;
      end;
       
       
       
      procedure TForm1.Timer1Timer(Sender: TObject);
      begin
      Form1.Canvas.Brush.Color:=clWhite;
      Form1.Canvas.FillRect(Form1.ClientRect);
       
      shape1.Draw();
      rect1.Draw();
      end;
       
      end.
    Сообщение отредактировано: Katerina1993 -
    0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
    0 пользователей:


    Рейтинг@Mail.ru
    [ Script execution time: 0,0494 ]   [ 17 queries used ]   [ Generated: 4.11.25, 10:55 GMT ]  
    Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.