Moving bitmap pixels - delphi

If I wanted to move / shift the pixels of a bitmap how could I do so?
procedure MovePixels(Bitmap: TBitmap; Horizontal, Vertical: Integer);
begin
{ move the Bitmap pixels to new position }
end;
Example:
By calling MovePixels(Image1.Picture.Bitmap, 20, 20) for example would output like so:
It would be useful to also specify / change the color of the canvas that is left showing after moving the pixels. So in this example that gray / brown color could be blue etc.
I noticed there is Bitmap.Canvas.Pixels and Bitmap.Canvas.MoveTo properties, is this what I would need to do this?
I really don't know and I bet it is so simple..

You can't easily move pixels, but you can make a copy.
var
Source, Dest: TRect;
....
Source := Rect(0, 0, Bitmap.Width, Bitmap.Height);
Dest := Source;
Dest.Offset(X, Y);
Bitmap.Canvas.CopyRect(Dest, Bitmap.Canvas, Source);
What remains is to fill in the space with the colour of your choice which I am sure you can do easily enough with a couple of calls to FillRect.
However, I think that it would be simpler not to attempt this in-place. Instead I would create a new bitmap. Perhaps like this:
function CreateMovedImage(Bitmap: TBitmap; X, Y: Integer; BackColor: TColor): TBitmap;
var
Source, Dest: TRect;
begin
Source := Rect(0, 0, Bitmap.Width, Bitmap.Height);
Dest := Source;
Dest.Offset(X, Y);
Result := TBitmap.Create;
Try
Result.SetSize(Bitmap.Width, Bitmap.Height);
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.Brush.Color := BackColor;
Result.Canvas.FillRect(Source);
Result.Canvas.CopyRect(Dest, Bitmap.Canvas, Source);
Except
Result.Free;
raise;
End;
end;

Related

Transparent PNG image loaded from resource file, resized with Grapics32 and drawn on the Canvas

I need a little help...
I have a transparent PNG image in my application resources. Until now I was loading it in a TPngImage and draw it on the screen with Canvas.Draw(X, Y, PngImage);. And it was drawn transparently. Now I updated my application to be DpiAware and I need to scale all images. I need a quality resampler and I choose to use Graphics32. I managed to do the resampling but I don't know how to keep the transparecy... I try all that I cand think of... The result of the following code is the image drawn with black color in the transparent region...
Foto32, Buff: TBitmap32;
FotoPng: TPngImage;
constructor TForm.Create(AOwner: TComponent);
const BkgHeight = 380;
var Res: TKernelResampler;
SRect, DRect: TRect;
ImgWidth: Integer;
begin
inherited;
Buff:= TBitmap32.Create;
Res:= TKernelResampler.Create;
Res.Kernel:= TLanczosKernel.Create;
FotoPng:= TPngImage.Create;
FotoPng.Transparent:= True;
FotoPng.TransparentColor:= clBlack;
FotoPng.LoadFromResourceName(HInstance, 'BKG_FOTO');
Foto32:= TBitmap32.Create;
Foto32.DrawMode:= dmBlend;
Foto32.CombineMode:= cmMerge;
Foto32.OuterColor:= clBlack;
Foto32.Canvas.Brush.Style:= bsClear;
Foto32.SetSize(FotoPng.Width, FotoPng.Height);
FotoPng.Draw(Foto32.Canvas, Rect(0, 0, FotoPng.Width, FotoPng.Height));
ImgWidth:= Round(Real(Foto32.Width / Foto32.Height) * BkgHeight);
SRect:= Rect(0, 0, Foto32.Width, Foto32.Height);
Buff.DrawMode:= dmBlend;
Buff.CombineMode:= cmMerge;
Buff.OuterColor:= clBlack;
Buff.Canvas.Brush.Style:= bsClear;
Buff.SetSize(Scale(ImgWidth), Scale(BkgHeight));
DRect:= Rect(0, 0, Buff.Width, Buff.Height);
Res.Resample(Buff, DRect, DRect, Foto32, SRect, dmTransparent {dmBlend}, nil);
end;
procedure TForm.Paint;
begin
// ....
Buff.DrawTo(Canvas.Handle, X, Y);
end;
And this is my transparent PNG image compiled into resources:
https://postimg.cc/3yy3wrJB
I found here a similar question, but I don't use the image with a TImage, I draw it directly on the canvas. And in the single answer, David says:
Anyway, if that is so, I would combine the transparency support of
TImage with the re-sampling ability of TBitmap32 to build a solution
that way. Keep the original image in a TBitmap32 instance. Whenever
you need to load it into the TImage component, for example when
re-sizing, use TBitmap32 to perform an in-memory re-size and load that
re-sized image.
This is exactly what I'm trying to do, but I don't know why the transparecy is not working. Any ideas ?
Your issue seems to be an issue with drawing the Buffer to the screen. Bitmap32 uses StretchDIBits for painting which ignores the alpha channel.
You could use the AlphaBlend function in order to draw your image:
procedure TForm1.FormPaint(Sender: TObject);
var
BF: TBlendFunction;
begin
BF.BlendOp := AC_SRC_OVER;
BF.BlendFlags := 0;
BF.SourceConstantAlpha := 255;
BF.AlphaFormat := AC_SRC_ALPHA;
Winapi.Windows.AlphaBlend(Canvas.Handle, 0, 0, Buff.Width, Buff.Height,
Buff.Canvas.Handle, 0, 0, Buff.Width, Buff.Height, BF);
end;
Or convert your TBitmap32 to a Delphi TBitmap and paint that using the VCL:
procedure TForm1.FormPaint(Sender: TObject);
var
Bmp: TBitmap;
I: Integer;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32bit;
Bmp.AlphaFormat := afDefined;
Bmp.SetSize(Buff.Width, Buff.Height);
for I := 0 to Buff.Height - 1 do
Move(Buff.ScanLine[I]^, Bmp.ScanLine[I]^, Buff.Width * 4);
Canvas.Draw(0, 0, Bmp);
finally
Bmp.Free;
end;
end;

Paint on TGPImage programmatically

Could an TGPImage be loaded from PNG file or resource
himg := TGPImage.Create('heading.png');
and then be modified by painting on it like using canvas?
Or, better to say, I would like to paint a background using programmatic methods and then load an image from PNG above my painting in order to operate with this merged image as one solid TGPImage.
I looked at methods and properties of TGPImage and didn't find painting instruments.
Could I probably do this using TBitmap?
Following does not work:
_hbm := TBitmap.Create();
_hbm.Width := 1000;
_hbm.Height := 1000;
_hbm.Canvas.Brush.Color := clBlack;
_hbm.Canvas.Pen.Color := clBlack;
_hbm.Canvas.FillRect(Rect(0, 0, 1000, 1000));
_hgb := TGPBitmap.Create(_hbm.Handle);
....................
GPGraphics.DrawImage(_hgb, 0, 0, _hgb.GetWidth(), _hgb.GetHeight());
You don't need a TBitmap for that.
You simply need to use a TGPGraphics associated with the TGPImage to draw on the TGPImage surface.
Here is a very simple example:
uses GDIPOBJ, GDIPAPI, GDIPUTIL;
procedure TForm1.Button1Click(Sender: TObject);
var
b: TGPBitmap;
g: TGPGraphics;
pen: TGPPen;
encoderClsid: TGUID;
begin
b := TGPBitmap.Create('D:\in.png');
try
g := TGPGraphics.Create(b);
try
pen := TGPPen.Create(MakeColor(255, 255, 0), 3);
try
{ Draw a yellow Rectangle }
g.DrawRectangle(pen, MakeRect(0, 0, 200, 200));
GetEncoderClsid('image/png', encoderClsid);
b.Save('D:\out.png', encoderClsid);
finally
pen.Free;
end;
finally
g.Free;
end;
finally
b.Free;
end;
end;

How to draw a solid color bitmap with a Text Centered?

The code below should be creating a bitmap that is a 48x48 rectangle, of blue background color and a Text (actually just a letter) centered horizontally and vertically of white color.
However nothing happens.
procedure MakeCustomIcon(AText: string; AWidth: Integer; AHeight: Integer; AColor: TAlphaColor; var ABlob: TBlob);
var
Bitmap: TBitmap;
Rect: TRectF;
InStream: TMemoryStream;
begin
Bitmap := TBitmap.Create;
InStream := TMemoryStream.Create;
try
Bitmap.SetSize(AWidth, AHeight);
Bitmap.Canvas.Clear(AColor);
Bitmap.Canvas.Stroke.Kind := TBrushKind.bkSolid;
Bitmap.Canvas.StrokeThickness := 1;
Bitmap.Canvas.Fill.Color := TAlphaColorRec.White;
Bitmap.Canvas.BeginScene;
Rect.Create(0, 0, AWidth, AHeight);
Bitmap.Canvas.FillText(Rect, AText, true, 100, [TFillTextFlag.ftRightToLeft], TTextAlign.taCenter, TTextAlign.taCenter);
Bitmap.Canvas.EndScene;
Bitmap.SaveToStream(InStream);
InStream.Position := 0;
ABlob.Clear;
ABlob.LoadFromStream(InStream);
finally
Bitmap.Free;
InStream.Free;
end;
I have tested the rest of my program to make sure the image (that Blob) is actually transporting and getting displayed, and it is doing so. The problem is fully contained on the way it is drawn the bitmap on the method above.
This TBlob is an array of byte.
I am looking to do rectangles like this below, to be used in TListView:
I have prepared a project.
1-) Write Text on TImage
2-) Draw on TImage
3-) Effect to TImage
I Try on XE5
Samples:
procedure ReDraw(Image: TImage);
var
MyRect: TRectF;
begin
if Image.Bitmap.IsEmpty then Exit;
MyRect := TRectF.Create(0, Ozellik.SeritTop, Image.Bitmap.Width, Ozellik.SeritBot);
with Image.Bitmap.Canvas do
begin
BeginScene;
if not Seffaf.IsChecked then
Fill.Color := Ozellik.SeritRenk
else
Fill.Color := TAlphaColorRec.Null;
FillRect(MyRect, 0, 0, [], 1);
Fill.Color := Ozellik.YaziRenk;
if FontCombo.ItemIndex <> -1 then
Font.Family := FontCombo.Items[FontCombo.ItemIndex];
Font.Size := Ozellik.YaziBoyut;
FillText(MyRect,FonYazi.Text.Trim,True,1,[],TTextAlign.taCenter,TTextAlign.taCenter);
EndScene;
end;
Image.Repaint;
end;
http://www.dosya.tc/server32/vHsbaC/CapsYapMasa_st_.rar.html
All canvas drawings must be grouped into a BeginScene/EndScene block. Also, it is recommended to draw within a try-finally block.
So, instead of
Bitmap.Canvas.Clear(AColor);
...
Bitmap.Canvas.BeginScene;
...
Bitmap.Canvas.EndScene;
you should do:
Bitmap.Canvas.BeginScene;
try
Bitmap.Canvas.Clear(AColor);
...
finally
Bitmap.Canvas.EndScene;
end;
-- Regards

DCEF3: How to get a screenshot

How to get screenshot of browser in DCEF3?
I create browser like this without VCL. The TakePicture method will only work if
No debugger is used
If ShowWindow is used
var
info: TCefWindowInfo;
Settings: TCefBrowserSettings;
begin
FillChar(info, SizeOf(info), 0);
info.width := width;
info.height := height;
FillChar(Settings, SizeOf(TCefBrowserSettings), 0);
Settings.Size := SizeOf(TCefBrowserSettings);
GetSettings(Settings);
CefBrowserHostCreateBrowser(#info, FHandler, FDefaultUrl, #settings, nil);
end;
procedure TakePicture(const Browser: ICefBrowser; Height, Width: Integer);
var
DC: HDC;
Bmp : TBitmap;
Handle : HWND;
Rect : trect;
BarHeight : integer;
BarLeft : integer;
begin
Bmp := TBitmap.Create;
Bmp.PixelFormat := pf32bit;
Handle := Browser.Host.WindowHandle;
ShowWindow(handle, SW_RESTORE); // will work only if this is used otherwise black image!
BarLeft := GetSystemMetrics(SM_CXFRAME);
BarHeight := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME);
GetWindowRect(Handle, Rect);
DC := GetDC(Handle);
Bmp.Width := Rect.Right - Rect.Left;
Bmp.Height := (Rect.Bottom - Rect.Top);
BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, -BarLeft, -BarHeight, SRCCOPY);
ReleaseDC(Handle, DC);
Bmp.SaveToFile('c:\test.bmp');
Bmp.Free;
end;
This is basically off-screen rendering. In the demos folder of DCEF3 you'll find a project 'offscreen'. The code you're looking for is in the OnPaint event of TChromiumOSR. It renders to a TBitmap32, but any bitmap could be made to work. Notice that it has been optimized to only paint the so-called "dirty" areas (those that have changed since last painting), but if you're making a screenshot, that's not what you want. In my check-out of the repository there's a line commented out showing the naive case of just painting everything:
SomeBitmap.SetSize(width, height);
Move(buffer^, SomeBitmap32.Bits^, width * height * 4);
It's my best guess that the magic number 4 represents 4 bytes (32-bits).
I warmly recommend using Graphics32 but it you have to use a regular TBitmap, I'll leave it up to you to work out how to turn the array of bits into pixels. Be warmed it will probably be a lot slower.

Delphi - how do I crop a bitmap "in place"?

If I have a TBitmap and I want to obtain a cropped image from this bitmap, can I perform the cropping operation "in place"? e.g. if I have a bitmap that is 800x600, how can I reduce (crop) it so that it contains the 600x400 image at the centre, i.e. the resulting TBitmap is 600x400, and consists of the rectangle bounded by (100, 100) and (700, 500) in the original image?
Do I need to go via another bitmap or can this operation be done within the original bitmap?
You can use the BitBlt function
try this code.
procedure CropBitmap(InBitmap, OutBitMap : TBitmap; X, Y, W, H :Integer);
begin
OutBitMap.PixelFormat := InBitmap.PixelFormat;
OutBitMap.Width := W;
OutBitMap.Height := H;
BitBlt(OutBitMap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY);
end;
and you can use in this way
Var
Bmp : TBitmap;
begin
Bmp:=TBitmap.Create;
try
CropBitmap(Image1.Picture.Bitmap, Bmp, 10,0, 150, 150);
//do something with the cropped image
//Bmp.SaveToFile('Foo.bmp');
finally
Bmp.Free;
end;
end;
If you want use the same bitmap, try this version of the function
procedure CropBitmap(InBitmap : TBitmap; X, Y, W, H :Integer);
begin
BitBlt(InBitmap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY);
InBitmap.Width :=W;
InBitmap.Height:=H;
end;
And use in this way
Var
Bmp : TBitmap;
begin
Bmp:=Image1.Picture.Bitmap;
CropBitmap(Bmp, 10,0, 150, 150);
//do somehting with the Bmp
Image1.Picture.Assign(Bmp);
end;
I know you have your accepted answer already, but since i wrote my version (which uses VCL wrapper instead of GDI call), i'll post it here instead of just throwing it away.
procedure TForm1.FormClick(Sender: TObject);
var
Source, Dest: TRect;
begin
Source := Image1.Picture.Bitmap.Canvas.ClipRect;
{ desired rectangle obtained by collapsing the original one by 2*2 times }
InflateRect(Source, -(Image1.Picture.Bitmap.Width div 4), -(Image1.Picture.Bitmap.Height div 4));
Dest := Source;
OffsetRect(Dest, -Dest.Left, -Dest.Top);
{ NB: raster data is preserved during the operation, so there is not need to have 2 bitmaps }
Image1.Picture.Bitmap.Canvas.CopyRect(Dest, Image1.Picture.Bitmap.Canvas, Source);
{ and finally "truncate" the canvas }
Image1.Picture.Bitmap.Width := Dest.Right;
Image1.Picture.Bitmap.Height := Dest.Bottom;
end;

Resources