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.

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;

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.