Нарисуйте эллипс непрозрачности в Delphi 2010 - PullRequest
4 голосов
/ 07 февраля 2011

Я хочу нарисовать эллипс непрозрачности в CodeGear Delphi 2010.

Я пытался нарисовать другой растр, Я установил растровый прозрачный цвет (для фона) Вызовите метод эллипса.

И на своем изображении я рисую растровое изображение с параметром непрозрачности (от перегрузки). Но это не работает.

Я хочу что-то вроде этого http://www.java2s.com/Tutorial/VBImages/WPF-UseOpacityMaskAndRadialGradientBrush.PNG

Кто-нибудь знает метод работы?

1 Ответ

16 голосов
/ 07 февраля 2011

у меня работает:

procedure TForm1.Button1Click(Sender: TObject);
var
  bm1, bm2: TBitmap;
begin
  bm1 := TBitmap.Create;
  bm1.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\portrait.bmp');

  bm2 := TBitmap.Create;
  bm2.SetSize(bm1.Width, bm1.Height);
  bm2.Canvas.Brush.Color := clRed;
  bm2.Canvas.Pen.Style := psClear;
  bm2.Canvas.Ellipse(0, 0, bm2.Width, bm2.Height);

  Canvas.Draw(100, 100, bm1);
  Canvas.Draw(100, 100, bm2, 127);
end;

Образец 1 http://privat.rejbrand.se/blendimg1.png

Если вы хотите больше контроля, вы всегда можете выполнить обработку вручную:

procedure TForm1.Button1Click(Sender: TObject);
type
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad;
  PRGB32Array = ^TRGB32Array;
  TScanline = TRGB32Array;
  PScanline = ^TScanline;
var
  bm1, bm2, bm3: TBitmap;
  sc1, sc2, sc3: PScanline;
  i: Integer;
  j: Integer;
var
  transp: real;
const
  opacity = 0.29;
begin
  transp := 1 - opacity;

  bm1 := TBitmap.Create;
  bm1.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\portrait.bmp');

  bm2 := TBitmap.Create;
  bm2.SetSize(bm1.Width, bm1.Height);
  bm2.Canvas.Brush.Color := clRed;
  bm2.Canvas.Pen.Style := psClear;
  bm2.Canvas.Ellipse(0, 0, bm2.Width, bm2.Height);

  bm3 := TBitmap.Create;
  bm3.SetSize(bm1.Width, bm1.Height);

  bm1.PixelFormat := pf32bit;
  bm2.PixelFormat := pf32bit;
  bm3.PixelFormat := pf32bit;

  for i := 0 to bm1.Height - 1 do
  begin
    sc1 := bm1.ScanLine[i];
    sc2 := bm2.ScanLine[i];
    sc3 := bm3.ScanLine[i];
    for j := 0 to bm1.Width - 1 do
      with sc3^[j] do
      begin
        rgbBlue := round(transp*sc1^[j].rgbBlue + opacity*sc2^[j].rgbBlue);
        rgbGreen := round(transp*sc1^[j].rgbGreen + opacity*sc2^[j].rgbGreen);
        rgbRed := round(transp*sc1^[j].rgbRed + opacity*sc2^[j].rgbRed);
      end;
  end;

  Canvas.Draw(100, 100, bm3);

end;

Образец 2 http://privat.rejbrand.se/blendimg2.png

Например, вы можете позволить фоновому изображению иметь непрозрачность 100% за пределами эллипса:

  ...
  for i := 0 to bm1.Height - 1 do
  begin
    sc1 := bm1.ScanLine[i];
    sc2 := bm2.ScanLine[i];
    sc3 := bm3.ScanLine[i];
    for j := 0 to bm1.Width - 1 do
      if sc2^[j].rgbBlue + sc2^[j].rgbGreen + sc2^[j].rgbRed = 3*255 then
        sc3^[j] := sc1^[j]
      else
        with sc3^[j] do
        begin
          rgbBlue := round(transp*sc1^[j].rgbBlue + opacity*sc2^[j].rgbBlue);
          rgbGreen := round(transp*sc1^[j].rgbGreen + opacity*sc2^[j].rgbGreen);
          rgbRed := round(transp*sc1^[j].rgbRed + opacity*sc2^[j].rgbRed);
        end;
  end;
  ...

Образец 3 http://privat.rejbrand.se/blendimg3.png

Не говоря уже о всех других интересных вещах, которые вы можете делать с помощью растровых изображений :

  ...
  for i := 0 to bm1.Height - 1 do
  begin
    sc1 := bm1.ScanLine[i];
    sc2 := bm2.ScanLine[i];
    sc3 := bm3.ScanLine[i];
    for j := 0 to bm1.Width - 1 do
      if sc2^[j].rgbBlue + sc2^[j].rgbGreen + sc2^[j].rgbRed = 3*255 then
        sc3^[j] := sc1^[j]
      else
        with sc3^[j] do
        begin
          rgbBlue := round(sin(transp*sc1^[j].rgbBlue + opacity*sc2^[j].rgbBlue));
          rgbGreen := round(transp*sc1^[j].rgbGreen + opacity*sc2^[j].rgbGreen);
          rgbRed := round(transp*sc1^[j].rgbRed + opacity*sc2^[j].rgbRed);
        end;
  end;
  ...

Образец 4 http://privat.rejbrand.se/blendimg4.png

Если вы действительно не хотите делать это вручную, я только что понял, вы можете нарисовать эллипс на копии первого растрового изображения, а затем смешать эти два растровых изображения:

procedure TForm1.Button1Click(Sender: TObject);
var
  bm1, bm2: TBitmap;
begin

  bm1 := TBitmap.Create;
  bm1.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\portrait.bmp');

  bm2 := TBitmap.Create;
  bm2.LoadFromFile('C:\Users\Andreas Rejbrand\Pictures\portrait.bmp');
  bm2.Canvas.Brush.Color := clRed;
  bm2.Canvas.Pen.Style := psClear;
  bm2.Canvas.Ellipse(0, 0, bm2.Width, bm2.Height);

  Canvas.Draw(100, 100, bm1);
  Canvas.Draw(100, 100, bm2, 127);
end;

Образец 5 http://privat.rejbrand.se/blendimg5.png

...