Перейти к содержанию
  • 0
jekans

Как определить цвет пикселя?

Вопросы

Подскажите пожалуйста глупому человеку :), как можно загрузив изображение:

buf: TBitmap;
buf.LoadFromFile('.bmp');

Определить цвет нужного мне пикселя (X,Y), и нарисовать хотя бы линию этого цвета на форме используя обычный: 

Canvas.DrawLine
 
 

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Рекомендуемые сообщения

  • 1

В первую очередь нужно научиться пользоваться поиском.

 

Определить цвет нужного мне пикселя (X,Y)...

и нарисовать хотя бы линию этого цвета на форме используя обычный: Canvas.DrawLine

 

На всякий случай пример:

var
  C: TAlphaColor;

procedure TForm1.FormCreate(Sender: TObject);
begin
   c := TAlphaColorRec.Null;
end;

///<Summary>
/// Получение цвета пикселя
///</Summary>
procedure TForm1.Button1Click(Sender: TObject);
var
  bm: TBitmap;
  M: TBitmapData;
begin
   bm := TBitmap.Create;
   bm.LoadFromFile( 'c:\TROP002_w100h100.PNG' );

   // Получение цвета пикселя
   bm.Map( TMapAccess.Read, M );
   C := M.GetPixel( 10, 10 );
   bm.Unmap( M );

   // Принудительная перерисовка
   Invalidate;

   bm.Free;
end;

///<Summary>
/// Отрисовка линии
///</Summary>
procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
begin
   Canvas.Stroke.Color := C;
   Canvas.Stroke.Kind := TBrushKind.Solid;
   Canvas.DrawLine( PointF( 0, 0 ), PointF( 100, 100 ), 1 );
end;

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0
estra

Премного благодарен сударь!!! :)

Пример этот я видел, но увы маленько "затупил" и у меня не вышло =(

Ваш код отличный!! особенно для меня как начинающего в освоении FM.

Спасибо!

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
Гость
Эта тема закрыта для публикации ответов.

  • Похожий контент

    • От ddr 2
      Требуется на форме отображать картинку TImage(кадр) обновляя её с высокой частотой. Обновляемая картинка динамически формируется попиксельно. Попиксельный доступ реализован через TBitmapData. Формирование кадра достаточно ресурсоёмко. Есть желание вынести формирование кадра в отдельный поток. Но опытным путем я выяснил, что TBitmapData нельзя использовать вне основного потока. Ниже тестовая демонстрационная реализация. Формирование кадра вынесено в функцию GetFMXBitmap. Если bmp := GetFMXBitmap; вызывается через Synchronize, то код на 100% потокобезопасен, если же вызов идет без Synchronize, то приложение валиться, достаточно лишь мышкой энергично изменять размеры окна(формы). Вопрос: TBitmapData полученный через TBitMap.Map действительно можно использовать только из основного потока, или  я допустил какую-то ошибку? Если только основной поток, то как бы поизящней обойти это ограничение?
      unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects; type TTestThread=class(TThread) Private Protected Procedure execute;override; Public constructor create(); end; TForm1 = class(TForm) Image1: TImage; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } TestTthread: TTestThread; end; var Form1: TForm1; implementation {$R *.fmx} function GetFMXBitmap: FMX.Graphics.TBitmap; var bitdata: TBitmapData; Count:Cardinal; begin Result := FMX.Graphics.TBitmap.Create; Result.SetSize(640,512); if (Result.Map(TMapAccess.ReadWrite{Write}, bitdata)) then try // здесь "рисуем" через bitdata for count := 0 to Result.width*Result.height-1 do begin pbyte(bitdata.Data)[4*count]:=Random(255); pbyte(bitdata.Data)[4*count+1]:=Random(255); pbyte(bitdata.Data)[4*count+2]:=Random(255); pbyte(bitdata.Data)[4*count+3]:=$FF; end; finally Result.Unmap(bitdata); end; end; constructor TTestThread.create(); begin FreeOnTerminate := true; inherited Create(false); end; Procedure TTestThread.execute; var bmp: FMX.Graphics.TBitmap; begin while not Terminated do begin {Вариант 1- следующая строчка закоментарена, Вариант 2- следующая строчка НЕ закоментарена } //bmp := GetFMXBitmap; TThread.Synchronize(nil, procedure begin {Вариант 1- следующая строчка НЕ закоментарена, Вариант 2- следующая строчка закоментарена } bmp := GetFMXBitmap; Form1.Image1.Bitmap.Assign(bmp); bmp.Free; end); end; end; procedure TForm1.FormCreate(Sender: TObject); begin Image1.Width:=640; Image1.Height:=512; TestTthread:=TTestThread.create; end; procedure TForm1.FormDestroy(Sender: TObject); begin TestTthread.Terminate; end; end.  
    • От Евгений Корепов
      Для одного своего проекта сделал, поделюсь, вдруг кому пригодится. Тестировал под Windows и Android.
      Для использования просто добавьте BitmapAsyncLoader в uses, а дальше все просто:
      ImageControl.Bitmap.LoadFromURLAsync('https://bipbap.ru/wp-content/uploads/2017/10/0_8eb56_842bba74_XL-640x400.jpg'); Код юнита хелпера:
      unit BitmapAsyncLoader; interface uses FMX.Graphics, System.Net.HttpClient, System.Types, System.Classes; type TBitmapAsyncLoader = class helper for TBitmap procedure LoadFromUrlAsync(const AUrl : String); end; implementation var AHTTPClient : THTTPClient; procedure TBitmapAsyncLoader.LoadFromURLAsync(const AURL : String); begin try AHTTPClient.BeginGet( procedure (const ASyncResult: IAsyncResult) var AHTTPResponse : IHTTPResponse; begin if Not ASyncResult.IsCompleted then exit; try AHTTPResponse:=THTTPClient.EndAsyncHTTP(ASyncResult); except end; if Assigned(AHTTPResponse) and (AHTTPResponse.StatusCode = 200) then TThread.Synchronize(Nil, procedure begin try Self.LoadFromStream(AHTTPResponse.ContentStream); except end; end ); end, AURL ); except end; end; initialization AHTTPClient:=THTTPClient.Create; finalization if Assigned(AHTTPClient) then begin AHTTPClient.DisposeOf; end; end. Архив с тестовым проектом прилагаю.
      BitmapAsyncLoader.7z
    • От PavelS
      Здравствуйте! Начал изучать FireMonkey  и столкнулся с тем, что TBitmap не поддерживает размер изображения больше 8132, кажется. Т.е. большие размеры рисунка он грузит, но за счёт потери качества, размер пиксела растёт, а размер рисунка по оси всё равно не превышает 8132. В то же время в простом дельфи можно грузить и работать с гораздо большими размерами, например, один из файлов имеет размер 61216 х 1486 точек. Подскажите пожалуйста, есть ли возможность работать с большими файлами в FireMоnkey и как это можно организовать? Программа создаётся для работы только в Windows.
    • От Tot999
      Добрый день! 
      Решил покопаться в своей старой спрайтовой игрушке, чтобы освежить в памяти знания и состряпать что-нибудь новое. Возникли сомнения, нормально ли сделано графическое отображение, можно ли доработать.
      Все спрайты в дизайнтайме распиханы по Timagelist-ам.  На старте приложения я загружаю битмапы из имэджлистов в свои обджектлисты, подгоняя под нужный размер. 
      MeduzasBitmpAr : array [1..numofMeduzas] of TObjectList<Tbitmap>;  
      Дальше рисую по таймеру в основном окне игры Tpaintbox.OnPaint:
               
      В принципе, даже на слабеньких телефончиках, всё вроде бодро. Но может, опытные товарищи чего подскажут, а то я 3ий день в собственном соку варюсь, ничего толкового.
    • От Ilya.Z
      Добрый день, может туплю, или не туда копаю.. есть ли Firemonkey более менее стандартный способ рисовать на поверхности  3D фигур?
      в частности интересует сфера, есть две координаты, нужно провести чрез них линию, так что бы бы она легла на поверхность, или начертить фигуру так же лежащую на поверхности.
      или надо копать в глубь математики, и разбивать на множество отрезков, расчитывать каждую координату для каждой точки и т.д.
      ну а заливка фигур как понимаю только через материалы доступна в 3D, но можно залить ограниченную область на поверхности тогда ?
      нашел очень симпатичный пример на youtube от QuarkCube - Sketch3d, но там интерактивное рисование мышкой, и каждая линия это множество примитивов, все красиво но не совсем то )
      пытаюсь рисовать скажем планету, и показать на ней треки, области, точки:) 
    • От Jeysi Z
      Здравствуйте, для проекта понадобилось рисовать разные 3d линии в зависимости от значения переменной, сначала решил проверить на совсем простом примере, но сразу возникли проблемы. В общем, в процедуре render организован case для переменной stage, в зависимости от её значения должны рисоваться разные линии, но этого не происходит, рисуется только первоначальная линия. 
      Вот код процедуры :
      procedure TForm2.Dummy1Render(Sender: TObject; Context: TContext3D); var i:integer; begin case stage of 1:begin if Context.BeginScene then try Context.Clear(TAlphaColorRec.White); Context.DrawLine(TPoint3D.Create(3,3,0),TPoint3D.Create(3,-3,0),1,TAlphaColorRec.Black); finally Context.EndScene; end; end; 2:begin if Context.BeginScene then try Context.Clear(TAlphaColorRec.White); Context.DrawLine(TPoint3D.Create(-3,3,0),TPoint3D.Create(-3,-3,0),1,TAlphaColorRec.Black); finally Context.EndScene; end; end; end; end;  Вот скрины работы программы. Снизу отображается значение переменной stage.

      Заранее спасибо.
    • От Jeysi Z
      Здравствуйте, начал делать проект о сечениях, нарисовал на viewport3D куб, поставил на грани несколько сфер и соединил их линиями (это была часть задумки). Потом решил добавить всему этому вращение, но когда начинаю вращать всё, что рисовалось в рендере пропадает, причём при отдалении камеры всё нормально. Не подскажете, как можно это исправить?
      Вот код рендера:
      procedure TForm2.Dummy1Render(Sender: TObject; Context: TContext3D);
      begin
      if Context.BeginScene then
          try
            Context.DrawLine(TPoint3D.Create(-3,3,-3),TPoint3D.Create(3,3,-3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(3,-3,-3),TPoint3D.Create(3,3,-3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(3,-3,-3),TPoint3D.Create(-3,-3,-3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(-3,3,-3),TPoint3D.Create(-3,-3,-3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(-3,3,3),TPoint3D.Create(3,3,3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(3,-3,3),TPoint3D.Create(3,3,3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(3,-3,3),TPoint3D.Create(-3,-3,3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(-3,3,3),TPoint3D.Create(-3,-3,3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(-3,3,-3),TPoint3D.Create(-3,3,3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(3,-3,-3),TPoint3D.Create(3,-3,3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(-3,-3,3),TPoint3D.Create(-3,-3,-3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(3,3,3),TPoint3D.Create(3,3,-3),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(Sphere1.Position.X,Sphere1.Position.Y,Sphere1.Position.Z),
            TPoint3D.Create(Sphere2.Position.X,Sphere2.Position.Y,Sphere2.Position.Z),1,TAlphaColorRec.Black);
            Context.DrawLine(TPoint3D.Create(Sphere3.Position.X,Sphere3.Position.Y,Sphere3.Position.Z),
            TPoint3D.Create(Sphere2.Position.X,Sphere2.Position.Y,Sphere2.Position.Z),1,TAlphaColorRec.Black);
          finally
            Context.EndScene;
          end;
      end;
      Вот код вращения
      procedure TForm2.Viewport3D1MouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Single);
      begin
          if ssleft in shift then
          begin
            Dummy2.RotationAngle.X:=Dummy2.RotationAngle.X-((Y-rot.Y)*0.3);
            Dummy2.RotationAngle.Y:=Dummy2.RotationAngle.Y-((X-rot.X)*0.3);
            Rot:=PointF(X,Y);
          end;
      end;
      Процедура масштабирования
      procedure TForm2.Viewport3D1MouseWheel(Sender: TObject; Shift: TShiftState;
        WheelDelta: Integer; var Handled: Boolean);
      begin
        CameraZ.Position.Z:=CameraZ.Position.Z+WheelDelta/40;
      end;
      На изображениях показано как работает программа


      И ещё один вопрос если позволите. Обнаружил, что если ставить отображение камеры и объектов на viewport3d как screen, то не получается сменить стандартную камеру. Можно ли это исправить?
      Заранее спасибо.
    • От Jeysi Z
      Здравствуйте, для проекта понадобилось рисовать линии в 3d графике, но возникла такая проблема, можете подсказать, что не так?
      Вот часть кода
      procedure TForm2.Sphere1Render(Sender: TObject; Context: TContext3D);
      var v1,v2:TPoint3D;
      begin
        if Context.BeginScene then
        try
          v1:=TPoint3D.Create(Sphere1.Position.X,Sphere1.Position.Y,Sphere1.Position.Z);
          v2:=TPoint3D.Create(Sphere2.Position.X,Sphere2.Position.Y,Sphere2.Position.Z);
          Context.drawline(v1,v2,1,TAlphaColorRec.Black);
        finally
          Context.EndScene;
        end;
      end;
      На изображении результат работы программы.

    • От x11
      Можно ли получить TBitmap из TBitmapImage? Конвертировать.
    • От Freezer_86
      Пишу кроссплатформенное приложение. Результат поиска отображается в TGrid. Стал вопрос отображения картинки в одной из колонок.
      На Windows все ок, но на планшете происходят просто чудеса: при первом отображение все корректно, но если простоколить вверх-вниз как картинки одни перетираются другими, часть вообще отображается вверх ногами.
      Код для сохранение картинки(jpg) в базу:
      if Assigned(sm) then begin sm.Position := 0; //TBlobField(dmData.cdsPlayerData.FieldByName('Photo')).LoadFromStream(sm); vImage := TImage.Create(nil); try sm.Position := 0; vImage.Bitmap.LoadFromStream(sm); vKoef := vImage.Bitmap.Height / 64; vImage.Bitmap.Resize(Trunc(vImage.Bitmap.Width / vKoef), Trunc(vImage.Bitmap.Height / vKoef)); sm.Free; sm := TMemoryStream.Create(); try vImage.Bitmap.SaveToStream(sm); TBlobField(dmData.cdsPlayerData.FieldByName('SmallPhoto')).LoadFromStream(sm); finally sm.Free; end; finally vImage.Free; end; end{if}; До скрола:

      После скрола:

      Пробовал и LiveBinding, и ручную прорисовку - результат один и тот же. Есть идеи что не так?
      P.S. Знаю что нужно делать через TListView, но заказчик хочет «сеточку как в старой программе», так как на android будет работать только на планшетах – я согласился.
       
  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу

×
×
  • Создать...