Mega Code Archive
Bitmaps
<![CDATA[
SOME USEFUL BITS OF CODE RELATING TO THE MANIPULATION OF BITMAPS
See also IconsAndButtonBitMaps.txt
THIS WORKS:
(simple copy from TImage to TBitMap)
procedure TDrawStyleObj.WriteBitMapFile(formImage: TImage;
blocksW, blocksH: Integer;
bmpFileName: String);
{Copy the TImage passed to the procedure to a bitMap Canvas using Assign}
var
tempBitMapOne: Graphics.TBitMap;
exeFileName : String;
exeFilePath : String;
begin
tempBitMapOne := Graphics.TBitMap.Create;
{it's one line of code if no scaling is involved}
tempBitMapOne.Assign(formImage.Picture.BitMap);
exeFileName := Application.ExeName;
exeFilePath := ExtractFilePath(exeFileName);
bmpFileName := exeFilePath + bitMapFileDir + bmpFileName + '.bmp';
tempBitMapOne.SaveToFile(bmpFileName);
tempBitMapOne.Free;
end;
THIS WORKS:
(copy from TImage to TBitMap with scaling)
procedure TDrawStyleObj.WriteBitMapFile(formImage: TImage;
blocksW, blocksH: Integer;
bmpFileName: String);
{Copy the TImage passed to the procedure to a bitMap Canvas using the
StretchDraw function. Converting from TImages to TBitMaps can be fiddly
but the StretchDraw method works OK here...}
var
destRect : TRect;
tempBitMapOne: Graphics.TBitMap;
exeFileName : String;
exeFilePath : String;
begin
tempBitMapOne := Graphics.TBitMap.Create;
tempBitMapOne.Width := 150;
tempBitMapOne.Height := 150;
destRect.Left := 0;
destRect.Top := 0;
destRect.Right := 150;
destRect.Bottom := 150;
tempBitMapOne.Canvas.CopyMode := cmSrcCopy;
//note the syntax for using the StretchDraw method->
//StretchDraw expects a second parameter of TGraphic...
tempBitMapOne.Canvas.StretchDraw(destRect, formImage.Picture.Graphic);
exeFileName := Application.ExeName;
exeFilePath := ExtractFilePath(exeFileName);
bmpFileName := exeFilePath + bitMapFileDir + bmpFileName + '.bmp';
tempBitMapOne.SaveToFile(bmpFileName);
tempBitMapOne.Free;
end;
THIS WORKS:
(copy from TImage to TBitMap with scaling of the image and the
bitmap both centred and also surrounded with a white border)
procedure TDrawStyleObj.WriteBitMapFileNumberThree(formImage: TImage;
blocksW, blocksH: Integer;
bmpFileName: String);
{Copy the TImage passed to the procedure to a bitMap Canvas using the
StretchDraw function. Converting from TImages to TBitMaps can be fiddly
but the StretchDraw method works OK here...}
var
destRect : TRect;
tempBitMapOne: Graphics.TBitMap;
exeFileName : String;
exeFilePath : String;
begin
tempBitMapOne := Graphics.TBitMap.Create;
{in Fox, the 'thumbnail' bitmaps are 250 by 200 pixels, so
let's conform to the same dimensions for consistency's sake...}
tempBitMapOne.Width := 250;
tempBitMapOne.Height := 200;
destRect.Left := 50;
destRect.Top := 25;
destRect.Right := 200;
destRect.Bottom := 175;
tempBitMapOne.Canvas.CopyMode := cmSrcCopy;
//note the syntax for using the StretchDraw method->
//StretchDraw expects a second parameter of TGraphic...
tempBitMapOne.Canvas.StretchDraw(destRect, formImage.Picture.Graphic);
exeFileName := Application.ExeName;
exeFilePath := ExtractFilePath(exeFileName);
bmpFileName := exeFilePath + bitMapFileDir + bmpFileName + '.bmp';
tempBitMapOne.SaveToFile(bmpFileName);
tempBitMapOne.Free;
end;
***************************************************************************************
MAKE A BITMAP NEGATIVE:
Try this
procedure TTest.Button1Click(Sender: TObject);
var
Rec := TRect;
begin
Rec.Left := 0;
Rec.Top := 0;
Rec.Right := Image1.Picture.Bitmap.Width;
Rec.Botton := Image1.Picture.Bitmap.Height;
Image1.Canvas.CopyMode := cmNotSrcCopy;
Image1.Canvas.CopyRect(Rec,Image1.Canvas,Rec);
end;
{ if image is negative one click change for not negative
if image is not negative one click change for negative}
***************************************************************************************
COMPLETE (HURRIED) PROGRAM TO SCALE A BITMAP
unit MainUnit;
//Richard Ebbs
//ELIS October 2000
//wee buggy test app
//to see 'ow 'orrible
//(or otherwise) bitmaps
//look when they are scaled
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Buttons, StdCtrls;
const
zoomIncrement = 1.1;
type
TMainForm = class(TForm)
TopPanel: TPanel;
DrawArea: TImage;
ZoomInSB: TSpeedButton;
ZoomOutSB: TSpeedButton;
DefaultButton: TButton;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ZoomInSBClick(Sender: TObject);
procedure ZoomOutSBClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DefaultButtonClick(Sender: TObject);
private
{private declarations}
originalBitMap: TBitMap;
drawnBitMap: TBitMap;
currentScale: Real;
procedure SetImageExtents;
procedure FillDrawArea;
procedure LoadBitMapFromDisk;
procedure ScaleBitMap;
procedure DrawScaledBitMap;
public
{public declarations}
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormCreate(Sender: TObject);
begin
currentScale := 1.0;
SetImageExtents;
originalBitMap := TBitMap.Create;
drawnBitMap := TBitMap.Create;
LoadBitMapFromDisk;
DrawArea.Canvas.Draw(50, 50, originalBitMap);
KeyPreview := True;
//DrawScaledBitMap;
//DrawArea.Refresh;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
originalBitMap.Free;
drawnBitMap.Free;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
if (MainForm.Width > Screen.Width) then
MainForm.Width := (Screen.Width - 1);
if (MainForm.Height > Screen.Height) then
MainForm.Height := (Screen.Height - 1);
DrawArea.Width := MainForm.Width;
DrawArea.Height := MainForm.Height;
//FillDrawArea;
//DrawScaledBitMap;
//DrawArea.Refresh;
end;
procedure TMainForm.SetImageExtents;
{sometimes you find that if you put a TImage on a form and use the TImage
as a 'draw area' it won't resize properly when the form is resized. This
may have to do with only a certain amount of space being reserved for the
image in memory (and the values of TImage.Width/Height not always being
congruent with 'internal bitmap.width/height'). This procedure attempts
to get around these problems as here we expand the image to the screen's
width at the outset so that this much maximum space is always available
whatever resizing of the image we do later...}
begin
DrawArea.Width := Screen.Width;
DrawArea.Height := Screen.Height;
DrawArea.Canvas.MoveTo(0, 0);
DrawArea.Canvas.Pen.Color := clWhite;
DrawArea.Canvas.LineTo(DrawArea.Width, DrawArea.Height);
DrawArea.align := alClient;
end;
procedure TMainForm.FillDrawArea;
//set the drawing area background
//colour to be white
var
imageRect: TRect;
begin
with DrawArea.Canvas do
begin
Brush.Color := clWhite;
imageRect.Left := 0;
imageRect.Top := 0;
imageRect.Right := Screen.Width;
imageRect.Bottom := Screen.Height;
FillRect(imageRect);
end;
end;
procedure TMainForm.LoadBitMapFromDisk;
begin
originalBitMap.LoadFromFile('Arnolfini.bmp');
end;
procedure TMainForm.ScaleBitMap;
//OK we don't need the tempBitMap
//variable at all: we could just
//copy from originalBitMap to
//drawnBitMap but the heck...
var
tempWidth, tempHeight: Real;
tempBitMap: TBitMap;
newRect: TRect;
begin
tempBitMap := TBitMap.Create;
tempWidth := (originalBitMap.Width * currentScale);
tempHeight := (originalBitMap.Height * currentScale);
newRect.Left := 0;
newRect.Right := Round(tempWidth);
newRect.Top := 0;
newRect.Bottom := Round(tempHeight);
tempBitMap.Width := Round(tempWidth);
tempBitMap.Height := Round(tempHeight);
tempBitMap.Canvas.StretchDraw(newRect, originalBitMap);
//FillDrawArea;
//DrawArea.Canvas.Draw(50, 50, tempBitMap);
drawnBitMap.Width := tempBitMap.Width;
drawnBitMap.Height := tempBitMap.Height;
drawnBitMap.Assign(tempBitMap);
tempBitMap.Free;
end;
procedure TMainForm.DrawScaledBitMap;
begin
FillDrawArea;
DrawArea.Canvas.Draw(50, 50, drawnBitMap);
end;
procedure TMainForm.ZoomInSBClick(Sender: TObject);
//zoom in
begin
currentScale := (currentScale * zoomIncrement);
ScaleBitMap;
DrawScaledBitMap;
end;
procedure TMainForm.ZoomOutSBClick(Sender: TObject);
//zoom out
begin
currentScale := (currentScale * (1 / zoomIncrement));
ScaleBitMap;
DrawScaledBitMap;
end;
procedure TMainForm.DefaultButtonClick(Sender: TObject);
begin
currentScale := 1.0;
FillDrawArea;
DrawArea.Canvas.Draw(50, 50, originalBitMap);
end;
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
keyChar: Char;
begin
keyChar := Char(Key);
if ((keyChar = 'a') or (keyChar = 'A')) then
begin
currentScale := (currentScale * zoomIncrement);
ScaleBitMap;
DrawScaledBitMap;
end;
if ((keyChar = 'b') or (keyChar = 'B')) then
begin
currentScale := (currentScale * (1 / zoomIncrement));
ScaleBitMap;
DrawScaledBitMap;
end;
if ((keyChar = 'd') or (keyChar = 'D')) then
begin
currentScale := 1.0;
FillDrawArea;
DrawArea.Canvas.Draw(50, 50, originalBitMap);
end;
end;
end.
]]>