[WVBR]

есть задача нанести на изображение полупрозрачный градиент с переходом от белого цвета с прозрачностью 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;

[Pyro]

если установлен imagemagick то градиент

Код:

convert -size 200x200 gradient:'rgba(255,255,255,.5)'-'rgba(0,0,255,0.95)' gradient.png

нанести на другое тоже как-то можно

[WVBR]

Сообщение от Pyro

если установлен imagemagick то градиент

Код:

convert -size 200x200 gradient:'rgba(255,255,255,.5)'-'rgba(0,0,255,0.95)' gradient.png

нанести на другое тоже как-то можно

благодарю. а в каком исполнении этот imagemagick представлен ? как компонент ... или билиотека.. вот эта команда как из делфи запускается?

[Pyro]

как отдельная программа коммандной строки, запускать их из дельфи можно по-разному

[NumLock]

на GDI+ создать градиентную кисть:

Код:

function GdipCreateLineBrushFromRectI(rect: PGpRect; color1: ARGB; color2: ARGB;
  mode: LinearGradientMode; wrapMode: WarpMode; out lineGradient: GpLineGradient): GpStatus;

и залить область.

[WVBR]

NumLock, благодарю за участие

я пробывл в интернете найти gdi+ компонент для делфи но не получилось этого сделатьь, я так понял это реализовано в неком юните который можно прекрепить в проэкт и использовать ту функцию которую вы озвучили. Я правильно понял ? мне нужно искать этот юнит с процедурами gdi+ ? или компонент

[NumLock]

http://zalil.ru/34208407

[WVBR]

NumLock благодарю

но всетаки решил проблему вот этим алгоритмом:

Код:

    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;

[NumLock]

Код:

procedure FillGradientBrush(ABitmap: TBitmap; ARect: TRect; StartColor, EndColor: DWORD);
var
  FBrush: TGPLinearGradientBrush;
  FGraphics: TGPGraphics;
begin
  FBrush:=TGPLinearGradientBrush.Create(MakeRect(ARect), StartColor, EndColor, LinearGradientModeHorizontal);
  FGraphics:=TGPGraphics.Create(ABitmap.Canvas.Handle);
  FGraphics.FillRectangle(FBrush, MakeRect(ARect));
  FGraphics.Free;
  FBrush.Free;
end;

begin
  FillGradientBrush(Image1.Picture.Bitmap, Image1.ClientRect, $80ff0000, $8000ff00);
end;