Place text in the header or footer of a Word document

Problem/Question/Abstract:

Can someone tell me how to set the text in footers of MS Word documents programmatically from inside D5? I can create and open the document. I think it has to do with the BuiltInDocumentProperties. However, I cannot find a property for the document footer. Any ideas?

Answer:

Solve 1:

You can't access the header/ footer via BuiltInDocumentProperties. Use this instead:

Footer:

{ ... }
aDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);
aDoc.Sections.Item(1).Footers.Item(wdHeaderFooterPrimary).Range.Text :=
  'This is a footer';
{ ... }

Header:

{ ... }
aDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);
aDoc.Sections.Item(1).Headers.Item(wdHeaderFooterPrimary).Range.Text :=
  'This is a header';
{ ... }


Solve 2:

This works with Word 2000, and I can't remember it having changed since Word 97, anyway. If Doc is your Word document:

{ ... }
var
  Hdr: HeaderFooter;
  { ... }
  Hdr := Doc.Sections.Item(1).Headers.Item(wdHeaderFooterPrimary);
  Hdr.Range.Text := 'This is a header';
  { ... }

how to delete temporary Internet Files

Problem/Question/Abstract:

How to delete Temporary Internet files.

Answer:

uses
WinInet;

procedure DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
end;
FreeMem(lpEntryInfo, dwEntrySize);
FindCloseUrlCache(hCacheDir);
end;


// Beispiel:
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteIECache;
end;

Extract FileName from Url

Problem/Question/Abstract:

How can I extract a FileName from a URL?  For example http://www.domain.com/file.zip -> file.zip

Answer:

Solve 1:

function ExtractUrlFileName(const AUrl: string): string;
var
I: Integer;
begin
I := LastDelimiter('\:/', AUrl);
Result := Copy(AUrl, I + 1, MaxInt);
end;


Solve 2:

You will just have to parse the string manually, ie:

Filename := '../../afolder/anotherfolder/aFilename.ext';
Pos := LastDelimiter('/\', Filename);
if (Pos > 0) then
Filename := Copy(Pos + 1, Length(Filename) - Pos, Filename);


Solve 3:

Filename := '../../afolder/anotherfolder/aFilename.ext';
Filename := StringReplace(Filename, '/', '\', [rfReplaceAll]);
Filename := ExtractFileName(Filename);


Solve 4:

You can treat a string as an array of characters and index individual characters in it with array notation. That allows you to write a loop that checks characters starting from the end of the string and walking backwards. Once you find the start of the filename you can use the Copy function to isolate it.

function GetFilenameFromUrl(const url: string): string;
var
i: Integer;
begin
Result := EmptyStr; // be a realist, assume failure
i := Length(url);
while (i > 0) and (url[i] <> '.') do
dec(i);

if i = 0 then
Exit; // no filename separator found

if AnsiCompareText(Copy(url, i, maxint), '.exe') <> 0 then
Exit; // no .exe at end of url

// find next '.' before current position
dec(i);
while (i > 0) and (url[i] <> '.') do
dec(i);

if i = 0 then
Exit; // no filename separator found
Result := Copy(url, i + 1, maxint);
end;

Give a listbox a rounded border

Problem/Question/Abstract:

How to give a listbox a rounded border

Answer:

To round a ListBox use CreateRoundRectRgn to shape it. Reduce the client size to reposition back in place. Experiment with the rounding value. The greater the round value the smoother it is.

Add a TListBox to a form

procedure TForm1.RoundListbox(var TheList: TListbox);
const
schange = 5;
rnd = 20;
var
thergn: HRGN;
mclient: TRect;
begin
mclient := TheList.ClientRect; {get size}
thergn := CreateRoundRectRgn(mclient.Left, mclient.top, mclient.right,
mclient.bottom, rnd, rnd);
TheList.BorderStyle := bsNone;
InflateRect(mclient, -schange, -schange); {shrink}
TheList.Perform(EM_SETRECTNP, 0, lparam(@mclient)); {change}
SetWindowRgn(TheList.Handle, thergn, true);
end;

Minimize an application by pressing [ALT] [TAB]

Problem/Question/Abstract:

I would like to be able to minimize my application if the user presses [ALT] + [TAB]. Will I need to hook the keyboard for this? There is lot of code around to disable [ALT] [TAB] but nothing to detect it.

Answer:

This works on WinNT SP3+, Win2K and WinXP:

{ ... }
var
FHook: HHook = 0;

const
WH_KEYBOARD_LL = 13;
LLKHF_ALTDOWN = KF_ALTDOWN shr 8;

type
tagKBDLLHOOKSTRUCT = packed record
vkCode: DWord;
scanCode: DWord;
flags: DWord;
time: DWord;
dwExtraInfo: PDWord;
end;
TKBDLLHOOKSTRUCT = tagKBDLLHOOKSTRUCT;
PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
{ ... }

function LowLevelKeyboardProc(HookCode: Longint; MessageParam: WParam;
StructParam: LParam): DWord; stdcall;
var
SwitchingTask: Boolean;
P: PKBDLLHOOKSTRUCT;
begin
SwitchingTask := False;
if (HookCode = HC_ACTION) then
case (MessageParam) of
WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP:
begin
P := PKBDLLHOOKSTRUCT(StructParam);
SwitchingTask := ((P.VKCode = VK_TAB) and (P.Flags and LLKHF_ALTDOWN <> 0))
or
((P.VKCode = VK_ESCAPE) and ((P.Flags and LLKHF_ALTDOWN) <> 0)) or
((P.VKCode = VK_ESCAPE) and ((GetKeyState(VK_CONTROL)
and $8000) <> 0));
end;
end;
if SwitchingTask then
begin
{If you want to disable task switch just uncomment next two lines}
// Result := 1;
// Exit;
{If not, put your code here...}
Application.Minimize;
end;
Result := CallNextHookEx(0, HookCode, MessageParam, StructParam);
end;

procedure SetHook;
begin
FHook := SetWindowsHookEx(WH_KEYBOARD_LL, @LowLevelKeyboardProc, Hinstance, 0);
end;

procedure UnHook;
begin
if FHook > 0 then
UnHookWindowsHookEx(FHook);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
SetHook;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
UnHook;
end;

Connecting to Firebird DB

Problem/Question/Abstract:

How do i connect to a remote firebird database server?

Answer:

Firebird/Interbase Databases
A Firebird database is a single file - normally either *.fdb or *.gdb - all the tables are stored in that file.
To create a new alias, follow the instructions above, select the INTRBASE driver, and set the following parameters.

Property  Value  Comments
Server Name     This is the fully qualified *.fdb or *.gdb file
User Name  SYSDBA  For employee.gdb, the default password is masterkey

Warning:  If the focus is in an Opened Interbase/Firebird table when Object / New... is selected, it is possible that you will create a new table or a new field instead of a new alias.

To connect to a remote firebird server, you MUST include the drive letter after the computer name.

CompName:C:\Program Files\Common Files\Borland Shared\Data\employee.gdb

The Interbase help says that the following format is also acceptable in ISQL - but it definitely does NOT work in the Database Explore.
\\CompName\C:\Program Files\Common Files\Borland Shared\Data\employee.gdb

Firebird is the open source version of Borland's Interbase database server.

.

Write multiple values to a bookmark in Word

Problem/Question/Abstract:

How can I add rows at the end of a wordtable even when I have vertically merged cells? I always receive the error message "cannot access individual rows in this collection because the table has vertically merged cells"! The recorded word macro simple add a row by "selection.insertrows 1", but I have problems converting this into a Delphi statement (defining the right selection etc.).

Answer:

I've been automating MS Word, using bookmarks. Sometimes I need to write multiple values to one bookmark. I pass the values to the following routine as comma-text in the AValue parameter. It works fine with D5 using the Word97 unit and MS Word 2000 executable. Hope it helps.

{ ... }
FMSWord := CreateComObject(CLASS_WordApplication) as WordApplication;
{ ... }

procedure TLTWordDocHandler.PopulateListBookMark(const ABookMarkName:
  string; const AValue: Widestring);
var
  i: integer;
  LBMName: OleVariant;
  MoveUnit: OleVariant;
  NumRows: OleVariant;
  WorkingList: TStringList;
begin
  LBMName := ABookMarkName;
  FMSWord.ActiveDocument.Bookmarks.Item(LBMName).Select;
  if FMSWord.Selection.Tables.Count = 0 then
    raise Exception.Create(Format(sBookmarkNotInTable, [ABookmarkName]));
  MoveUnit := wdCell;
  NumRows := 1;
  WorkingList := TStringList.Create;
  try
    WorkingList.CommaText := AValue;
    for i := 0 to WorkingList.Count - 1 do
    begin
      FMSWord.Selection.TypeText(WorkingList.Strings[i]);
      if not (i = (WorkingList.Count - 1)) then
        FMSWord.Selection.MoveRight(MoveUnit, EmptyParam, EmptyParam);
          {97 & 2000 compliant}
    end;
  finally
    FreeAndNil(WorkingList);
  end;
end;

Web Pages about developing Winhelp and HTML help files

Problem/Question/Abstract:

Web Pages about developing Winhelp and HTML help files

Answer:

Helpmaster
Web site with lots of Winhelp/ HTML Help related information and links

Helpware Home Page
A web site focussing on HTML help

HTML Help Center
Samples, source code and tools for working with HTML Help

MSDN Online Library
Official Microsoft page with extensive information on HTML help

Richard Hendricks' Windows Help File Authoring Web Site
Many links to WinHelp and HTML Help related sources

VizAcc
Home of Help Jotter - a commercial WYSIWYG Windows help authoring tool creating all types of help files and printed manuals from the same data

Winhelp.net
Tips and information about developing Winhelp and HTML help files

WinWriters
Winhelp/ HTML Help related links and online help journal

Speed up some queries on my Microsoft SQL Server

Problem/Question/Abstract:

What can I do to speed up some queries on my Microsoft SQL Server?

Answer:

I have found that queries like:

select * from table1 innerjoin table2 on table1.field=table2.field

...sometimes will query quickly, but takes time to return a result.

The solution I have found to work is to insert the first query to a temporary table, then query the second, like:


select * into #temptable from table1 innerjoin table2 on table1.field=table2.field

select * from #temptable


The "#temptable" can be anything starting with the pound sign.  The temporary table will be released when your connection is closed.

I have found what I think is the answer here-- table locking.
When I query active tables, I fight with other applications having locks on various rows and tables.  When the query takes part into a temporary table, the lock is not there.

This article then has a really silly premise, I concur.

What should be used rather than temporary tables in a select statement is the "with (nolock)" feature that does a dirty read. Like:

select * from BigTable with (nolock)

rather than:
select * into #tempTable from BigTable

Format Float with Comma

Problem/Question/Abstract:

Format Float with Comma

Answer:

function FormatNum(Value: Extended; Decimal: Integer): string;
var
  SLen, SPos: Integer;
  SVal: string;
begin
  Str(Value: 0: Decimal, SVal);
  SLen := Length(SVal);
  if Decimal = 0 then
    SPos := SLen - 2
  else
    SPos := SLen - (Decimal + 3);
  while SPos > 1 do
  begin
    Insert(',', SVal, SPos);
    SPos := SPos - 3;
  end;
  Result := SVal;
end;

Also, you can simply do this:

i: Extended;
s: string;

i := 1000.123456;
s := Format('%.2n', [i]);

The value of s will be 1,000.12

You can also add your own characters, so you could do something like this:

s := Format('$%.2n', [i]);

This would output $1,000.12

So, good luck in your number to string formatting.

Next Position of a sub-string in a string

Problem/Question/Abstract:

The Pos funciton of Delphi returns the first occurence of a sub string within a string, only. How to get the positions of the next occurences?

Answer:

Solve 1:

This solution was developed using Borland Delphi 5 Service Pack 1. It is based upon the Pos algorithm delivered by Borland within the Systems unit, completely written in Assembler. !!!It might work with other versions of Borland Delphi (3.x, 4.x, 5.0) but has not been tested on them!!!

The syntax is similar to the syntax of the Pos function supplied by Delphi:

function NextPos(Substr: string; S: string; LastPos: DWORD = 0): DWORD;

NextPos returns the index value of the first character in a specified substring that occurs in a given string starting after the index value supplied by LastPos. LastPos may be omitted.

Note: As LastPos you should pass the position of the last occurence, not last position + 1. Just for convinience.

Here the commented Code:

function NextPos(SubStr: AnsiString; Str: AnsiString; LastPos: DWORD
  = 0): DWORD;
type
  StrRec = packed record
    allocSiz: Longint;
    refCnt: Longint;
    length: Longint;
  end;
const
  skew = sizeof(StrRec);

  asm
  // Search-String passed?
  TEST    EAX,EAX
  JE      @@noWork

  // Sub-String passed?
  TEST    EDX,EDX
  JE      @@stringEmpty

   // Save registers affected
PUSH ECX
PUSH EBX
PUSH ESI
PUSH EDI

// Load Sub-String pointer
MOV ESI, EAX
// Load Search-String pointer
MOV EDI, EDX
// Save Last Position in EBX
MOV EBX, ECX
// Get Search-String Length
MOV ECX, [EDI - skew].StrRec.length
// subtract Start Position
SUB ECX, EBX
// Save Start Position of Search String to return
PUSH EDI
// Adjust Start Position of Search String
ADD EDI, EBX
// Get Sub-String Length
MOV EDX, [ESI - skew].StrRec.length
// Adjust
DEC EDX
// Failed if Sub-String Length was zero
JS@@fail
// Pull first character of Sub-String for SCASB function
MOV AL, [ESI]
// Point to second character for CMPSB function
INC ESI
// Load character count to be scanned
SUB ECX, EDX
// Failed if Sub-String was equal or longer than Search-String
JLE@@fail
@@loop:
// Scan for first matching character
REPNE SCASB
// Failed, if none are matching
JNE@@fail
// Save counter
MOV EBX, ECX
PUSH ESI
PUSH EDI
// load Sub-String length
MOV ECX, EDX
// compare all bytes until one is not equal
REPE CMPSB
// restore counter
POP EDI
POP ESI
// all byte were equal, search is completed
JE@@found
// restore counter
MOV ECX, EBX
// continue search
JMP@@loop
@@fail:
// saved pointer is not needed
POP EDX
xor EAX, EAX
JMP@@exit
@@stringEmpty:
// return zero - no match
xor EAX, EAX
JMP@@noWork
@@found:
// restore pointer to start position of Search-String
POP EDX
// load position of match
MOV EAX, EDI
// difference between position and start in memory is
//   position of Sub
SUB EAX, EDX
@@exit:
// restore registers
POP EDI
POP ESI
POP EBX
POP ECX
@@noWork:
end;


Solve 2:

PosEx function:

function PosEx(SubStr: string; s: string; Index: DWord): DWord;
var
  I: Integer;
begin
  I := Pos(SubStr, Copy(s, Index, Length(s) - Index + 1));
  if I <> 0 then
    I := I + Index - 1;
  Result := I;
end;

The prarameter Index is the position you want to begin to search substr in s.

How to scroll a TTreeView?

Problem/Question/Abstract:

How to scroll a TTreeView?

Answer:

procedure TForm1.FormMouseWheelUp(Sender: TObject;
  Shift: TShiftState;
  MousePos: TPoint;
  var Handled: Boolean);

var
  iPos: Integer;

begin
  iPos := GetScrollPos(Form1.TreeView1.Handle, SB_VERT);
  SetScrollPos(Form1.TreeView1.Handle, SB_VERT, iPos - 1, True);
  // Don't set Handled to True otherwise the scrollbar scrolls
  // but the content of the TreeView does NOT scroll!
  // I have not found a way to check if the TreeView has a scrollbar or not.
  // Maybe if you first call:
  // GetScrollRange(Form1.TreeView1.Handle, SB_VERT,lpMinPos,lpMaxPos);
  // and then:
  // if MaxPos = 0 and MinPos = 0 then there is no vertical scrollbar
  // if MaxPos <> 0 then there is a vertical scrollbar
end;

Draw the caption of a TForm programmatically

Problem/Question/Abstract:

I need to be able to draw the text in a TForm's caption area manually, without using WM_SETTEXT (setting the TForm's Caption property, or using the API call SetWindowText, both use this method so they are unsuitable). I need functionality similar to DrawText where the text is drawn directly rather than sent to a message handler. Can anyone help?

Answer:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure WriteTexttoDC(WinHandle: HWND; Text: string; X, Y: Integer);
var
  DC: HDC;
begin
  DC := GetWindowDC(WinHandle);
  ExtTextOut(DC, 1, 1, ETO_CLIPPED, nil, PChar(Text), Length(Text), nil);
  ReleaseDC(WinHandle, DC);
end;

procedure TForm1.WMPaint(var Message: TWMPaint);
begin
  WriteTexttoDC(Handle, 'Is it OK?', 5, 5);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  WriteTexttoDC(Handle, 'Is it OK?', 5, 5);
end;

end.

How to create a Paradox table with an AutoInc field at runtime

Problem/Question/Abstract:

How do I create a Paradox table with an Auto Increment type field programmatically? I'm using TTable.CreateTable, but TFieldType doesn't include this type.

Answer:

Use a TQuery and SQL CREATE TABLE statement. For example:

procedure TForm1.Button1Click(Sender: TObject);
begin
  with Query1 do
  begin
    DatabaseName := 'DBDemos';
    with SQL do
    begin
      Clear;
      Add('CREATE TABLE "PDoxTbl.db" (ID AUTOINC,');
      Add('Name CHAR(255),');
      Add('PRIMARY KEY(ID))');
      ExecSQL;
      Clear;
      Add('CREATE INDEX ByName ON "PDoxTbl.db" (Name)');
      ExecSQL;
    end;
  end;
end;