Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2007.06.17;
Скачать: [xml.tar.bz2];

Вниз

Не работает процедура   Найти похожие ветки 

 
Lyberzon ©   (2006-09-30 13:27) [0]

Уважаемые мастера! Есть некая процедура преобразующая цветной битмап в ч/белый. Если вызывать ее из приложения, то все работает. Но при вызове в компоненте (кнопка) - результат нулевой. В чем проблема? Вот код:

procedure DrawDisabledBitmap(Dest, Sour: TBitmap);
type
TRGB=record
 B,G,R: Byte;
end;
pRGB = ^TRGB;

var
x,y: Integer;
Color: TColor;
r,g,b: Byte;

function ToGray(c: TColor): TColor;
var
 Gray: byte;
begin
 Gray:=Round((0.3 * GetRValue(c)) + (0.59 * GetGValue(c)) + (0.11 * GetBValue(c)));
 Result:=RGB(Gray and r, Gray and g, Gray and b);
end;

begin
Dest.Assign(Sour);
r:=GetRValue(ColorToRGB(clBtnFace));
g:=GetGValue(ColorToRGB(clBtnFace));
b:=GetBValue(ColorToRGB(clBtnFace));
for y:=0 to Sour.Height-1 do
 for x:=0 to Sour.Width-1 do
 begin
   Color:=Sour.Canvas.Pixels[x,y];
 Dest.Canvas.Pixels[x,y]:=ToGray(Color);
 end;
end;


 
lyberzon ©   (2006-09-30 13:31) [1]

Извиняюсь. Приведенный выше код работает везде, а тот который ниже в компоненте (кнопке) не работает:

procedure DrawDisabledBitmap(var Dest, Sour: TBitmap);
type
TRGB=record
B,G,R: Byte;
end;
pRGB = ^TRGB;

var
b: TBitmap;
x,y: Integer;
Color: TColor;
r1,g1,b1: Byte;
pSour: pRGB;

function ToGray(c: TColor): TColor;
var
 Gray: byte;
begin
 Gray:=Round((0.3 * GetRValue(c)) + (0.59 * GetGValue(c)) + (0.11 * GetBValue(c)));
 Result:=RGB(Gray and r1, Gray and g1, Gray and b1);
end;

begin
b:=TBitmap.Create;
b.Assign(Sour);
b.PixelFormat:=pf24bit;
r1:=GetRValue(ColorToRGB(clBtnFace));
g1:=GetGValue(ColorToRGB(clBtnFace));
b1:=GetBValue(ColorToRGB(clBtnFace));
for y:=0 to b.Height-1 do
 begin
  pSour:=b.ScanLine[y];
  for x:=0 to b.Width-1 do
   begin
    Color:=(pSour.B shl 16 or pSour.G shl 8 or pSour.R);
    pSour.B:=GetBValue(ToGray(Color));
    pSour.G:=GetGValue(ToGray(Color));
    pSour.R:=GetRValue(ToGray(Color));
    Inc(pSour);
  end;
 end;
Dest.Assign(b);
b.Free;
end;


 
antonn ©   (2006-09-30 13:49) [2]

а так?
procedure PrepareBitmapBW(var _B_out:Tbitmap);
const  MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
type  PRGBArray = ^TRGBArray;
 TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
var x, y: Integer; RowOut: PRGBArray;
begin
 _B_out.PixelFormat:=pf24bit;
 for y:=0 to _B_out.Height-1 do begin
    RowOut:= _B_out.ScanLine[y];
   for x:=0 to _B_out.Width-1 do begin
         RowOut[x].rgbtRed:=RowOut[x].rgbtRed*0.3;
         RowOut[x].rgbtGreen:=RowOut[x].rgbtGreen*0.59;
         RowOut[x].rgbtBlue:=RowOut[x].rgbtBlue*0.11;
   end;
 end
end;

procedure DrawDisabledBitmap(var Dest, Sour: TBitmap);
var b: TBitmap;
begin
b:=TBitmap.Create;
try
b.Assign(Sour);
 PrepareBitmapBW(b);
Dest.Assign(b);
finally
 b.Free;
end;
end;


 
Vovan#1   (2006-09-30 13:54) [3]

2 Lyberzon:

У меня работают идентично. Может быть, дело не в вызове из обработчика нажатия кнопки, а в том, что ты передаёшь как параметр и как отображаешь потом?


 
antonn ©   (2006-09-30 14:04) [4]

точнее так:
procedure PrepareBitmapBW(var _B_out:Tbitmap);
const  MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
type  PRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
var x, y: Integer; RowOut: PRGBArray;
begin
_B_out.PixelFormat:=pf24bit;
for y:=0 to _B_out.Height-1 do begin
   RowOut:= _B_out.ScanLine[y];
  for x:=0 to _B_out.Width-1 do begin
        RowOut[x].rgbtRed:=trunc(RowOut[x].rgbtRed*0.3+RowOut[x].rgbtGreen*0.59+RowOut[x].rgbtBlue*0.11);
        RowOut[x].rgbtGreen:=RowOut[x].rgbtRed;
        RowOut[x].rgbtBlue:=RowOut[x].rgbtRed;
  end;
end
end;

procedure DrawDisabledBitmap(Dest, Sour: TBitmap);
var b: TBitmap;
begin
b:=TBitmap.Create;
try
b.Assign(Sour);
PrepareBitmapBW(b);
Dest.Assign(b);
finally
b.Free;
end;
end;


 
Lyberzon ©   (2006-09-30 15:35) [5]

В качестве параметра передаю FBitmap, который затем в Paint; override; рисую на канвасе кнопки. Процедуру вызываю в OnChange основного изображения и при создании кнопки. Antonn, а твой код точно работает в составе кнопки?


 
antonn ©   (2006-09-30 15:44) [6]

Lyberzon ©   (30.09.06 15:35) [5]
Antonn, а твой код точно работает в составе кнопки?

мой код точно переводит битмап в градации серого.
Проблема в коде, который рисует на кнопке.


 
lyberzon ©   (2006-09-30 16:16) [7]

Ну этот код прост:

procedure TBAFlatSpeedButton.Paint;
begin
if not Enabled then
 begin
  if not FDisabledBitmap.Empty then
   Canvas.Draw(0,0,FDisabledBitmap);
 end
else
 if not FBitmap.Empty then
  Canvas.Draw(0,0,FBitmap);
end;


 
lyberzon ©   (2006-09-30 17:15) [8]

Вот исходник кнопки:
http:\\button2011.narod.ru\BAFlatSpeedButton.rar


 
lyberzon ©   (2006-09-30 17:19) [9]


> точнее так:

этот код также не отрисовывает в составе кнопки...


 
lyberzon ©   (2006-10-01 09:43) [10]

Ну что, так никто и не разобрался в чем дело?


 
Vovan#1   (2006-10-01 12:24) [11]

Дело в ошибках архитектуры компонента. Создай его, загрузи в него картинку, присвой Enabled := False и посчитай, сколько раз вызывалось DrawDisabledBitmap. В результате, при первом её вызове рисуется правильная картинка, а потом уже рисуется белая, которая и показывается. Кроме того, правильнее будет:


type
 TRGB = packed record
   B,G,R: Byte;
  end;


 
lyberzon ©   (2006-10-01 12:38) [12]

В принципе ограничить количество генераций картинки до 1 раза несложно. Но мне всеже неясно, почему в последующие разы рисуется белый фон? Ведь исходное изображение никоим образом не модифицируется...


 
Vovan#1   (2006-10-01 15:11) [13]

>Ведь исходное изображение никоим образом не модифицируется...

Порядок такой:

Button.Bitmap.LoadFromFile("some.bmp");

Срабатывает SetBitmap, где FBitmap.Assign.

Срабатывает OnChange, где рисуется правильный неактивный битмап.

А дальше в SetBitmap вызывается FBitmap.Dormant. И всё, с тех пор не работает.


 
Lyberzon ©   (2006-10-02 12:41) [14]

На самом деле ситуация не меняется, даже если убрать FBitmap.Dormant отовсюду, где он встречается. Я нашел причину. В самой процедуре нужно было делать так:

procedure DrawDisabledBitmap(Dest, Sour: TBitmap);
const
MaxPixelCount=(MaxInt div SizeOf(TRGBTriple));

type
TRGBArray=array[0..MaxPixelCount-1] of TRGBTriple;
PRGBArray=^TRGBArray;

var
x,y: Integer;
bm: TBitmap;
PBitRow: PRGBArray;

begin
bm:=TBitmap.Create;
bm.Width:=Sour.Width;
bm.Height:=Sour.Height;
bm.Canvas.Draw(0,0,Sour);

bm.PixelFormat:=pf24bit;
for y:=0 to bm.Height-1 do
 begin
  PBitRow:=bm.ScanLine[y];
  for x:=0 to bm.Width-1 do
....   ....
 end;
Dest.Assign(bm);
bm.Free;
end;


А было вот как:

procedure DrawDisabledBitmap(Dest, Sour: TBitmap);
const
MaxPixelCount=(MaxInt div SizeOf(TRGBTriple));

type
TRGBArray=array[0..MaxPixelCount-1] of TRGBTriple;
PRGBArray=^TRGBArray;

var
x,y: Integer;
bm: TBitmap;
PBitRow: PRGBArray;

begin
bm:=TBitmap.Create;
bm.Assign(Sour);
bm.PixelFormat:=pf24bit;
for y:=0 to bm.Height-1 do
 begin
  PBitRow:=bm.ScanLine[y];
  for x:=0 to bm.Width-1 do
....   ....
 end;
Dest.Assign(bm);
bm.Free;
end;


 
Vovan#1   (2006-10-02 15:02) [15]

У меня если убрать все Dormant, то работает. Вот сама процедура:


procedure DrawDisabledBitmap(Dest, Sour: TBitmap);
type
 TRGB = packed record
   B,G,R: Byte;
  end;
 PRGBArray = ^TRGBArray;
 TRGBArray = array [Word] of TRGB;

var
b: TBitmap;
x,y: Integer;
Color: TColor;
r1,g1,b1: Byte;
pSour: PRGBArray;

function ToGray(c: TColor): TColor;
var
 Gray: byte;
begin
 Gray:=Round((0.3 * GetRValue(c)) + (0.59 * GetGValue(c)) + (0.11 * GetBValue(c)));
 Result:=RGB(Gray and r1, Gray and g1, Gray and b1);
end;

begin
b:=TBitmap.Create;
b.Assign(Sour);
b.PixelFormat := pf24bit;
r1:=GetRValue(ColorToRGB(clBtnFace));
g1:=GetGValue(ColorToRGB(clBtnFace));
b1:=GetBValue(ColorToRGB(clBtnFace));
for y := 0 to b.Height-1 do
 begin
  pSour := b.ScanLine[y];
  for x:=0 to b.Width-1 do
   begin
    Color := RGB(pSour[x].R, pSour[x].G, pSour[x].B);
    pSour[x].B := GetBValue(ColorToRGB(ToGray(Color)));
   pSour[x].G := GetGValue(ColorToRGB(ToGray(Color)));
    pSour[x].R := GetRValue(ColorToRGB(ToGray(Color)));
  end;
 end;
Dest.Assign(b);
b.Free;
end;


 
lyberzon ©   (2006-10-03 13:22) [16]

А зачем он вообще нужен этот Dormant? Просто я немного переработал чей-то код, а там был этот Dormant. Ну я по незнанию его и не тронул.. Переводится как <Бездействующий>, а какие деиствия он осуществляет при вызове? И уместно ли его вызовы в данном случае?


 
Vovan#1   (2006-10-03 21:47) [17]

>А зачем он вообще нужен этот Dormant? Просто я немного переработал чей-то код, а там был этот Dormant. Ну я по незнанию его и не тронул.. Переводится как <Бездействующий>, а какие деиствия он осуществляет при вызове? И уместно ли его вызовы в данном случае?

Дормант освобождает handle (HBITMAP), тем самым битмап становится аппаратно независимым. Borland считает, что это как-то облегчает нагрузку на ресурсы. Assign, похоже, копирует не только пиксели, но и handle.

Ты в [14] сделал копирование без вопросов - новый объект, новый handle. Я бы так и оставил.


 
lyberzon ©   (2006-10-04 12:08) [18]

Спасибо за консультации и помощь!!!!!



Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2007.06.17;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.04 c
15-1179910817
Кевларвестов Семен
2007-05-23 13:00
2007.06.17
Почему-то не устанавливается BDS 2006


15-1179751846
Вай
2007-05-21 16:50
2007.06.17
процессор


2-1179843409
programmist87
2007-05-22 18:16
2007.06.17
Журнал Internet Explorer


15-1179987422
Kedr
2007-05-24 10:17
2007.06.17
Посоветуйте литературу


9-1153902502
Илья Щукин
2006-07-26 12:28
2007.06.17
Ошибка компиляции





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский