На главную Наши проекты:
Журнал   ·   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_
  
> Как вернуться hex прежний цвет?
    Здравствуйте, создала тайлы в форме hex при наведении мышкой они перекрещиваются в синий цвет (по умолчанию они черного). Как вернуть цвет обратно когда мышка убрана с тайла при этом, не используя команды очистки холста?
    Цитата

    Вот эти НЕ ИСПОЛЬЗУЯ:
    Form1.Canvas.Brush.Color:=clWhite;
    Form1.Canvas.FillRect(Form1.ClientRect);

    В конце кода, создала список параметров, обозначающий текущий Hex. Надо использовать эти параметры чтобы при убирании мышки цвет линий становился опять черный.
    ExpandedWrap disabled
      //TCurrentHex
       c1.q:=q;
       c1.r:=r;
       c1.s:=s;
       c1.x:=p3.x;
       c1.y:=p3.y;
       
       Label1.Caption:='CurrentHex Q ='+FloatToStr(c1.q);
       Label2.Caption:='CurrentHex R ='+FloatToStr(c1.r);
       Label3.Caption:='CurrentHex S ='+FloatToStr(c1.s);
       Label4.Caption:='CurrentHex X ='+FloatToStr(c1.x);
       Label5.Caption:='CurrentHex Y ='+FloatToStr(c1.y);

    При наведении мышки на тайл цвет синий. Когда перемещаюсь по полю все тайлы становятся синими. Пример на картинке ниже.

    Прикреплённый файлПрикреплённый файлimg1.jpg (185,41 Кбайт, скачиваний: 12)
    Должен быть синего цвета только текущий hex (на котором указана мышка). Полностью пример кода:
    ExpandedWrap disabled
      unit Unit1;
       
      interface
       
      uses
        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
        Dialogs, StdCtrls, ComCtrls, ExtCtrls;
       
      type
        ThexParametres=record hexHeight,hexWidth,vertDist,horizDist:Currency  ; end;
        TPoint2=record x,y,z:Currency  ; end;
        THex=record q,r,s:Currency  ; end;
        TCurrentHex=record q,r,s,x,y:Currency  ; end;
        TRect=record left,right,top,bottom:Currency  ; end;
        TForm1 = class(TForm)
          Label1: TLabel;
          ControlBar1: TControlBar;
          Label2: TLabel;
          Label3: TLabel;
          Label4: TLabel;
          Label5: TLabel;
          procedure FormPaint(Sender: TObject);
          procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
            Y: Integer);
        private
          { Private declarations }
        public
          { Public declarations }
        end;
        function getHexParametres():ThexParametres;
        function hexToPixel(h:THex):TPoint2;
        function getHexCornerCoord(center:TPoint2; i:Integer):TPoint2;
        procedure drawHex(center:TPoint2;color:TColor;width:Integer);
        procedure drawLine(start1, end1:TPoint2;color:TColor;width:Integer);
        procedure drawHexCoordinates(cs:TCanvas;center:TPoint2;h:THex);
        function getCanvasPosition():TRect;
        function Hex(q,r,s:Integer):THex;
        function pixelToHex(p:TPoint2):THex;
        function cubeRound(cube:THex):THex;
       // Hex(q,r,s){
         //   return {q:q,r:r,s:s}
         // }
        //function pixelToHex()
      var
        Form1: TForm1;
        hexWidth, hexHeight,vertDist,horizDist:Integer;
        canvasWidth, canvasHeight:Integer;
        hexParametres: ThexParametres;
      implementation
       
      {$R *.dfm}
       
       
      procedure drawLine(start1, end1:TPoint2;color:TColor;width:Integer);
      begin
      Form1.Canvas.Pen.Width:=width;
      Form1.Canvas.Pen.Color:=color;
      Form1.Canvas.MoveTo(Trunc(start1.x),Trunc(start1.y));
      Form1.Canvas.LineTo(Trunc(end1.x),Trunc(end1.y));
      end;
       
       
       
      procedure drawHexCoordinates(cs:TCanvas;center:TPoint2;h:THex);
      begin
       Cs.Font.Size:= 4;
       Cs.TextOut(Trunc(center.x+2), Trunc(center.y-10),FloatToStr(h.q));
       Cs.TextOut(Trunc(center.x), Trunc(center.y+5),FloatToStr(h.r));
       Cs.TextOut(Trunc(center.x-15), Trunc(center.y-10),FloatToStr(h.s));
       
      end;
       
      function cubeRound(cube:THex):THex;
      var rx, ry, rz, x_diff, y_diff, z_diff:Real;
      begin
      rx := Trunc(cube.q);
      ry := Trunc(cube.r);
      rz := Trunc(cube.s);
       
      x_diff := Abs(rx - cube.q);
      y_diff := Abs(ry - cube.r);
      z_diff := Abs(rz - cube.s);
       
      if ((x_diff > y_diff) and (x_diff > z_diff)) then
      begin
        rx := -ry-rz;
      end
      else
      if (y_diff > z_diff) then
      begin
        ry := -rx-rz;
      end
      else
      begin
         rz := -rx-ry;
      end;
       
      result.q:=rx;
      result.r:=ry;
      result.s:=rz;
       
       
       
      end;
       
      function pixelToHex(p:TPoint2):THex;
      var q,r:Real;
      var size:Integer;
      begin
      size:=20;
       q:=((p.x - 400) * Sqrt(3)/3 - (p.y - 300) / 3) / size;
       r:= (p.y - 300) * 2/3 / size;
       result.q := q;
       result.r := r;
       result.s := - q - r;
      end;
       
      procedure drawHex(center:TPoint2;color:TColor;width:Integer);
      var i:Integer;
      var start1,end1:TPoint2;
      begin
       for i := 0 to 5 do
       begin
         start1 := getHexCornerCoord(center,i);
         end1 := getHexCornerCoord(center,i+1);
         drawLine(start1, end1,color,width);
       end;
       
      end;
       
      function getHexCornerCoord(center:TPoint2; i:Integer):TPoint2;
      var angle_deg, angle_rad,x,y:Real;
      begin
      angle_deg := 60 * i + 30;
      angle_rad := PI / 180 * angle_deg;
      x := center.x + 20 * Cos(angle_rad);
      y := center.y + 20 * Sin(angle_rad);
      result.x := x;
      result.y := y;
      end;
       
      function getCanvasPosition():TRect;
      begin
      result.left := 0;
      result.right := 802;
      result.top := 8;
      result.bottom := 610;
      end;
       
      function Hex(q,r,s:Integer):THex;
      begin
        result.q := q;
        result.r := r;
        result.s := s;
      end;
       
      function hexToPixel(h:THex):TPoint2;
      begin
       result.x := 20 * Sqrt(3) * (h.q + h.r/2) + 400;
       result.y := 20 * 3/2 * h.r + 300;
      end;
      function getHexParametres():ThexParametres;
      begin
       result.hexHeight:=20*2;
       result.hexWidth:= Sqrt(3)/2 * 40;
       result.vertDist:= 40 * 3 / 4;
       result.horizDist:=34.64101615137754;
      end;
       
       
       
       
      procedure TForm1.FormPaint(Sender: TObject);
      var hexWidth, hexHeight,vertDist,horizDist:Currency;
      var hPar:ThexParametres;
      var qLeftSide,qRightSide,rTopSide,rBottomSide:Integer;
      var r,r1,p,q,n:Integer;
      var h,p1:TPoint2;
      var x,y:Real;
      begin
       
       
       
      hPar:=getHexParametres();
       
      hexWidth := hPar.hexWidth;
      hexHeight := hPar.hexHeight;
      vertDist := hPar.vertDist;
      horizDist := hPar.horizDist;
       
      qLeftSide := Round(400/horizDist);
      qRightSide := Round((800 - 400)/horizDist);
      rTopSide := Round(300/vertDist);
      rBottomSide := Round((600 - 300)/vertDist);
       
       
       
      p:=0;
      for r := 0 to rBottomSide do
      begin
       if (r mod 2 = 0) and (r<>0) then
       begin
         inc(p);
       end;
       for q := -qLeftSide to qRightSide do
        begin
         h := hexToPixel(Hex(q-p,r,0));
         x:=h.x;
         y:=h.y;
         if (((x > hexWidth/2) and (x < 800 - hexWidth/2)) and ((y > hexHeight/2) and (y < 600 - hexHeight/2))) then
         begin
          p1.x := x;
          p1.y := y;
          p1.z := 0;
          drawHex(p1,$000000,1);
        
          drawHexCoordinates(Form1.Canvas, p1, Hex(q-p,r,-q -r));
         // ShowMessage(FloatToStr(x));
         end;
       
        end;
       
       
       
       
      end;
       
      n := 0;
       
      for r1 := -1 downto -rTopSide do
      begin
       
       if (r1 mod 2 <> 0) then
       begin
         inc(n);
       end;
       for q := -qLeftSide to qRightSide do
        begin
       
         h := hexToPixel(Hex(q+n,r1,0));
         x:=h.x;
         y:=h.y;
        
         if (((x > hexWidth/2) and (x < 800 - hexWidth/2)) and ((y > hexHeight/2) and (y < 600 - hexHeight/2))) then
         begin
       
          p1.x := x;
          p1.y := y;
          p1.z := 0;
          
          drawHex(p1,$000000,1);
          drawHexCoordinates(Form1.Canvas, p1, Hex(q+n,r1,-q -r1));
          
         end;
        end;
       
      end;
      end;
       
      procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
      var tC:TRect;
      left,  top, q,r,s:Real;
       
      offsetX,offsetY:Real;
      hX,h1:THex;
      p1,p3,htp:TPoint2;
      c1:TCurrentHex;
      begin
       
        tC := getCanvasPosition();
        left := tC.left;
       // right := tC.right;
        top := tC.top;
        //bottom := tC.bottom;
       
        offsetX := X - left;
        offsetY := Y - top;
        p1.x:=offsetX;
        p1.y:=offsetY;
        p1.z:=0;
       
       
        hX := cubeRound(pixelToHex(p1));
       
        q := hX.q;
        r := hX.r;
        s := hX.s;
       
        h1.q:=q;
        h1.r:=r;
        h1.s:=s;
        
       
        htp := hexToPixel(h1);
        
       
        p3.x:=htp.x;
        p3.y:=htp.y;
        p3.z:=0;
       
        drawHex(p3,$d52b1e,2);
       
       //TCurrentHex
       c1.q:=q;
       c1.r:=r;
       c1.s:=s;
       c1.x:=p3.x;
       c1.y:=p3.y;
       
       Label1.Caption:='CurrentHex Q ='+FloatToStr(c1.q);
       Label2.Caption:='CurrentHex R ='+FloatToStr(c1.r);
       Label3.Caption:='CurrentHex S ='+FloatToStr(c1.s);
       Label4.Caption:='CurrentHex X ='+FloatToStr(c1.x);
       Label5.Caption:='CurrentHex Y ='+FloatToStr(c1.y);
       
      end;
       
      end.

    На всякий случай прикладываю исходники. Программа: Delphi 7.
    Прикреплённый файлПрикреплённый файлHexTile.zip (13,5 Кбайт, скачиваний: 8)
    Сообщение отредактировано: Katerina1993 -
      Вся проблема в том, что вы в обработчике мыши занимаетесь перерисовкой. Это не правильно. Но если так хочется, тогда запоминайте координаты hex, который перерисовали и вначале обработчика сохраняйте его, а перед перерисовкой проверяйте на совпадение с текущим. Если совпадает, тогда не перерисовывайте, иначе сначала стирайте (перерисовывайте черным цветом) старый, а после перерисовывайте синим новый.
        Помоему это и так очевидно, что нужно как-то предыдущий hex вычислить только я не знаю как?
          Так он у вас уже вычислен. Просто используйте значения из переменных (перенесите переменные из обработчика в блок глобальных).

          Вот смотрите. У вас вызывается обработчик MouseMove первый раз и в глобальных значениях должно быть как-то помечено, что координаты предыдущего hex не существуют (самое простое указать значения по больше или отрицательные, тогда он просто не нарисуется). Далее выполняется обработчик MouseMove и вычисляет по координатам x, y некоторый новый hex. Вот эти значения и сохраняйте в глобальные переменные.

          При втором и последующих вызовах обработчика надо будет сравнивать координаты в глобальных переменных и получившиеся при вычислениях с x, y передаваемых в параметрах обработчику MouseMove. Если координаты совпали, тогда мышка все еще двигается над одним и тем же hex. Если не совпали, тогда hex, который сохранен в глобальных переменных стираете (перерисовываете черным), а вновь вычисленный hex перерисовываете синим. А после обновляете значения в глобальных переменных записывая туда координаты нового hex.
          Сообщение отредактировано: macomics -
            Совет в целом верный, но только никогда не делайте так:
            Цитата macomics @
            перенесите переменные из обработчика в блок глобальных

            Цитата macomics @
            самое простое указать значения по больше или отрицательные

            !
              По хорошему лучше всего сохранять координаты x, y и пересчитывать. Но это муторно, нужно писать функции, но будет правильнее.

              ExpandedWrap disabled
                // ...
                type TForm1 = class(TForm)
                   // ...
                   private
                   // ...
                      hex_hit: TPoint; // Это поле надо при создании формы инициализировать значениями Point(ClientWidth div 2, ClientHeight div 2). Или просто обнулить.
                   end;
                 
                // ...
                 
                implementation
                 
                // ...
                 
                function GetHexByCoord(hit: TPoint; tc: TRect): TPoint2; // Эта функция написана соответственно вашему же коду из обработчика MouseMove
                var hX:THex; p1:TPoint2; // она позволяет дважды рассчитать hex по набору координат курсора.
                begin
                   p1.x := hit.x - tc.left;
                   p1.y := hit.y - tc.top;
                   p1.z := 0;
                   with cubeRound(pixelToHex(p1)) do begin
                      hX.q := q;
                      hX.r := r;
                      hX.s := s;
                   end;
                   with hexToPixel(hX) do begin
                      Result.x := x;
                      Result.y := y;
                      Result.z := 0;
                   end;
                end;
                 
                procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
                  Y: Integer);
                var prev, curr: TPoint2;
                begin
                   prev := GetHexByCoord(hex_hit, ClientRect); // Вычисляем повторно параметры предыдущего hex по координатам сохраненным в приватном поле hex_hit
                   curr := GetHexByCoord(Point(X, Y), ClientRect); // Вычисляем параметры текущего hex по координатам полученным обработчиком MouseMove
                   if (curr.x <> prev.x) or (curr.y <> prev.y) then begin // Сравниваем параметры и если один из них не совпадает, тогда надо перерисовывать
                      drawHex(prev, clBlack, 2); // Сначала стираем старый hex (перерисовываем черным, но нужно увеличить ширину пера иначе останутся синие пиксели)
                      drawHex(curr, $d52b1e, 2); // Потом рисуем новый hex
                      hex_hit := Point(X, Y); // и сохраняем параметры для проверки на следующем вызове
                   end;
                end;
                 
                // ...
                 
                end.
              Вот как-то так. Я ваш же код переписал и не проверял расчеты, но должно работать.
                ExpandedWrap disabled
                  unit Unit1;
                   
                  interface
                   
                  uses
                    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                    Dialogs, StdCtrls, ComCtrls, ExtCtrls;
                   
                  type
                    ThexParametres=record hexHeight,hexWidth,vertDist,horizDist:Currency  ; end;
                    TPoint2=record x,y,z:Currency  ; end;
                    THex=record q,r,s:Currency  ; end;
                    TCurrentHex=record q,r,s,x,y:Currency  ; end;
                    TRect=record left,right,top,bottom:Currency  ; end;
                    TForm1 = class(TForm)
                      Label1: TLabel;
                      ControlBar1: TControlBar;
                      Label2: TLabel;
                      Label3: TLabel;
                      Label4: TLabel;
                      Label5: TLabel;
                      procedure FormCreate(Sender: TObject);
                      procedure FormPaint(Sender: TObject);
                      procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
                        Y: Integer);
                    private
                      { Private declarations }
                    public
                      { Public declarations }
                    end;
                    function getHexParametres():ThexParametres;
                    function hexToPixel(h:THex):TPoint2;
                    function getHexCornerCoord(center:TPoint2; i:Integer):TPoint2;
                    procedure drawHex(center:TPoint2;color:TColor;width:Integer);
                    procedure drawLine(start1, end1:TPoint2;color:TColor;width:Integer);
                    procedure drawHexCoordinates(cs:TCanvas;center:TPoint2;h:THex);
                    function getCanvasPosition():TRect;
                    function Hex(q,r,s:Integer):THex;
                    function pixelToHex(p:TPoint2):THex;
                    function cubeRound(cube:THex):THex;
                   // Hex(q,r,s){
                     //   return {q:q,r:r,s:s}
                     // }
                    //function pixelToHex()
                  var
                    Form1: TForm1;
                    hexWidth, hexHeight,vertDist,horizDist:Integer;
                    canvasWidth, canvasHeight:Integer;
                    hexParametres: ThexParametres;
                  implementation
                   
                  {$R *.dfm}
                   
                   
                  procedure drawLine(start1, end1:TPoint2;color:TColor;width:Integer);
                  begin
                  Form1.Canvas.Pen.Width:=width;
                  Form1.Canvas.Pen.Color:=color;
                  Form1.Canvas.MoveTo(Trunc(start1.x),Trunc(start1.y));
                  Form1.Canvas.LineTo(Trunc(end1.x),Trunc(end1.y));
                  end;
                   
                   
                   
                  procedure drawHexCoordinates(cs:TCanvas;center:TPoint2;h:THex);
                  begin
                   Cs.Font.Size:= 4;
                   Cs.TextOut(Trunc(center.x+2), Trunc(center.y-10),FloatToStr(h.q));
                   Cs.TextOut(Trunc(center.x), Trunc(center.y+5),FloatToStr(h.r));
                   Cs.TextOut(Trunc(center.x-15), Trunc(center.y-10),FloatToStr(h.s));
                   
                  end;
                   
                  function cubeRound(cube:THex):THex;
                  var rx, ry, rz, x_diff, y_diff, z_diff:Real;
                  begin
                  rx := Trunc(cube.q);
                  ry := Trunc(cube.r);
                  rz := Trunc(cube.s);
                   
                  x_diff := Abs(rx - cube.q);
                  y_diff := Abs(ry - cube.r);
                  z_diff := Abs(rz - cube.s);
                   
                  if ((x_diff > y_diff) and (x_diff > z_diff)) then
                  begin
                    rx := -ry-rz;
                  end
                  else
                  if (y_diff > z_diff) then
                  begin
                    ry := -rx-rz;
                  end
                  else
                  begin
                     rz := -rx-ry;
                  end;
                   
                  result.q:=rx;
                  result.r:=ry;
                  result.s:=rz;
                   
                   
                   
                  end;
                   
                  function pixelToHex(p:TPoint2):THex;
                  var q,r:Real;
                  var size:Integer;
                  begin
                  size:=20;
                   q:=((p.x - 400) * Sqrt(3)/3 - (p.y - 300) / 3) / size;
                   r:= (p.y - 300) * 2/3 / size;
                   result.q := q;
                   result.r := r;
                   result.s := - q - r;
                  end;
                   
                  procedure drawHex(center:TPoint2;color:TColor;width:Integer);
                  var i:Integer;
                  var start1,end1:TPoint2;
                  begin
                   for i := 0 to 5 do
                   begin
                     start1 := getHexCornerCoord(center,i);
                     end1 := getHexCornerCoord(center,i+1);
                     drawLine(start1, end1,color,width);
                   end;
                   
                  end;
                   
                  function getHexCornerCoord(center:TPoint2; i:Integer):TPoint2;
                  var angle_deg, angle_rad,x,y:Real;
                  begin
                  angle_deg := 60 * i + 30;
                  angle_rad := PI / 180 * angle_deg;
                  x := center.x + 20 * Cos(angle_rad);
                  y := center.y + 20 * Sin(angle_rad);
                  result.x := x;
                  result.y := y;
                  end;
                   
                  function getCanvasPosition():TRect;
                  begin
                  result.left := 0;
                  result.right := 802;
                  result.top := 8;
                  result.bottom := 610;
                  end;
                   
                  function Hex(q,r,s:Integer):THex;
                  begin
                    result.q := q;
                    result.r := r;
                    result.s := s;
                  end;
                   
                  function hexToPixel(h:THex):TPoint2;
                  begin
                   result.x := 20 * Sqrt(3) * (h.q + h.r/2) + 400;
                   result.y := 20 * 3/2 * h.r + 300;
                  end;
                  function getHexParametres():ThexParametres;
                  begin
                   result.hexHeight:=20*2;
                   result.hexWidth:= Sqrt(3)/2 * 40;
                   result.vertDist:= 40 * 3 / 4;
                   result.horizDist:=34.64101615137754;
                  end;
                   
                   
                   
                   
                  procedure TForm1.FormPaint(Sender: TObject);
                  var hexWidth, hexHeight,vertDist,horizDist:Currency;
                  var hPar:ThexParametres;
                  var qLeftSide,qRightSide,rTopSide,rBottomSide:Integer;
                  var r,r1,p,q,n:Integer;
                  var h,p1:TPoint2;
                  var x,y:Real;
                  begin
                   
                   
                   
                  hPar:=getHexParametres();
                   
                  hexWidth := hPar.hexWidth;
                  hexHeight := hPar.hexHeight;
                  vertDist := hPar.vertDist;
                  horizDist := hPar.horizDist;
                   
                  qLeftSide := Round(400/horizDist);
                  qRightSide := Round((800 - 400)/horizDist);
                  rTopSide := Round(300/vertDist);
                  rBottomSide := Round((600 - 300)/vertDist);
                   
                   
                   
                  p:=0;
                  for r := 0 to rBottomSide do
                  begin
                   if (r mod 2 = 0) and (r<>0) then
                   begin
                     inc(p);
                   end;
                   for q := -qLeftSide to qRightSide do
                    begin
                     h := hexToPixel(Hex(q-p,r,0));
                     x:=h.x;
                     y:=h.y;
                     if (((x > hexWidth/2) and (x < 800 - hexWidth/2)) and ((y > hexHeight/2) and (y < 600 - hexHeight/2))) then
                     begin
                      p1.x := x;
                      p1.y := y;
                      p1.z := 0;
                      drawHex(p1,$000000,1);
                    
                      drawHexCoordinates(Form1.Canvas, p1, Hex(q-p,r,-q -r));
                     // ShowMessage(FloatToStr(x));
                     end;
                   
                    end;
                   
                   
                   
                   
                  end;
                   
                  n := 0;
                   
                  for r1 := -1 downto -rTopSide do
                  begin
                   
                   if (r1 mod 2 <> 0) then
                   begin
                     inc(n);
                   end;
                   for q := -qLeftSide to qRightSide do
                    begin
                   
                     h := hexToPixel(Hex(q+n,r1,0));
                     x:=h.x;
                     y:=h.y;
                    
                     if (((x > hexWidth/2) and (x < 800 - hexWidth/2)) and ((y > hexHeight/2) and (y < 600 - hexHeight/2))) then
                     begin
                   
                      p1.x := x;
                      p1.y := y;
                      p1.z := 0;
                      
                      drawHex(p1,$000000,1);
                      drawHexCoordinates(Form1.Canvas, p1, Hex(q+n,r1,-q -r1));
                      
                     end;
                    end;
                   
                  end;
                  end;
                   
                  procedure TForm1.FormCreate(Sender: TObject);
                  begin
                  form1.DoubleBuffered:=true
                  end;
                   
                  procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
                    Y: Integer);
                  var tC:TRect;
                  left,  top, q,r,s:Real;
                   
                  offsetX,offsetY:Real;
                  hX,h1:THex;
                  p1,p3,htp:TPoint2;
                  c1:TCurrentHex;
                  begin
                   
                    tC := getCanvasPosition();
                    left := tC.left;
                   // right := tC.right;
                    top := tC.top;
                    //bottom := tC.bottom;
                   
                    offsetX := X - left;
                    offsetY := Y - top;
                    p1.x:=offsetX;
                    p1.y:=offsetY;
                    p1.z:=0;
                   
                   
                    hX := cubeRound(pixelToHex(p1));
                   
                    q := hX.q;
                    r := hX.r;
                    s := hX.s;
                   
                    h1.q:=q;
                    h1.r:=r;
                    h1.s:=s;
                    
                   
                    htp := hexToPixel(h1);
                    
                   
                    p3.x:=htp.x;
                    p3.y:=htp.y;
                    p3.z:=0;
                    form1.Repaint;
                    drawHex(p3,$d52b1e,2);
                   // drawHex(p3,$F0F0F0,2);
                   //drawHex(p1,$000000,1);
                   //Form1.Canvas.Pen.Width:=1;
                   
                   //TCurrentHex
                   c1.q:=q;
                   c1.r:=r;
                   c1.s:=s;
                   c1.x:=p3.x;
                   c1.y:=p3.y;
                   
                   Label1.Caption:='CurrentHex Q ='+FloatToStr(c1.q);
                   Label2.Caption:='CurrentHex R ='+FloatToStr(c1.r);
                   Label3.Caption:='CurrentHex S ='+FloatToStr(c1.s);
                   Label4.Caption:='CurrentHex X ='+FloatToStr(c1.x);
                   Label5.Caption:='CurrentHex Y ='+FloatToStr(c1.y);
                   
                  end;
                   
                  end.


                Можно так, но это подгон по желаемое)

                В общем фокус в том, что я заставляю поле перерисоваться и после "закрашиваю" выбранный шестигранник.
                Но можно же и "область закрасить с центром" перерисовать, так чтобы стерся предыдущий "выделенный шестигранник". :scratch:
                Сообщение отредактировано: RusSun -
                  macomics, Ошибку выдает "Несоответствие типов", когда используешь ClientRect во втором параметре GetHexByCoord. Я решила использовать getCanvasPosition. Почти получилось только все равно след остается темного цвета и с толщиной линии “2”. Пример:
                  ExpandedWrap disabled
                    procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
                      Y: Integer);
                    var tC:TRect;
                    //left,  top, q,r,s:Real;
                     
                    //offsetX,offsetY:Real;
                    //hX,h1:THex;
                    //p1,p3,htp:TPoint2;
                    //c1:TCurrentHex;
                    var prev, curr: TPoint2;
                    begin
                     
                       tC := getCanvasPosition();
                       prev := GetHexByCoord(hex_hit, tC); // Вычисляем повторно параметры предыдущего hex по координатам сохраненным в приватном поле hex_hit
                       curr := GetHexByCoord(Point(X, Y), tC); // Вычисляем параметры текущего hex по координатам полученным обработчиком MouseMove
                       if (curr.x <> prev.x) or (curr.y <> prev.y) then begin // Сравниваем параметры и если один из них не совпадает, тогда надо перерисовывать
                          drawHex(prev, clGreen, 1); // Сначала стираем старый hex (перерисовываем черным, но нужно увеличить ширину пера иначе останутся синие пиксели)
                          drawHex(curr, $d52b1e, 2); // Потом рисуем новый hex
                          hex_hit := Point(X, Y); // и сохраняем параметры для проверки на следующем вызове
                       end;
                    end;
                  Сообщение отредактировано: Katerina1993 -
                    Чтобы избавиться от следа черного цвета можно: а) увеличить в Paint ширину пера для рисования элементов до 2; б) вызвать рисование hex 3 раза, при этом первый раз рисовать старый hex цветом фона, второй раз рисовать его же черным, а после обводить синим новый.

                    ExpandedWrap disabled
                          procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
                            Y: Integer);
                          var tC:TRect;
                          //left,  top, q,r,s:Real;
                          
                          //offsetX,offsetY:Real;
                          //hX,h1:THex;
                          //p1,p3,htp:TPoint2;
                          //c1:TCurrentHex;
                          var prev, curr: TPoint2;
                          begin
                          
                             tC := getCanvasPosition();
                             prev := GetHexByCoord(hex_hit, tC); // Вычисляем повторно параметры предыдущего hex по координатам сохраненным в приватном поле hex_hit
                             curr := GetHexByCoord(Point(X, Y), tC); // Вычисляем параметры текущего hex по координатам полученным обработчиком MouseMove
                             if (curr.x <> prev.x) or (curr.y <> prev.y) then begin // Сравниваем параметры и если один из них не совпадает, тогда надо перерисовывать
                                drawHex(prev, Form1.Color, 2); // Очищаем до цвета фона (но у прилегающих hex немного обрежем границы, а чтобы и от этого избавиться, тогда надо перерисовать все 6 hex: этот центральный и еще 5 прилегающих, кроме того, который нарисуем синим)
                                drawHex(prev, clGreen, 1); // Сначала стираем старый hex (перерисовываем черным, но нужно увеличить ширину пера иначе останутся синие пиксели)
                                drawHex(curr, $d52b1e, 2); // Потом рисуем новый hex
                                hex_hit := Point(X, Y); // и сохраняем параметры для проверки на следующем вызове
                             end;
                          end;
                      Все, вопрос решен спасибо за помощь.
                      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                      0 пользователей:


                      Рейтинг@Mail.ru
                      [ Script execution time: 0,1500 ]   [ 18 queries used ]   [ Generated: 29.03.24, 14:54 GMT ]