На главную Наши проекты:
Журнал   ·   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_
  
> панель с изменяемым размерами , сабж
    Всем привет ;)
    Нашел пример в сети, где изменяется один угол панели, правый нижний.
    ExpandedWrap disabled
      var
      Moving :Boolean;
      Start,
      InitialSize :TPoint;
       
      implementation
       
      {$R *.DFM}
       
      procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
      begin
      if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then
      begin
      Moving := True;
      Start := Point(X,Y);
      InitialSize := Point(Panel1.Width, Panel1.Height);
      end
      end;
       
      procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
      begin
      if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then
      Panel1.Cursor := crSizeNwSe
      else
      Panel1.Cursor := crDefault;
       
      if Moving then
      begin
      Panel1.Width := InitialSize.X+(X-Start.X);
      Panel1.Height := InitialSize.Y+(Y-Start.Y);
      end
      end;
       
      procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
      begin
      Moving := False;
      end;


    Мне нужно сделать изменяемыми ещё три угла панели, "поведение как у формы", правда это будет панель.
    Попробовал экспериментировать с этим кодом, правда что-то не так. <_< :) :lool: :blush: :crazy:
    Соответствующие файлы прикрепляю к данной теме.
    ExpandedWrap disabled
      unit Unit1;
       
      interface
       
      uses
        Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls;
      type TCornerPos = (LV,PV,PN,LN,None);
      // L -левый
      // P -правый
      // V -верхний
      // N -нижний
      // -> угол
      type
        TForm1 = class(TForm)
          Panel1: TPanel;
          procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
          procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
            Y: Integer);
          procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
        private
          { Private declarations }
        public
          { Public declarations }
        end;
       
      var
        Form1: TForm1;
       
        Moving :Boolean;
        Start,
        InitialSize :TPoint;
        PanelCorners:TCornerPos;
      implementation
       
      {$R *.dfm}
      procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
      begin
         //
         //(X in [0,Panel1.Width]) and (Y in [0,Panel1.Height])
         //
       
      //Если точка находится в "левом верхнем углу"
        if PtInRect(Rect(0, 0, 10, 10), ScreenToClient(Point(X, Y))) then
        begin
         PanelCorners:= LV;
         Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» "
        end
        else
         begin
         // PanelCorners:= None;  //не выбран угол
          Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка»
        end;
      //Если точка находится в "правом нижнем углу"
        if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then
        begin
          PanelCorners:= PN;  //выбран угол "правый нижний"
          Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» "
        end
        else
        begin
         // PanelCorners:= None;  //не выбран угол
          Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка»
        end;
       
        if Moving and (PanelCorners= PN) then //в движении меняем размеры панели ( «Ширины» , «Высоты» )
        begin
          Panel1.Width := InitialSize.X+(X-Start.X);
          Panel1.Height := InitialSize.Y+(Y-Start.Y);
        end;
        
        if Moving and (PanelCorners= LV) then
        begin
          Panel1.Left:= Panel1.Left+(X-Start.X);
          panel1.Top:=  panel1.Top+(Y-Start.Y);
          Panel1.Width:= Panel1.Width - (X-Start.X);
          Panel1.Height:= Panel1.Height - (Y-Start.Y)
        end;
       
      end;
      procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      begin
      if PanelCorners= LV then
        begin
        Moving := True; // разрешаем движение
        Start := Point(X,Y);// даём текущую точку
        end;
      if PanelCorners= PN then
        begin
        Moving := True; // разрешаем движение
        Start := Point(X,Y);// даём текущую точку
        InitialSize := Point(Panel1.Width, Panel1.Height); //даём вторую точку "правый нижний угол"
        end
      end;
       
       
       
      procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
      begin
      Moving := False; //Запрет движения
      end;
       
      end.

    Прикреплённый файлПрикреплённый файлtest_resize_by_mouse0.rar (186,78 Кбайт, скачиваний: 4)
    Прикреплённый файлПрикреплённый файлtest_resize_by_mouse1.rar (187,63 Кбайт, скачиваний: 5)
      У вас когда мышь попадает в первый ЛВ-угол, то последующий код проверки на ПН-угол выкидывает успешный результат. Надо всё второе условие перенести в else первого:
      ExpandedWrap disabled
        //Если точка находится в "левом верхнем углу"
          if PtInRect(Rect(0, 0, 10, 10), Point(X, Y)) then
          begin
           PanelCorners:= LV;
           Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» "
          end
          else
           begin
         
        //Если точка находится в "правом нижнем углу"
          if (X>Panel1.Width-10) and (Y>Panel1.Height-10) then
          begin
            PanelCorners:= PN;  //выбран угол "правый нижний"
            Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» "
          end
          else
          begin
           // PanelCorners:= None;  //не выбран угол
            Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка»
          end;
          end;
          if Moving and (PanelCorners= PN) then //в движении меняем размеры панели ( «Ширины» , «Высоты» )
        Спасибо :thanks:
          Галочку/кнопку 'вопрос решён' не забывайте ставить.
            Итак что получилось:
            ExpandedWrap disabled
              unit Unit1;
               
              interface
               
              uses
                Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls;
              type TCornerPos = (LV,PV,PN,LN,None);
              // L -левый
              // P -правый
              // V -верхний
              // N -нижний
              // -> угол
              type
                TForm1 = class(TForm)
                  Panel1: TPanel;
                  procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
                    Shift: TShiftState; X, Y: Integer);
                  procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
                    Y: Integer);
                  procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
                    Shift: TShiftState; X, Y: Integer);
                private
                  { Private declarations }
                public
                  { Public declarations }
                end;
               
              var
                Form1: TForm1;
               
                f:boolean;
                mX,mY:integer;
               
                Moving :Boolean;
                Start,
                InitialSize :TPoint;
                PanelCorners:TCornerPos;
              implementation
               
              {$R *.dfm}
              procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState;  X,
                Y: Integer);
              begin
                 //
                 //(X in [0,Panel1.Width]) and (Y in [0,Panel1.Height])
              //Если точка находится в "левом верхнем углу"
                if PtInRect(Rect(0, 0, 10, 10), Point(X, Y))  then    // and not
                begin
                 PanelCorners:= LV;  //выбран угол левый верхний
                 Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» "
                end
                else
                if PtInRect(Rect(Form1.Panel1.Width-10,0,Form1.Panel1.Width,10 ),Point(X, Y)) then
                begin
                 PanelCorners:= PV;  //выбран угол правый верхний
                 Panel1.Cursor := crSizeNESW //меняем курсор на "изменение размера «тянуть» "
                end
                else
               
                if PtInRect(Rect(Form1.Panel1.Width-10,Form1.Panel1.Height-10,Form1.Panel1.Width,Form1.Panel1.Height ),Point(X, Y)) then
                begin
                  PanelCorners:= PN;  //выбран угол "правый нижний"
                  Panel1.Cursor := crSizeNwSe //меняем курсор на "изменение размера «тянуть» "
                end
                    else
                if PtInRect(Rect(0,Form1.Panel1.Height-10,10,Form1.Panel1.Height ),Point(X, Y))  then
                 begin
                 PanelCorners:= LN; //выбран угол "левый нижний"
                 Panel1.Cursor := crSizeNESW //меняем курсор на "изменение размера «тянуть» "
                end else
                begin
                PanelCorners:= None; //не выбрано
                Panel1.Cursor := crDefault; //возвращаем курсор по умолчанию «стрелка»
                end;
               
               
                if Moving and (PanelCorners= PN) then //в движении меняем размеры панели ( «Ширины» , «Высоты» )
                begin
                  Panel1.Width := InitialSize.X+(X-Start.X);
                  Panel1.Height := InitialSize.Y+(Y-Start.Y);
                end
                else
                if Moving and (PanelCorners= LV) then //в движении меняем положение панели и сохраняем Правый нижний угол "неизменным"
                begin
                  Panel1.Left:= Panel1.Left+(X-Start.X);
                  panel1.Top:=  panel1.Top+(Y-Start.Y);
                  Panel1.Width:= Panel1.Width - (X-Start.X);
                  Panel1.Height:= Panel1.Height - (Y-Start.Y)
                end;
                if Moving and (PanelCorners= PV) then
                begin
                  panel1.Top:=  panel1.Top+(Y-Start.Y);
                  Panel1.Width:= Panel1.Width + (X-Start.X);
               
                  Panel1.Height:= Panel1.Height - (Y-Start.Y)//компенсация движения угла
                end;
                if Moving and (PanelCorners= LN) then
                begin
                  Panel1.Left:= Panel1.Left+(X-Start.X);
                  Panel1.Height:= Panel1.Height + (Y-Start.Y);
               
                  Panel1.Width:= Panel1.Width - (X-Start.X);//компенсация движения угла
                end;
               If f then
              begin
                  Panel1.Left:=Panel1.Left-(mX-X);
                  Panel1.Top:=Panel1.Top-(mY-Y)
              end;
              end;
              procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
                Shift: TShiftState; X, Y: Integer);
              begin
              If Button = mbRight then
                begin
                 f:=true;
                mx:=X;
                my:=Y;
                end;
              if PanelCorners= LV then
                begin
                Moving := True; // разрешаем движение
                Start := Point(X,Y);// даём текущую точку
                end;
              if PanelCorners= PN then
                begin
                Moving := True; // разрешаем движение
                Start := Point(X,Y);// даём текущую точку
                InitialSize := Point(Panel1.Width, Panel1.Height); //даём вторую точку "правый нижний угол"
                end;
              if PanelCorners= PV then
                begin
                Moving := True; // разрешаем движение
                Start := Point(X,Y);// даём текущую точку
                end;
              if PanelCorners= LN then
                begin
                Moving := True; // разрешаем движение
                Start := Point(X,Y);// даём текущую точку
                end;
              end;
               
               
               
              procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
                Shift: TShiftState; X, Y: Integer);
              begin
              Moving := False; //Запрет движения
              f:=false
              end;
               
              end.


            Вопрос такого плана:
            Если при нажатии "двигать" курсор мыши медленно,
            то работает, но, если немного "быстрее",
            то курсор "снова становиться стрелкой" и изменение размера прекращается :huh: <_<
            Цитата
            Хм. Не то чтобы карета превращается в тыкву...
            :-? :'(
              1. Можно перед самой первой проверкой попадания смотреть: Moving или нет. Если уже идёт движение, то нечего анализировать на попадание в квадратик!
              2. Но оказаться может так, что выведут размер за окно и там отпустят мышь... Против этого был изобретён механизм захвата SetCapture и всё такое.
                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                0 пользователей:


                Рейтинг@Mail.ru
                [ Script execution time: 0,0364 ]   [ 18 queries used ]   [ Generated: 19.03.24, 07:01 GMT ]