You are not logged in. Please login or register.
My Visual Database → Russian → преобразовать цветное изображений в черно белое
продолжаю писать игру (ПАЗЛЫ)
варианты в сети по преобразованию изображения есть но у меня так не получилось применить их в MVD..
цель преобразования ( создание подсказок ) и у меня это уже реализовано, но подсказки получаются в цветном варианте, а нужен черно белый ...
видео
https://youtu.be/62V8WOg2nwQ
А в чем именно затруднения?
Доступ к пикселям картинки можно осуществить через канву, вот пример:
procedure SetMaskColor(AImage: TdbImage; AColor: TColor);
// раскрасить картинку-маску в нужный цвет
// маска служит для создания круглой виньетки.
var
x: integer;
y: integer;
begin
for y := 0 to AImage.Height - 1 do
for x := 0 to AImage.Width - 1 do
begin
if AImage.Canvas.Pixels(x, y) <> clWhite then
AImage.Canvas.Pixels(x, y) := AColor
end;
end;Преобразование цвета в компоненты тоже видел на форуме. Обратное преобразование - встроенная функция RGB();
Вот пример из проекта с форума:
procedure GenerYarkost(Color: TColor); //Генерация шкалы яркости для выбранного оттенка
var
j: Integer; //счётчики
r, g, b: real;//RGB
begin
b := Color div $10000;
g := (Color mod $10000) div $100;
r := Color mod $100;
frmCol.Caption := 'RGB: R='+floattostr(r)+' G='+floattostr(g)+' B='+floattostr(b)+' HEX: '+TColorToHex(Color);
StepR:=(256-r)/256; //определение шага для красного
StepG:=(256-g)/256; //определение шага для зелёного
StepB:=(256-b)/256; //определение шага для синего
for j:=255 downto 0 do
begin
r:=r+StepR; //меняем оттенок красного
g:=g+StepG; //меняем оттенок зеленого
b:=b+StepB; //меняем оттенок синего
if r>255 then r:=255; //проверяем чтобы не превысил 255
if g>255 then g:=255;
if b>255 then b:=255;
imCol3.Canvas.Pen.Color:=RGB(round(r), round(g), round(b));
imCol3.Canvas.MoveTo(0,j);
imCol3.Canvas.LineTo(40,j);
end;
end;Осталось выбрать формулу для перевода цвета в черно-белое изображение, например вот такую:
C = 0.2989 * R + 0.5870 * G + 0.1140 * B
А в чем именно затруднения?
Доступ к пикселям картинки можно осуществить через канву, вот пример
в примерах в сети используются GetRValue, GetGValue, GetBValue, вот их я и не понимал чем заменить, так как в MVD их нет
в примерах в сети используются GetRValue, GetGValue, GetBValue, вот их я и не понимал чем заменить, так как в MVD их нет
В Delphi и Lasarus есть... Скопипиздил из исходников:
procedure RedGreenBlue(rgb: TColor; var Red, Green, Blue: Byte);
begin
Red := rgb and $000000ff;
Green := (rgb shr 8) and $000000ff;
Blue := (rgb shr 16) and $000000ff;
end;function Blue(rgb: TColor): BYTE;
begin
Result := (rgb shr 16) and $000000ff;
end;
function Green(rgb: TColor): BYTE;
begin
Result := (rgb shr 8) and $000000ff;
end;
function Red(rgb: TColor): BYTE;
begin
Result := rgb and $000000ff;
end;Ну а вообще у Bitmap-а в программе должно быть свойство Monochrome, а его нет.
Так же рекомендую заюзать для обработки изображения COM-объекты WIA.ImageFile, WIA.ImageProcess из библиотеки wiaaut.dll
Так же рекомендую заюзать для обработки изображения COM-объекты WIA.ImageFile, WIA.ImageProcess из библиотеки wiaaut.dll
Круть крутецкая: сканеры, веб-камеры и прочее, и прочее...
https://docs.microsoft.com/ru-ru/previo … -startpage
Осталось создать 5-6 примеров для MVD и памятник при жизни обеспечен ))). По крайней мере народная тропа пользователей MVD не зарастёт.
на сколько я понял эту тему
в каждом пикселе имеются оттенки 3-х цветов, вот их мне и нужно получить, преобразовать и вернуть обратно в этот пиксель..
но в ваши примерах я не могу понять как мне получить эти оттенки
без Get(R,G,B)Value я конкретно забуксовал..
я вообще туда иду или как ?
procedure Form1_Button1_OnClick (Sender: TObject; var Cancel: boolean);
var
i,j: integer;
c,d: TColor;
begin
for i :=Form1.Image1.Left to Form1.Image1.Left+Form1.Image1.Width-1 do
for j :=Form1.Image1.Top to Form1.Image1.Top+Form1.Image1.Height-1 do
begin
c :=Form1.Image1.Picture.Bitmap.Canvas.Pixels[i-Form1.Image1.Left,j-Form1.Image1.Top];
d :=RGBToGray(c);
Form1.Image1.Picture.Bitmap.Canvas.Pixels[i-Form1.Image1.Left,j-Form1.Image1.Top] :=d;
end;
end;
function RGBToGray(RGBColor : TColor) : TColor;
var
Gray : byte;
begin
Gray :=Round((0.30*GetRValue(RGBColor))+
(0.59*GetGValue(RGBColor))+(0.11*GetBValue(RGBColor)));
Result :=RGB(Gray, Gray, Gray);
end;
function GetRValue(rgb: TColor): Byte;
begin
Result :=rgb and $000000ff;
end;
function GetGValue(rgb: TColor): Byte;
begin
Result :=(rgb shr 8) and $000000ff;
end;
function GetBValue(rgb: TColor): Byte;
begin
Result :=(rgb shr 16) and $000000ff;
end;я вообще туда иду или как ?
Туда ))))
в
c :=Form1.Image1.Picture.Bitmap.Canvas.Pixels[i-Form1.Image1.Left,j-Form1.Image1.Top];постоянно получаю -1
загрузил изображение в bitmap (с) читается
все равно не понимаю, возвращается тоже самое значение (((
просто закрасило часть картинки черным..
короче с начало нужно Color преобразовать в RGB
а в MVD нет ColorToRGB();
короче с начало нужно Color преобразовать в RGB
а в MVD нет ColorToRGB();
А выше я там бобров наверное пас...
УРА !!!!!!! я это сделал !!!
так и знал, что все на много проще, чем в попадавшихся примерах
procedure Form1_OnShow (Sender: TObject; Action: string);
begin
Form1.DBImage1.Picture.Bitmap.LoadFromFile('image.bmp');
end;
procedure Form1_Button1_OnClick (Sender: TObject; var Cancel: boolean);
var
i,j,r,g,b: integer;
c,d: TColor;
begin
for i :=0 to Form1.DBImage1.Picture.Width-1 do
for j :=0 to Form1.DBImage1.Picture.Height-1 do
begin
c :=Form1.DBImage1.Picture.Bitmap.Canvas.Pixels[ i,j];
d:=round((0.30*GetRValue(c))+(0.59*GetGValue(c))+(0.11*GetBValue(c)));
Form1.DBImage1.Picture.Bitmap.Canvas.Pixels[i,j] :=RGB(d,d,d);
end;
end;
function GetRValue(rgb: TColor): Byte;
begin
Result:=rgb and $000000ff;
end;
function GetGValue(rgb: TColor): Byte;
begin
Result:=(rgb shr 8) and $000000ff;
end;
function GetBValue(rgb: TColor): Byte;
begin
Result:=(rgb shr 16) and $000000ff;
end;теперь подскажите как быть с тормозами при преобразовании
sibprogsistem wrote:короче с начало нужно Color преобразовать в RGB
а в MVD нет ColorToRGB();А выше я там бобров наверное пас...
сделал и немного огорчился
процесс слишком долгий хотел воспользоваться (application.processmessages;) но это меня только еще больше убило..
придется создавать программу (комбайн) которая будет добавлять и сразу преобразовывать изображения в БД
сделал и немного огорчился
процесс слишком долгий...
Насколько долгий? Приведите пример: размер изображения ( A x B, пикселей ) - время конвертации ( мСек ).
Судя по вашему видео, тейлы маленькие (100х50)....
ProcessMessages позволит избежать фризов курсора и продолжить игру, даже если расчёт изображения не закончен. Делайте расчет следующего элемента заранее, пока игрок двигает предыдущую фигуру. Либо как вы выразились, используйте "комбайн" - преобразуйте изображения в момент загрузки в БД,
sibprogsistem wrote:сделал и немного огорчился
процесс слишком долгий...Насколько долгий? Приведите пример: размер изображения ( A x B, пикселей ) - время конвертации ( мСек ).
Судя по вашему видео, тейлы маленькие (100х50)....ProcessMessages позволит избежать фризов курсора и продолжить игру, даже если расчёт изображения не закончен. Делайте расчет следующего элемента заранее, пока игрок двигает предыдущую фигуру. Либо как вы выразились, используйте "комбайн" - преобразуйте изображения в момент загрузки в БД,
максимальные размеры (основного) изображения 1100х640 , делится на 4, 16, 64 и 100, тайлы - 64(8х8) и 100 (10х10) проблем не создадут, через ProcessMessages вообще все плавно.. Можно создать условия и построить экран загрузки Тогда само (основное) изображение и тайлы держать в памяти, но что-то мне подсказывает, что это не хорошо, лучше использовать уже 2-ва готовых варианта изображения..
проблема только в весе преобразованной кортики у меня получается не менее 2-х МБ.
объясните мне как такое возможно
при преобразовании изображения через сгенерированный TBitman, процесс преобразования чуть более минуты
если добавить в процедуру преобразования ( application.processmessages; ) , то процесс тратит около 25 секунд
а вот при любой попытке визуализировать данный процесс, хоть через тот же TProgressBar , время обработки увеличивается до 9-ти минут..
процедура преобразования::
procedure SettingPazzle_bLoadImages_OnClick (Sender: TObject; var Cancel: boolean);
var
OpenDialog: TOpenDialog;
i,c: integer;
procedure convert;
var
i,j,r,g,b: integer;
c,d: TColor;
prog:TProgressBar;
buf:TBitmap;
begin
SettingPazzle.dbiColor.Picture.Bitmap.Canvas.StretchDraw(0,0,1100,640,SettingPazzle.dbiLoad.Picture.Graphic);
SettingPazzle.dbiColor.Width:=SettingPazzle.dbiColor.Picture.Width;
SettingPazzle.dbiColor.Height:=SettingPazzle.dbiColor.Picture.Height;
buf:=TBitmap.Create;
buf.Width:=SettingPazzle.dbiColor.Picture.Width;
buf.Height:=SettingPazzle.dbiColor.Picture.Height;
prog:=TProgressBar.Create(SettingPazzle);
prog.Parent:=SettingPazzle.pProgress;
prog.Left:=0;
prog.Top:=0;
prog.Width:= SettingPazzle.pProgress.Width;
prog.Height:= SettingPazzle.pProgress.Height;
prog.Visible:=True;
prog.Max:=SettingPazzle.dbiColor.Width*SettingPazzle.dbiColor.Height;
prog.Min:=0;
SettingPazzle.pProgress.Visible:=True;
for i :=0 to SettingPazzle.dbiColor.Width-1 do
for j :=0 to SettingPazzle.dbiColor.Height-1 do
begin
application.processmessages;
prog.Position:=prog.Position+1;
c :=SettingPazzle.dbiColor.Picture.Bitmap.Canvas.Pixels[i,j];
d:=round((0.30*GetRValue(c))+(0.59*GetGValue(c))+(0.11*GetBValue(c)));
buf.Canvas.Pixels[i,j] :=RGB(d,d,d);
end;
SettingPazzle.dbiLoadBW.Picture.Bitmap.Canvas.Draw(0,0,buf);
SettingPazzle.dbiColor.Picture.Graphic.SaveToFile('C:\Users\user\Desktop\Новая папка\'+IntToStr(nn)+'(c).jpg');
SettingPazzle.dbiLoadBW.Picture.Graphic.SaveToFile('C:\Users\user\Desktop\Новая папка\'+IntToStr(nn)+'(b).jpg');
end;
function GetRValue(rgb: TColor): Byte;
begin
Result:=rgb and $000000ff;
end;
function GetGValue(rgb: TColor): Byte;
begin
Result:=(rgb shr 8) and $000000ff;
end;
function GetBValue(rgb: TColor): Byte;
begin
Result:=(rgb shr 16) and $000000ff;
end;
begin
OpenDialog := TOpenDialog.Create(SettingPazzle);
OpenDialog.Options := ofHideReadOnly+ofAllowMultiSelect+ofEnableSizing;
if OpenDialog.Execute then
begin
c := OpenDialog.Files.Count-1;
for i := 0 to c do
begin
if FileExists(OpenDialog.Files[i]) then
begin
nn:=i;
SettingPazzle.eImageName.Text:=ExtractFileName(OpenDialog.Files[i]);
SettingPazzle.dbiLoad.Picture.LoadFromFile(OpenDialog.Files[i]);
SettingPazzle.dbiLoad.dbFileName := OpenDialog.Files[i];
convert;
end;
end;
end;
OpenDialog.Free;
SettingPazzle.pProgress.Visible:=False;
end;самый быстрый вариант без (TProgressBar)
Не нужно прогресс после каждого пикселя обновлять )))) делайте это для каждых 100 или 1000 пикселей (или для одной строки/колонки). То же самое относится и к вызову ProcessMessages.
prog.Max:=SettingPazzle.dbiColor.Width;
...
for i :=0 to SettingPazzle.dbiColor.Width-1 do
begin
application.processmessages;
prog.Position:=prog.Position+1;
for j :=0 to SettingPazzle.dbiColor.Height-1 do
begin
c :=SettingPazzle.dbiColor.Picture.Bitmap.Canvas.Pixels[i,j];
d:=round((0.30*GetRValue(c))+(0.59*GetGValue(c))+(0.11*GetBValue(c)));
buf.Canvas.Pixels[i,j] :=RGB(d,d,d);
end;
end;Можно в принципе только зеленый использовать
d:=GetGValue(c);
buf.Canvas.Pixels[i,j] :=RGB(d,d,d);k245, vovka3003 Спасибо!!
My Visual Database → Russian → преобразовать цветное изображений в черно белое
Powered by PunBB, supported by Informer Technologies, Inc.
Theme Hydrogen by Kushi