Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Lazarus, Free Pascal, CodeTyphon
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 31.07.2016, 10:39   #1
zvygin1964
Старожил
 
Аватар для zvygin1964
 
Регистрация: 19.06.2013
Сообщений: 2,463
По умолчанию Рисование на Image.

Хочу рисованную стрелку. Сам сделать не смогу. Пока делаю так:
Код:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
     t:=t+i ;
     x:=round(xc+ro*sin(t*pi/180))-((random(20)*i));{определяем координаты}
     y:=round(yc-ro*cos(t*pi/180));
      //======================
      if   (x<=40) then   // условие границы
      begin
     x:=40 ;
     i:=1;
      end
      else
      begin
    //ничего не делаем
     end;

      if (x>=290) then   // условие границы
      begin
      x:=290;
      i:=-1;
      end
     else
     begin
     //ничего не делаем
     end;
    // ======================
     Shape1.Left:=x;
     Shape1.Top:=y;
end;
Изображения
Тип файла: gif стрелка, которая работает.gif (60.2 Кб, 168 просмотров)
Вложения
Тип файла: 7z Shape1 кружится по Image_6.7z (580.1 Кб, 18 просмотров)
Репутация: полный "0"
zvygin1964 вне форума Ответить с цитированием
Старый 31.07.2016, 11:05   #2
newerow1989
Я самый любопытный
Участник клуба
 
Аватар для newerow1989
 
Регистрация: 24.07.2012
Сообщений: 1,949
По умолчанию

Ну, тут 2 варианта:
- либо добавить Image2, нарисовать на нем стрелку и поворачивать ее;
- либо геометрически вычислять расположение контура стрелки

Я могу отрезок начертить без стрелки!

Я не могу сообразить, для чего "-((random(20)*i));"?
С запрограммированным приветом, Неверов Евгений!
Сайт: http://newerow1989.ru
[Паскаль] [Delphi]

Последний раз редактировалось newerow1989; 31.07.2016 в 11:08.
newerow1989 вне форума Ответить с цитированием
Старый 31.07.2016, 11:37   #3
zvygin1964
Старожил
 
Аватар для zvygin1964
 
Регистрация: 19.06.2013
Сообщений: 2,463
По умолчанию

Цитата:
Сообщение от newerow1989 Посмотреть сообщение
- либо добавить Image2, нарисовать на нем стрелку и поворачивать ее;
С этим я справиться не смог. Не слушается и не переводится в Лазарус:
Код:
type
  PixelArray=array [0..32768] of TRGBTriple;
  pPixelArray=^PixelArray;
 
var
  b: TBitmap;

procedure RotateBitmap_ads(SourceBitmap: TBitmap;
          out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
  cosRadians : Double;
  inX : Integer;
  inXOriginal : Integer;
  inXPrime : Integer;
  inXPrimeRotated : Integer;
  inY : Integer;
  inYOriginal : Integer;
  inYPrime : Integer;
  inYPrimeRotated : Integer;
  OriginalRow : pPixelArray;
  Radians : Double;
  RotatedRow : pPixelArray;
  sinRadians : Double;
begin
  DestBitmap.Width := SourceBitmap.Width;
  DestBitmap.Height := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf24bit;
  Radians := -(Angle) * PI / 180;
  sinRadians := Sin(Radians);
  cosRadians := Cos(Radians);
  for inX := DestBitmap.Height-1 downto 0 do
  begin
    RotatedRow := DestBitmap.Scanline[inX];
    inXPrime := 2*(inX - 300) + 1;      //inXPrime := 2*(inX - Center.y) + 1;
    for inY := DestBitmap.Width-1 downto 0 do
    begin
     inYPrime := 2*(inY - Center.x) + 1;    // inYPrime := 2*(inY - Center.x) + 1;   // inYPrime := 2*(inY - 300) + 1;    // inYPrime := 2*(inY - Center.x) + 1;
      inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians); //inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
      inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
      inYOriginal := (inYPrimeRotated - 1)+ 200;   // inYOriginal := (inYPrimeRotated - 1) div 2 + Center.x;
      inXOriginal := (inXPrimeRotated - 1) + 200; //inXOriginal := (inXPrimeRotated - 1) div 2 + 200;
      if (inYOriginal >= 0) and (inYOriginal <= SourceBitmap.Width-1) and
      (inXOriginal >= 0) and (inXOriginal <= SourceBitmap.Height-1) then
      begin
        OriginalRow := SourceBitmap.Scanline[inXOriginal];
        RotatedRow[inY] := OriginalRow[inYOriginal];
      end
      else
      begin
        RotatedRow[inY].rgbtBlue :=255; //  фон под картинкой после поворота   := 255;
        RotatedRow[inY].rgbtGreen :=255;
        RotatedRow[inY].rgbtRed :=255;//clWhite ;
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  b:= TBitmap.Create;
  b.Width:= Image3.Width;
  b.Height:= Image3.Height;
  Image3.Transparent:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  b.Free;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  RotateBitmap_ads(Image1.Picture.Bitmap,b,Point(Image1.Width div 2,Image1.Height div 2),TrackBar1.Position);
  Image3.Canvas.Draw(0,0,b);
end;
Цитата:
Сообщение от newerow1989 Посмотреть сообщение
для чего "-((random(20)*i));"?
Изображение становится реалистичней.
Изображения
Тип файла: gif сумашедшая стрелка.gif (37.9 Кб, 177 просмотров)
Репутация: полный "0"

Последний раз редактировалось zvygin1964; 31.07.2016 в 11:41.
zvygin1964 вне форума Ответить с цитированием
Старый 31.07.2016, 11:38   #4
zvygin1964
Старожил
 
Аватар для zvygin1964
 
Регистрация: 19.06.2013
Сообщений: 2,463
По умолчанию

Цитата:
Сообщение от newerow1989 Посмотреть сообщение
отрезок начертить без стрелки
Если Canvas, то получается непрозрачным.
Изображения
Тип файла: gif Canvas.gif (18.1 Кб, 171 просмотров)
Репутация: полный "0"
zvygin1964 вне форума Ответить с цитированием
Старый 31.07.2016, 11:41   #5
newerow1989
Я самый любопытный
Участник клуба
 
Аватар для newerow1989
 
Регистрация: 24.07.2012
Сообщений: 1,949
По умолчанию

Прозрачность:
Код:
Image1.Transparent:=true;
либо в окне объекте инспектора установить
С запрограммированным приветом, Неверов Евгений!
Сайт: http://newerow1989.ru
[Паскаль] [Delphi]
newerow1989 вне форума Ответить с цитированием
Старый 31.07.2016, 11:42   #6
zvygin1964
Старожил
 
Аватар для zvygin1964
 
Регистрация: 19.06.2013
Сообщений: 2,463
По умолчанию

Цитата:
Сообщение от newerow1989 Посмотреть сообщение
Прозрачность:
Код:
Image1.Transparent:=true;
либо в окне объекте инспектора установить
Transparent:=true;// Не помогает.

Переделать на Лазарус не смог:
Код:
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Image1.Swivel := TrackBar1.Position;
end;

{ TImage }

constructor TImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  FScale := TBitmap.Create;
  FScale.Width := 800;
  FScale.Height := 500;
  SetScale();

  Center := True;
  Stretch := True;
  Proportional := True;

  Swivel := 0;
end;

destructor TImage.Destroy;
begin
  FScale.Free;
  inherited;
end;

//procedure TImage.WMPaint(var Message: TWMPaint);
procedure TImage.Paint;
const
{$J+}
  b: Boolean = True;
{$J-}
var
  Xo, Yo, R: Integer;
  A: Real;
begin
  inherited;

  b := not b;
  if {Proportional and} b then Exit;

  Picture.Assign(FScale);

  Xo := 400;   // Xo := 400;
  Yo := 500;    //  Yo := 400;
  R := 350;
  A := FSwivel * pi / 180;

  with Canvas, Pen do
  begin
    Width := 5;
    Color := clBlack;
    MoveTo(Xo, Yo);
    LineTo(Xo + Round((R + 35) * cos(A)), Yo - Round((R + 35) * sin(A)));
  end; 
end;

procedure TImage.SetScale;
var
  i, j,
  Xo, Yo,
  X, Y,
  R,
  A1, A2: Integer;

  A, dA: Real;

  s: String;

begin
  Xo := 0;        //Xo := 400;
  Yo := 400;
  R := 300;
  A1 := 150;
  A2 := -120;
  A := A1 * pi / 180;
  dA := A2 / (4 * 5) * pi / 180;

  with FScale.Canvas, Pen do
  begin

    Brush.Style := bsClear;
    Brush.Color := clMoneyGreen;
    Font.Size := 16;


    Width := 5;
    Color := clWhite;
    MoveTo(Xo + Round(R * cos(A)), Yo - Round(R * sin(A)));
    AngleArc(FScale.Canvas.Handle, Xo, Yo, R, A1, A2);

    MoveTo(Xo + Round(R * cos(A)), Yo - Round(R * sin(A)));
    LineTo(Xo + Round((R + 35) * cos(A)), Yo - Round((R + 35) * sin(A)));

  end;
end;

procedure TImage.SetSwivel(ASwivel: Integer);
begin
  FSwivel := 150 - ASwivel;
  Repaint;
end;
Репутация: полный "0"

Последний раз редактировалось zvygin1964; 31.07.2016 в 11:45.
zvygin1964 вне форума Ответить с цитированием
Старый 31.07.2016, 11:44   #7
newerow1989
Я самый любопытный
Участник клуба
 
Аватар для newerow1989
 
Регистрация: 24.07.2012
Сообщений: 1,949
По умолчанию

А если индекс поменять:
Image3

Вложения не полностью выложены в первом посте!
С запрограммированным приветом, Неверов Евгений!
Сайт: http://newerow1989.ru
[Паскаль] [Delphi]
newerow1989 вне форума Ответить с цитированием
Старый 31.07.2016, 12:11   #8
zvygin1964
Старожил
 
Аватар для zvygin1964
 
Регистрация: 19.06.2013
Сообщений: 2,463
По умолчанию

Цитата:
Сообщение от newerow1989 Посмотреть сообщение
Вложения не полностью выложены в первом посте!
Переложил сюда: https://www.dropbox.com/sh/rhlrnu089...RH_MZ9XAa?dl=0


Это Панел не просвечивается. Нет у неё свойства Transparent .
Репутация: полный "0"

Последний раз редактировалось zvygin1964; 31.07.2016 в 12:20.
zvygin1964 вне форума Ответить с цитированием
Старый 31.07.2016, 12:13   #9
newerow1989
Я самый любопытный
Участник клуба
 
Аватар для newerow1989
 
Регистрация: 24.07.2012
Сообщений: 1,949
По умолчанию

Вот поворачивание стрелки на Image:
Код:
var p:array of array of TColor;
    x0,y0,alfa:integer;

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
   alfa:=0;
   x0:=Image1.Width div 2;
   y0:=Image1.Height div 2;
   If x0<y0 then
      x0:=y0;
   If x0>y0 then
      y0:=x0;
   SetLength(p,x0*2,y0*2);
   With Image1.Canvas do
   begin
      Pen.Color:=clBlack;
      Brush.Color:=clBlue;
      Polygon([Point(x0-5,y0),Point(x0-5,15),Point(x0-10,20),Point(x0,0),
         Point(x0+10,20),Point(x0+5,15),Point(x0+5,y0)]);
      For i:=0 to x0*2-1 do
         For j:=0 to y0*2-1 do
            p[i,j]:=Pixels[i,j];
   end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,j,x,y:integer;
    al,l:real;
begin
   alfa:=alfa+1;
   With Image1.Canvas do
   begin
      Pen.Color:=clWhite;
      Brush.Color:=clWhite;
      Rectangle(0,0,Image1.Width,Image1.Height);
      For i:=0 to Image1.Width do
         For j:=0 to Image1.Height do
         begin
            x:=-x0+i;
            y:=y0-j;
            l:=Sqrt(x*x+y*y);
            If x=0 then
            begin
               If y>0 then
                  al:=90 else
               If y<0 then
                  al:=270 else
                  al:=0;
            end else
            begin
               al:=ArcTan(y/x)*180/pi;
               If x<0 then
                  al:=al+180;
            end;
            al:=al+alfa+180;
            x:=Round(Cos(al*pi/180)*l)+x0;
            y:=Round(Sin(al*pi/180)*l)+y0;
            If (x>=0) and (y>=0) and (x<x0*2) and (y<y0*2) then
               Pixels[i,j]:=p[x,y];
         end;
   end;
end;
С запрограммированным приветом, Неверов Евгений!
Сайт: http://newerow1989.ru
[Паскаль] [Delphi]
newerow1989 вне форума Ответить с цитированием
Старый 31.07.2016, 13:03   #10
zvygin1964
Старожил
 
Аватар для zvygin1964
 
Регистрация: 19.06.2013
Сообщений: 2,463
По умолчанию

Нет. Тоже получилась не прозрачная. Да ещё и на черном фоне.
Изображения
Тип файла: gif стрелка от newerow1989.gif (12.2 Кб, 88 просмотров)
Репутация: полный "0"
zvygin1964 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
WYSIWYG рисование текста на Image Человек_Борща Общие вопросы Delphi 3 06.09.2013 22:58
Рисование и редактирование объектов Image ZLoy_molo4nik Мультимедиа в Delphi 2 15.05.2012 16:50
Рисование на Canve Image Alexsandr Общие вопросы Delphi 0 12.03.2012 18:15
Считыванием координат с файла и рисование в image! VinDiz Помощь студентам 2 15.01.2012 11:22
Рисование в image! За ранее огромное спасибо!!! Evgent_0 Помощь студентам 0 30.11.2011 21:39