In a previous article, I talked about OpenSource GDI+ Library for Delphi. In this article I will present a small application which is the basic of an image processing or image drawing application.
A form to display an image
The application is divided into two forms. One main form and one image display form. The main form creates two instances of the image display form to show two images side by side. The image display forms are created as parented, that is they appears as a child window of the main form.
The most interesting part of the code, involving GDI+ Library is into the image display form. Beside displaying an image, the display form expose a small API to manipulate the image. The main form is very simple and provides a user interface for the display form API.
In this demo, the API is quite simple. It provides zoom and pan and a trivial paint of something above the image. Nevertheless, the code is really serious and you can easily start your own image processing or drawing application.
The display form actually display a bitmap loaded from a file using GDI+ decoders. You can load JPG, GIF, TIF and other format. You could as well create the bitmap from an image capture device such a camera or a scanner. This bitmap is named "FullBitmap" in the code.
The bitmap is drawn into a second bitmap which will be used for display. On this second bitmap the application could paint or draw anything. In this demo, it paints only a simple text but in a real application, you could - for example - have a data structure representing geometrical items and draw those items. You'll get a drawing program. This second bitmap is named "ViewBitmap" in the code.
To create zoom and pan, I used GDI+ built in coordinate transformations and a bunch of variables describing the zoom and pan.
GDI+ also provide a clipping function that I used to make sure the displayed image, zoomed and panned is not drawn outside of the viewing area.
Finally, the display form also display a border around the image. It is used when multiple images are displayed on the same window. The "active" image has his border drawn in a different color.
Below you'll find full source code for your reference. It is also available for download as a full project from my website at:
http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html
unit ImageDisplay;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, ExtCtrls, Forms, Dialogs, GdiPlus;
const
WM_APP_PAINT = WM_USER + 1;
DEMO_FILE = '..\..\ics_logo.gif';
type
TImageForm = class(TForm)
private
FFrameWidth : Integer;
FFrameHeight : Integer;
FPaintTop : Integer;
FPaintLeft : Integer;
FPaintMargin : Integer;
FPaintHeight : Integer;
FPaintWidth : Integer;
FYTop : Integer;
FXLeft : Integer;
FZoomFactor : Double; // 1.0 = no zoom
FFullBitMap : IGPBitmap;
FViewBitmap : IGPBitmap;
FMarginColor : TColor;
FAppPaintFlag : Boolean;
function CreateGraphicInterface: IGPGraphics;
procedure PaintSomething(Graphics: IGPGraphics);
protected
procedure Paint; override;
procedure Resize; override;
procedure InitDrawingArea(ALeft, ATop, AWidth, AHeight, AMargin: Integer);
procedure TriggerAppPaint;
procedure WMAppPaint(var Msg: TMessage); message WM_APP_PAINT;
procedure SetMarginColor(const Value: TColor);
function ZoomFitCompute: Double;
public
constructor Create(AOwner : TComponent); override;
procedure ZoomIn(Speed: Double);
procedure ZoomOut(Speed: Double);
procedure PanRight;
procedure PanDown;
procedure PanLeft;
procedure PanUp;
procedure PanCenter;
function LoadFromFile(const AFileName: String): Boolean;
property MarginColor : TColor read FMarginColor
write SetMarginColor;
end;
var
ImageForm: TImageForm;
implementation
{$R *.dfm}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TImageForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FZoomFactor := 1.0;
InitDrawingArea(0, 0, Width, Height, 0);
if FileExists(DEMO_FILE) then
LoadFromFile(DEMO_FILE);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TImageForm.LoadFromFile(const AFileName : String) : Boolean;
begin
FFullBitMap := TGPBitmap.Create(AFileName);
FFrameWidth := FFullBitMap.Width;
FFrameHeight := FFullBitMap.Height;
FViewBitmap := TGPBitmap.Create(FFrameWidth, FFrameHeight,
PixelFormat24bppRGB);
TriggerAppPaint;
Result := TRUE;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TImageForm.CreateGraphicInterface : IGPGraphics;
begin
Result := TGPGraphics.Create(Canvas.Handle);
Result.ResetTransform;
Result.TranslateTransform(FPaintLeft + FXLeft, FPaintTop + FYTop,
MatrixOrderPrepend);
Result.ScaleTransform(FZoomFactor, FZoomFactor, MatrixOrderPrepend);
Result.InterpolationMode := InterpolationModeHighQualityBilinear;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.Paint;
var
Graphics : IGPGraphics;
ViewGraphics : IGPGraphics;
Points : array [0..4] of TGPPoint;
WorldPoints : array [0..1] of TGPPoint;
WorldDrawingArea : TGPRect;
WorldBitmapArea : TGPRect;
begin
FAppPaintFlag := FALSE;
Graphics := CreateGraphicInterface;
if Assigned(FFullBitMap) then begin
Points[0].X := 0;
Points[0].Y := 0;
Points[1].X := FFullBitMap.Width;
Points[1].Y := FFullBitMap.Height;
Points[2].X := FPaintWidth;
Points[2].Y := FPaintHeight;
Points[3].X := FXLeft;
Points[3].Y := FYTop;
Points[4].X := FPaintLeft;
Points[4].Y := FPaintTop;
Graphics.TransformPoints(CoordinateSpaceWorld, // Destination
CoordinateSpaceDevice, // Source
Points);
// World coordinate space are simply bitmap coordinate space
WorldBitmapArea.X := 0;
WorldBitmapArea.Y := 0;
WorldBitmapArea.Width := FFullBitMap.Width;
WorldBitmapArea.Height := FFullBitMap.Height;
WorldDrawingArea.X := Points[0].X - Points[3].X;
WorldDrawingArea.Y := Points[0].Y - Points[3].Y;
WorldDrawingArea.Width := (Points[2].X - Points[3].X) - WorldDrawingArea.X;
WorldDrawingArea.Height := (Points[2].Y - Points[3].Y) - WorldDrawingArea.Y;
Graphics.SetClip(WorldDrawingArea);
ViewGraphics := TGPGraphics.FromImage(FViewBitMap);
ViewGraphics.DrawImage(FFullBitMap, 0, 0, FFrameWidth, FFrameHeight);
PaintSomething(ViewGraphics);
Graphics.DrawImage(FViewBitMap, 0, 0, FFrameWidth, FFrameHeight);
// Draw the rectangle surrounding the image.
WorldPoints[0].X := 0;
WorldPoints[0].Y := 0;
WorldPoints[1].X := FFullBitMap.Width;
WorldPoints[1].Y := FFullBitMap.Height;
Graphics.TransformPoints(CoordinateSpaceDevice, // Destination
CoordinateSpaceWorld, // Source
WorldPoints);
end
else begin
// FFullBitmap not assigned
WorldPoints[0].X := 0;
WorldPoints[0].Y := 0;
WorldPoints[1].X := 0;
WorldPoints[1].Y := 0;
end;
Canvas.Pen.Style := psClear;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Color;
// Left
Canvas.Rectangle(0, 0,
WorldPoints[0].X + 1, FPaintHeight + 1);
// Right
Canvas.Rectangle(WorldPoints[1].X, 0,
FPaintWidth + 1, FPaintHeight + 1);
// Top
Canvas.Rectangle(WorldPoints[0].X, 0,
WorldPoints[1].X + 1, WorldPoints[0].Y + 1);
// Bottom
Canvas.Rectangle(WorldPoints[0].X, WorldPoints[1].Y,
WorldPoints[1].X + 1, FPaintHeight + 1);
// Paint margin area (used to show selected image)
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := FMarginColor;
Canvas.Pen.Width := FPaintMargin;
Canvas.MoveTo(FPaintMargin div 2, FPaintMargin div 2);
Canvas.LineTo(FPaintWidth + 1, FPaintMargin div 2);
Canvas.LineTo(FPaintWidth + 1, FPaintHeight + 1);
Canvas.LineTo(FPaintMargin div 2, FPaintHeight + 1);
Canvas.LineTo(FPaintMargin div 2, 0);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.InitDrawingArea(
ALeft, ATop, AWidth, AHeight, AMargin : Integer);
begin
FPaintMargin := AMargin;
FPaintTop := ATop + AMargin;
FPaintLeft := ALeft + AMargin;
FPaintWidth := AWidth - ALeft - AMargin;
FPaintHeight := AHeight - ATop - AMargin;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.Resize;
var
NewXLeft, NewYTop : Integer;
begin
InitDrawingArea(0, 0, ClientWidth, ClientHeight, 2);
NewXLeft := (FPaintWidth - Round(FFrameWidth * FZoomFactor)) div 2;
NewYTop := (FPaintHeight - Round(FFrameHeight * FZoomFactor)) div 2;
if NewXLeft > 0 then
FXLeft := NewXLeft;
if NewYTop > 0 then
FYTop := NewYTop;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.WMAppPaint(var Msg: TMessage);
begin
Paint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.TriggerAppPaint;
begin
// To avoid too much repainting, we use a flag and a custom message.
// The custom message will trigger the painting.
// Once the custom message has been posted, the falg is set and no more
// message will be posted until the flag is reset by the paint routine.
if not FAppPaintFlag then begin
FAppPaintFlag := TRUE;
PostMessage(Handle, WM_APP_PAINT, 0, 0);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.SetMarginColor(const Value: TColor);
begin
FMarginColor := Value;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.ZoomOut(Speed : Double);
begin
if Abs(Speed) < 0.001 then
FZoomFactor := ZoomFitCompute
else if Speed < 0 then
FZoomFactor := -Speed
else
FZoomFactor := FZoomFactor / 1.05;
if FZoomFactor < 0.01 then
FZoomFactor := 0.01;
if Abs(FZoomFactor - 1.0) < 0.001 then
FZoomFactor := 1.0; // Avoid cumulating error
//TriggerZoomChange(FZoomFactor);
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.ZoomIn(Speed : Double);
begin
if Abs(Speed) < 0.001 then
FZoomFactor := ZoomFitCompute
else if Speed < 0 then
FZoomFactor := -Speed
else
FZoomFactor := FZoomFactor * Speed;
if Abs(FZoomFactor - 1.0) < 0.001 then
FZoomFactor := 1.0; // Avoid cumulating error
//TriggerZoomChange(FZoomFactor);
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TImageForm.ZoomFitCompute : Double;
var
Z1, Z2 : Double;
begin
if (FFrameWidth = 0) or (FFrameHeight = 0) then begin
Result := 1.0;
FXLeft := 0;
FYTop := 0;
Exit;
end;
Z1 := FPaintWidth / FFrameWidth;
Z2 := FPaintHeight / FFrameHeight;
if Z1 < Z2 then
Result := Z1 * 0.95
else
Result := Z2 * 0.95;
FXLeft := (FPaintWidth - Round(FFrameWidth * Result)) div 2;
FYTop := (FPaintHeight - Round(FFrameHeight * Result)) div 2;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.PanRight;
begin
FXLeft := FXLeft + 10;
FYTop := FYTop + 0;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.PanLeft;
begin
FXLeft := FXLeft - 10;
FYTop := FYTop + 0;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.PanUp;
begin
FXLeft := FXLeft + 0;
FYTop := FYTop - 10;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.PanDown;
begin
FXLeft := FXLeft + 0;
FYTop := FYTop + 10;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.PanCenter;
begin
FXLeft := (FPaintWidth - Round(FFrameWidth * FZoomFactor)) div 2;
FYTop := (FPaintHeight - Round(FFrameHeight * FZoomFactor)) div 2;
TriggerAppPaint;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TImageForm.PaintSomething(Graphics: IGPGraphics);
var
FontFamily : IGPFontFamily;
Font : IGPFont;
Point : TGPPointF;
SolidBrush : IGPBrush;
begin
FontFamily := TGPFontFamily.Create('Times New Roman');
Font := TGPFont.Create(FontFamily, 24, FontStyleRegular, UnitPixel);
SolidBrush := TGPSolidBrush.Create(TGPColor.Create(255, 255, 0, 0));
Point.Initialize(10, 10);
Graphics.TextRenderingHint := TextRenderingHintAntiAlias;
Graphics.DrawString('Delphi rocks!', Font, Point, SolidBrush);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
Using TImageForm
The form we saw above is used twice in the sample application to display two images side by side. The form has 3 panels: a top panel acting as a tool bar and two panels below for the two images.
The tool bar has been made very simple: only basic buttons to call the image display form API on behalf of the active image. It's up to you to use a nice user interface, you've got the idea.
The two image panels are use to host a display form. Each one showing his independent image.
Finally, an OpenDialog is used to load an image from a file. You can easily add the code to save an image as well since GDI+ does all the work for you.
unit ImageMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ImageDisplay, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TMainForm = class(TForm)
TopPanel: TPanel;
LeftPanel: TPanel;
Splitter1: TSplitter;
RightPanel: TPanel;
ZoomFitButton: TButton;
ZoomInButton: TButton;
ZoomOutButton: TButton;
PanLeftButton: TButton;
PanRightButton: TButton;
PanUpButton: TButton;
PanDownButton: TButton;
PanCenterButton: TButton;
Zoom100Button: TButton;
OpenButton: TButton;
OpenDialog1: TOpenDialog;
procedure LeftPanelResize(Sender: TObject);
procedure RightPanelResize(Sender: TObject);
procedure ZoomFitButtonClick(Sender: TObject);
procedure ZoomInButtonClick(Sender: TObject);
procedure ZoomOutButtonClick(Sender: TObject);
procedure PanLeftButtonClick(Sender: TObject);
procedure PanRightButtonClick(Sender: TObject);
procedure PanUpButtonClick(Sender: TObject);
procedure PanDownButtonClick(Sender: TObject);
procedure PanCenterButtonClick(Sender: TObject);
procedure Zoom100ButtonClick(Sender: TObject);
procedure OpenButtonClick(Sender: TObject);
private
FLeftImage : TImageForm;
FRightImage : TImageForm;
FActiveImage : TImageForm;
procedure SetActiveImage(Image : TImageForm);
procedure ImageClick(Sender: TObject);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ TMainForm }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TMainForm.Create(AOwner: TComponent);
begin
inherited Create(Aowner);
FLeftImage := TImageForm.CreateParented(LeftPanel.Handle);
FLeftImage.BorderStyle := bsNone;
FLeftImage.OnClick := ImageClick;
FLeftImage.Visible := TRUE;
FRightImage := TImageForm.CreateParented(RightPanel.Handle);
FRightImage.BorderStyle := bsNone;
FRightImage.OnClick := ImageClick;
FRightImage.Visible := TRUE;
// Unselect active image and select left image as active
// It will set the image borders correctly
SetActiveImage(nil);
SetActiveImage(FLeftImage);
// Call resize handler for both panels to set images display size
LeftPanelResize(LeftPanel);
RightPanelResize(LeftPanel);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TMainForm.Destroy;
begin
FreeAndNil(FLeftImage);
FreeAndNil(FRightImage);
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.LeftPanelResize(Sender: TObject);
begin
if Assigned(FLeftImage) then
FLeftImage.BoundsRect := Rect(0, 0,
LeftPanel.Width - 1,
LeftPanel.Height - 1);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.OpenButtonClick(Sender: TObject);
begin
if not Assigned(FActiveImage) then
SetActiveImage(FLeftImage);
OpenDialog1.Filter := 'JPEG images (*.jpg)|*.jpg|' +
'TIFF images (*.tif)|*.tif|' +
'BMP images (*.bmp)|*.bmp|' +
'GIF images (*.gif)|*.gif|' +
'PNG images (*.png)|*.png|' +
'All files (*.*)|*.*|' +
'';
// OpenDialog1.InitialDir := FInitialDir;
OpenDialog1.Options := OpenDialog1.Options + [ofPathMustExist,
ofFileMustExist];
if not OpenDialog1.Execute(Handle) then
Exit;
FActiveImage.LoadFromFile(OpenDialog1.FileName);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.RightPanelResize(Sender: TObject);
begin
if Assigned(FRightImage) then
FRightImage.BoundsRect := Rect(0, 0,
RightPanel.Width - 1,
RightPanel.Height - 1);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.SetActiveImage(Image: TImageForm);
begin
if not Assigned(Image) then begin
FLeftImage.MarginColor := Color;
FRightImage.MarginColor := Color;
end
else begin
if Assigned(FActiveImage) then
FActiveImage.MarginColor := Color;
FActiveImage := Image;
FActiveImage.MarginColor := clBlack;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.ImageClick(Sender: TObject);
begin
SetActiveImage(Sender as TImageForm);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.Zoom100ButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.ZoomIn(-1.0);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.ZoomFitButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.ZoomIn(0);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.ZoomInButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.ZoomIn(1.05);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.ZoomOutButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.ZoomOut(1.05);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.PanCenterButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.PanCenter;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.PanDownButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.PanDown;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.PanLeftButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.PanLeft;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.PanRightButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.PanRight;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TMainForm.PanUpButtonClick(Sender: TObject);
begin
if Assigned(FActiveImage) then
FActiveImage.PanUp;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
Read previous article at:
http://francois-piette.blogspot.be/2013/05/opensource-gdi-library.html
This article is available from:
http://francois-piette.blogspot.be/2013/05/opensource-gdi-library-part-2.html
Download source code at:
http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
No comments:
Post a Comment