May 9, 2013

OpenSource GDI+ Library - Part 2


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: