I am working with delphi. I have TImage, to which I assign a bitmap.
imgmain.Picture.Bitmap := bmpMain;
imgmain.Picture.Bitmap.PixelFormat := pf24bit;
imgmain is object of TImage and bmpMain is object of TBitmap
I want to zoom my image. I have one trackbar on my form and as I click on trackbar the image should get zoom. What should I do?
Thank You.
Edit :
I found some solution at here It works but it cut my image.
The code you refer to sets up a transformation from one coordinate space to another, I didn't notice anything that would cut/crop your image there. However, instead of having an inversely proportional zoom factor I'd rather have, easy to understand, linear scaling. Also, I see no reason switching map modes depending on the scaling factor, I would modify the SetCanvasZoomFactor like this;
procedure SetCanvasZoomPercent(Canvas: TCanvas; AZoomPercent: Integer);
begin
SetMapMode(Canvas.Handle, MM_ISOTROPIC);
SetWindowExtEx(Canvas.Handle, 100, 100, nil);
SetViewportExtEx(Canvas.Handle, AZoomPercent, AZoomPercent, nil);
end;
A simplified (no error checking) working example with a bitmap loaded to a TImage, scaled via a TrackBar could be like the below. Note that the above function is inlined in the TrackBar's OnChange event.
type
TForm1 = class(TForm)
imgmain: TImage;
TrackBar1: TTrackBar;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
bmpmain: TBitmap;
[..]
[...]
procedure TForm1.FormCreate(Sender: TObject);
begin
bmpmain := TBitmap.Create;
bmpmain.LoadFromFile(ExtractFilePath('samplebitmap.bmp');
bmpmain.PixelFormat := pf32bit; // No significance, just seems faster here than pf24bit
TrackBar1.Min := 10;
TrackBar1.Max := 200;
TrackBar1.Frequency := 10;
TrackBar1.PageSize := 10;
TrackBar1.Position := 100; // Fires OnChange
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmpmain.Free;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
var
Zoom, x, y: Integer;
begin
Zoom := TrackBar1.Position;
if not (Visible or (Zoom = 100)) or (Zoom = 0) then
Exit;
SetMapMode(imgmain.Canvas.Handle, MM_ISOTROPIC);
SetWindowExtEx(imgmain.Canvas.Handle, 100, 100, nil);
SetViewportExtEx(imgmain.Canvas.Handle, Zoom, Zoom, nil);
x := imgmain.Width * 50 div Zoom - bmpmain.Width div 2;
y := imgmain.Height * 50 div Zoom - bmpmain.Height div 2;
imgmain.Canvas.Draw(x, y, bmpmain);
if (x > 0) or (y > 0) then begin
imgmain.Canvas.Brush.Color := clWhite;
ExcludeClipRect(imgmain.Canvas.Handle, x, y, x + bmpmain.Width, y + bmpmain.Height);
imgmain.Canvas.FillRect(imgmain.Canvas.ClipRect);
end;
Label1.Caption := 'Zoom: ' + IntToStr(TrackBar1.Position) + '%';
end;
edit: same code with a TImage in a ScrollBox;
type
TForm1 = class(TForm)
TrackBar1: TTrackBar;
Label1: TLabel;
ScrollBox1: TScrollBox;
imgmain: TImage;
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
bmpmain: TBitmap;
[...]
[...]
const
FULLSCALE = 100;
procedure TForm1.FormCreate(Sender: TObject);
begin
imgmain.Left := 0;
imgmain.Top := 0;
bmpmain := TBitmap.Create;
bmpmain.LoadFromFile(ExtractFilePath(Application.ExeName) + '610x.bmp');
bmpmain.PixelFormat := pf32bit;
TrackBar1.Min := FULLSCALE div 10; // %10
TrackBar1.Max := FULLSCALE * 2; // %200
TrackBar1.PageSize := (TrackBar1.Max - TrackBar1.Min) div 19;
TrackBar1.Frequency := TrackBar1.PageSize;
TrackBar1.Position := FULLSCALE;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmpmain.Free;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
var
Zoom: Integer;
begin
Zoom := TrackBar1.Position;
if not (Visible or (Zoom = FULLSCALE)) or (Zoom = 0) then
Exit;
SetMapMode(imgmain.Canvas.Handle, MM_ISOTROPIC);
SetWindowExtEx(imgmain.Canvas.Handle, FULLSCALE, FULLSCALE, nil);
SetViewportExtEx(imgmain.Canvas.Handle, Zoom, Zoom, nil);
imgmain.Width := Round(bmpmain.Width * Zoom / FULLSCALE);
imgmain.Height := Round(bmpmain.Height * Zoom / FULLSCALE);
if Assigned(imgmain.Picture.Graphic) then begin
imgmain.Picture.Graphic.Width := imgmain.Width;
imgmain.Picture.Graphic.Height := imgmain.Height;
end;
imgmain.Canvas.Draw(0, 0, bmpmain);
Label1.Caption := 'Zoom: ' +
IntToStr(Round(TrackBar1.Position / FULLSCALE * 100)) + '%';
end;
Using the undocumented SetWindowCompositionAttribute API on Windows 10, it's possible to enable glass for a window. The glass is white or clear, as seen in this screenshot:
However, the Windows 10 Start menu and the notification center, which both also uses glass, both blend with the accent colour, like so:
How does it do it?
Investigations
The accent colour in the following examples is a light purple - here's a screenshot from the Settings app:
The AccentPolicy structure defined in this example code has accent state, flags and gradient color fields:
AccentPolicy = packed record
AccentState: Integer;
AccentFlags: Integer;
GradientColor: Integer;
AnimationId: Integer;
end;
and the state can have any of these values:
ACCENT_ENABLE_GRADIENT = 1;
ACCENT_ENABLE_TRANSPARENTGRADIENT = 2;
ACCENT_ENABLE_BLURBEHIND = 3;
Note that the first two of these were found on this github gist.
The third works fine - that enables glass. Of the other two,
ACCENT_ENABLE_GRADIENT results in a window that is completely gray, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.
ACCENT_ENABLE_TRANSPARENTGRADIENT results in a window that is painted completely with the accent colour, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.
So this is getting close, and it seems to be what some of the popup windows like the volume control applet use.
The values can't be or-ed together, and the value of the GradientColor field has no effect except that it must be non-zero.
Drawing directly on a glass-enabled window results in very odd blending. Here it's filling the client area with red (0x000000FF in ABGR format):
and any non-zero alpha, eg 0xAA0000FF, results in no colour at all:
Neither match the look of the Start menu or notification area.
How do those windows do it?
Since GDI forms on Delphi don't support alpha channels (unless using alpha layered windows, which might not be suitable), commonly the black color will be taken as the transparent one, unless the component supports alpha channels.
tl;dr Just use your TTransparentCanvas class, .Rectangle(0,0,Width+1,Height+1,222), using the color obtained with DwmGetColorizationColor that you could blend with a dark color.
The following will use TImage component instead.
I'm going to use a TImage and TImage32 (Graphics32) to show the difference with alpha channels. This is a borderless form, because borders won't accept our colorization.
As you can see, the left one is using TImage1 and is affected by Aero Glass, and the right one is using TGraphics32, which allows to overlay with opaque colors (no translucent).
Now, we will be using a TImage1 with a translucent PNG that we can create with the following code:
procedure SetAlphaColorPicture(
const Col: TColor;
const Alpha: Integer;
Picture: TPicture;
const _width: Integer;
const _height: Integer
);
var
png: TPngImage;
x,y: integer;
sl: pByteArray;
begin
png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);
try
png.Canvas.Brush.Color := Col;
png.Canvas.FillRect(Rect(0,0,_width,_height));
for y := 0 to png.Height - 1 do
begin
sl := png.AlphaScanline[y];
FillChar(sl^, png.Width, Alpha);
end;
Picture.Assign(png);
finally
png.Free;
end;
end;
We need to add another TImage component to our form and send it back so other components won't be below it.
SetAlphaColorPicture(clblack, 200, Image1.Picture, 10,10 );
Image1.Align := alClient;
Image1.Stretch := True;
Image1.Visible := True;
And that's is how our form will look like the Start Menu.
Now, to get the accent color use DwmGetColorizationColor, which is already defined in DwmAPI.pas
function TForm1.GetAccentColor:TColor;
var
col: cardinal;
opaque: longbool;
newcolor: TColor;
a,r,g,b: byte;
begin
DwmGetColorizationColor(col, opaque);
a := Byte(col shr 24);
r := Byte(col shr 16);
g := Byte(col shr 8);
b := Byte(col);
newcolor := RGB(
round(r*(a/255)+255-a),
round(g*(a/255)+255-a),
round(b*(a/255)+255-a)
);
Result := newcolor;
end;
However, that color won't be dark enough as shown by the Start Menu.
So we need to blend the accent color with a dark color:
//Credits to Roy M Klever http://rmklever.com/?p=116
function TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor;
var
c1,c2: LongInt;
r,g,b,v1,v2: byte;
begin
A := Round(2.55 * A);
c1 := ColorToRGB(Col1);
c2 := ColorToRGB(Col2);
v1 := Byte(c1);
v2 := Byte(c2);
r := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 8);
v2 := Byte(c2 shr 8);
g := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 16);
v2 := Byte(c2 shr 16);
b := A * (v1 - v2) shr 8 + v2;
Result := (b shl 16) + (g shl 8) + r;
end;
...
SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50) , 222, Image1.Picture, 10, 10);
And this is the result blending clBlack with the Accent color by 50%:
There are other things that you might want to add, like for example detecting when the accent color changes and automatically update our app color too, for example:
procedure WndProc(var Message: TMessage);override;
...
procedure TForm1.WndProc(var Message: TMessage);
const
WM_DWMCOLORIZATIONCOLORCHANGED = $0320;
begin
if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then
begin
// here we update the TImage with the new color
end;
inherited WndProc(Message);
end;
To maintain consistency with Windows 10 start menu settings, you can read the registry to find out if the Taskbar/StartMenu is translucent (enabled) and the start menu is enabled to use the accent color or just a black background, to do so this keys will tell us:
'SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize'
ColorPrevalence = 1 or 0 (enabled / disabled)
EnableTransparency = 1 or 0
This is the full code, you need TImage1, TImage2, for the colorization, the other ones are not optional.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GR32_Image, DWMApi, GR32_Layers,
Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.pngimage, Registry;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image3: TImage;
Image321: TImage32;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function TaskbarAccented:boolean;
function TaskbarTranslucent:boolean;
procedure EnableBlur;
function GetAccentColor:TColor;
function BlendColors(Col1, Col2: TColor; A: Byte): TColor;
procedure WndProc(var Message: TMessage);override;
procedure UpdateColorization;
public
{ Public declarations }
end;
AccentPolicy = packed record
AccentState: Integer;
AccentFlags: Integer;
GradientColor: Integer;
AnimationId: Integer;
end;
TWinCompAttrData = packed record
attribute: THandle;
pData: Pointer;
dataSize: ULONG;
end;
var
Form1: TForm1;
var
SetWindowCompositionAttribute: function (Wnd: HWND; const AttrData: TWinCompAttrData): BOOL; stdcall = Nil;
implementation
{$R *.dfm}
procedure SetAlphaColorPicture(
const Col: TColor;
const Alpha: Integer;
Picture: TPicture;
const _width: Integer;
const _height: Integer
);
var
png: TPngImage;
x,y: integer;
sl: pByteArray;
begin
png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);
try
png.Canvas.Brush.Color := Col;
png.Canvas.FillRect(Rect(0,0,_width,_height));
for y := 0 to png.Height - 1 do
begin
sl := png.AlphaScanline[y];
FillChar(sl^, png.Width, Alpha);
end;
Picture.Assign(png);
finally
png.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.EnableBlur;
const
WCA_ACCENT_POLICY = 19;
ACCENT_ENABLE_BLURBEHIND = 3;
DrawLeftBorder = $20;
DrawTopBorder = $40;
DrawRightBorder = $80;
DrawBottomBorder = $100;
var
dwm10: THandle;
data : TWinCompAttrData;
accent: AccentPolicy;
begin
dwm10 := LoadLibrary('user32.dll');
try
#SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');
if #SetWindowCompositionAttribute <> nil then
begin
accent.AccentState := ACCENT_ENABLE_BLURBEHIND ;
accent.AccentFlags := DrawLeftBorder or DrawTopBorder or DrawRightBorder or DrawBottomBorder;
data.Attribute := WCA_ACCENT_POLICY;
data.dataSize := SizeOf(accent);
data.pData := #accent;
SetWindowCompositionAttribute(Handle, data);
end
else
begin
ShowMessage('Not found Windows 10 blur API');
end;
finally
FreeLibrary(dwm10);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
BlendFunc: TBlendFunction;
bmp: TBitmap;
begin
DoubleBuffered := True;
Color := clBlack;
BorderStyle := bsNone;
if TaskbarTranslucent then
EnableBlur;
UpdateColorization;
(*BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := 96;
BlendFunc.AlphaFormat := AC_SRC_ALPHA;
bmp := TBitmap.Create;
try
bmp.SetSize(Width, Height);
bmp.Canvas.Brush.Color := clRed;
bmp.Canvas.FillRect(Rect(0,0,Width,Height));
Winapi.Windows.AlphaBlend(Canvas.Handle, 50,50,Width, Height,
bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, BlendFunc);
finally
bmp.Free;
end;*)
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
function TForm1.TaskbarAccented: boolean;
var
reg: TRegistry;
begin
Result := False;
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');
try
if reg.ReadInteger('ColorPrevalence') = 1 then
Result := True;
except
Result := False;
end;
reg.CloseKey;
finally
reg.Free;
end;
end;
function TForm1.TaskbarTranslucent: boolean;
var
reg: TRegistry;
begin
Result := False;
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');
try
if reg.ReadInteger('EnableTransparency') = 1 then
Result := True;
except
Result := False;
end;
reg.CloseKey;
finally
reg.Free;
end;
end;
procedure TForm1.UpdateColorization;
begin
if TaskbarTranslucent then
begin
if TaskbarAccented then
SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50) , 222, Image1.Picture, 10, 10)
else
SetAlphaColorPicture(clblack, 222, Image1.Picture, 10,10 );
Image1.Align := alClient;
Image1.Stretch := True;
Image1.Visible := True;
end
else
Image1.Visible := False;
end;
function TForm1.GetAccentColor:TColor;
var
col: cardinal;
opaque: longbool;
newcolor: TColor;
a,r,g,b: byte;
begin
DwmGetColorizationColor(col, opaque);
a := Byte(col shr 24);
r := Byte(col shr 16);
g := Byte(col shr 8);
b := Byte(col);
newcolor := RGB(
round(r*(a/255)+255-a),
round(g*(a/255)+255-a),
round(b*(a/255)+255-a)
);
Result := newcolor;
end;
//Credits to Roy M Klever http://rmklever.com/?p=116
function TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor;
var
c1,c2: LongInt;
r,g,b,v1,v2: byte;
begin
A := Round(2.55 * A);
c1 := ColorToRGB(Col1);
c2 := ColorToRGB(Col2);
v1 := Byte(c1);
v2 := Byte(c2);
r := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 8);
v2 := Byte(c2 shr 8);
g := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 16);
v2 := Byte(c2 shr 16);
b := A * (v1 - v2) shr 8 + v2;
Result := (b shl 16) + (g shl 8) + r;
end;
procedure TForm1.WndProc(var Message: TMessage);
//const
// WM_DWMCOLORIZATIONCOLORCHANGED = $0320;
begin
if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then
begin
UpdateColorization;
end;
inherited WndProc(Message);
end;
initialization
SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute');
end.
Here is the source code and demo binary hope it helps.
I hope there is a better way, and if there is, please let us know.
BTW on C# and WPF it is easier, but those apps are very slow on cold start.
[Bonus Update]
Alternatively on Windows 10 April 2018 Update or newer (might work on Fall Creators Update), you can use Acrylic blur behind instead, it can be used as follows:
const ACCENT_ENABLE_ACRYLICBLURBEHIND = 4;
...
accent.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND;
// $AABBGGRR
accent.GradientColor := (opacity SHL 24) or (clRed);
But this might not work if WM_NCCALCSIZE is executed, i.e. will only work on bsNone border style or WM_NCALCSIZE avoided. Notice that colorizing is included, no need to paint manually.
AccentPolicy.GradientColor has effect when you play with AccentPolicy.AccentFlags, I found these values:
2 - fills window with AccentPolicy.GradientColor - what you need
4 - makes area to the right and bottom of the window blurred (weird)
6 - combination of above: fills whole screen with AccentPolicy.GradientColor and blurs area like 4
To set AccentPolicy.GradientColor property, you'll need ActiveCaption and InactiveCaption system colours. I would try Rafael's suggestion to use GetImmersiveColor* family of functions (see update). Also there is a question for Vista/7.
Note: I tried drawing with GDI+ and saw that FillRectangle() works incorrectly with Glass when brush.alpha==0xFF (workarounds here). Inner rectangles have brush.alpha==0xFE on both screenshots because of this bug.
Screenshots note: GradientColor==0x80804000, it doesn't have to be premultiplied, just a coincidence.
Update:
To get accent color, you can use C++/WinRT - it is a documented and thus preferred approach for Windows 10:
#include <winrt/Windows.UI.ViewManagement.h> // may need "Microsoft.Windows.CppWinRT" NuGet package
...
using namespace winrt::Windows::UI::ViewManagement;
winrt::Windows::UI::Color accent = UISettings{}.GetColorValue(UIColorType::Accent);
Just add transparent colored component to the form. I have selfwriten component like TPanel (on Delphi).
Here Alpha = 40%:
I want to draw quite complex images with alpha-transparent rectangles and alpha-transparent images.
There is GDI+ wrapper from Mitov, but it doesn't seem to support 32bit BMP files plus it rescales them and the documentation is terrible. BMPs are way faster than PNGs so I want to use them.
There is SynGDI wrapper of GDI+, but it seems very basic and there is no documentation for it.
There is also this trick for GDI:
procedure DrawAlphaAPI(Source: TBitmap; Destination: TCanvas;
const X, Y: Integer; const Opacity: Byte = 255);
var BlendFunc: TBlendFunction;
begin
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := Opacity;
if Source.PixelFormat = pf32bit then
BlendFunc.AlphaFormat := AC_SRC_ALPHA
else
BlendFunc.AlphaFormat := 0;
Windows.AlphaBlend(Destination.Handle, X, Y, Source.Width, Source.Height,
Source.Canvas.Handle, 0, 0, Source.Width, Source.Height, BlendFunc);
end;
But when I call it with Opacity = 255 it draws 32bit bitmaps not properly (something like they are half transparent where they should be fully).
I don't want to use Scanline to make pixels transparent as this will be too complicated to draw all the transparent rectangles this way.
Also I thin GDI+ should be faster on modern computers, am I right?
So the question is: how to draw an alpha transparent rectangle and bitmap easily (without tons of code)?
Preferred Delphi: 7. I also have 2005 and XE3 but since 7 is a speed demon I would most want something to work from 7 up.
If you prepare the ordinary TBitmap, any of the GDI+ implementations can be used just assigning bmp.Canvas.Handle.
Your problem in compiling might be caused by an old DirctDraw-Version in the Folder, just remove it.
implementation
uses GDIPAPI, GDIPOBJ;
{$R *.dfm}
Procedure PrepareBMP(bmp: TBitmap; Width, Height: Integer);
var
p: Pointer;
begin
bmp.PixelFormat := pf32Bit;
bmp.Width := Width;
bmp.Height := Height;
bmp.HandleType := bmDIB;
bmp.ignorepalette := true;
bmp.alphaformat := afPremultiplied;
// clear all Scanlines
p := bmp.ScanLine[Height - 1];
ZeroMemory(p, Width * Height * 4);
end;
procedure TForm2.Button1Click(Sender: TObject);
var
bmp: TBitmap;
G: TGPGRaphics;
B: TGPSolidBrush;
begin
bmp := TBitmap.Create;
try
PrepareBMP(bmp, 300, 300);
G := TGPGRaphics.Create(bmp.Canvas.Handle);
B := TGPSolidBrush.Create(MakeColor(100, 255, 0, 0));
try
G.SetSmoothingMode(SmoothingModeHighQuality);
G.FillEllipse(B, MakeRect(0.0, 0, 300, 300));
B.SetColor(MakeColor(100, 0, 255, 128));
G.FillEllipse(B, MakeRect(40.0, 40, 260, 260));
finally
B.Free;
G.Free;
end;
// draw overlapping in Form Canvas to display transparency
Canvas.Draw(0, 0, bmp);
Canvas.Draw(100, 100, bmp);
finally
bmp.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;