I have a requirement to draw a number to a image.That number will changes automatically.how can we create an image dynamically in Delphi 7 ?
.If any one knows please suggest me.
Yours Rakesh.
You can use the Canvas property of a TBitmap to draw a text in a image
check this procedure
procedure GenerateImageFromNumber(ANumber:Integer;Const FileName:string);
Var
Bmp : TBitmap;
begin
Bmp:=TBitmap.Create;
try
Bmp.PixelFormat:=pf24bit;
Bmp.Canvas.Font.Name :='Arial';// set the font to use
Bmp.Canvas.Font.Size :=20;//set the size of the font
Bmp.Canvas.Font.Color:=clWhite;//set the color of the text
Bmp.Width :=Bmp.Canvas.TextWidth(IntToStr(ANumber));//calculate the width of the image
Bmp.Height :=Bmp.Canvas.TextHeight(IntToStr(ANumber));//calculate the height of the image
Bmp.Canvas.Brush.Color := clBlue;//set the background
Bmp.Canvas.FillRect(Rect(0,0, Bmp.Width, Bmp.Height));//paint the background
Bmp.Canvas.TextOut(0, 0, IntToStr(ANumber));//draw the number
Bmp.SaveToFile(FileName);//save to a file
finally
Bmp.Free;
end;
end;
And use like this
procedure TForm1.Button1Click(Sender: TObject);
begin
GenerateImageFromNumber(10000,'Foo.bmp');
Image1.Picture.LoadFromFile('Foo.Bmp');//Image1 is a TImage component
end;
Related
How to clear timage canvas to avoid duplicate image when changing input size? Why nil command doesn't work?
This is my code
begin
image1.Canvas := nil;
image1.Canvas.Pen.Color := clRed;
image1.Canvas.Brush.Color := clBlue;
image1.canvas.rectangle(10,10,vwpj,vwlb);
end;
You can't assign Nil or any value to Canvas, Canvas is a property for read only, so you need to remove the first line and then draw on the TImage canvas:
Image1.Canvas.Pen.Color := clRed;
Image1.Canvas.Brush.Color := clBlue;
Image1.canvas.rectangle(0,0,Image1.Height,Image1.Width);
Edit:
You have to set the image to default every time you draw on it's canvas:
Procedure:
Procedure TForm1.Default(Image: TImage);
begin
Image.Canvas.Pen.Color := clBtnFace;
Image.Canvas.Brush.Color := clBtnFace;
Image.Canvas.FillRect(Rect(0,0,Image.Height,Image.Width));
end;
Then call it as:
procedure TForm1.Button1Click(Sender: TObject);
begin
Default(Image1);
Image1.Canvas.Pen.Color := clRed;
Image1.Canvas.Brush.Color := clBlue;
Image1.canvas.rectangle(0,0,Image1.Height,Image1.Width);
end;
From what you have written and tried to explain in your many previous edits.
This is a possible solution to your problem.
Requirements:
Add four TEdit components to your form.
Add one TButton.
And one TImage.
Code:
var
Xorigin,Yorigin,vwpj,vwlb:integer;
....
begin
vwpj := strtoint(vwpjEdit.text);
vwlb := strtoint(vwlbEdit.text);
Xorigin := strtoint(XoriginEdit.Text);
Yorigin := strtoint(YoriginEdit.Text);
// You have to wipe the canvas with a base color,
image1.Canvas.Brush.Color := clwhite;
image1.Canvas.FillRect(rect(0,0,image1.Width,image1.height));
image1.Canvas.Pen.Color := clRed;
image1.Canvas.Brush.Color := clBlue;
image1.Canvas.rectangle(Xorigin,Yorigin,vwlb,vwpj);
end;
Explanation: I understand that you want to draw a rectangle on the Canvas property of a TImage. With the condition of each time you resize the rectangle you want to clear the Canvas (you implied this by assigning nil to canvas which is wrong considering that Canvas is a read only property).
Now the above code does this by filling the canvas with a base color (I chose clwhite) by using the Fillrect() method.
From this you need to understand that there is no such thing as clearing the image, either you delete it (using the free command as you say) and it will be gone and if you want to draw on it again you will need to create it.
the second option is that you fill it with a background color (the base clwhite I chose) or as a third option, resize the image as well.
All what maters is that as long as that image is still there the canvas and what you have drawn on it will remain.
Results of the code above
I have a TBitmap, inside the TBitmap there is load a "map image" (image of a map). This map image have a white background and a lot of black line (no antialising only 2 colors white background and black line).
Now I must do this:
Remove the white background from TBitmap (transparent background and black line);
If possible and only if possible replace black line color with another color;
Save the result as trasparent PNG image;
I don't have idea if these are possible.
Suggestions?
NOTE I want avoid to use 3th part of class or VCL if possible. I can use FreeImage library if need because I just use it on my project. I use Delphi XE3.
Change pixelformat to pf1Bit. Create a palette with 2 entries, change the values of the TPaletteEntry to the desired color value (in the shown exaple to red). Create a TPNGImage, assign the bitmap and set the transparency for the PNG.
implementation
uses pngimage;
{$R *.dfm}
Type
TMyPalette = Packed Record
palVersion : Word;
palNumEntries : Word;
palPalEntry : Array [0..1] of TPaletteEntry;
End;
Procedure ChangeBlackColor(bmp:TBitMap);
var
pal:TMyPalette;
begin
bmp.PixelFormat := pf1Bit;
bmp.HandleType := bmDIB;
With pal Do
Begin
palVersion:=$0300;
palNumEntries:=2;
palPalEntry[0].peRed:= $FF;
palPalEntry[0].peGreen:=$00;
palPalEntry[0].peBlue:= $00;
palPalEntry[0].peFlags:=PC_RESERVED;
palPalEntry[1].peRed:= $FF;
palPalEntry[1].peGreen:=$FF;
palPalEntry[1].peBlue:= $FF;
palPalEntry[1].peFlags:=PC_RESERVED;
End;
bmp.Palette := CreatePalette(pLogPalette(#pal)^)
end;
procedure TForm3.Button1Click(Sender: TObject);
var
png:TPngimage;
bmp:TBitmap;
begin
// sample image
Image1.Canvas.Rectangle(0,0,Image1.Width-1,Image1.Height-1);
Image1.Canvas.Ellipse(1,1,Image1.Width,Image1.Height);
bmp := Image1.Picture.Bitmap;
ChangeBlackColor(bmp);
png:=TPngimage.Create;
try
png.Assign(bmp);
png.TransparentColor := clWhite;
png.Transparent := true;
Image2.Picture.Assign(png);
finally
png.Free;
end;
end;
How to completely disable transparency of given PNGObject? By the way I am using PNGImage unit of Version 1.564.
I don't think it's possible to permanently disable TPNGObject image transparency. Or at least I couldn't find a property for doing this. And it should have been controlled by a property since when you assign or load an image, the TPNGObject takes the image parameters (including transparency) from the image file assigned.
So as a workaround I would prefer to use the RemoveTransparency procedure after when you load or assign the image:
uses
PNGImage;
procedure TForm1.Button1Click(Sender: TObject);
var
PNGObject: TPNGObject;
begin
PNGObject := TPNGObject.Create;
try
PNGObject.LoadFromFile('C:\Image.png');
PNGObject.RemoveTransparency;
PNGObject.Draw(Canvas, Rect(0, 0, PNGObject.Width, PNGObject.Height));
finally
PNGObject.Free;
end;
end;
For just drawing a TPNGObject (Delphi PNGComponents library) to some background color (in example: white) with alpha blending, try this:
uses
PNGImage, PNGFunctions;
procedure TForm1.Button1Click(Sender: TObject);
var png: TPNGObject;
bmp: TBitmap;
begin
try
// load PNG
png := TPNGObject.Create;
png.LoadFromFile('MyPNG.png');
// create Bitmap
bmp := TBitmap.Create;
bmp.Width := png.Width;
bmp.Height := png.Height;
// set background color to whatever you want
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(Rect(0, 0, png.Width, png.Height));
// draw PNG on Bitmap with alpha blending
DrawPNG(png, bmp.Canvas, Rect(0, 0, png.Width, png.Height), []);
// save Bitmap
bmp.SaveToFile('MyBMP.bmp');
finally
FreeAndNil(png);
FreeAndNil(bmp);
end;
end;
To use the DrawPNG procedure you have to include the PNGFunctions unit.
I have a table contains Image in a Picture field and I am going to put them into an ImageList.
Here is the code:
ImageList.Clear;
ItemsDts.First;
ImageBitmap:= TBitmap.Create;
try
while not ItemsDts.Eof do
begin
if not ItemsDtsPicture.IsNull then
begin
ItemsDtsPicture.SaveToFile(TempFileBitmap);
ImageBitmap.LoadFromFile(TempFileBitmap);
ImageList.Add(ImageBitmap, nil);
end;
ItemsDts.Next;
end;
finally
ImageBitmap.Free;
end;
But I have some problem for images with difference size from ImageList size.
Update:
My problem is that when adding Image larger than ImageList size (32 * 32), for example 100 * 150 It does not appear correctly in a component connected to ImageList (for example in a ListView).
It seems newly added image is not stretched but is Croped. I want new image to be stretched as in ImageList Editor.
I don't know if ImageList provides a property to automatically stretch the image. Unless someone finds some built-in, you can always stretch the image yourself before adding it to the ImageList. And while you're at it, stop using the file-on-disk: use a TMemoryStream instead. Something like this:
var StretchedBMP: TBitmap;
MS: TMemoryStream;
ImageList.Clear;
ItemsDts.First;
StretchedBMP := TBitmap.Create;
try
// Prepare the stretched bmp's size
StretchedBMP.Width := ImageList.Width;
StretchedBMP.Height := ImageList.Height;
// Prepare the memory stream
MS := TMemoryStream.Create;
try
ImageBitmap:= TBitmap.Create;
try
while not ItemsDts.Eof do
begin
if not ItemsDtsPicture.IsNull then
begin
MS.Size := 0;
ItemsDtsPicture.SaveToStream(MS);
MS.Position := 0;
ImageBitmap.LoadFromStream(MS);
// Stretch the image
StretchedBMP.Canvas.StretchDraw(Rect(0, 0, StretchedBmp.Width-1, StretchedBmp.Height-1), ImageBitmap);
ImageList.Add(StretchedBmp, nil);
end;
ItemsDts.Next;
end;
finally MS.Free;
end;
finally StretchedBMP.Free;
end;
finally
ImageBitmap.Free;
end;
PS: I edited your code in the browser's window. I can't guarantee it compiles, but if it doesn't, it should be easy to fix.
I need a fast way to create 24 bits bitmaps (and save to a file) in runtime,specifing the Width , Height and color
something like
procedure CreateBMP(Width,Height:Word;Color:TColor;AFile: string);
and call like this
CreateBMP(100,100,ClRed,'Red.bmp');
you can use the Canvas property of the TBitmap, setting the Brush to the color which you want to use, then call FillRect function to fill the Bitmap.
try something like this :
procedure CreateBitmapSolidColor(Width,Height:Word;Color:TColor;const FileName : TFileName);
var
bmp : TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf24bit;
bmp.Width := Width;
bmp.Height := Height;
bmp.Canvas.Brush.Color := Color;
bmp.Canvas.FillRect(Rect(0, 0, Width, Height));
bmp.SaveToFile(FileName);
finally
bmp.Free;
end;
end;
You don't actually need to call FillRect. If you set the Brush.Color before setting the width and height the bitmap will use this color for all the pixels. I've never actually seen this behavior documented so it may change in future versions.