BMP rotation
Question
I want to rotate BMPs (rotate to any arbitrary angle around its center of mass)
on form with Delphi code.
Answer
A:
I can think of a brute force method, but its efficiency might be
questionable, don't try it without a co-processor!
Do a pixel-by-pixel mapping from a source bitmap to a target bitmap (using
the Canvas.Pixels property). For each pixel do a rectangular-polar
coordinate conversion, add the angle offset to the polar coordinate, then
convert back to rectangular and place the pixel at these new coordinates in
the target bitmap. You may also have to dither in a few missing pixels
depending on the accuracy / rounding of your arithmatic.
The X, Y transformation you would need would be as follows:
X,Y = old pixel coordinates
X1,Y1 = new pixel coordinates
T = rotation angle (in radians)
R, A - intermediate values representing the polar coordinates
R = Sqrt(Sqr(X) + Sqr(Y));
A = Arctan(Y/X);
X1 = R * Cos(A+T);
Y1 = R * Sin(A+T);
I really hope there is a better way of doing it, but if you can't find
anything else, this may be worth a try. I'm happy it will work, but may be
rather slow.
A:
>Do a pixel-by-pixel mapping from a source bitmap to a target bitmap (using
>the Canvas.Pixels property).
This is a good start -- but try thinking of it the other way around. Do a
pixel-by-pixel mapping from the target bitmap to the source bitmap, so
you're thinking about where the pixels are coming from, rather than where
they are going.
Here is a formula for rotation about the origin:
x, y = coordinates in the target bitmap
t = angle
u, v = coordinates in the source bitmap
x = u * cos(t) - v * sin(t)
y = v * cos(t) + u * sin(t)
Now, if I've solved these equations right for u and v, here's what they
would be (no guarantees, that's why I've included the originals!):
x * cos(t) + y
u = --------------------
sqr(cos(t)) + sin(t)
v = y * cos(t) - x
--------------------
sqr(cos(t)) + sin(t)
So, assuming you know the angle of rotation, you might calculate the
constants cos(t) and 1/sqr(cos(t))+sin(t) just before your loop; it might
look something like this (some adjustment and clipping needed):
ct := cos(t);
ccst := 1/sqr(cos(t))+sin(t);
for x := 0 to width do
for y := 0 to height do
dest.pixels[x,y] := source.pixels[Round((x * ct + y) * ccst),
Round((y * ct - x) * ccst)];
If you wanted to speed it up, and didn't care about accumulated round-off
error, you could realize that since you're moving a pixel at a time, the
distance between pixels in the u,v map is constant as you move across the
row, and again as you move down the column. I'll use the calculated
variables above as shorthand. Just plug in (x,y) = (1,0) and (x,y) = (0,1)
in the equation above to get:
duCol := ct * ccst;
dvCol := -ccst;
duRow := ccst;
dvRow := ct * ccst;
uStart := 0;
vStart := 0;
for x := 0 to width do
begin
u := uStart;
v := vStart;
for y := 0 to height do
begin
dest.pixels[x,y] := source.pixels[Round(u), Round(v)];
u := u + rowdu;
v := v + rowdv;
end;
uStart := uStart + duCol;
vStart := vStart + dvCol;
end;
All code provided as-is and without warranty!
If you're adventurous and want to try rotation around an arbitrary point,
try solving these for u and v:
Xp, Yp (X-sub-p, Y-sub-p) is the pivot point
others defined as above
x = Xp + (u - Xp) * cos(t) - (y - Yp) * sin(t)
y = Yp + (y - Yp) * cos(t) - (x - Xp) * sin(t)
A:
The original equations:
x = u * cos(t) - v * sin(t)
y = v * cos(t) + u * sin(t)
are correct but when I solve for u and v, I get this:
x * cos(t) + y * sin(t)
u = -----------------------
sqr(cos(t)) + sqr(sin(t))
y * cos(t) - x * sin(t)
v = ------------------------
sqr(cos(t)) + sqr(sin(t))
TOutline icons
Question
Is it possible to individually specify the icons displayed in a TOutline
component?
Answer
A:
It is possible, but its not necessarily easy. To do it you need to use an
"Owner Draw" outline. In the Outline's OnDrawItem event you'll need to
paint your bitmap and then the text. That parts pretty easy, but you have
to deal with indention, drawing the tree, etc. Plus there are a couple of
bugs/unexpected behaviors that get in the way.
Here's a snippet of code from an OnDrawItem handler that draws a bitmap
followed by the outline item text. The code for handling the bitmap could
probably be improved because I haven't had much experience with Windows
graphics. In case its not obvious olnOutline is my outline and bmpBitMap is
the bitmap.
{Get outline index. The DrawItem Index param is simply the number of the row
being dran and does not take into account collapsed nodes }
lIndex := GetItem(Rect.Left, Rect.Top);
Offset := 2; {Determines spacing between bitmap and text}
with olnOutline do
begin
with Canvas do
begin
{Indent the bitmap based on the Level of the OutlineNode}
Inc(Rect.Left, Offset + (ItemHeight * (Items[lIndex].Level -1)));
{Copy the bitmap }
BrushCopy(Bounds(Rect.Left, Rect.Top, bmpBitMap.Width, bmpBitMap.Height),
bmpBitMap, Bounds(0, 0, bmpBitMap.Height, bmpBitMap.Width),
bmpBitMap.TransparentColor);
{Draw the text to the right of the bitmap}
Inc(Rect.Left,bmpBitMap.Width + Offset);
TextOut(Rect.Left, Rect.Top, Items[lIndex].Text);
end; {with Canvas}
end; {with Outline}
Notes:
This snippet is from a larger block of code and I tried to trim out the
uneccesary junk, but it won't work without a little modification.
There is a problem with Outline's redrawing if you change the width of the
Outline at runtime. I think it only happens when the horizontal scrollbar
is disabled. Anyway, the problem is that the Rect passed to the OnDrawItem
event is the width before you resized the Outline. You could get around
this by using the Outline's width to set the right side of the Rect rather
than using the value supplied by Delphi.
This code DOES NOT draw the tree. I kept thinking I'd steal the code from
the VCL source, but it wasn't needed for this application so I never go to
it. Really wish the tree drawing routine was accessible, but it's not.
Converting Icons to Glyphs
Question
I need to convert Icons(.ICO) into Bitmaps(.BMP) for use in Glyphs at
run-time. I have seen an application to do this but it didn't come with
source code. Does anyone know an easy way to do this? I would prefer a
short code segment but a VCL component would also be an option.
Answer
This is a small example with how to load an icon contained in a
file EXE in a Glyph of an SpeedButton and as cleaning the Glyph.
Sorry but the commentaries of the code source are in Spanish.
*****************************************
unit Procs;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, StdCtrls, Buttons, ExtCtrls, ShellAPI;
procedure LlenaBoton(boton: TSpeedButton; Programa: string);
procedure LimpiaBoton(boton: TSpeedButton);
var
{Botones de programas}
Pic: TPicture;
Fname : String;
TempFile: array[0..255] of Char;
Icon : TIcon;
implementation
uses ttotro;
procedure LlenaBoton(boton: TSpeedButton; Programa: string);
var
NumFiles, NameLength : integer;
nIconsInFile : word;
rBoton : TRect;
oBitmap : TBitmap;
oBitmap2: TBitmap;
NombreBitmap: string;
begin
try
screen.cursor := crHourglass;
{Extrae el Icono}
Icon := TIcon.Create;
StrPCopy(TempFile, Programa);
Icon.Handle := ExtractIcon(HInstance, TempFile, 0);
{Crea una instancia de TPicture}
Pic := TPicture.Create;
{Asigna el icon.handle a la propiedad Pic.icon}
Pic.Icon := Icon;
{Configura el tamano del bitmap como el del icono y el del segundo
bitmap con el tamano del boton}
oBitmap := TBitMap.create;
oBitmap2 := TBitMap.create;
oBitmap2.Width := Icon.Width;
oBitmap2.Height := Icon.Height;
oBitmap.Width := boton.Width-4;
oBitmap.Height := boton.Height-4;
{ Dibuja el icono en el bitmap }
oBitmap2.Canvas.Draw( 0, 0, Pic.Graphic );
rBoton.left := 1;
rBoton.Top := 1;
rBoton.right:= boton.Width-6;
rBoton.Bottom := boton.Height-6;
oBitmap.Canvas.StretchDraw(rBoton, oBitmap2);
Boton.Hint := Programa;
NombreBitmap := Copy(programa, 1, Length(programa)-3)+'BMP';
{Salva el bitmap en un fichero}
If Not FileExists(NombreBitmap) Then
begin
oBitmap.SaveToFile(ExtractFilePath(Application.ExeName)+ExtractFileName(NombreBitmap));
Boton.Glyph := oBitmap;
end
else
{Carga el BMP en el boton}
Boton.Glyph.LoadFromFile(ExtractFilePath(Application.ExeName)+ExtractFileName(NombreBitmap));
finally
Icon.Free;
oBitmap.Free;
oBitmap2.Free;
screen.cursor := crDefault;
end; {main begin}
end; {llenaboton}
procedure LimpiaBoton(boton: TSpeedButton);
var
oBitmap : TBitmap;
rBoton : TRect;
begin
try
{Configuara el tamano del bitmap como el del icono y el del segundo
bitmap con el tamano del boton}
oBitmap := TBitMap.create;
oBitmap.Width := boton.Width-4;
oBitmap.Height := boton.Height-4;
Boton.Glyph := oBitmap;
finally
oBitmap.Free;
end; {main begin}
end; {limpiaboton}
end.
Delphi Graphics
Question
I have a project to develop a small video format....
I've done some tests with Delphi and it takes approx. 4 seconds for it
to fill a 250 x 250 bitmap, one pixel at a time...this is obviously
too slow...there has to be other ways to do it.
Answer
If you are simply trying to display one image in a resonable amount
of time, create a TBitmap object, play around with it, and then when
you are ready to display it to the screen, call
Image.Canvas.Draw(0, 0, Bitmap) to copy it and draw it to the screen.
You see, the main time consumer is the painting of the screen, not in
the setting of the Image's attributes. As a result, you want to set the
pixel's colors in a non-visible object (the TBitmap you created), and
then display the whole Bitmap at once. Here is some code for a form
with a single Image component on it:
procedure TForm1.FormPaint(Sender: TObject);
Var
TmpX, TmpY : Byte;
MyImage : TBitmap;
begin
Form1.Width := 260; Form1.Height := 260;
Image1.Width := 250; Image1.Height := 250;
Image1.top := 5; Image1.width := 5;
MyImage := TBitmap.Create;
MyImage.Width := 250; MyImage.Height := 250;
FOR TmpX := 0 TO 249 DO
FOR TmpY := 0 TO 249 DO
MyImage.Canvas.Pixels[TmpX,TmpY] :=
RGB(TmpX, 250 - TmpY, (TmpX + TmpY DIV 2));
Image1.Canvas.Draw(0, 0, MyImage);
MyImage.Free;
end;
If you want to do really fast graphics, look into the GDI (API)
functions and/or the WinG functions given out by Microsoft. These
are a bit tedious to learn and use, and they are outside of Delphi's
domain.
Icons loaded and converted for TBitBtn no white
Question
I don't think this is the problem - as I said if I load it into an image, it
works - the transparent parts are - and the white parts are white - when I
put them on a button though, all white becomes transparent!
Answer
A:
If you load an icon into a TImage, it "understands" icons and displays
transparency info accordingly. Icons actually contain two bitmaps, one
containing the normal color info, with white areas to represent where
transparency should go; then a second "mask" bitmap that also has white for
the transparent areas, and black for the colored areas. When the two are
"xored" together with the background, the white on white areas show the
background through, the color (including white) on black areas show the color
of the icon; (you can also get "inverted background" areas in an icon by
having areas that are black in the colored bitmap but are white on the mask).
When you convert the icon to a bitmap, the transparency info is lost
because bitmaps don't have the built-in capacity for storing this extra
mask bitmap that is used to make transparent parts. I'd guess the icons
you're using are generally "free standing" objects with transparent
backgrounds, that means that the color bitmap is surrounded in white.
So, when you load one into a TBitbutton or TSpeedbutton's glyph
property, the lowerleft corner color (which will be white in these
cases) now gets interpreted as transparent, giving the effect you
describe.
The solution is to convert the icon to a bitmap and save it as a .BMP
file, then edit it with ImageEdit, Resource Workshop, or even PaintBrush
and use an otherwise unused color as the lower left pixel and anywhere
else you WANT to be transparent. Otherwise, I have some code that
extracts the color and mask bitmaps from an icon, you could then use
these to write out a bitmap that has the appropritate pixels set to an
unused color, though finding that unused color might be a bit tedious
programatically; hmmm, I'm smelling a utility here, I may have to get to
work on this.
Transparent Forms and Bitmaps
Question
Anyone know how to make a form transparent? Also make a bitmap
background transparent in Delphi?
Answer
A:
Here's a nice routine to draw a transparent bitmap onto another.
{This procedure will draw a source bitmap onto a target bitmap,
leaving information from the taget to shine through where the
pixels in the source are of the specified transparent color.
t = The target canvas to be drawn onto
x,y = The position on the target where source is drawn
s = The source bitmap
TrCol = The color that will become transparent in the source bmp
NOTE: Don't forget to repaint the target, eg Image1.Invalidate}
procedure DrawTransparent(t: TCanvas; x,y: Integer; s: TBitmap; TrCol: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin
try
bmpAND := TBitmap.Create; bmpAND.Width := s.Width; bmpAND.Height := s.Height; bmpAND.Monochrome := True;
oldcol := SetBkColor(s.Canvas.Handle, ColorToRGB(TrCol));
BitBlt(bmpAND.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
SetBkColor(s.Canvas.Handle, oldcol);
bmpINVAND := TBitmap.Create; bmpINVAND.Width := s.Width; bmpINVAND.Height := s.Height; bmpINVAND.Monochrome := True;
BitBlt(bmpINVAND.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, NOTSRCCOPY);
bmpXOR := TBitmap.Create; bmpXOR.Width := s.Width; bmpXOR.Height := s.Height;
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, bmpINVAND.Canvas.Handle, 0,0, SRCAND);
bmpTarget := TBitmap.Create; bmpTarget.Width := s.Width; bmpTarget.Height := s.Height;
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, t.Handle, x,y, SRCCOPY);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, SRCAND);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpXOR.Canvas.Handle, 0,0, SRCINVERT);
BitBlt(t.Handle, x,y,s.Width,s.Height, bmpTarget.Canvas.Handle, 0,0, SRCCOPY);
finally
bmpXOR.Free;
bmpAND.Free;
bmpINVAND.Free;
bmpTarget.Free;
end;{End of TRY section}
end;
Transparent bitmap brush
Question
Answer
A:
The following unit draws two bitmaps on a form. One is used
as the background, and the second one as the foreground. The
foreground bitmap is displayed as a "transparent" bitmap.
Read the comments for a complete (well sort of) explanation.
{ Purpose: Display a transparent bitmap loaded from a file
Author: Michael Vincze (vincze@ti.com)
Date: 04/20/95
Usage: Create a blank form, named Form1, compile and run.
Limits: This unit has been tested for both 16 and 256 color bitmaps.
It is assumed that the lower left pixel of the bitmap represents
the transparent color.
Notes: If this file is to be used for any purpose please leave
this header intact and give credit to the author if used for
any purpose.
Please contact the author if any improvements are made.
The author stakes no claim for this programs usefullness
or purpose.
Version: 1.00 04/20/95 Initial creation
}
unit Tbmpu;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
ImageForeGround: TImage;
ImageBackGround: TImage;
public
{ Public declarations }
end;
procedure DrawTransparentBitmap (ahdc: HDC;
Image: TImage;
xStart, yStart: Word);
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure DrawTransparentBitmap (ahdc: HDC;
Image: TImage;
xStart, yStart: Word);
var
TransparentColor: TColor;
cColor : TColorRef;
bmAndBack,
bmAndObject,
bmAndMem,
bmSave,
bmBackOld,
bmObjectOld,
bmMemOld,
bmSaveOld : HBitmap;
hdcMem,
hdcBack,
hdcObject,
hdcTemp,
hdcSave : HDC;
ptSize : TPoint;
begin
{ set the transparent color to be the lower left pixel of the bitmap
}
TransparentColor := Image.Picture.Bitmap.Canvas.Pixels[0,
Image.Height - 1];
TransparentColor := TransparentColor or $02000000;
hdcTemp := CreateCompatibleDC (ahdc);
SelectObject (hdcTemp, Image.Picture.Bitmap.Handle); { select the bitmap }
{ convert bitmap dimensions from device to logical points
}
ptSize.x := Image.Width;
ptSize.y := Image.Height;
DPtoLP (hdcTemp, ptSize, 1); { convert from device logical points }
{ create some DCs to hold temporary data
}
hdcBack := CreateCompatibleDC(ahdc);
hdcObject := CreateCompatibleDC(ahdc);
hdcMem := CreateCompatibleDC(ahdc);
hdcSave := CreateCompatibleDC(ahdc);
{ create a bitmap for each DC
}
{ monochrome DC
}
bmAndBack := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);
bmAndObject := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);
bmAndMem := CreateCompatibleBitmap (ahdc, ptSize.x, ptSize.y);
bmSave := CreateCompatibleBitmap (ahdc, ptSize.x, ptSize.y);
{ each DC must select a bitmap object to store pixel data
}
bmBackOld := SelectObject (hdcBack, bmAndBack);
bmObjectOld := SelectObject (hdcObject, bmAndObject);
bmMemOld := SelectObject (hdcMem, bmAndMem);
bmSaveOld := SelectObject (hdcSave, bmSave);
{ set proper mapping mode
}
SetMapMode (hdcTemp, GetMapMode (ahdc));
{ save the bitmap sent here, because it will be overwritten
}
BitBlt (hdcSave, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
{ set the background color of the source DC to the color.
contained in the parts of the bitmap that should be transparent
}
cColor := SetBkColor (hdcTemp, TransparentColor);
{ create the object mask for the bitmap by performing a BitBlt()
from the source bitmap to a monochrome bitmap
}
BitBlt (hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
{ set the background color of the source DC back to the original color
}
SetBkColor (hdcTemp, cColor);
{ create the inverse of the object mask
}
BitBlt (hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);
{ copy the background of the main DC to the destination
}
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, ahdc, xStart, yStart, SRCCOPY);
{ mask out the places where the bitmap will be placed
}
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
{ mask out the transparent colored pixels on the bitmap
}
BitBlt (hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
{ XOR the bitmap with the background on the destination DC
}
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCPAINT);
{ copy the destination to the screen
}
BitBlt (ahdc, xStart, yStart, ptSize.x, ptSize.y, hdcMem, 0, 0, SRCCOPY);
{ place the original bitmap back into the bitmap sent here
}
BitBlt (hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcSave, 0, 0, SRCCOPY);
{ delete the memory bitmaps
}
DeleteObject (SelectObject (hdcBack, bmBackOld));
DeleteObject (SelectObject (hdcObject, bmObjectOld));
DeleteObject (SelectObject (hdcMem, bmMemOld));
DeleteObject (SelectObject (hdcSave, bmSaveOld));
{ delete the memory DCs
}
DeleteDC (hdcMem);
DeleteDC (hdcBack);
DeleteDC (hdcObject);
DeleteDC (hdcSave);
DeleteDC (hdcTemp);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{ create image controls for two bitmaps and set their parents
}
ImageForeGround := TImage.Create (Form1);
ImageForeGround.Parent := Form1;
ImageBackGround := TImage.Create (Form1);
ImageBackGround.Parent := Form1;
{ load images
}
ImageBackGround.Picture.LoadFromFile ('c:\delphi\images\splash\16color\earth.bmp');
ImageForeGround.Picture.LoadFromFile ('c:\delphi\images\splash\16color\athena.bmp');
{ set background image size to its bitmap dimensions
}
with ImageBackGround do
begin
Left := 0;
Top := 0;
Width := Picture.Width;
Height := Picture.Height;
end;
{ set the foreground image size centered in the background image
}
with ImageForeGround do
begin
Left := (ImageBackGround.Picture.Width - Picture.Width) div 2;
Top := (ImageBackGround.Picture.Height - Picture.Height) div 2;
Width := Picture.Width;
Height := Picture.Height;
end;
{ do not show the transparent bitmap as it will be displayed (BitBlt()ed)
by the DrawTransparentBitmap() function
}
ImageForeGround.Visible := False;
{ draw the tranparent bitmap
note how the DC of the foreground is used in the function below
}
DrawTransparentBitmap (ImageBackGround.Picture.Bitmap.Canvas.Handle, {HDC}
ImageForeGround, {TImage}
ImageForeGround.Left, {X}
ImageForeGround.Top {Y} );
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{ free images
}
ImageForeGround.Free;
ImageBackGround.Free;
end;
end.
One draw directly onto the screen (not the form)
Question
Copying the pre-screensaver screen contents to the maximized screensaver-
form, and then slowly changing the contents of the form, creating the
illusion that the screen itself is changing.
The problem then is: how can I read the pixels of the displayed (complete)
screen directly?
Answer
A:
Create a form, drop a TImage control to the form, make it a decent size,
and drop a button on it. DblClick the button and add the following code.
Var
ScreenDC : HDC;
begin
ScreenDC:=CreateDC('DISPLAY',nil,nil,nil);
BitBlt(Image1.Canvas.Handle, 0,0, Image1.Width, Image1.Height,
ScreenDC, 0,0, SRCCOPY);
Image1.Refresh;
DeleteDC(ScreenDC);
end;
That will copy the desktop into the Image Control. Play around with the
0,0 near the ScreenDC to move the TopLeft of the image to want to
capture. Move your form around and click the button, Look up BitBlt in
the help file it might explain some things.
You could just as easily create a memory bitmap
Var
ScreenDC : HDC;
fBitmap : TBitmap;
begin
fBitmap := TBitmap.Create;
fBitmap.Width := 100;
fBitmap.Height := 100;
ScreenDC:=CreateDC('DISPLAY',nil,nil,nil);
BitBlt(FBitmap.Canvas.Handle, 0,0, FBitmap.Width, FBitmap.Height,
ScreenDC, 0,0, SRCCOPY);
{ You now have a copy of the screen from (0,0,100,100) in the
fBitmap, you now can }
{ do what you want to it, merge it with another bitmap?, or anything
else you want to. }
{ Clean Up }
DeleteDC(ScreenDC);
fBitmap.Free
end;