DWScript: OpenSource scripting engine for Delphi

Delphi Web Script (DWScript) is an OpenSource object-oriented scripting engine for Delphi based on Delphi language. Contrary to what its name suggest, DWScript is more of a general scripting engine than a web script engine.

DWScript provides a few Delphi component you can use to add scripting to your own application. You can expose functions, variable, constants, classes, object instances and data types defined in your Delphi program so that they becomes available from the script code.

Full source code is available from Google code at http://code.google.com/p/dwscript/ Included in the distribution are some useful sample demos.



Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

Programmer picks: 7 must-try mobile dev tools

InfoWorld has selected Embarcadero RAD Studio XE4 in his slideshow about mobile dev tools. Established companies like Intel and Embarcadero Technologies, as well as lesser-known players are continually rolling out technologies to help meet mobile developers' needs.

Read the full article at: http://www.infoworld.com/slideshow/101586/programmer-picks-7-must-try-mobile-dev-tools-218867#slide6


Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

Internet Explorer Automation Part 4

I this article, I will explain how to extract statistics from Blogger stats page. This follows the previous article in which you learned how to automate the login process and get the stats page.

The stats page is organized in a number of HTML elements. The one which is interesting for us is a table. Since there are many tables in the page, I had to find out a way to detect the correct one, even if the page layout changes.

The idea is to enumerate all the HTML elements in the page, check for the table tag and check the labels against string constants. This is easy since the table is organized in two columns, one with the label and one with the number.

To iterate all the HTML elements is easy. As we saw in previous article, there is a property of the HTML document which is a collection (a kind of array) name “all”. It is enough to enumerate it and for each item in the collection query the interface IID_IHTMLElement to get hand on the HTML element.

Having the HTML element, we can check the tagName property which is actually the tag type. We are looking for ‘Table’. If it is a table, we get the innertext property which as its name implies is the raw text inside the tag. Raw text means it is the text without any embedded tags. In the case of an HTML table, we get the content of all table cells. We will search that text for the labels such as “Pageviews today” and then extract the number just after. For that purpose I wrote a little utility function I will show you in a moment.

Here is the code to do what I’ve just described:

    Coll := FHtmlDoc.all;
    for I := 0 to Coll.Length - 1 do begin
        pDisp := Coll.item(I, var2);
        if pDisp.QueryInterface(IID_IHTMLElement, HtmlElem) = S_OK then begin
            if SameText(HtmlElem.tagName, 'TABLE') then begin
                Txt := String(HtmlElem.innertext);
                if not ExtractNumberAfterText(Txt, TxtToday,
                                              CountToday) then
                    continue;
                if not ExtractNumberAfterText(Txt, TxtYesterday,
                                              CountYesterday) then
                    continue;
                if not ExtractNumberAfterText(Txt, TxtLastMonth,
                                              CountLastMonth) then
                    continue;
                if not ExtractNumberAfterText(Txt, TxtAllTime,
                                              CountAllTime) then
                    continue;

                Buf := AnsiString(
                          FormatDateTime('YYYY/MM/DD;HH:NN:SS;', Now) +
                          '"_' + FBlogId + '";' +
                          IntToStr(CountToday) + ';' +
                          IntToStr(CountYesterday) + ';' +
                          IntToStr(CountLastMonth) + ';' +
                          IntToStr(CountAllTime));
                Result := TRUE;
                break;
            end;
        end;
    end;

The utility function ExtractNumberAfterText is rather simple. It is just simple Delphi code to parse the string. We just have to pay attention to skip all spaces and line breaks because they are not significant in HTML.

function ExtractNumberAfterText(
    const Source : String;
    const Text   : String;
    out   Number : Integer) : Boolean;
var
    J : Integer;
begin
    Result := FALSE;
    Number := 0;
    J := Pos(Text, Source);
    if J <= 0 then
        Exit;
    // Search for first digit right after searched text,
    // ignore anything not a digit
    J := J + Length(Text);
    while (J <= Length(Source)) and
          (not CharInSet(Source[J], ['0'..'9'])) do
        Inc(J);
    // After first digit, scan all digit and ',' or '.' (which
    // are used as thousand separator (Depends on language, any will do)
    repeat
        // If we have a digit, use it to build the final number
        if CharInSet(Source[J], ['0'..'9']) then
            Number := Number * 10 + Ord(Source[J]) - Ord('0');
        Inc(J);
    until (J > Length(Source)) or
          (not CharInSet(Source[J], ['0'..'9', ',', '.']));
    Result := TRUE;
end;

About the design of the application

I explained how to automate Internet Explorer. I showed the actual code used. But I didn’t gave any explanation about how I have designed the whole application.

I always like to separate the user interface from data processing. For that purpose, I created two source files: one with the user interface and one with a class having the automation code.

My user interface is very basic: a simple form with a memo showing messages about what is going on. I could as well write a console mode application or a service application. This doesn’t really matters.

My data processing code is encapsulated in a class I named TQueryBloggerStatistics. It explains what it does. The class is a kind of container. It exposes a few methods and properties to permit what has to be done with that kind of automation.

The class declaration is as follow:

    TQueryBloggerStatistics = class
    private
        FWebBrowser   : IWebBrowser2;
        FBlogID       : String;
        FUserEMail    : String;
        FUserPassword : String;
        FLogFileName  : String;
        FVisible      : Boolean;
        FOnDisplay    : TDisplayEvent;
        function WaitComplete(const URL : String = ''): IHTMLDocument2;
        function FindTag(const Coll    : IHTMLElementCollection;
                         const TagName, TagID: String): IHTMLElement;
        procedure Display(const Msg : String);
    public
        constructor Create;
        function  Execute : Boolean;
        procedure Quit;
        procedure LoadConfig(const IniFileName : String); overload;
        procedure LoadConfig; overload;
        function  SaveConfig(const IniFileName: String) : Boolean; overload;
        function  SaveConfig : Boolean; overload;
        property  BlogID       : String        read  FBlogID
                                               write FBlogID;
        property  UserEMail    : String        read  FUserEMail
                                               write FUserEMail;
        property  UserPassword : String        read  FUserPassword
                                               write FUserPassword;
        property  LogFileName  : String        read  FLogFileName
                                               write FLogFileName;
        property  Visible      : Boolean       read  FVisible
                                               write FVisible;
        property  OnDisplay    : TDisplayEvent read  FOnDisplay
                                               write FOnDisplay;
    end;

I won’t reproduce the implementation here because I already showed most interesting part. You can download the full source code for the class and the complete demo application from my website at:
http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html

Previous article: http://francois-piette.blogspot.be/2013/05/internet-explorer-automation-part-3.html

Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

Pascal still an advantage for some iOS, Android developers

Just read this article. It could also interest you so I share it:
http://www.zdnet.com/pascal-still-an-advantage-for-some-ios-android-developers-7000014743/


Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

Be-Delphi Event 3.0

Be-Delphi Event 3.0 on November 21st in Edegem, Belgium. Stay tuned for more info...

Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

Internet Explorer Automation Part 3

Today I will present an Internet Explorer automation which will query Blogger stats page automatically. IE automation is required because Blogger website makes heavy use of JavaScript to dynamically construct the stats page. Downloading the webpage with a HTTP component won’t work because the numbers we are looking for are not in clear! JavaScript must be executed to get hand of it.

The code I will show you will also take care of authentication. Asking for the stats page without being first authenticated and you get the authentication page instead. The code I’ll present will detect the login page, fill the form automatically, submit it and then request the stats page again and finally extract the data.

For those not accustomed with Blogger author interface and his stats page, the screen dump shows an actual view of the page. It shows the stats for this week (At the time of writing this article). What we are interested in is to get the column on the right showing “Pageviews today 149”, “Pageviews yesterday 434” and the two other lines. This is an HTML table that we have to extract from the document.

As I said above before getting this stats page, you must be authenticated. This means that if you are not authenticated, Blogger will show you the login page whatever you asked in the first place. For your reference, here is a screen dump of the authentication page:

On that page, we see a form with two fields for Email and Password and a button “Sign in” to click. The program will locate those fields, assign a value and then click on the button.

Document Object Model (DOM)

The World Wide Web Consortium (W3C) Document Object Model (DOM) is a platform- and language-neutral interface that permits programs or scripts to access and update the content, structure, and style of a document. The W3C DOM includes a model for how a standard set of objects representing HTML and XML documents are combined, and an interface for accessing and manipulating them.

Internet Explorer exposes DOM thru a set of COM interfaces available to external programs such as our Delphi application. This is documented on MSDN website at:
      http://msdn.microsoft.com/en-us/library/ie/hh772384(v=vs.85).aspx

I will only scratch the surface of DOM. Just enough to get you started and to accomplish the task for the sample application.

We saw in previous article that we can connect to IE by calling this line:

    FWebBrowser := CreateComObject(CLASS_InternetExplorer) as IWebBrowser2;

And that we can navigate to an URL with this line of code:

        FWebBrowser.Navigate(Url, EmptyParam, EmptyParam, EmptyParam, EmptyParam);

To get hand on the interface which is the entry point for the DOM, we must get the document (whatever it is) and the get the interface to the HTML document (if it exists):

      Doc := FWebBrowser.Document;
      Doc.QueryInterface(IID_IHTMLDocument2, HtmlDoc);

Those code lines are easy but wait! There can be some glitches. Internet Explorer takes some time to fetch URL and build document. A document can be quite complex and could requires a lot of downloads for HTML, images, CSS, scripts and more. And once everything is downloaded, scripts have to be executed. There are various status available to be sure everything is OK. The method WaitComplete here after takes an URL, navigate to it and wait until the HTML document interface is available and the document is ready:

function TQueryBloggerStatistics.WaitComplete(
    const URL : String = ''): IHTMLDocument2;
var
    Doc : IDispatch;
begin
    Result := nil;
    if URL <> '' then
        FWebBrowser.Navigate(Url, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
    while FWebBrowser.Busy do
        Sleep(250);
    while FWebBrowser.Document = nil do
        Sleep(250);
    Doc := FWebBrowser.Document;
    if Doc.QueryInterface(IID_IHTMLDocument2, Result) <> S_OK then
        Exit;
    while not SameText(Result.readyState, 'complete') do
        Sleep(250);
end;

WaitComplete takes and optional URL and returns the IHTMLDocument2 interface required for handling the document. Tests are made to be sure everything is ready or complete. The code is quite straightforward but this must be done like that.

Once we’ve got an IHTMLDocument2 interface, we can use it to traverse the document object model (DOM) to find the HTML elements we need and to get or set their properties.

The HTML document has a number of collections like images, links, scripts and the likes. And there is a special collection returning absolutely everything. It is named “all”. We will use it to find what we need. For example, in the login form, we need to get hand on the HTML INPUT tag for each field and submit buttons. Each HTML tag has a TagName such as “input” and a tagID. TagName is an HTML standard while TagID is chosen by the web developer, in this case by Blogger. Fortunately at Blogger, they used very clear and meaningful TagId sucha as “Email” (for the Email input field), “Passwd” (for the password input field) and “Signin” for the submit button.

Since we have to get hand on several HTML elements, I wrote a little function FindTag:

function TQueryBloggerStatistics.FindTag(
    const Coll    : IHTMLElementCollection;
    const TagName : String;
    const TagID   : String) : IHTMLElement;
var
    PDisp : IDispatch;
    Var2  : OleVariant;
    I     : Integer;
begin
    for I := 0 to Coll.Length - 1 do begin
        pDisp := Coll.item(I, var2);
        if pDisp.QueryInterface(IID_IHTMLElement, Result) = S_OK then begin
            if SameText(Result.tagName, TagName) and
               SameText(Result.Id, TagID) then
                Exit;
        end;
    end;
    Result := nil;
end;

FindTag has to be called like this:

    HtmlElem := FindTag(FHtmlDoc.All, 'INPUT', 'EMail');
    if Assigned(HtmlElem) then
        HtmlElem.setAttribute('Value', FUserEMail, 0);

This excerpt find tag name “input” tag having an ID “Email”. The result, if found, is the interface to handle that HTML element. Here I use the interface to set the attribute “value” to the user email (variable FUserEMail hold the Email address).

FindTag code is relatively simple although accessing the collection items is a little bit tricky and must pass thru the use of another interface. Sorry but this is how Microsoft designed IE to handle the DOM.

Detecting and handling the login page

The code I’ll show you below will query a webpage by his URL. Nere this URL is supposed to be the stats page of a given Blogger’s blog. We’ll come back to that URL later. It makes use of WaitComplete to fetch the URL, wait until it is ready and complete and then use FindTag to see it the page conatins an “input” tag with and ID “Email”. If this is the case, then it is assumed we have received the login page. The conde then fetch in cascade all other required tags in that page, fill it with user data and then claa the “Click” method of the HTML element which is the submit button. And guess what… IE will send the form to Blogger and authentication take place.

    FHtmlDoc := WaitComplete(URL);
    if not Assigned(FHtmlDoc) then
        Exit;

    // Check for login page
    // If found, fill in the form and subit it before continuing
    HtmlElem := FindTag(FHtmlDoc.All, 'INPUT', 'EMail');
    if Assigned(HtmlElem) then begin
        HtmlElem.setAttribute('Value', FUserEMail, 0);
        HtmlElem := FindTag(FHtmlDoc.All, 'INPUT', 'Passwd');
        if Assigned(HtmlElem) then begin
            HtmlElem.setAttribute('Value', FUserPassword, 0);
            HtmlElem := FindTag(FHtmlDoc.All, 'INPUT', 'PersistentCookie');
            if Assigned(HtmlElem) then
                HtmlElem.setAttribute('Checked', '', 0);
            HtmlElem := FindTag(FHtmlDoc.All, 'INPUT', 'Signin');
            if Assigned(HtmlElem) then begin
                HtmlElem.click;
                Display('Login...');
                // We have found login form and must wait for login to occur
                FHtmlDoc := WaitComplete;
                if not Assigned(FHtmlDoc) then
                    Exit;
                // Login is finished, we must navigate again to the target URL
                FHtmlDoc := WaitComplete(URL);
                if not Assigned(FHtmlDoc) then
                    Exit;
                HtmlElem := FindTag(FHtmlDoc.All, 'INPUT', 'EMail');
                if Assigned(HtmlElem) then begin
                    Display('Login failed');
                    Exit;
                end;
            end;
        end;
    end;

The next step is to extract the statistics from the stat page.
We will do that in the next article. Stay tuned!

Read also part 1 and part 2.

Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be

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

OpenSource GDI+ Library

Sometimes ago, I discovered an open source GDI+ Library built by Erik Van Bilsen. I now use that Library extensively with excellent result.

I used it to build an image processing system and other similar things.

The Library is intended for Delphi 2009 and above. I currently use it with Delphi XE4 with no problem. It comes with a nice sample application that demonstrate the usage of GDI+ through examples which are Microsoft own samples translated to Delphi.

You can find more info at Erik Van Bilsen website.
The project is hosted on SourceForge at http://sourceforge.net/projects/delphigdiplus/
Microsoft home page for GDI+ is at http://msdn.microsoft.com/en-us/library/windows/desktop/ms533798(v=vs.85).aspx

Update: Sample application article at:
   http://francois-piette.blogspot.be/2013/05/opensource-gdi-library-part-2.html

Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be