Tuesday, April 17, 2012

Speed up Delphi 7 loading time

My Delphi 7 loading time is so slow, about 1.30 minute. I know that's to slow, but i am using netbook with AMD E-350 processor. Googling around how to speed it up, and found this wonderful app that can speed up Delphi 7 loading time. And now i can get into my delphi for only 25 seconds!!! wow...  I love this apps.... It's called DelphiSpeedUp 3.1. and it's free, You should check it out. And compiling time is faster too, once my compile time it's about 25 seconds and now after installing it, it took only 16 seconds.

Sunday, April 15, 2012

Fix Illegal character in input file when installing JEDI 3.45

Fix Illegal character in input file when installing JEDI 3.45 for Delphi 7.

Error Messages :
jvcl\run\JvPageSetup.pas(1) Error: Illegal character in input file: 'ï' ($EF)
JvDlgs.dpk(86) Fatal: Could not compile used unit '..\..\run\JvPageSetup.pas'

jvcl\run\JvDialogs.pas(1) Error: Illegal character in input file: 'ï' ($EF)
JvDlgs.dpk(86) Fatal: Could not compile used unit '..\..\run\JvDialogs.pas'

How to fix :
Open the JvPageSetup.pas and JvDialogs.pas using Notepad++



and change the encoding from UTF-8 into ANSI for both files, save them. And run the install.bat again. Now your installation won't give any error message and successful.

Fix Delphi 7 WinHelp

When you are installing Delphi 7 on Windows 7, the Help system inside Delphi 7 is not working. And this is the solution to fix it.

1. Go to Microsoft website to get the MS Update Fix.
here is the MS Update Fix for Winhelp


2. Download the update, and run it, start Delphi 7, and voila the Delphi 7 Help system is working now...


Installing Delphi 7 on Windows 7

If you still love to developing with Delphi 7 and you're using Windows 7. Here's the tricks on how to install it.

1. Make sure you run the install.exe as Administrator.
2. Ignore the compatibility issue and run the program.
3. Install Delphi 7, by click on it.
4. After installation finishes, don't run Delphi yet.
    Because it will pop an error message like this. And it will pop the error message whenever you want to start a new application.
5. Now go to C:\Program Files (x86)\Borland\ (assuming you are using Win7 64bit)
    And right click on Delphi 7 Folder, choose Properties. Uncheck Read-only Checkbox and click apply.
6. Next, click the Security Tab, click on Users, and click Edit button to change the permission for user to allow full access...
    check the Full Control and Modify checkbox, and click the Apply button.

7. Click OK button, to close it. And you can run the Delphi 7.
    If Delphi 7 still pop up the Incompatibility Issue message, Just click the Don't show this message again checkbox and run the program.


The installation of Delphi 7 is now finished.

If you are having trouble of using Delphi 7 Winhelp. Please read next solution to fix delphi 7 help system.

Thursday, April 12, 2012

Hide flickering MDI Child Creation

// To hide annoying flickering MDI Child creation

  try
    SendMessage(Application.MainForm.ClientHandle,WM_SETREDRAW,0,0);
    FormChild:=TBaseChildForm.Create(application);
    FormChild.Caption:='Form '+IntToStr(n);
    FormChild.Show;
  finally
    SendMessage(Application.MainForm.ClientHandle,WM_SETREDRAW,1,0);
    RedrawWindow(Application.MainForm.ClientHandle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_NOINTERNALPAINT);
  end;

Sunday, April 8, 2012

Parse String with Delimiter into String List

// Parse String with Delimiter into String List

// Screenshot of running sample application

procedure TForm1.btnParseClick(Sender: TObject);
begin
  ParseDelimited(Memo1.lines, edit1.text, edit2.text);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  edit3.Text:=Edit1.Text+Edit2.Text;
end;

procedure TForm1.ParseDelimited(const sl: TStrings; const value:string,
  delimiter: string);
// Originally from : http://delphi.about.com/od/adptips2005/qt/parsedelimited.htm
// Tweak a bit by me, to be more understand  to read
// to use it in your own program don't forget to remove all "memo2.lines" Lines.
var
   nPosDeli : integer;
   sGet : string;
   sProcess : string;
   nLenDeli : integer;
begin
   nLenDeli := Length(delimiter) ;
   sProcess := value + delimiter;
   sl.BeginUpdate;
   sl.Clear;
   memo2.lines.clear;
   try
     while Length(sProcess) > 0 do
     begin
       memo2.Lines.Add('[sProcess]                                        : '+sProcess);
       memo2.Lines.Add('Length(sProcess)                                  : '+IntToStr(Length(sProcess)));
       nPosDeli := Pos(delimiter, sProcess) ;
       memo2.Lines.Add('Pos(delimiter, sProcess) [nPosDeli]               : '+IntToStr(nPosDeli));
       sGet := Copy(sProcess,0,nPosDeli-1) ;
       memo2.Lines.Add('Copy(sProcess,0,nPosDeli-1) [sGet]                : '+sGet);
       sl.Add(sGet) ;
       sProcess := Copy(sProcess,nPosDeli+nLenDeli,MaxInt) ;
       memo2.Lines.Add('Copy(sProcess,nPosDeli+nLenDeli,MaxInt) [sProcess]: '+sProcess);
       memo2.Lines.Add(' ');
     end;
   finally
     sl.EndUpdate;
   end;
end;

Sunday, April 1, 2012

Put Application on Windows Startup

{You can Drag and Drop your Application to Windows Startup Group to make it start automatically whenever Windows Startup. Or you can programmatically put it in code using Delphi.}

// *********************************************** //
procedure RunOnStartup(sProgTitle : string;
    sCmdLine: string;
    bRunOnce: boolean;
    bRemove: boolean) ;
// *********************************************** //    
 var
   sKey: string;
   Section: string;

 begin
   if (bRunOnce) then
     sKey := 'Once'
   else
     sKey := '';

   Section := 'Software\Microsoft\Windows\CurrentVersion\Run' + sKey + #0;

   with TRegIniFile.Create('') do
     try
       RootKey := HKEY_LOCAL_MACHINE;
       if bRemove then
         DeleteKey(Section, sProgTitle)
       else
         WriteString(Section, sProgTitle, sCmdLine) ;
     finally
       Free;
     end;
 end;

 {
Parameter Description:
    sProgTitle:
        Name of your program.
    sCmdLine:
        This is the full path name to your program.
    bRunOnce:
        True to run the application once, such as intalling first time application.
        False to run the application everytime windows startup.
    bRemove:
        True to remove startup key.

How to use:
RunOnStartup(
    'MyCalculator',
    'My Own Calculator',
    'MyCalc.exe',
    False );
}

Wednesday, March 28, 2012

Scrolling Window Caption Bar Title

// Scrolling Window Caption Bar Title

// Screen shot of running application

// dfm
object Form1: TForm1
  Caption = 'Scrolling Window Caption Bar Title'
  Position = poScreenCenter
  object Button1: TButton
    Caption = 'Start Animation'
    Default = True
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Text = 'Scrolling Window Caption Bar Title'
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer1Timer
  end
end

// unit1
type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

const
   {$J+}       // using assignable typed constant
   scrollingCaption : string = 'Scrolling Window Caption Bar Title...';
   {$J-}
var
  Form1: TForm1;

implementation

{$R *.dfm}
// ********************************************************** //
procedure TForm1.Button1Click(Sender: TObject);
// ********************************************************** //
begin
   if TButton(Sender).Caption='Start Animation' then
   begin
      scrollingCaption:=' >> '+Edit1.Text+' <<  ';
      Timer1.Enabled:=true;
      TButton(Sender).Caption:='Stop Animation';
   end
   else
   begin
      Timer1.Enabled:=false;
      TButton(Sender).Caption:='Start Animation';
   end;
end;

// ********************************************************** //
procedure TForm1.Timer1Timer(Sender: TObject);
// ********************************************************** //
var
   n: Integer;
begin
  Form1.Caption := scrollingCaption;
  for n := 1 to (Length(scrollingCaption) - 1) do
    scrollingCaption[n] := Form1.Caption[n + 1];

  scrollingCaption[Length(scrollingCaption)] := Form1.Caption[1];
end;

Flashing / Blinking Application Windows Caption Bar

// Flashing (blinking) application window caption bar, in order to get user attention

object Form1: TForm1
  Caption = 'Form1'
  object Button1: TButton
    Caption = 'Flash On'
    OnClick = Button1Click
  end 
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer1Timer
  end
end
 
// ********************************************* //
procedure TForm1.Button1Click(Sender: TObject);
// ********************************************* //
begin
  if TButton(Sender).Caption='Flash On' then
  begin
    beep;
    TButton(Sender).Caption:='Flash Off';
    Timer1.Enabled:=true;
  end
  else
  begin
    TButton(Sender).Caption:='Flash On';
    Timer1.Enabled:=False;
  end;
end;

// ********************************************* //
procedure TForm1.Timer1Timer(Sender: TObject);
// ********************************************* //
begin
   FlashWindow (Handle, True) ;
end;

Hide Application Task Bar Button from Windows Taskbar

// ******************************************************* //
// Hide Application Taskbar Button for Delphi <=2006
// ******************************************************* //

procedure TForm1.FormCreate(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE) ;
  SetWindowLong(Application.Handle, GWL_EXSTYLE, getWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW) ;
  ShowWindow(Application.Handle, SW_SHOW) ;
end;

// above code doesn't work on Delphi >=2007


// ******************************************************* //
// Hide Applicaton Taskbar Button for Delphi >=2007
// ******************************************************* //

// Menu->Project->View Source
program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := False;   // Change True to False, Default is True
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

// on Unit1.pas
procedure TForm1.FormActivate(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;

How to detect application idle time

// How To Track Application Idle Time

// Screen shot of the program

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TMainForm = class(TForm)
    Timer1: TTimer;
    Panel1: TPanel;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    function SecondsIdle:DWord;
    function SecToTime(Sec:Integer):string;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

{ TMainForm }

// ******************************************************** //
function TMainForm.SecondsIdle: DWord;
// from : http://delphi.about.com/od/adptips2004/a/bltip1104_4.htm
// ******************************************************** //
var
   liInfo: TLastInputInfo;
begin
   liInfo.cbSize := SizeOf(TLastInputInfo) ;
   GetLastInputInfo(liInfo) ;
   Result := (GetTickCount - liInfo.dwTime) DIV 1000;
end;

// ******************************************************** //
function TMainForm.SecToTime(Sec: Integer): string;
// from : http://delphi.about.com/cs/adptips2003/a/bltip0403_5.htm
// ******************************************************** //
var
   H, M, S: string;
   ZH, ZM, ZS: Integer;
begin
   ZH := Sec div 3600;
   ZM := Sec div 60 - ZH * 60;
   ZS := Sec - (ZH * 3600 + ZM * 60) ;
   H := IntToStr(ZH) ;
   M := IntToStr(ZM) ;
   S := IntToStr(ZS) ;
   Result := H + ':' + M + ':' + S;
end;

// ******************************************************** //
procedure TMainForm.Timer1Timer(Sender: TObject);
// ******************************************************** //
begin
  Panel1.Caption:='You are idle for : '+SecToTime(SecondsIdle);
end;

end.

Creating MDI Tabbed Interface (Sample)

// Creating MDI = Multiple Document Interface with Tabbed Interface (with Sample Codes)

 // Unit 1 Form

// Unit 2 Form

// Running Application

// Sample Code

unit Unit1;

interface

uses
     // ... please put your own...
type
  TMainForm = class(TForm)
    mdiChildrenTabs: TTabSet;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    procedure mdiChildrenTabsChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure MDIChildCreated(const childHandle : THandle);
    Procedure MDIChildDestroyed(const childHandle : THandle);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses Unit2;
// ****************************************************************************** //
procedure TMainForm.mdiChildrenTabsChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);  
// ****************************************************************************** //
var
  cHandle: Integer;
  k: Integer;
begin
  cHandle := Integer(mdiChildrenTabs.Tabs.Objects[NewTab]);

  if mdiChildrenTabs.Tag = -1 then Exit;

  for k := 0 to MDIChildCount - 1 do
  begin
    if MDIChildren[k].Handle = cHandle then
    begin
      MDIChildren[k].Show;
      Break;
    end;
  end;
end;

// ****************************************************************************** //
procedure TMainForm.ToolButton1Click(Sender: TObject);
// ****************************************************************************** //
var FormChild : TBaseChildForm;
begin
  FormChild:=TBaseChildForm.Create(nil);
  FormChild.Show;
end;

// ****************************************************************************** //
procedure TMainForm.MDIChildCreated(const childHandle: THandle);
// ****************************************************************************** //
begin
  mdiChildrenTabs.Tabs.AddObject(TForm(FindControl(childHandle)).Caption, TObject(childHandle));
  mdiChildrenTabs.TabIndex := -1 + mdiChildrenTabs.Tabs.Count;
end;

// ****************************************************************************** //
procedure TMainForm.MDIChildDestroyed(const childHandle: THandle);
// ****************************************************************************** //
var
  idx: Integer;
begin
  idx := mdiChildrenTabs.Tabs.IndexOfObject(TObject(childHandle));
  mdiChildrenTabs.Tabs.Delete(idx);
end;

end. 

// ********************************** Unit 2 *********************************** //

unit Unit2;

interface

uses
     // ... please put your own...

type
  TBaseChildForm = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure WMMDIACTIVATE(var msg : TWMMDIACTIVATE) ; message WM_MDIACTIVATE;
  public
    { Public declarations }
  end;

var
  BaseChildForm: TBaseChildForm;

implementation

{$R *.dfm}

uses Unit1;

{ TBaseChildForm }

// ****************************************************************************** //
procedure TBaseChildForm.Button1Click(Sender: TObject);
// ****************************************************************************** //
begin
  panel1.Caption:='Hello World';
end;

// ****************************************************************************** //
procedure TBaseChildForm.FormCreate(Sender: TObject);
// ****************************************************************************** //
begin
  MainForm.MDIChildCreated(self.Handle)
end;

// ****************************************************************************** //
procedure TBaseChildForm.FormDestroy(Sender: TObject);
// ****************************************************************************** //
begin
  MainForm.MDIChildDestroyed(self.Handle);
end;

// ****************************************************************************** //
procedure TBaseChildForm.FormClose(Sender: TObject; var Action: TCloseAction);
// ****************************************************************************** //
begin
  action:=caFree;
end;

// ****************************************************************************** //
procedure TBaseChildForm.WMMDIACTIVATE(var msg: TWMMDIACTIVATE);
// ****************************************************************************** //
var
  active: TWinControl;
  idx: Integer;
begin
  active := FindControl(msg.ActiveWnd) ;

  if Assigned(active) then
  begin
    idx := MainForm.mdiChildrenTabs.Tabs.IndexOfObject(TObject(msg.ActiveWnd));
    MainForm.mdiChildrenTabs.Tag := -1;
    MainForm.mdiChildrenTabs.TabIndex := idx;
    MainForm.mdiChildrenTabs.Tag := 0;
  end;
end;

end.

Friday, March 23, 2012

Set Tab Stops for TMemo

{
    Editor: TDBRichEdit;
    private
        Procedure SetMemoTabStop;
 }
      
// ************************************************************************ //
procedure TMainForm.FormCreate(Sender: TObject);
// ************************************************************************ //
begin
    SetMemoTabStop;
end;

// ************************************************************************ //
procedure TMainForm.SetMemoTabStop;
// ************************************************************************ //
// Codes Originally From : http://delphi.about.com/cs/adptips2001/a/bltip1201_2.htm   
// and modified by me to become Tab Per Character not Tab Per Pixels. 

var
   DialogUnitsX : LongInt;
   PixelsX : LongInt;
   i : integer;
   PixelPerCharExt : Extended;
   PixelPerCharInt : Integer;
   TabArray : array[0..4] of integer;
begin
   Editor.WantTabs := true;
   DialogUnitsX := LoWord(GetDialogBaseUnits) ;

   // must get pixels per characters...
   PixelPerCharExt:=(Editor.Font.Size / 72)*96;
   PixelPerCharInt:=Trunc(PixelPerCharExt);

   PixelsX := PixelPerCharInt*4; // tab. 4 character, just change 4 with anything you like.

   for i := 1 to 5 do begin
    TabArray[i - 1] :=
      ((PixelsX * i ) * 4) div DialogUnitsX;
   end;
   SendMessage(Editor.Handle,
               EM_SETTABSTOPS,
               5,
               LongInt(@TabArray)) ;
   Editor.Refresh;
end;

Monday, March 19, 2012

Create Firebird Database Programmatically

// To create Firebird Database programmatically
IBDatabase1.DatabaseName:=ChangeFileExt(Application.ExeName,'.fdb');
IBDatabase1.Params.Add('USER ''SYSDBA''');
IBDatabase1.Params.Add('PASSWORD ''masterkey''');
IBDatabase1.Params.Add('PAGE_SIZE 4096');
IBDatabase1.CreateDatabase;
IBDatabase1.Open;
   
// To open Firebird Database programmatically
IBDatabase1.DatabaseName:=ChangeFileExt(Application.ExeName,'.fdb');
IBDatabase1.Params.Add('USER_NAME=SYSDBA');
IBDatabase1.Params.Add('PASSWORD=masterkey');
IBDatabase1.Params.Add('PAGE_SIZE 4096');
IBDatabase1.Open;

Check wheter or not Firebird is running

// Don't forget to include the unit WinSvc.
// Call IsFirebirdRunning Function in your program :

// ********************************************************************************** //
Procedure TMainForm.FormCreate(Sender: TOBject);
// ********************************************************************************** //
Begin
    If not (IsFirebirdRunning) then ShowMessage('Firebird is not running');
End;

// ********************************************************************************** //
Function IsFirebirdRunning:boolean;
// ********************************************************************************** //
begin
    Result:=(ServiceGetStatus('','FirebirdServerDefaultInstance') = SERVICE_RUNNING);
end;

// ********************************************************************************** //
Function ServiceGetStatus(sMachine, sService: string ): DWord;
// ********************************************************************************** //
var
    schm,
    schs : SC_Handle;
    ss : TServiceStatus;
    dwStat : DWord;
begin
    dwStat := 0;

    schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);

    if (schm > 0) then
    begin
        schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);

        if (schs > 0) then
        begin
            if (QueryServiceStatus(schs, ss)) then
            begin
                dwStat := ss.dwCurrentState;
            end;
            CloseServiceHandle(schs);
        end;
        CloseServiceHandle(schm);
    end;
    Result := dwStat;
end;

Welcome to my Delphi Tips and Tricks Blog

Here you'll find Delphi Tips and Tricks that might be useful to you.