Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Не работает процедура [D7, WinXP]


Lyberzon ©   (2006-09-30 13:27:00) 

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

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-10-04 12:08:00) [1]

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

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

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

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

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

lyberzon   (2006-10-03 13:22:00) [3]

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

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

У меня если убрать все 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-02 12:41:00) [5]

На самом деле ситуация не меняется, даже если убрать 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-01 15:11:00) [6]

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

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

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

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

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

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

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

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

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

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


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

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

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

lyberzon   (2006-09-30 17:19:00) [10]


> точнее так:

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

lyberzon   (2006-09-30 17:15:00) [11]

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

lyberzon   (2006-09-30 16:16:00) [12]

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

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;

antonn   (2006-09-30 15:44:00) [13]

Lyberzon ©   (30.09.06 15:35) [5]
Antonn, а твой код точно работает в составе кнопки?
мой код точно переводит битмап в градации серого.
Проблема в коде, который рисует на кнопке.

Lyberzon   (2006-09-30 15:35:00) [14]

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

antonn   (2006-09-30 14:04:00) [15]

точнее так:
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;

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

2 Lyberzon:

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

antonn   (2006-09-30 13:49:00) [17]

а так?
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;

lyberzon   (2006-09-30 13:31:00) [18]

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

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;

Наверх

Титульная страница Поиск, карта сайта Написать письмо