Search results for 'TBitmap'. 7 post(s) found.
- 2009/06/26 Save TBitmap image to Jpeg format image in Delphi
- 2007/09/11 Rotate Bitmap (any angle, any center of rotation)
- 2007/09/11 Show *any* graphics as Glyph on a SpeedButton
- 2007/09/11 Paint a Form with a tiled bitmap image
- 2007/09/11 Grayscaling a bitmap ?
- 2007/09/11 How to convert an ICO to a BMP
- 2007/09/11 Convert a BMP to a JPG
Delphi supports Jpeg unit as well as Bitmap unit for image processing. Following example convert and save Bitmap into Jpeg format. The source format must be TBitmap instance.
unit Jpeg;
procedure BitmapToJpeg(FileName: string; Img:TGraphic);
var
m_Jpeg: TJpegImage;
m_Bitmap: TBitmap;
begin
try
m_Jpeg:= TJpegImage.Create;
m_Bitmap := TBitmap.Create;
m_Bitmap.Width := Img.Width;
m_Bitmap.Height := Img.Height;
m_Bitmap.Canvas.Draw( 0, 0, Img);
// m_Bitmap.Canvas.StretchDraw( 0, 0, , ...,Img);
m_Jpeg.Assign( m_Bitmap);
m_Jpeg.SaveToFile( FileName);
finally
m_Jpeg.Free;
end;
end;
procedure BitmapToJpeg(FileName: string; Img:TGraphic);
var
m_Jpeg: TJpegImage;
m_Bitmap: TBitmap;
begin
try
m_Jpeg:= TJpegImage.Create;
m_Bitmap := TBitmap.Create;
m_Bitmap.Width := Img.Width;
m_Bitmap.Height := Img.Height;
m_Bitmap.Canvas.Draw( 0, 0, Img);
// m_Bitmap.Canvas.StretchDraw( 0, 0, , ...,Img);
m_Jpeg.Assign( m_Bitmap);
m_Jpeg.SaveToFile( FileName);
finally
m_Jpeg.Free;
end;
end;
Another posts included in "Delphi"
| How to get parameter string ? (0) | 2009/06/30 |
| How to return exit code such as exit() function in C/C++ ? (0) | 2009/07/02 |
| How to send email by TIdSMTP VCL ? (0) | 2009/07/07 |
| How to get screen resolution in case of using multiple monitors ? (0) | 2008/12/16 |
| How to turn off monitor ? (0) | 2008/12/10 |
| Find File at certain directory in Delphi (0) | 2008/10/10 |
| Sending email messages in .Net (0) | 2007/10/04 |
| Implementing C#'s foreach loop in Delphi 8 (0) | 2007/10/04 |
Trackback : Cannot send a trackbact to this post.
Here's how to rotate a TBitmap at any angle:
Const PixelMax = 32768;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;
Procedure RotateBitmap_ads(
SourceBitmap : TBitmap;
out DesTBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DesTBitmap.Width := SourceBitmap.Width;
DesTBitmap.Height := SourceBitmap.Height;
DesTBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians) ;
cosRadians := Cos(Radians) ;
For inX := DesTBitmap.Height-1 Downto 0 Do
Begin
RotatedRow := DesTBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
For inY := DesTBitmap.Width-1 Downto 0 Do
Begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians) ;
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians) ;
inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
If
(inYOriginal >= 0) And
(inYOriginal <= SourceBitmap.Width-1) And
(inXOriginal >= 0) And
(inXOriginal <= SourceBitmap.Height-1)
Then
Begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;
{Usage:}
procedure TForm1.Button1Click(Sender: TObject) ;
Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;
end;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;
Procedure RotateBitmap_ads(
SourceBitmap : TBitmap;
out DesTBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DesTBitmap.Width := SourceBitmap.Width;
DesTBitmap.Height := SourceBitmap.Height;
DesTBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians) ;
cosRadians := Cos(Radians) ;
For inX := DesTBitmap.Height-1 Downto 0 Do
Begin
RotatedRow := DesTBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
For inY := DesTBitmap.Width-1 Downto 0 Do
Begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians) ;
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians) ;
inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
If
(inYOriginal >= 0) And
(inYOriginal <= SourceBitmap.Width-1) And
(inXOriginal >= 0) And
(inXOriginal <= SourceBitmap.Height-1)
Then
Begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;
{Usage:}
procedure TForm1.Button1Click(Sender: TObject) ;
Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;
end;
Another posts included in "Delphi"
| Are we connected to the Internet? (0) | 2007/09/18 |
| Download a file from the Internet with progress indicator (0) | 2007/09/18 |
| Extracting the domain (host) name from an e-mail address (0) | 2007/09/18 |
| TImage.Bitmap fade out (0) | 2007/09/11 |
| TDesktopCanvas - draw on Windows Desktop (0) | 2007/09/11 |
| TColor to HTML color (0) | 2007/09/11 |
| Show *any* graphics as Glyph on a SpeedButton (0) | 2007/09/11 |
| Rotating Text (0) | 2007/09/11 |
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/29 04:17
moneyideas
-
Subject different money making ideas
2010/01/29 13:11
moneyideas
-
Subject different money making ideas
2010/01/31 16:39
moneyideas
TBitBtn and TSpeedButton accept only BMP pictures, if you have some other picture format, like ICO or JPG, (in an Image component) you want to show as a Glyph, you'll need to "transform" it to Bitmap, here's how:
var
bmp: TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.Width := Image.Picture.Graphic.Width;
bmp.Height := Image.Picture.Graphic.Height;
bmp.Canvas.Draw(0, 0, Image.Picture.Graphic) ;
BitBtn.Glyph:=bmp;
finally
bmp.Free;
end;
end;
bmp: TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.Width := Image.Picture.Graphic.Width;
bmp.Height := Image.Picture.Graphic.Height;
bmp.Canvas.Draw(0, 0, Image.Picture.Graphic) ;
BitBtn.Glyph:=bmp;
finally
bmp.Free;
end;
end;
Another posts included in "Delphi"
| TColor to HTML color (0) | 2007/09/11 |
| TDesktopCanvas - draw on Windows Desktop (0) | 2007/09/11 |
| TImage.Bitmap fade out (0) | 2007/09/11 |
| Rotating Text (0) | 2007/09/11 |
| Paint a Form with a tiled bitmap image (0) | 2007/09/11 |
| Is Point in Polygon? (0) | 2007/09/11 |
| Implementing a lasso drawing technique (0) | 2007/09/11 |
| Grayscaling a bitmap ? (0) | 2007/09/11 |
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/29 05:08
moneyideas
-
Subject different money making ideas
2010/01/29 13:56
moneyideas
-
Subject different money making ideas
2010/01/31 16:39
moneyideas
Here's how to draw tiled bitmap image on a Form:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject) ;
procedure FormPaint(Sender: TObject) ;
procedure FormClose(Sender: TObject;
var Action: TCloseAction) ;
private
public
end;
var
Form1: TForm1;
Bitmap: TBitmap;
...
procedure TForm1.FormCreate(Sender: TObject) ;
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP') ;
end;
procedure TForm1.FormClose
(Sender: TObject; var Action: TCloseAction) ;
begin
Bitmap.Free;
end;
procedure TForm1.FormPaint(Sender: TObject) ;
var
X, Y, W, H: LongInt;
begin
with Bitmap do begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do begin
X := 0;
while X < Width do begin
Canvas.Draw(X, Y, Bitmap) ;
Inc(X, W) ;
end;
Inc(Y, H) ;
end;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject) ;
procedure FormPaint(Sender: TObject) ;
procedure FormClose(Sender: TObject;
var Action: TCloseAction) ;
private
public
end;
var
Form1: TForm1;
Bitmap: TBitmap;
...
procedure TForm1.FormCreate(Sender: TObject) ;
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP') ;
end;
procedure TForm1.FormClose
(Sender: TObject; var Action: TCloseAction) ;
begin
Bitmap.Free;
end;
procedure TForm1.FormPaint(Sender: TObject) ;
var
X, Y, W, H: LongInt;
begin
with Bitmap do begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do begin
X := 0;
while X < Width do begin
Canvas.Draw(X, Y, Bitmap) ;
Inc(X, W) ;
end;
Inc(Y, H) ;
end;
end;
Another posts included in "Delphi"
| Rotating Text (0) | 2007/09/11 |
| Show *any* graphics as Glyph on a SpeedButton (0) | 2007/09/11 |
| TColor to HTML color (0) | 2007/09/11 |
| Is Point in Polygon? (0) | 2007/09/11 |
| Implementing a lasso drawing technique (0) | 2007/09/11 |
| Grayscaling a bitmap ? (0) | 2007/09/11 |
| Get Cursor Image (draw it on a Canvas) (0) | 2007/09/11 |
| How to convert HIcon to TIcon ? (0) | 2007/09/11 |
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/29 00:23
moneyideas
-
Subject different money making ideas
2010/01/29 08:37
moneyideas
-
Subject different money making ideas
2010/01/31 16:39
moneyideas
This example uses an averaging mechanism to obtain GrayScale intensity on a pixel-by-pixel basis. Specifically, it averages the Red, Green and Blue component values of a color and assigns that value back to each RGB component.
Usage:
GrayScale(Image1.Picture.Graphic, image1.Picture.Bitmap, 0) ;
Here's the source code can use above usage code.
type
TRGBColor = record
case Integer of
0 : (Color : TColor) ;
1 : (Red, Green, Blue, Intensity : Byte) ;
2 : (Colors : array[0..3] of Byte) ;
end;
procedure GrayScale(Graphic : TGraphic;
Bitmap : TBitmap;
Contrast : Integer ) ;
var bmp, mask : TBitmap;
x, y , Avg : Integer;
RGBColor : TRGBColor;
begin
if not Assigned(Graphic) then
Exit;
bmp := TBitmap.Create;
mask := TBitmap.Create;
try
bmp.Height := Graphic.Height;
bmp.Width := Graphic.Width;
with bmp.Canvas do begin
if Graphic is TBitmap then
Brush.Color := (Graphic as TBitmap).TransparentColor
else
Brush.Color := clPurple;
FillRect(ClipRect) ;
Draw(0,0,Graphic) ;
end;
mask.assign(bmp) ;
mask.mask(bmp.TransparentColor) ;
with bmp.Canvas do begin
for y := 0 to ClipRect.Bottom do begin
for x := 0 to ClipRect.Right do begin
if mask.Canvas.Pixels[x,y] = clBlack then begin
RGBColor.Color := Pixels[x,y] ;
with RGBColor do begin
Avg := ((Red+Green+Blue) div 3) ;
Inc(Avg, Contrast) ;
if Avg > 255 then
Avg := 255
else if Avg < 0 then
Avg := 0;
Red := Avg;
Green := Avg;
Blue := Avg;
end;
Pixels[x,y] := RGBColor.Color;
end;
end;
end;
end;
if Assigned(Bitmap) then
Bitmap.Assign(bmp)
else if Graphic is TBitmap then
(Graphic as TBitmap).Assign(bmp) ;
finally
bmp.Free;
mask.Free;
end;
end;
TRGBColor = record
case Integer of
0 : (Color : TColor) ;
1 : (Red, Green, Blue, Intensity : Byte) ;
2 : (Colors : array[0..3] of Byte) ;
end;
procedure GrayScale(Graphic : TGraphic;
Bitmap : TBitmap;
Contrast : Integer ) ;
var bmp, mask : TBitmap;
x, y , Avg : Integer;
RGBColor : TRGBColor;
begin
if not Assigned(Graphic) then
Exit;
bmp := TBitmap.Create;
mask := TBitmap.Create;
try
bmp.Height := Graphic.Height;
bmp.Width := Graphic.Width;
with bmp.Canvas do begin
if Graphic is TBitmap then
Brush.Color := (Graphic as TBitmap).TransparentColor
else
Brush.Color := clPurple;
FillRect(ClipRect) ;
Draw(0,0,Graphic) ;
end;
mask.assign(bmp) ;
mask.mask(bmp.TransparentColor) ;
with bmp.Canvas do begin
for y := 0 to ClipRect.Bottom do begin
for x := 0 to ClipRect.Right do begin
if mask.Canvas.Pixels[x,y] = clBlack then begin
RGBColor.Color := Pixels[x,y] ;
with RGBColor do begin
Avg := ((Red+Green+Blue) div 3) ;
Inc(Avg, Contrast) ;
if Avg > 255 then
Avg := 255
else if Avg < 0 then
Avg := 0;
Red := Avg;
Green := Avg;
Blue := Avg;
end;
Pixels[x,y] := RGBColor.Color;
end;
end;
end;
end;
if Assigned(Bitmap) then
Bitmap.Assign(bmp)
else if Graphic is TBitmap then
(Graphic as TBitmap).Assign(bmp) ;
finally
bmp.Free;
mask.Free;
end;
end;
Another posts included in "Delphi"
| Implementing a lasso drawing technique (0) | 2007/09/11 |
| Is Point in Polygon? (0) | 2007/09/11 |
| Paint a Form with a tiled bitmap image (0) | 2007/09/11 |
| Get Cursor Image (draw it on a Canvas) (0) | 2007/09/11 |
| How to convert HIcon to TIcon ? (0) | 2007/09/11 |
| Extract an icon from an Windows application and paint on a Form (0) | 2007/09/11 |
| How to draw transparent text on Windows Desktop (0) | 2007/09/11 |
| How to draw rotated text (0) | 2007/09/11 |
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/29 03:02
moneyideas
-
Subject different money making ideas
2010/01/29 11:44
moneyideas
-
Subject different money making ideas
2010/01/31 16:39
moneyideas
If you have an icon file (ICO) and want to convert it to a bitmap image, use the following code:
Procedure IcoToBmp;
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico') ;
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon ) ;
Bitmap.SaveToFile('c:\picture.bmp') ;
Icon.Free;
Bitmap.Free;
end;
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico') ;
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon ) ;
Bitmap.SaveToFile('c:\picture.bmp') ;
Icon.Free;
Bitmap.Free;
end;
Another posts included in "Delphi"
| How to draw rotated text (0) | 2007/09/11 |
| How to draw transparent text on Windows Desktop (0) | 2007/09/11 |
| Extract an icon from an Windows application and paint on a Form (0) | 2007/09/11 |
| How to Convert Pixels to Millimeters (0) | 2007/09/11 |
| How to capture Windows Desktop to Bitmap (0) | 2007/09/11 |
| Cut a rectangle from an Image to Clipboard (0) | 2007/09/11 |
| Convert TColor to Hex & Hex to TColor (0) | 2007/09/11 |
| Convert a BMP to a JPG (0) | 2007/09/11 |
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/29 04:19
moneyideas
-
Subject different money making ideas
2010/01/29 13:25
moneyideas
-
Subject different money making ideas
2010/01/31 16:39
moneyideas
You can easily convert a BMP image to a JPG (JPEG) image:
{
Usage:
BMPtoJPG('mybitmap.bmp','myjpeg.jpg')
}
function BMPtoJPG
(var BMPpic, JPGpic: string):boolean;
var Bitmap: TBitmap;
JpegImg: TJpegImage;
begin
Result:=False;
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile(BMPpic) ;
JpegImg := TJpegImage.Create;
try
JpegImg.Assign(Bitmap) ;
JpegImg.SaveToFile(JPGpic) ;
Result:=True;
finally
JpegImg.Free
end;
finally
Bitmap.Free
end;
end;
Usage:
BMPtoJPG('mybitmap.bmp','myjpeg.jpg')
}
function BMPtoJPG
(var BMPpic, JPGpic: string):boolean;
var Bitmap: TBitmap;
JpegImg: TJpegImage;
begin
Result:=False;
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile(BMPpic) ;
JpegImg := TJpegImage.Create;
try
JpegImg.Assign(Bitmap) ;
JpegImg.SaveToFile(JPGpic) ;
Result:=True;
finally
JpegImg.Free
end;
finally
Bitmap.Free
end;
end;
Another posts included in "Delphi"
| Convert TColor to Hex & Hex to TColor (0) | 2007/09/11 |
| Cut a rectangle from an Image to Clipboard (0) | 2007/09/11 |
| How to capture Windows Desktop to Bitmap (0) | 2007/09/11 |
| Reading a directory content (0) | 2007/09/10 |
| Path shortener: c:\AB\C...DE\F.ghi (0) | 2007/09/10 |
| How to Split and Merge Files (0) | 2007/09/10 |
| Get File 'Last Modified' attribute (0) | 2007/09/10 |
| From/to the 8.3 (short) format to/from the long format (0) | 2007/09/10 |
Trackback : Cannot send a trackbact to this post.
-
Subject different money making ideas
2010/01/29 02:42
moneyideas
-
Subject different money making ideas
2010/01/29 11:21
moneyideas
-
Subject different money making ideas
2010/01/31 16:39
moneyideas
Prev
Rss Feed