March 18, 2014

On the fly form

This article explain how to create a form on the fly. Such a form is created by code, without using the designer.

You will surely ask why you would do that! Granted the Delphi form designer is very easy to use. But in some cases it is not practical because it creates several files and makes more difficult, for example, to hide the form in a component.

This is exactly the case I had: in a component I needed a small helper form. I wanted the code to be in the component source itself. You may already use an "on the fly" form without knowing: InputQuery and InputBox are already such a form. Their code is located in the Dialogs unit.

Actually, there is not much magic to use to create an "on the fly" form. After all a form is just an object as any other object. The only special thing is related to the constructor. The form constructor insist on loading a form from a resource as it had been created with the designer and his DFM file. If there is no DFM and you call Create, you get an exception EResNotFound with a resource name equal to your form class name.

Instead of Create, you have to call CreateNew. This is easy but somewhat misleading. This is why the code I present below override the standard constructor named Create and call CreateNew. This way you can use the standard constructor without worrying.

The sample code I use to demonstrate the "on the fly" form is very easy. The form is a simple form named TComboBoxInputForm with a combobox and a pair of buttons for OK/Cancel. I created an Execute method which calls ShowModal after having initialized the combobox with an array of const values passed as argument.

Here is the code showing the use:

procedure TForm1.Button1Click(Sender: TObject);
var
    Form    : TComboBoxInputForm;
    AResult : String;
begin
    Form := TComboBoxInputForm.Create(Self);
    try
        if Form.Execute(['Delphi', 123, 2.3, TRUE],
                        Edit1.Text, AResult,
                        'Select value') then
            Edit1.Text := AResult;
    finally
        FreeAndNil(Form);
    end;
end;

This code uses TComboBoxInputForm to ask the user to select a value in a list.

The source code is very simple and looks like any other form, except since there is no DFM file, all used components are created and initialized from the constructor.

type
    TComboBoxInputForm = class(TCustomForm)
        ComboBox     : TComboBox;
        OKButton     : TButton;
        CancelButton : TButton;
    protected
        procedure OKButtonClick(Sender: TObject);
        procedure CancelButtonClick(Sender: TObject);
    public
        constructor Create(AOwner : TComponent); override;
        function Execute(const Values   : array of const;
                         const ADefault : String;
                         out   AResult  : String;
                         const ACaption : String = '') : Boolean;
    end;

    TForm1 = class(TForm)
        Button1: TButton;
        Edit1: TEdit;
        procedure Button1Click(Sender: TObject);
    end;

var
    Form1: TForm1;

implementation

{$R *.dfm}

{ TComboBoxInputForm }

constructor TComboBoxInputForm.Create(AOwner: TComponent);
begin
    // We need the following lines to avoid the EResNotFound exception
    // because we have no DFM resource for our form
    GlobalNameSpace.BeginWrite;
    try
        CreateNew(AOwner);
    finally
        GlobalNameSpace.EndWrite;
    end;
    BorderStyle          := bsToolWindow;
    ComboBox             := TComboBox.Create(Self);
    ComboBox.Parent      := Self;
    ComboBox.Top         := 16;
    ComboBox.Left        := 32;
    ComboBox.Style       := csDropDownList;
    OKButton             := TButton.Create(Self);
    OKButton.Parent      := Self;
    OKButton.Top         := ComboBox.Top + ComboBox.Height + 8;
    OKButton.Left        := ComboBox.Left;
    OKButton.Width       := 50;
    OKButton.Caption     := '&OK';
    OKButton.Default     := TRUE;
    OKButton.OnClick     := OKButtonClick;
    CancelButton         := TButton.Create(Self);
    CancelButton.Parent  := Self;
    CancelButton.Top     := OKButton.Top;
    CancelButton.Left    := OkButton.Left + OKButton.Width + 16;
    CancelButton.Width   := OKButton.Width;
    CancelButton.Caption := '&Cancel';
    CancelButton.Cancel  := TRUE;
    CancelButton.OnClick := CancelButtonClick;
    ComboBox.Width       := OKButton.Width + CancelButton.Width + 16;
    ClientWidth          := ComboBox.Left + ComboBox.Width + ComboBox.Left;
    ClientHeight         := ComboBox.Top + OKButton.Top + OKButton.Height;
end;

procedure TComboBoxInputForm.OKButtonClick(
    Sender : TObject);
begin
    Close;
    ModalResult := mrOK;
end;

procedure TComboBoxInputForm.CancelButtonClick(
    Sender : TObject);
begin
    Close;
    ModalResult := mrCancel;
end;

function TComboBoxInputForm.Execute(
    const Values   : array of const;
    const ADefault : String;
    out   AResult  : String;
    const ACaption : String) : Boolean;
var
    I    : Integer;
const
    BoolToStr : array [Boolean] of String = ('FALSE', 'TRUE');
begin
    Caption   := ACaption;
    ComboBox.Items.Clear;
    I := Low(Values);
    while I <= High(Values) do begin
        case Values[I].VType of
        vtUnicodeString: ComboBox.Items.Add(Values[I].VPWideChar);
        vtBoolean:       ComboBox.Items.Add(BoolToStr[Values[I].VBoolean]);
        vtInteger:       ComboBox.Items.Add(IntToStr(Values[I].VInteger));
        vtExtended:      ComboBox.Items.Add(FloatToStr(Values[I].VExtended^));
        end;
        Inc(I);
    end;
    // Preselect default item
    I := ComboBox.Items.IndexOf(ADefault);
    if I >= 0 then
        ComboBox.ItemIndex := I;

    Result := ShowModal = mrOK;
    if Result then
        AResult := ComboBox.Text
    else
        AResult := ADefault;
end;






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

March 11, 2014

End of Windows XP. Modernize your applications.

You've probably seen the news that Microsoft is ending support for Windows XP on April 8th of this year. It is time to update your old applications to work with the new generation of modern operating systems.

There is an upcoming webminar by Marco Cantù on Mernizing Delphi and C++Builder Windows applications: http://forms.embarcadero.com/ModernWindowsApps3-19






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

March 1, 2014

Persistent form with F11 to fullscreen

This article shows how to create a persistent form having the ability to go real full screen. A persistent form is one which remember his size and position. Real full screen means the form use all the available screen area without having border nor title bar.

The form goes to full screen using the F11 key, just like Internet Explorer does. Of course a menu item or other UI gadget may be used for that purpose as well.

All in all, it is not much difficult to do. The code I will show you below make use of the followings items:

  1. Form position and size: each form has Top, Left, Width and Height properties. BoundsRect property is a TRect with those values.
  2. Form state: each form can be maximized, minimized or in normal state.
  3. Form full screen: The form simply has the size of the desktop work area and no border nor title bar. My code use the kind of border as a flag for full screen.
  4. Monitor: A form can be completely on a monitor or partially on one monitor or another monitor.
  5. Screen: a screen is made of all available monitors. There are some TScreen methods helping located the monitor where a given window (ie. a form) is located.
  6. Desktop area: the desktop area is made of all monitors areas. The main monitor also has the task bar on one of its size, reducing the available work area.
  7. IniFile: My code use a classic INI file to store data when the application quits so that it can be reloaded with it is restarted.
  8. Special shell folder: Windows Explorer has a number of well known folders. My code use "Local AppData" folder to store the INI file. This way each user has a private INI file.
  9. Key preview: the keyboard actions are directed to the control having the focus. A form has a property KeyPreview which make the keyboard events (KeyDown and the likes) to be triggered on behalf of the form before being triggered on behalf of the control having focus. This way a form can override the action associated with any key. My code trap F11 to toggle full screen mode.
I won't explain all the details of the demo application because it is quite simple. Don't hesitate to use the comment section of this article to ask for your question regarding my code.

The application is a simple VCL form application having a single form. The form source code is in FullScreenMain.pas, the project is FullScreen.dpr. I used Delphi XE5 but the code should works with most Delphi versions.

FullScreenMain.pas
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       François PIETTE
              http://francois-piette@blogspot.be
Creation:     Mar 01, 2014
Description:  Persitent position and size form having the ability to go
              full screen using F11 (Like IE) or popup menu.
Version:      1.00
History:


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit FullScreenMain;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics,
    Controls, Forms, Dialogs, ShlObj, IniFiles, Menus, ComCtrls, StdCtrls;

const
    CompanyFolder        = 'OverByte';

type
    TFullScreenMainForm = class(TForm)
        MainMenu1: TMainMenu;
        FileMainMenu: TMenuItem;
        QuitMainMenu: TMenuItem;
        ViewMainMenu: TMenuItem;
        FullScreenMainMenu: TMenuItem;
        StatusBar1: TStatusBar;
        Button1: TButton;
        procedure FullScreenMainMenuClick(Sender: TObject);
        procedure QuitMainMenuClick(Sender: TObject);
        procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    private
    protected
        FLocalAppData           : String;
        FAppName                : String;
        FIniFileName            : String;
        FInitialized            : Boolean;
        FIniSection             : String;
        FIniSectionData         : String;
        FNormalBounds           : TRect;
        procedure DoShow; override;
        procedure DoClose(var Action: TCloseAction); override;
        procedure SetFullScreen(Value : Boolean);
    public
        constructor Create(AOwner : TComponent); override;
        property IniFileName            : String     read  FIniFileName
                                                     write FIniFileName;
        property IniSection             : String     read  FIniSection
                                                     write FIniSection;
        property IniSectionData         : String     read  FIniSectionData
                                                     write FIniSectionData;
        property LocalAppData           : String     read  FLocalAppData
                                                     write FLocalAppData;
        property AppName                : String     read  FAppName
                                                     write FAppName;
    end;

var
    FullScreenMainForm : TFullScreenMainForm;

implementation

{$R *.dfm}

const
    SectionWindow      = 'WindowMain';   // Must be unique for each window
    SectionData        = 'Data';
    KeyFullScreen      = 'FullScreen';
    KeyWindowState     = 'WindowState';
    KeyTop             = 'Top';
    KeyLeft            = 'Left';
    KeyWidth           = 'Width';
    KeyHeight          = 'Height';

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{ TFullScreenMainForm }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TFullScreenMainForm.Create(AOwner: TComponent);
var
    Path : array [0..MAX_PATH] of Char;
begin
    SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
    FIniSection     := SectionWindow;
    FIniSectionData := SectionData;
    FAppName        := ChangeFileExt(ExtractFileName(Application.ExeName), '');
    FLocalAppData   := IncludeTrailingPathDelimiter(Path) +
                       CompanyFolder + '\' + FAppName + '\';
    FIniFileName    := FLocalAppData + FAppName + '.ini';
    KeyPreview      := TRUE;   // We need this to see F11 key whatever the
                               // control having focus
    inherited Create(AOwner);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.DoShow;
var
    IniFile      : TIniFile;
    I            : Integer;
    AFullScreen  : Boolean;
    AWindowState : TWindowState;
begin
    if not FInitialized then begin
        FInitialized := TRUE;

        ForceDirectories(ExtractFilePath(FIniFileName));
        IniFile := TIniFile.Create(FIniFileName);
        try
            AFullScreen  := IniFile.ReadBool(FIniSection, KeyFullScreen, FALSE);
            AWindowState := TWindowState(IniFile.ReadInteger(
                              FIniSection, KeyWindowState, Ord(WindowState)));

            Width  := IniFile.ReadInteger(FIniSection, KeyWidth,  Width);
            Height := IniFile.ReadInteger(FIniSection, KeyHeight, Height);
            Top    := IniFile.ReadInteger(FIniSection, KeyTop,
                                          (Screen.Height - Height) div 2);
            Left   := IniFile.ReadInteger(FIniSection, KeyLeft,
                                          (Screen.Width  - Width)  div 2);
        finally
            IniFile.Destroy;
        end;

        // Check if form is on an existing monitor
        I := 0;
        while I < Screen.MonitorCount do begin
            if (Top >= Screen.Monitors[I].Top) and
               (Top <= (Screen.Monitors[I].Top +
                             Screen.Monitors[I].Height)) and
               (Left >= Screen.Monitors[I].Left) and
               (Left <= (Screen.Monitors[I].Left +
                              Screen.Monitors[I].Width)) then
                break;
            Inc(I);
        end;
        if I >= Screen.MonitorCount then begin
            // Form is outside of any monitor. Move to center of main monitor
            Top  := (Screen.Height - Height) div 2;
            Left := (Screen.Width  - Width)  div 2;
        end;
        // Save form's bounds so that it is restored after full screen
        FNormalBounds := BoundsRect;

        // Restore window state as saved at previous exit time, except if it
        // was minimized (Usually user don't like to have their application
        // to start minimized)
        if (AWindowState <> wsMinimized) and (AWindowState <> WindowState) then
            WindowState := AWindowState;

        // Restore full screen mode as saved at previous exit time
        if AFullScreen then
            SetFullScreen(AFullScreen);
    end;
    inherited DoShow;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.DoClose(var Action: TCloseAction);
var
    IniFile      : TIniFile;
    AFullScreen  : Boolean;
    AWindowState : TWindowState;
begin
    try
        IniFile := TIniFile.Create(FIniFileName);
        try
            // Save full screen mode flag for next startup
            AFullScreen := BorderStyle <> bsSizeable;
            if AFullScreen then
                SetFullScreen(FALSE);
            IniFile.WriteBool(FIniSection,    KeyFullScreen, AFullScreen);

            // Save current windows state for next startup
            AWindowState := WindowState;
            IniFile.WriteInteger(FIniSection, KeyWindowState, Ord(AWindowState));

            // Save current form's position and size
            // We need to set the window to normal mode to get correct position
            // and size
            if WindowState <> wsNormal then
                WindowState := wsNormal;
            IniFile.WriteInteger(FIniSection, KeyTop,    Top);
            IniFile.WriteInteger(FIniSection, KeyLeft,   Left);
            IniFile.WriteInteger(FIniSection, KeyWidth,  Width);
            IniFile.WriteInteger(FIniSection, KeyHeight, Height);
        finally
            IniFile.Destroy;
        end;
    except
        // Ignore any exception when saving window size and position
    end;
    inherited DoClose(Action);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.SetFullScreen(Value : Boolean);
begin
    if Value then begin
        // Save form's bounds so that it is restored after full screen
        FNormalBounds := BoundsRect;
        // Remove form's border
        BorderStyle   := bsNone;
        // Set form's size and position to the entire monitor's workarea
        BoundsRect    := Screen.MonitorFromWindow(Handle).WorkareaRect;
    end
    else begin
        // Select normal border for the form
        BorderStyle   := bsSizeable;
        // Restore form's size and position as it was before full screen
        BoundsRect    := FNormalBounds;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.FormKeyDown(
    Sender  : TObject;
    var Key : Word;
    Shift   : TShiftState);
begin
    if (Key = VK_F11) and (Shift = []) then begin
        Key := 0;                       // Signal we have handled the key
        SetFullScreen(BorderStyle = bsSizeable);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.FullScreenMainMenuClick(Sender: TObject);
begin
    SetFullScreen(BorderStyle = bsSizeable);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFullScreenMainForm.QuitMainMenuClick(Sender: TObject);
begin
    Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.

FullScreenMain.dfm
object FullScreenMainForm: TFullScreenMainForm
  Left = 2111
  Top = 115
  Caption = 'Full Screen Demo'
  ClientHeight = 395
  ClientWidth = 510
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnKeyDown = FormKeyDown
  DesignSize = (
    510
    395)
  PixelsPerInch = 96
  TextHeight = 13
  object StatusBar1: TStatusBar
    Left = 0
    Top = 376
    Width = 510
    Height = 19
    Panels = <
      item
        Text = 'Here is the status bar'
        Width = 50
      end>
  end
  object Button1: TButton
    Left = 392
    Top = 345
    Width = 115
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Bottom Right button'
    TabOrder = 1
  end
  object MainMenu1: TMainMenu
    Left = 112
    Top = 64
    object FileMainMenu: TMenuItem
      Caption = '&File'
      object QuitMainMenu: TMenuItem
        Caption = '&Quit'
        OnClick = QuitMainMenuClick
      end
    end
    object ViewMainMenu: TMenuItem
      Caption = '&View'
      object FullScreenMainMenu: TMenuItem
        Caption = '&FullScreen'
        OnClick = FullScreenMainMenuClick
      end
    end
  end
end

FullScreen.dpr
program FullScreen;

uses
  Forms,
  FullScreenMain in 'FullScreenMain.pas' {FullScreenMainForm};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFullScreenMainForm, FullScreenMainForm);
  Application.Run;
end.




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