I use Delphi 6.0, and I have TPanel, that contains TVirtualStringTree, that contains many nodes (more, than 1 screen).
I need to save this panel (with all nodes) to the BMP as a picture.
I use this method to save panel:
procedure TfrmDidTreeTime.cmSaveGantClick(Sender: TObject);
var
bmp : tBitmap;
cnt : Integer;
Dc : HDC;
R : TRect;
begin
inherited;
DC := GetDC ( pnlChart.handle);
R := pnlChart.boundsRect;
bmp := tBitmap.create;
bmp.width := R.Right-R.Left;
bmp.Height := R.Bottom - R.Top;
Bitblt(bmp.canvas.handle,0,0,bmp.Width,bmp.height,dc,r.left,r.top,srccopy);
spdSaveGraph.DefaultExt := 'bmp';
spdSaveGraph.FileName := 'Gant.bmp';
spdSaveGraph.Filter := 'Bitmap Picture|*.bmp';
if spdSaveGraph.Execute then
bmp.saveToFile (spdSaveGraph.FileName);
bmp.free;
end;
But this method saves only nodes that shows on the screen, but I need to save all of nodes.
procedure TfrmDidTreeTime.cmSaveDidTreeTimeClick(Sender: TObject);
var
bmp_total: tBitmap;
bmp_current : tBitmap;
r: TRect;
dc: HDC;
date_start: TDateTime;
h: integer;
bmp_current_position: integer;
scroll_position_current: integer;
scroll_position_total: integer;
screen_count: integer;
begin
inherited;
date_start := dtpDateStart.Value;
dc := GetDC (tvDidTimeTree.handle);
r := tvDidTimeTree.boundsRect;
bmp_total := tBitmap.create;
bmp_total.width := r.Right - r.Left - sbxVertical.Width - 3;
h := r.Bottom - r.Top - tvDidTimeTree.Header.Height;
if h < 0 then
h := 0;
SendMessage(tvDidTimeTree.Handle, WM_VSCROLL, SB_BOTTOM, 0);
scroll_position_total := GetScrollPos(tvDidTimeTree.Handle, sb_Vert);
screen_count := round(scroll_position_total / h);
bmp_total.Height := h * (screen_count + 1);
bmp_current_position := 0;
SendMessage(tvDidTimeTree.Handle, WM_VSCROLL, SB_TOP, 0);
tvDidTimeTree.Repaint;
while (scroll_position_current < scroll_position_total) do
begin
r := tvDidTimeTree.boundsRect;
dc := GetDC (tvDidTimeTree.handle);
bmp_current := tBitmap.create;
bmp_current.width := r.Right - r.Left - sbxVertical.Width - 3;
bmp_current.Height := h - 5;
Bitblt(bmp_total.canvas.handle, 0, bmp_current_position, bmp_current.Width, bmp_current.height, dc, r.left, r.top, srccopy);
scroll_position_current := GetScrollPos(tvDidTimeTree.Handle, sb_Vert);
SendMessage(tvDidTimeTree.Handle, WM_VSCROLL, SB_PAGEDOWN, 0);
tvDidTimeTree.Repaint;
bmp_current_position := bmp_current_position + bmp_current.Height;
end;
spdSaveGraph.DefaultExt := 'bmp';
spdSaveGraph.FileName := DateToStr(date_start) + '—' + DateToStr(IncMonth(date_start, 1)) + '.bmp';
spdSaveGraph.Filter := 'Bitmap Picture|*.bmp';
if spdSaveGraph.Execute then
bmp_total.saveToFile (spdSaveGraph.FileName);
bmp_total.free;
end;
Related
How to rotate and draw a transperent PNG image using GDI+ directly on TChart?
Currently I load PNG image to a bitmap and use two bitmaps for GDI+ rotation (it works very fast) and then make the target bitmap transparent and draw it on TChart's canvas (it works slow when transparency is on).
procedure TPitchDisplay._chartAfterDraw(Sender: TObject);
var
c: TCanvas3D;
pw, ph: Integer;
r: TRect;
bmp: TBitmap;
rotAngle: Integer;
begin
_setKnobBounds();
c := _chart.Canvas;
_drawCircle(c, _knob.CenterPoint.X, _knob.CenterPoint.Y, Round(_knob.YRadius * 0.9));
c.StretchDrawQuality := sqHigh;
pw := 450;
ph := Round((pw / _shipBitmap.Width) * _shipBitmap.Height);
r.Left := _chart.ChartXCenter - pw div 2;
r.Top := Round(_chart.Height / 3);
r.Width := pw;
r.Height := ph;
//Draw water
c.StretchDraw(Rect(0, r.Top + Round(ph / 1.5), _chart.Width, _chart.Height), _waterBitmap);
//Draw rotated ship over it
bmp := TBitmap.Create();
try
bmp.Width := Round(_shipBitmap.Width * 1.2);
bmp.Height := Round(_shipBitmap.Height * 1.7);
bmp.TransparentColor := clBlack;
bmp.Transparent := True;
bmp.TransparentMode := TTransparentMode.tmFixed;
if VarIsNumeric(_pitchBox.Value) then
rotAngle := _pitchBox.Value
else
rotAngle := 0;
TGraphUtils.RotateBitmap(_shipBitmap, bmp, 0.5, 0.7, rotAngle, False, clBlack);
c.StretchDraw(r, bmp);
finally
bmp.Free();
end;
end;
Rotation routine:
class procedure TGraphUtils.RotateBitmap(srcBmp, tgtBmp: TBitmap; rotateAtX, rotateAtY: Single; Degs: Integer; AdjustSize: Boolean;
BkColor: TColor = clNone);
var
Tmp: TGPBitmap;
Matrix: TGPMatrix;
C: Single;
S: Single;
NewSize: TSize;
Graphs: TGPGraphics;
P: TGPPointF;
attr: TGPImageAttributes;
begin
Tmp := TGPBitmap.Create(srcBmp.Handle, srcBmp.Palette);
Matrix := TGPMatrix.Create();
try
Matrix.RotateAt(Degs, MakePoint(rotateAtX * srcBmp.Width, rotateAtY * srcBmp.Height));
if AdjustSize then begin
C := Cos(DegToRad(Degs));
S := Sin(DegToRad(Degs));
NewSize.cx := Round(srcBmp.Width * Abs(C) + srcBmp.Height * Abs(S));
NewSize.cy := Round(srcBmp.Width * Abs(S) + srcBmp.Height * Abs(C));
tgtBmp.Width := NewSize.cx;
tgtBmp.Height := NewSize.cy;
end;
Graphs := TGPGraphics.Create(tgtBmp.Canvas.Handle);
attr := TGPImageAttributes.Create;
try
Graphs.Clear(ColorRefToARGB(ColorToRGB(BkColor)));
Graphs.SetTransform(Matrix);
//attr.SetColorKey($FFFFFF {TGPColor.Blue}, $FFFFFF {TGPColor.Blue}, ColorAdjustTypeBitmap);
Graphs.DrawImage(Tmp, (Cardinal(tgtBmp.Width) - Tmp.GetWidth) div 2,
(Cardinal(tgtBmp.Height) - Tmp.GetHeight) div 2);
finally
attr.Free();
Graphs.Free();
end;
finally
Matrix.Free();
Tmp.Free();
end;
end;
procedure TForm1.Chart1AfterDraw(Sender: TObject);
var
GPImage: TGPImage;
GPGraphics: TGPGraphics;
Matrix: TGPMatrix;
c: TCanvas3d;
begin
c := Chart1.Canvas;
GPImage := TGPImage.Create('e:\2.png');
GPGraphics := TGPGraphics.Create(C.Handle);
Matrix := TGPMatrix.Create;
Matrix.Rotate(30);
Matrix.Scale(0.5, 0.5);
GPGraphics.SetTransform(Matrix);
GPGraphics.DrawImage(GPImage, 150, 0);
Matrix.Free;
GPGraphics.Free;
GPimage.Free;
end;
Not precise example of output into form center:
IM := TGPMatrix.Create;
IM := Matrix.Clone;
IM.Invert;
pc := MakePoint(Width div 2 - GPImage.GetWidth() div 2,
Height div 2 - Integer(GPImage.GetHeight) div 2);
Im.TransformPoints(pgppoINT(#pc));
GPGraphics.DrawImage(GPImage, pc);
I would like to know if it is possible to make the Form transparent (AlphaBlend) without the Border (where the minimize button is and all that) being transparent too? If it is, how can I do it?
It is possible, but any controls you put on such form will not be visible.
Here is some base code to get you started, but I have never used it on forms with border, so there might be possible issues with border functionality. Most likely, you will have to create bitmap that will include window border and set alpha for that part to 255;
procedure PremultiplyBitmap(Bitmap: TBitmap);
var
Row, Col: Integer;
p: PRGBQuad;
begin
Bitmap.AlphaFormat := afPremultiplied;
for Row := 0 to Bitmap.Height - 1 do
begin
Col := Bitmap.Width;
p := Bitmap.ScanLine[Row];
while (Col > 0) do
begin
p.rgbBlue := p.rgbReserved * p.rgbBlue div 255;
p.rgbGreen := p.rgbReserved * p.rgbGreen div 255;
p.rgbRed := p.rgbReserved * p.rgbRed div 255;
inc(p);
dec(Col);
end;
end;
end;
procedure PremultiplyBitmapAlpha(Bitmap: TBitmap; Alpha: byte);
var
Row, Col: Integer;
p: PRGBQuad;
begin
Bitmap.AlphaFormat := afPremultiplied;
for Row := 0 to Bitmap.Height - 1 do
begin
Col := Bitmap.Width;
p := Bitmap.ScanLine[Row];
while (Col > 0) do
begin
p.rgbReserved := Alpha;
p.rgbBlue := p.rgbReserved * p.rgbBlue div 255;
p.rgbGreen := p.rgbReserved * p.rgbGreen div 255;
p.rgbRed := p.rgbReserved * p.rgbRed div 255;
inc(p);
dec(Col);
end;
end;
end;
procedure BlendForm(Form: TCustomForm; Bmp: TBitmap);
var
BitmapPos: TPoint;
BitmapSize: TSize;
BlendFunction: TBlendFunction;
begin
BitmapPos := Point(0, 0);
BitmapSize.cx := Bmp.Width;
BitmapSize.cy := Bmp.Height;
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 255;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(Form.Handle, 0, nil, #BitmapSize, Bmp.Canvas.Handle, #BitmapPos, 0, #BlendFunction, ULW_ALPHA);
end;
procedure TForm1.CreateWnd;
var
ExStyle: DWORD;
begin
inherited;
ExStyle := GetWindowLong(Handle, GWL_EXSTYLE);
if (ExStyle and WS_EX_LAYERED = 0) then
SetWindowLong(Handle, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32bit;
Bmp.Width := ClientWidth;
Bmp.Height := ClientHeight;
PremultiplyBitmapAlpha(Bmp, 200);
BlendForm(Form1, Bmp);
finally
Bmp.Free;
end;
end;
Bitmaps you use have to be 32-bit bitmaps. If you want to blend whole bitmap with some alpha value, you can use PremultiplyBitmapAlpha procedure, and if your bitmap has alpha channel you can then use PremultiplyBitmap procedure.
For speed improvements you can use premultiplied byte table like this:
var
PreMult: array[byte, byte] of byte;
procedure InitializePreMult;
var
Row, Col: Integer;
begin
// precalculate all possible values of a*b
for Row := 0 to 255 do
for Col := Row to 255 do
PreMult[Row, Col] := Row*Col div 255;
end;
and then PremultiplyBitmap procedure would use that lookup table:
procedure PremultiplyBitmap(Bitmap: TBitmap);
var
Row, Col: integer;
p: PRGBQuad;
begin
for Row := 0 to Bitmap.Height-1 do
begin
Col := Bitmap.Width;
p := Bitmap.ScanLine[Row];
while (Col > 0) do
begin
p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue];
p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen];
p.rgbRed := PreMult[p.rgbReserved, p.rgbRed];
inc(p);
dec(Col);
end;
end;
end;
I am trying to add capture screenshot of active window using this code
procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap) ;
var
w,h : integer;
DC : HDC;
hWin : Cardinal;
r : TRect;
begin
if activeWindow then
begin
hWin := GetForegroundWindow;
dc := GetWindowDC(hWin) ;
GetWindowRect(hWin,r) ;
w := r.Right - r.Left;
h := r.Bottom - r.Top;
end
else
begin
hWin := GetForegroundWindow;
dc := GetDC(hWin) ;
w := GetDeviceCaps (DC, HORZRES) ;
h := GetDeviceCaps (DC, VERTRES) ;
end;
try
destBitmap.Width := w;
destBitmap.Height := h;
BitBlt(destBitmap.Canvas.Handle,
0,
0,
destBitmap.Width,
destBitmap.Height,
DC,
0,
0,
SRCCOPY) ;
finally
ReleaseDC(hWin, DC) ;
end;
end;
And in Button1 i use :
var
path:string;
b:TBitmap;
begin
path:= ExtractFilePath(Application.ExeName) + '/Screenshot/';
b := TBitmap.Create;
try
ScreenShot(TRUE, b) ;
b.SaveToFile(path + 'Screenshot_1.png');
finally
b.FreeImage;
FreeAndNil(b) ;
end;
end;
it works good only problem is it not capture title bar :(
Here is Full Active window view :
And Here is what i get from that code
Where am i doing wrong ??
I don't know what kind of visual styling components you're using (the form icon indicates it's Delphi 7, though).
This code works perfectly for me:
function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
DC: HDC;
wRect: TRect;
Width, Height: Integer;
begin
DC := GetWindowDC(WindowHandle);
Result := TBitmap.Create;
try
GetWindowRect(WindowHandle, wRect);
Width := wRect.Right - wRect.Left;
Height := wRect.Bottom - wRect.Top;
Result.Width := Width;
Result.Height := Height;
Result.Modified := True;
BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
finally
ReleaseDC(WindowHandle, DC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Capture: TBitmap;
begin
// For active window, change Handle to GetForegroundWindow()
Capture := CaptureWindow(Handle);
try
Capture.SaveToFile('E:\TempFiles\ScreenCapture2014.bmp');
finally
Capture.Free;
end;
end;
Here's the image I captured:
I have tested and got the same result.
original with border
But if you set
sSkinProvider1.AllowExtBorders:=False;
you get a screenshot without the transparent roundet border.
then set back
sSkinProvider1.AllowExtBorders:=True;
No need to do after that a second
Form1.Repaint;
You will see only a short switch.
procedure TForm1.BitBtn1Click(Sender: TObject);
var
path:string;
b:TBitmap;
begin
sSkinProvider1.AllowExtBorders:=False;
Form1.Repaint;
path:= ExtractFilePath(Application.ExeName) + 'Screenshot\';
b := TBitmap.Create;
try
ScreenShot(TRUE, b) ;
b.SaveToFile(path + 'Screenshot_1.png');
finally
b.FreeImage;
FreeAndNil(b) ;
sSkinProvider1.AllowExtBorders:=True;
[...]
btw. do not set the path like
path:= ExtractFilePath(Application.ExeName) + '/Screenshot/';
use windows style backslash and only one
path:= ExtractFilePath(Application.ExeName) + 'Screenshot\';
Tested with Delphi5
How can I replace color on TCanvas on Delphi XE2? The following code works incredibly slow:
for y := ARect.Top to ARect.Top + ARect.Height - 1 do
for x := ARect.Left to ARect.Left + ARect.Width - 1 do
if Canvas.Pixels[x, y] = FixedColor then
Canvas.Pixels[x, y] := Canvas.Pixels[ARect.Left, ARect.Top];
Here are two function (with and without tolerance) to replace the color:
Bonus:
Code to test the functions also provided. Load your image in a TImage control, then use the MouseUp event to change the color under mouse.
procedure ReplaceColor(BMP: TBitmap; OldColor, NewColor: TColor);
VAR
x, y: Integer;
R,G,B: Byte;
R_,G_,B_: Byte;
aPixel: PRGBTriple;
begin
R:= GetRValue(OldColor);
G:= GetGValue(OldColor);
B:= GetBValue(OldColor);
R_:= GetRValue(NewColor);
G_:= GetGValue(NewColor);
B_:= GetBValue(NewColor);
BMP.PixelFormat := pf24bit;
for y := 0 to BMP.Height - 1 do
for x := 0 to BMP.Width - 1 do
begin
aPixel := BMP.ScanLine[y];
Inc(aPixel, x);
if (aPixel^.rgbtRed = R)
AND (aPixel^.rgbtGreen = G)
AND (aPixel^.rgbtBlue = B) then
begin
aPixel^.rgbtRed := R_;
aPixel^.rgbtGreen := G_;
aPixel^.rgbtBlue := B_;
end;
end;
end;
procedure ReplaceColor(BMP: TBitmap; OldColor, NewColor: TColor; ToleranceR, ToleranceG, ToleranceB: Byte);
VAR
x, y: Integer;
R,G,B: Byte;
R_,G_,B_: Byte;
aPixel: PRGBTriple;
begin
R:= GetRValue(OldColor);
G:= GetGValue(OldColor);
B:= GetBValue(OldColor);
R_:= GetRValue(NewColor);
G_:= GetGValue(NewColor);
B_:= GetBValue(NewColor);
BMP.PixelFormat := pf24bit;
for y := 0 to BMP.Height - 1 do
for x := 0 to BMP.Width - 1 do
begin
aPixel := BMP.ScanLine[y];
Inc(aPixel, x);
if (abs(aPixel^.rgbtRed - R)< ToleranceR)
AND (abs(aPixel^.rgbtGreen- G)< ToleranceG)
AND (abs(aPixel^.rgbtBlue - B)< ToleranceB) then
begin
aPixel^.rgbtRed := R_;
aPixel^.rgbtGreen := G_;
aPixel^.rgbtBlue := B_;
end;
end;
end;
procedure TfrmTester.imgOnMouseUp(Sender: TObject; Shift: TShiftState; X, Y: Integer);
VAR
PixelClr: TColor;
BMP: TBitmap;
begin
// Collect the new color, under mouse pointer
PixelClr:= imgReplaceOrig.Picture.Bitmap.Canvas.Pixels[x, y];
if PixelClr< 0 then EXIT;
Label1.Caption := 'x'+IntToStr(X)+':y='
+ IntToStr(Y)
+' r'+ IntToStr(GetRValue(Pixel))
+', g'+ IntToStr(GetGValue(Pixel))
+', b'+ IntToStr(GetBValue(Pixel));
BMP:= TBitmap.Create;
BMP.Assign(imgReplaceOrig.Picture.Bitmap);
// Replace the color
cGraphUtil.ReplaceColor(BMP, PixelClr, clBlue, 44, 44, 44);
imgReplace.Picture.Assign(BMP);
FreeAndNil(BMP);
end;
var
aBitmap: TBitmap;
x, y: Integer;
aPixel: PRGBTriple;
...
aBitmap := TBitmap.Create;
try
aBitmap.PixelFormat := pf24bit;
aBitmap.Height := ARect.Height;
aBitmap.Width := ARect.Width;
aBitmap.Canvas.CopyRect(TRect.Create(0, 0, aBitmap.Width, aBitmap.Height), Canvas, ARect);
for y := 0 to aBitmap.Height - 1 do
for x := 0 to aBitmap.Width - 1 do
begin
aPixel := aBitmap.ScanLine[y];
Inc(aPixel, x);
if (aPixel^.rgbtRed = GetRValue(FixedColor)) and (aPixel^.rgbtGreen = GetGValue(FixedColor)) and (aPixel^.rgbtBlue = GetBValue(FixedColor)) then
aPixel^ := PRGBTriple(aBitmap.ScanLine[y])^;
end;
Canvas.Draw(ARect.Left, ARect.Top, aBitmap);
finally
aBitmap.Free;
end;
I am looking to draw an opacity ellipse in CodeGear Delphi 2010.
I had tried to draw to an another bitmap,
I had set the bitmap transparent color(for background)
Call the ellipse method.
And in my image I draw the bitmap with opacity parameter(from overload). But it doesn't work.
I want something like this http://www.java2s.com/Tutorial/VBImages/WPF-UseOpacityMaskAndRadialGradientBrush.PNG
Does anybody know an working method?
It works for me:
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;
If you want more control, you can always do the processing manually:
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;
You can for example let the background image be at 100 % opacity outside the ellipse:
...
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;
...
Not to mention all other cool stuff you can do with pixmap manipulation:
...
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;
...
If you really don't want to do it manually, I just figured out, you can draw the ellipse on a copy of the first bitmap, and then blend these two bitmaps:
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;