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

Delphi XE4 MS-Office components

Delphi XE4 is delivered with 3 sets of Microsoft Office components (Word, Excel, Outlook, Power Point and Access): Office 2000, Office XP and Office 2010. None is installed by default.

To install Office components, you must launch the IDE, select "Component" menu and then "Install packages". In the list shown, you'll find "Microsoft Office 200 sample Automation Server Wrapper Components" and similar for XP. You don't see the package for office 2010 but it is delivered.

If you need Office XP or office 2000, just click the check box in front of the corresponding item in the list then click OK.

If you need Offcie 2010, click the "Add..." button below the list and navigate to "Program Files (x86)\Embarcadero\RAD Studio\11.0\bin" and select "dcloffice2010180.bpl". then click OK.

After installation of any one of the Office component package, you'll have a new tab "Servers" in the component palette with all the Office component wrappers.

By the way, always select the oldest version you can use because it will work with more recent Office version. Of course you can use recent Office functions only with recent component wrapper, but then your application will not work if an old Microsoft Office is installed.

Recommanded reading: "Automate Microsoft Office from Delphi" article available from my blog at http://francois-piette.blogspot.be/2013/01/automate-microsoft-office-from-delphi.html

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

Getting Network Share List

Network neighborhood can be obtained programmatically in any application. It’s just a matter of a single Windows API call to the NetShareEnum function.

MSDN publish the complete description of NetShareEnum at http://msdn.microsoft.com/en-us/library/windows/desktop/bb525387(v=vs.85).aspx

Since Delphi doesn’t provide the definition, we have to define it our self. With the help of MSDN we find that NetShareEnum is defined for C/C++ language into Lmshare.h and the function is implemented in Netapi32.dll.

Lmshare.h can be found in Windows SDK which is a free download from Microsoft.

But don’t worry; I’ve done the work for you!

function NetShareEnum(ServerName       : PWideChar;
                      Level            : DWORD;
                      var BufPtr       : Pointer;
                      PrefMaxLen       : DWORD;
                      var EntriesRead  : DWORD;
                      var TotalEntries : DWORD;
                      var ResumeHandle : DWORD) : NET_API_STATUS; stdcall;
             external 'NetAPI32.dll' name 'NetShareEnum';

ServerName points to a Unicode string that specifies the DNS or NetBIOS name of the remote computer. Use nil to specify the local computer. It works with the name beginning with two backslashes or just the server name.

Level is an integer which defines which information you want to retrieve. In this sample, we will use the basic level of information which is level 1.

BufPtr is a variable which will be filled by the API with the address of a buffer where the requested information has been copied. This buffer must be freed later using NetApiBufferFree. BufPtr is defined as an untyped pointer since the actual data type change according to the level argument.

PrefMaxLen specifies the preferred maximum length of returned data. A special value (-1) specifies that the function allocate the amount of memory required for the data. There is practical reason to not use that value since all computers have plenty of RAM today.

EntriesRead returns the number of entries returned in the buffer.

TotalEntries receive the total number of entries. Useful if PrefMaxLength is too small. But Microsoft says it is only a hint.

ResumeHandle is a handle which can be used to resume an interrupted enumeration. Should be set to zero for the first call to the function.

The return value is an error code. Actually the NET_API_STATUS is simply a DWORD.

We saw that NetShareEnum is allocating memory for use and that this memory must be freed using NetApiBufferFree. This new API function is defined in the same file. Here is his Delphi declaration:

function NetApiBufferFree(Buffer : Pointer) : NET_API_STATUS; stdcall;
             external 'NetAPI32.dll' name 'NetApiBufferFree';

To be able to effectively use NetShareEnum, we still need the data type declaration. You can see on MSDN the various levels (see link above). We will use basic information which is level 1:

type
    SHARE_INFO_1 = record
        shi1_netname     :  PWideChar;
        shi1_type        :  DWORD;
        shi1_remark      :  PWideChar;
    end;
    PSHARE_INFO_1 = ^SHARE_INFO_1;

shi1_netname is the name of the network share, the one you see using Windows own Explorer.

shi1_type is a bit mask which defines what the share is, for example a disk or a printer.

const
    STYPE_DISKTREE  = 0;
    STYPE_PRINTQ    = 1;
    STYPE_DEVICE    = 2;
    STYPE_IPC       = 3;
    STYPE_TEMPORARY = $40000000;
    STYPE_SPECIAL   = $80000000;

shi1_remark is the description given when the share has been created on the server.


It’s time now to use NetShareEnum in a real program. Create a new VCL form application; drop a button and a TMemo on it. Use the code below.

procedure TForm1.EnumerateShares1(
    const Server : PChar;
    const Pfx    : String = '');
const
    MAX_PREFERRED_LENGTH = -1;
    NERR_SUCCESS         = 0;
var
    EntriesRead  : DWORD;
    TotalEntries : DWORD;
    ResHandle    : DWORD;
    ShareInfo1   : PSHARE_INFO_1;
    P            : PSHARE_INFO_1;
    Status       : NET_API_STATUS;
    I            : Integer;
begin
    ResHandle := 0;
    Status := NetShareEnum(Server, 1, Pointer(ShareInfo1),
                           DWORD(MAX_PREFERRED_LENGTH),
                           EntriesRead, TotalEntries, ResHandle);
    try
        if Status <> NERR_SUCCESS then
            Exit;
        P := ShareInfo1;
        for I := 0 to TotalEntries - 1 do begin
            Memo1.Lines.Add(Pfx + P.shi1_netname +
                           ' ' + ShareTypeToStr(P.shi1_type));
            Inc(P);
        end;
    finally
        NetApiBufferFree(ShareInfo1);
    end;
end;

This code is really simple. Isn’t it? There is a call to NetShareEnum and then a loop to iterate thru all the record returned in the buffer, displaying the share name and share type. Finally, NetApiBufferFree is called to release the memory allocated by NetShareEnum.

I created a small function to decode the share type:

function ShareTypeToStr(SType : DWORD) : String;
begin
    case SType and $FFFF of
    STYPE_DISKTREE:  Result := '[Disk]';
    STYPE_PRINTQ:    Result := '[Printer]';
    STYPE_DEVICE:    Result := '[Device]';
    STYPE_IPC:       Result := '[IPC]';
    else
                     Result := '[Type0x' + IntToHex(SType, 8) + ']';
    end;
    if (SType and STYPE_SPECIAL) <> 0 then
        Result := Result + '[Special]';
    if (STYpe and STYPE_TEMPORARY) <> 0 then
        Result := Result + '[Temporary]';
end;

I should be clear to you that you have to call the nice function from the button onclick event handler like this:

procedure TForm1.Button1Click(Sender: TObject);
begin
    EnumerateShares1('ML150');
end;

In that demo, ‘ML150’ is the name of a server on my network. Use an appropriate name for your network. Or an empty string to list the shares on the local computer.

A last note: this code has been built using Delphi XE4. It should work unchanged with all Unicode enabled version of Delphi (2009 and up). For older Delphi, you have to pay attention to Unicode strings that the API is using and convert it to Ansi strings.

This article is available from:
  http://francois-piette.blogspot.be/2013/04/getting-network-share-list.html


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

Delphi XE4 and AnsiString

I already ported a lot of my applications to Delphi XE4. This represent hundreds of thousands lines of code. All in all this was very easy, coming from XE3.

There is only one changed feature that forced me to slightly update my source code: in XE4, all AnsiString routines have been moved to a new unit named System.AnsiStrings. I had to add this unit where ever I used on of those routines. If you don't, XE4 gives a warning about deprecated function:

Given the code:

procedure TForm1.Button1Click(Sender: TObject);
var
    S : AnsiString;
    L : Integer;
begin
    S := 'Hello world!';
    L := StrLen(PAnsiChar(S));
end;

You get the warning:

    [dcc32 Warning] Unit1.pas(32): W1000 Symbol 'StrLen' is deprecated: 
 'Moved to the AnsiStrings unit'

Sadly, if you add System.AnsiStrings to the uses clause and recompile the code, you get the warning:

[dcc32 Error] Unit1.pas(33): E2251 Ambiguous overloaded call to 'StrLen'
  System.SysUtils.pas(10369): Related method: 
       function StrLen(const PAnsiChar): Cardinal;
  System.AnsiStrings.pas(3166): Related method: 
       function StrLen(const PAnsiChar): Cardinal;

I don’t clearly understand why the compiler emit this warning because as you see, the two overloaded versions of StrLen are the same!

To avoid this issue, you have to fully qualify StrLen like this:

procedure TForm1.Button1Click(Sender: TObject);
var
    S : AnsiString;
    L : Integer;
begin
    S := 'Hello world!';
    L := System.AnsiStrings.StrLen(PAnsiChar(S));
end;

Unfortunately, this makes the code not compilable anymore with previous Delphi versions. XE3 has an AnsiStrings unit but without StrLen.

I have to produce code working for several Delphi versions. So I designed a little workaround so that change in my existing source code is mimimal. I wrote a new _StrLen function which has the required conditional compilation to make it works with all Delphi versions. And everywhere I call StrLen, I replaced it by _StrLen. This is easy to find since the compiler complain at each instance.

function _StrLen(const S : PAnsiChar): Cardinal;
begin
{$IFDEF VER250}
    Result := System.AnsiStrings.StrLen(S);
{$ELSE}
    Result := StrLen(S);
{$ENDIF}
end;

In the uses clause, I have this:

uses
  Windows, Messages,
{$IFDEF VER250}
  System.AnsiStrings,
{$ENDIF}
  SysUtils, Variants, Classes, Graphics,  Controls, Forms, Dialogs, StdCtrls;

Please note that in order to say compatible with very old Delphi versions such as Delphi 7, I don’t use prefixes and instead I use the “unit scope name” in the project options so that the compiler properly resolve “SysUtils” to “System.SysUtils” and the likes for compilers which supports unit scope naming. Anyway, almost all my source code was already written that way because most of it exists long before Delphi supported that feature.

What I explained here about StrLen occurs with many other ANSI strings routines. Same solution applies to all.

This article is available from:
  http://francois-piette.blogspot.be/2013/04/delphi-xe4-and-ansistring.html

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