VPF::нанести на изображение полупрозрачный градиент

WVBR

Дата 24.1.2013, 16:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 9.5.2006

Репутация: нет
Всего: нет

есть задача нанести на изображение полупрозрачный градиент с переходом от белого цвета с прозрачностью 50% до синего цвета с прозрачностью 5%

вот пример исходника процедуры, которая на image1 наносит градиент при попиксильном анализе, все бы ничего, но получается нанести только один цвет и без указания процентов, как добавить синий цвет и задать процент?

Код


procedure TForm1.save1Click(Sender: TObject);
    procedure ImageGradient(bitmap: tbitmap; p:boolean);
type 
TRGB = record 
r: byte; 
g: byte; 
b: byte; 
end; 
ARGB = array[0..1]of TRGB; 
PARGB = ^ARGB; 
var 
pb, ps: PARGB; 
x,y,b:integer; 

function Min(a, b: Longint): Longint;
  begin
 if a > b then Result := b else  Result := a;
end; 

function convertByte(BaseColor: TColor; i:integer): TColor;
  begin
 if p=true then b:=Y else b:=x;
//RGB(A1-(A1-B1)/h*i, A2-(A2-B2)/h*i, A3-(A3-B3)/h*i);
Result := RGB(Min(GetRValue(ColorToRGB(BaseColor)) + round((255)*b/bitmap.Height), 255),
Min(GetGValue(ColorToRGB(BaseColor))+ round(255*b/bitmap.Height), 255),
Min(GetBValue(ColorToRGB(BaseColor))+ round(255*b/bitmap.Height), 255));
 end; 
  begin
bitmap.Assign(bitmap);
bitmap.PixelFormat:=pf24bit;

 for y:=0 to bitmap.Height-1 do
  begin
pb:=bitmap.scanline[y];
ps:=bitmap.scanline[y];
 for x:=0 to bitmap.Width-1 do
  begin
ps[x].r:=convertByte(pb[x].r,x);
ps[x].g:=convertByte(pb[x].g,x);
ps[x].b:=convertByte(pb[x].b,x)
end;

end;
end;
begin
     ImageGradient(Image1.Picture.Bitmap,false);
end;

есть задача нанести на изображение полупрозрачный градиент  с переходом от белого цвета с прозрачностью 50% до синего цвета с прозрачностью 5% 

вот пример исходника процедуры, которая на image1 наносит градиент при попиксильном анализе, все бы ничего, но получается нанести только один цвет и без указания процентов, как добавить синий цвет и задать процент?


[PASCAL]
procedure TForm1.save1Click(Sender: TObject);
    procedure ImageGradient(bitmap: tbitmap; p:boolean);
type 
TRGB = record 
r: byte; 
g: byte; 
b: byte; 
end; 
ARGB = array[0..1]of TRGB; 
PARGB = ^ARGB; 
var 
pb, ps: PARGB; 
x,y,b:integer; 

function Min(a, b: Longint): Longint;
  begin
 if a > b then Result := b else  Result := a;
end; 

function convertByte(BaseColor: TColor; i:integer): TColor;
  begin
 if p=true then b:=Y else b:=x;
//RGB(A1-(A1-B1)/h*i, A2-(A2-B2)/h*i, A3-(A3-B3)/h*i);
Result := RGB(Min(GetRValue(ColorToRGB(BaseColor)) + round((255)*b/bitmap.Height), 255),
Min(GetGValue(ColorToRGB(BaseColor))+ round(255*b/bitmap.Height), 255),
Min(GetBValue(ColorToRGB(BaseColor))+ round(255*b/bitmap.Height), 255));
 end; 
  begin
bitmap.Assign(bitmap);
bitmap.PixelFormat:=pf24bit;

 for y:=0 to bitmap.Height-1 do
  begin
pb:=bitmap.scanline[y];
ps:=bitmap.scanline[y];
 for x:=0 to bitmap.Width-1 do
  begin
ps[x].r:=convertByte(pb[x].r,x);
ps[x].g:=convertByte(pb[x].g,x);
ps[x].b:=convertByte(pb[x].b,x)
end;

end;
end;
begin
     ImageGradient(Image1.Picture.Bitmap,false);
end;

Alexeis

Дата 25.1.2013, 11:11 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Нужно сформировать изображение битмап в формате 32 бита на пиксель с указанным градиентом по цвету. Затем заполнить 4й байт альфа-канала процентом градиента 0..255 . Далее применяя WinAPI функцию AlphaBlend наложить битмап с градиентом на нужный контекст hDC .

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

WVBR

Дата 26.1.2013, 16:03 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 9.5.2006

Репутация: нет
Всего: нет

Alexeis, благодарю за участие
я сделал как ты сказал вот реализация:

Код


procedure DrawGradient(ACanvas: TCanvas; Rect: TRect;
   Horicontal: Boolean; Colors: array of TColor);
 type
   RGBArray = array[0..2] of Byte;
 var
   x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
   Faktor: double;
   A: RGBArray;
   B: array of RGBArray;
   merkw: integer;
   merks: TPenStyle;
   merkp: TColor;
 begin
   mx := High(Colors);
   if mx > 0 then
   begin
     if Horicontal then
       mass := Rect.Right - Rect.Left
     else
       mass := Rect.Bottom - Rect.Top;
     SetLength(b, mx + 1);
     for x := 0 to mx do
     begin
       Colors[x] := ColorToRGB(Colors[x]);
       b[x][0] := GetRValue(Colors[x]);
       b[x][1] := GetGValue(Colors[x]);
       b[x][2] := GetBValue(Colors[x]);
     end;
     merkw := ACanvas.Pen.Width;
     merks := ACanvas.Pen.Style;
     merkp := ACanvas.Pen.Color;
     ACanvas.Pen.Width := 1;
     ACanvas.Pen.Style := psSolid;
     faColorsh := Round(mass / mx);
     for y := 0 to mx - 1 do
     begin
       if y = mx - 1 then
         bis := mass - y * faColorsh - 1
       else
         bis := faColorsh;
       for x := 0 to bis do
       begin
         Stelle := x + y * faColorsh;
         faktor := x / bis;
         for z := 0 to 3 do
           a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
         ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
         if Horicontal then
         begin
           ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
           ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
         end
         else
         begin
           ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
           ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
         end;
       end;
     end;
     b := nil;
     ACanvas.Pen.Width := merkw;
     ACanvas.Pen.Style := merks;
     ACanvas.Pen.Color := merkp;
   end
   else
     // Please specify at least two colors 
    raise EMathError.Create('Es mussen mindestens zwei Farben angegeben werden.');
 end;

 // Example Calls: 
// Aufrufbeispiele:

procedure ggg  ;
    var
 bmp1, bmp2: TBitMap;   
 Blend: TBlendFunction;   
begin
 Image1.Picture.Bitmap.PixelFormat := pf32bit; // ????????? ??? ? 32 ???
 Image2.Picture.Bitmap.PixelFormat := pf32bit;
 Blend.BlendOp := AC_SRC_OVER;
 Blend.BlendFlags := 0;
 Blend.SourceConstantAlpha := 155; // ???????????? 50% (0 - 255)
 Blend.AlphaFormat := AC_SRC_ALPHA;
 // ??????????? ?????? 2 ?? ?????? 1. ????????? ? bmp1
 if Windows.AlphaBlend(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height, Image2.Picture.Bitmap.Canvas.Handle, 0, 0, Image2.Picture.Bitmap.Width, Image2.Picture.Bitmap.Height, Blend) then
   image2.Canvas.Draw(0, 0, Image1.Picture.Bitmap) // ?????? ????????? ?? ?????
 else ShowMessage(IntToStr(GetLastError)); // ??? ??? ??????, ???? ???????? ?? ???????

end;

вот так вызываю

DrawGradient(Image2.Canvas, Rect(0, 0, Image1.Picture.Bitmap.width, Image1.Picture.Bitmap.Height), true, [clblue, clWhite]);

ggg ;

тоесть создаю градиент на Image2 заливаю картинку на Image1
а затем второй функцией ggg; накладываю картинку с градиентом на на изображение с 50% прозрачностью
Blend.SourceConstantAlpha := 155;
НО это не по заданию!
ведь нужно 95% один цвет и 5% другой. Как это сделать?

Это сообщение отредактировал(а) WVBR - 26.1.2013, 16:03

Alexeis

Дата 27.1.2013, 01:03 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Чет я не наблюдаю кода заполняющего 4й байт альфаканала степенью прозрачности каждого пиксела. Если есть сомнения в работоспособности, то попробуйте нарисовать картику с альфа прозрачностью в фотшопе, загрузить в TBitmap и затем нарисовать функцией AlphaBlend

Если установлено Blend.AlphaFormat := AC_SRC_ALPHA; то Blend.SourceConstantAlpha := 155; уже не нужно, поскольку прозрачность берется из 4й компоненты каждого пиксела.

--------------------

WVBR

Дата 27.1.2013, 21:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 9.5.2006

Репутация: нет
Всего: нет

Код


    procedure FillGradient(bt:tbitmap; ARect: TRect; StartColor, EndColor: TColor; StartAlpha, EndAlpha:byte; TopBottom:boolean);
    type TBitTArray = array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad;
    var
     rc1, rc2, gc1, gc2, bc1, bc2, ac1,ac2, _yy1,_yy2,y,x,_xx1,_xx2: Integer;
     rl1, rl2, gl1:integer; al:double;
     Brush: HBrush;  Row32:PRGBAArray; RowSet:TRGBQuad; RowSetP:^TRGBQuad;
     P: ^TBitTArray;
    begin
      rc1 := GetRValue(StartColor);
      gc1 := GetGValue(StartColor);
      bc1 := GetBValue(StartColor);
     
      rc2 := GetRValue(EndColor);
      gc2 := GetGValue(EndColor);
      bc2 := GetBValue(EndColor);
     
      if(ARect.Top<0) then ARect.Top:=0 else if(ARect.Top>bt.Height) then ARect.Top:=bt.Height;
      if(ARect.Left<0) then ARect.Left:=0 else if(ARect.Left>bt.Width) then ARect.Left:=bt.Width;
     
      _yy1:=0;
      _yy2:=ARect.Bottom-ARect.Top;
     
      _xx1:=0;
      _xx2:=ARect.Right-ARect.Left;
     
      if  TopBottom then begin
     
     
      for y:=_yy1 to _yy2-1 do begin
         Row32:= bt.ScanLine[y+ARect.Top];
     
         RowSet.rgbBlue:=(bc1 + (((bc2 - bc1) * (_yy1 + y)) div _yy2));
         Rowset.rgbGreen:=(gc1 + (((gc2 - gc1) * (_yy1 + y)) div _yy2));
         RowSet.rgbRed:=(rc1 + (((rc2 - rc1) * (_yy1 + y)) div _yy2));
     
         al:=((StartAlpha + (((EndAlpha - StartAlpha) * (_yy1 + y)) div _yy2)))/255;
     
         for x:=_xx1 to _xx2-1 do begin
            Row32[x+ARect.Left].rgbBlue:=round((1-al)*Row32[x+ARect.Left].rgbBlue+al*RowSet.rgbBlue);
            Row32[x+ARect.Left].rgbGreen:=round((1-al)*Row32[x+ARect.Left].rgbGreen+al*RowSet.rgbGreen);
            Row32[x+ARect.Left].rgbRed:=round((1-al)*Row32[x+ARect.Left].rgbRed+al*RowSet.rgbRed);
         end;
     
      end;
     
      end else begin
     
         P:=AllocMem(_xx2 * SizeOf(TRGBQuad));
         try
     
     
            RowSetP:=Pointer(@P^[0]);
            for x:=_xx1 to _xx2-1 do begin
                RowSetP.rgbRed:=(rc1 + (((rc2 - rc1) * (ARect.Left + x)) div ARect.Right));
                RowSetP.rgbGreen:=(gc1 + (((gc2 - gc1) * (ARect.Left + x)) div ARect.Right));
                RowSetP.rgbBlue:=(bc1 + (((bc2 - bc1) * (ARect.Left + x)) div ARect.Right));
                RowSetP.rgbReserved:=((StartAlpha + (((EndAlpha - StartAlpha) * (_xx1 + x)) div _xx2)));
                inc(RowSetP);
            end;
     
     
            for y:=_yy1 to _yy2-1 do begin
                Row32:= bt.ScanLine[y+ARect.Top];
     
                RowSetP:=Pointer(@P^[0]);
                for x:=_xx1 to _xx2-1 do begin
                    al:=RowSetP.rgbReserved/255;
     
                    Row32[x+ARect.Left].rgbBlue:=round((1-al)*Row32[x+ARect.Left].rgbBlue+al*RowSetP.rgbBlue);
                    Row32[x+ARect.Left].rgbGreen:=round((1-al)*Row32[x+ARect.Left].rgbGreen+al*RowSetP.rgbGreen);
                    Row32[x+ARect.Left].rgbRed:=round((1-al)*Row32[x+ARect.Left].rgbRed+al*RowSetP.rgbRed);
     
                    inc(RowSetP);
               end;
     
            end;
     
         finally
            FreeMem(P, _xx2*SizeOf(TRGBQuad));
         end;
     
     
      end;
    end;

задача решена. код реализации. всем спасибо за участие

Присоединённый файл ( Кол-во скачиваний: 13 )

Безымянный1.jpg 69,61 Kb

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »