Can I directly modify per-pixel alpha data for TPngImage between loading it from somewhere and drawing it somewhere? If so, how? Thanks.
Yes, I think that is easy.
For example, this code will set the opacity to zero (that is, the transparency to 100 %) on every pixel in the upper half of the image:
var
png: TPNGImage;
sl: PByteArray;
...
for y := 0 to png.Height div 2 do
begin
sl := png.AlphaScanline[y];
FillChar(sl^, png.Width, 0);
end;
This will make a linear gradient alpha channel, from full transparency (alpha = 0) to full opacity (alpha = 255) from left to right:
for y := 0 to png.Height do
begin
sl := png.AlphaScanline[y];
for x := 0 to png.Width - 1 do
sl^[x] := byte(round(255*x/png.Width));
end;
Basically, what I am trying to say, is that
(png.AlphaScanline[y]^)[x]
is the alpha value (the opacity), as a byte, of the pixel at row y and col x.
You could use something like this:
for Y := 0 to Image.Height - 1 do begin
Line := Image.AlphaScanline[Y];
for X := 0 to Image.Width - 1 do begin
Line[X] := ALPHA
end;
end;
Related
In a 2D grid, we start from the origin (0, 0) and then we can move by one cell at the time with either (x+1, x-1, y+1, y-1).
I have to find the largest area with this constraint: for any point in the area, the sum of the digits of abs(x) plus the sum of the digits of abs(y) should be at most 23.
For example, the point (59,75) isn't valid because 5 + 9 + 7 + 5 = 26.
The point (-51, -7) is valid because 5 + 1 + 7 = 13, which is less than 23.
What could be a way to solve this with great time-complexity ?
Look at this picture. It shows as white those points with digits sum < 23 in the first quadrant reachable from coordinate origin (edit: needed <=23).
Seems it is not hard to make breadth-first search like flood-fill with special border condition sumdigit <=23 (coordinate limit is 699) and count them all.
White filling spreads from origin until border value is met. This process resembles water flooding with level 23. Black islands stay in white sea and solid black border limits it. Count of white pixels is area of continuous region around origin.
.
Moreover, it is possible to determine count of white points in every 100x100 square depending on its coordinates and get mathematical formula.
Scaled fragment:
Primitive implementation in Delphi (there are effective non-recursive Floodfill implementations) gives white pixel count 592597
var
mark: TDictionary<Integer, Integer>;
function digitsum(x, y: integer): integer;
begin
if mark.ContainsKey((x + 1000) * 2000 + y + 1000) then
Exit(9999);
Result := 0;
x := abs(x);
y := abs(y);
while y > 0 do begin
Result := Result + y mod 10;
y := y div 10;
end;
while x > 0 do begin
Result := Result + x mod 10;
x := x div 10;
end;
end;
function flood(x, y: integer): integer;
begin
if digitsum(x,y) > 23 then
Exit(0);
Result := 1;
mark.Add((x + 1000) * 2000 + y + 1000, 0);
Canvas.Pixels[x, y] := clWhite;
Inc(Result, flood(x + 1, y));
Inc(Result, flood(x - 1, y));
Inc(Result, flood(x, y - 1));
Inc(Result, flood(x, y + 1));
end;
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(ClientRect);
mark:= TDictionary<Integer, Integer>.Create;
Caption := flood(0, 0).ToString;
I have a DrawGrid with 600 x 600 Cells.
Each Cell gets painted with a color dependig on its Value.
Displaying the Grid needs ~1 second.
Question is: how can this be improved, so drawing needs less time?
The OnDrawCell Event looks like:
(MyVal is the Col/Row value and is taken from an 2 dimensional Array)
...
MyVal := MyArray[ACol, ARow];
case MyVal of
0: Drawgrid1.Canvas.brush.Color := clRed;
1: Drawgrid1.Canvas.brush.Color := clBlue;
...
end;
Drawgrid1.Canvas.Brush.Style := bsSolid;
Drawgrid1.Canvas.fillrect(Rect);
Thank you.
Klaus
everyone
I've been trying to solve the following problem in Delphi.
I want to make take an image and to make just one antialiased round corner.
I know how to make all 4 corners round by using RoundRect. However, I don't seem to figure out how to make just one.
I've been trying to solve the problem like this:
procedure RoundCorner(var image: TBitmap; w,h : integer);
//w - width of an image
//h - height of an image
//radius can be set at 150 (rounded rect radius)
// image is the timage object received as var parameter
var
i, j :integer;
x, y :double;
begin
i:= w - Trunc(radius);
x:= 0;
y:= radius - sqrt(sqr(radius) - sqr(x));
while(i < w) do
begin
j:=0;
while(j <= y) do
begin
image.Canvas.Pixels[i-1,j]:=clWhite; //a colour of your choosing or just erase this line
j := j + 1;
end;
y:= radius - sqrt(sqr(radius) - sqr(x));
x := x + 1;
i := i + 1;
end;
end;
This works, however I'm faced with 2 problems:
The corner is not antialiased
I want to fill the cut region with a different colour
Any suggestions are welcomed
Thanks.
First of all in your case "antialiasing" does mean that your image have to have a 32 bit pixel format in order to make a round transparent corner. Second thing is that you cannot access alpha channel via Canvas, you would need to access bitmap pixels directly via Scanline property or maybe to use a library like Graphics32 or AGG.
Another "modern" way to implement round corner is to use FMX and put the image inside a roundrect and clip it by the roundrect.
I'm using BDS 2007...
When a user double-clicks a grid cell in our application we display a modal window over the grid. I developed the routine below to draw an animation frame on the grid. It enlarges by drawing and erasing a frame in steps, before the window shows (much like the Windows UI animation). The same routine gets called again (with bExpand=False) after the window closes, to give the UI effect of the window imploding back into the grid cell.
This routine worked fine in Windows XP but misbehaves when Aero is enabled (works fine in Windows 7 without Aero). The animation frame redraws slowly...even if I comment out the DelayMSecs line (which is just a loop that calls Sleep(0) repeatedly until the iDelay number of milliseconds has passed).
And when the routine is called again (after the window closes) it is equally slow, plus leaves a frame on the screen, plus there's a ghost image of the (now closed) window left in place, essentially alpha-blended with the normal display contents of the grid.
Most of the routine's code calculates the changing rectangle size. Only three lines do the actual draw & erase of the animation rect:
ScreenCanvas.Rectangle( r ); //draw frame
SysStuff.DelayMSecs( iDelay ); //
ScreenCanvas.Rectangle( r ); //pmXOR pen ...erase frame
Any ideas on why this is slow under Aero, or what I need to change?
procedure T_fmExplore.AnimateRects(ASourceRect, ADestRect: TRect; bExpand:
boolean; bAdjustSourceForFrame: boolean = True);
{ Draw animation frames in steps, for transition from ASourceRect to ADestRect.
bExpand: determines whether the animation rect is expanding or contracting.
bAdjustSourceForFrame: resize the animation rect smaller for the window frame. }
const
MINSTEPS = 10; //Min redraws of the animation rect (frame)
MAXSTEPS = 20; //30 was too many, too slow
MAXDELAY = 100; //Delay between drawing each rect frame
MINDELAY = 1;
var
iSteps: integer;
DeltaHt: Integer; //Rect size chg for each redraw of animation window
DeltaWidth: Integer;
DeltaTop : integer; //Origin change for each redraw
DeltaLeft : integer;
TgtWidth, TgtHt: Integer;
iTemp: Integer;
iDelay: integer;
r : TRect; //Animation frame's rect
ScreenCanvas: TCanvas;
begin
r := ASourceRect;
TgtWidth := ADestRect.Right - ADestRect.Left; //Target rect's Width
TgtHt := ADestRect.Bottom - ADestRect.Top; //Target rect's Height
//Initially Deltas hold total chg in Width & Height
DeltaWidth := TgtWidth - (r.Right - r.Left); //TgtWidth - old width
DeltaHt := TgtHt - (r.Bottom - r.Top);
//For smooth animation we adjust number of iSteps & Delay relative to the window area.
//Larger window = more iSteps and shorter Delay between drawing each step.
iSteps := Max( DeltaWidth * DeltaHt div 6500, MINSTEPS );
iSteps := Min( iSteps, MAXSTEPS );
//Now convert Deltas to the delta in window rect size
DeltaWidth := DeltaWidth div iSteps;
DeltaHt := DeltaHt div iSteps;
DeltaTop := (ADestRect.Top - ASourceRect.Top) div iSteps;
DeltaLeft := (ADestRect.Left - ASourceRect.Left) div iSteps;
iDelay := Max( MAXDELAY div iSteps, MINDELAY );
ScreenCanvas := TCanvas.Create;
try
ScreenCanvas.Handle := GetDC( 0 ); //Desktop
try
with ScreenCanvas do begin
Pen.Color := clWhite; //Do NOT use clBlack with pmXOR mode: with (r=0, g=0, b=0) there are no bytes to XOR.
Pen.Mode := pmXOR; //MUST use pmXOR pen, so 2nd Rectangle call (see below) erases what we drew.
Pen.Style := psSolid;
Pen.Width := 3; //Thin line. Was: Pen.Width := GetSystemMetrics(SM_CXFRAME);
Brush.Style := bsClear;
if bAdjustSourceForFrame then
InflateRect(ASourceRect, -Pen.Width, -Pen.Width);
repeat
iTemp := (r.Bottom - r.Top) + DeltaHt; //Height
if (bExpand and (iTemp > TgtHt)) or (not bExpand and (iTemp < TgtHt)) then begin
r.Top := ADestRect.Top;
r.Bottom := Top + TgtHt;
end else begin
r.Top := r.Top + DeltaTop; //Assign Top first...Bottom is calc'd from it
r.Bottom := r.Top + iTemp;
end;
iTemp := (r.Right - r.Left) + DeltaWidth; //Width
if (bExpand and (iTemp > TgtWidth)) or (not bExpand and (iTemp < TgtWidth)) then begin
r.Left := r.Left + DeltaLeft;
r.Right := r.Left + TgtWidth;
end else begin
r.Left := r.Left + DeltaLeft; //Assign Left first...Right is calc'd from it
r.Right := r.Left + iTemp;
end;
ScreenCanvas.Rectangle( r ); //draw frame
SysStuff.DelayMSecs( iDelay ); //
ScreenCanvas.Rectangle( r ); //pmXOR pen ...erase frame
until (r.Right - r.Left = TgtWidth) and (r.Bottom - r.Top = TgtHt);
end;
finally
ReleaseDC( 0, ScreenCanvas.Handle );
ScreenCanvas.Handle := 0;
end;
finally
ScreenCanvas.Free;
end;
end;
Question
What's the best way to draw a bitmap with a per-pixel alpha onto a control's Canvas?
My bitmap data is stored in a 2d array of 32-bit pixel values.
T32BitPixel = packed record
Blue : byte;
Green : byte;
Red : byte;
Alpha : byte;
end;
My control is a descendent of TCustomTransparentControl.
Background
For a GUI I'm building I need to draw semi-transparent controls over other controls and textured backgrounds. The control graphics are created using AggPasMod (a port of Anti-Grain Geometry).
TCustomTransparentControl.Canvas.Handle provides access to the device context for drawing but I'm not sure how to blit the pixel data from there.
Assuming, you have your pixel array composed like the image rows and pixels in them, I would do it this way. The Canvas parameter is a target canvas, the X and Y are coordinates, where the bitmap will be rendered in the target canvas and the Pixels is the pixel array:
type
TPixel = packed record
B: Byte;
G: Byte;
R: Byte;
A: Byte;
end;
TPixelArray = array of array of TPixel;
procedure RenderBitmap(Canvas: TCanvas; X, Y: Integer; Pixels: TPixelArray);
var
I: Integer;
Size: Integer;
Bitmap: TBitmap;
BlendFunction: TBlendFunction;
begin
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit;
Bitmap.Width := Length(Pixels[0]);
Bitmap.Height := Length(Pixels);
Size := Bitmap.Width * SizeOf(TPixel);
for I := 0 to Bitmap.Height - 1 do
Move(Pixels[I][0], Bitmap.ScanLine[I]^, Size);
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 255;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
AlphaBlend(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, BlendFunction);
finally
Bitmap.Free;
end;
end;