Create a TStringGrid with one column of runtime created buttons in it

Problem/Question/Abstract:

I want the following: A StringGrid with 1 column of buttons in it. The number of rows in the grid is not known at design time, so the buttons are created at runtime.

Answer:

TSpeedButton will work and you won't have to worry about the TabStop. The problem with using the Rect that comes in as a param, it doesn't hit all the cells in the column. So what you end up with is buttons displaying in the wrong cells. If it doesn't matter, then you're ok. But if it does, then you'll need to update the entire column for all the visible cells. Here's what I came up with:

{ ... }
var
  HelpButtons: array of TSpeedButton;

procedure Form1.CreateTheButtons;
var
  i: Integer;
begin
  SetLength(HelpButtons, ParamGrid.RowCount - 1);
  for i := 0 to ParamGrid.RowCount - 2 do
  begin
    HelpButtons[i] := TSpeedButton.Create(Self);
    HelpButtons[i].Visible := False;
    HelpButtons[i].Parent := ParamGrid;
    HelpButtons[i].Caption := IntToStr(i) + ' ?';
    HelpButtons[i].Width := 34;
    HelpButtons[i].Height := 18;
    HelpButtons[i].Tag := i;
    HelpButtons[i].OnClick := ParamGridButtonClick;
  end;
  {Force the buttons to show}
  ParamGrid.Refresh;
end;

procedure TForm1.ParamGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

  procedure UpdateTheColumn;
  var
    i: Integer;
    R: TRect;
  begin
    for i := ParamGrid.TopRow to (ParamGrid.VisibleRowCount + ParamGrid.TopRow) do
    begin
      if i >= ParamGrid.RowCount then
        Break;
      R := ParamGrid.CellRect(2, i);
      HelpButtons[i - 1].Top := R.Top;
      HelpButtons[i - 1].Left := R.Left;
      if not HelpButtons[i - 1].Visible then
        HelpButtons[i - 1].Visible := True;
    end;
  end;

begin
  if Length(HelpButtons) = 0 then
    Exit;
  if not FRefresh then
    Exit;
  if ((ACol = 2) and (ARow > 0)) then
  begin
    UpdateTheColumn;
  end;
end;

procedure TForm1.ParamGridButtonClick(Sender: TObject);
begin
  ShowMessage('Click ' + Sender.ClassName + ' ' + IntToStr(TControl(Sender).Tag));
end;

Incremental Searches with a TListbox

Problem/Question/Abstract:

How can I create a form that has a list box that I can perform an incremental search on?

Answer:

There are a couple of ways to do this. One's hard and slow, the other easy and fast (we're going to take the easy and fast option).

For those of you who aren't familiar with incremental searching with list boxes, the concept is simple: A user types part of a string into an edit box, then the list box automatically selects one of its items that most closely matches the value typed by the user. For example of this, open up any topic search dialog in a Windows Help file. If you type into the edit box, the list will scroll to the value that most closely matches what you type.

Why is creating a capability like this essential? Because it's tedious to scroll through a list that has lots of items. Imagine if a list contained hundreds of unsorted items. To get to the value you're looking for would take a long time if you only had the capability of scrolling through the list using the vertical scroll bar. But if you knew at least part of the value you're trying to find, entering it into an edit box and getting the item you want immediately is a much more attractive solution.

Let's delve into what you have to do make this work. First, here's the unit code for a sample form I produced:

unit uinclist;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
{This is a test string to load into the list box at runtime}
const
  ListStrings = 'United States'#13'Guatemala'#13'Mexico'#13 +
    'El Salvador'#13'Costa Rica'#13'Yucatan'#13 +
    'China'#13'Japan'#13'Thailand'#13'Switzerland'#13 +
    'Germany'#13'Lichtenstein'#13'Jamaica'#13'Greece' +
    'Turkey'#13'Ireland'#13'United Kingdom'#13'Scotland' +
    'Canada'#13'Uruguay'#13'Paraguay'#13'Cuba'#13 +
    'Spain'#13'Italy'#13'France'#13'Portugal'#13'New Zealand'#13 +
    'Austria'#13'Australia'#13'Philippines'#13'Korea'#13 +
    'Malaysia'#13'Tibet'#13'Nepal'#13'India'#13'Sri Lanka'#13 +
    'Pakistan'#13 + 'Saudi Arabia'#13'United Arab Emerates'#13'Iran'#13 +
    'Ukraine'#13'Belarus'#13 +
    'Chechen'#13'Yugoslavia'#13'Czechoslovakia'#13'Slovina'#13'Kazakhstan'#13 +
    'Egypt'#13'Morocco'#13'Macedonia'#13'Cyprus'#13'Finland'#13 +
    'Norway'#13'Sweden'#13'Denmark'#13'Netherlands'#13'Lithuania'#13;
begin
  ListBox1.Items.SetText(ListStrings);
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
  S: array[0..255] of Char;
begin
  StrPCopy(S, Edit1.Text);
  with ListBox1 do
    ItemIndex := Perform(LB_SELECTSTRING, 0, LongInt(@S));
end;

end.

Form1 has two controls: a TEdit and a TListBox. Notice that during FormCreate, I loaded up the value of the list box with the huge string of countries. This was only for testing purposes. How you load up your list is up to you. Now, the trick to making the incremental search is in the OnChange event of Edit1. I've used the Windows message LB_SELECTSTRING to perform the string selection for me. Let's talk about the message.

LB_SELECTSTRING is one of the members of the WinAPI list box message family (all preceeded by LB_) that manipulates all aspects of a list box object in Windows. The message takes two parameters: wParam, the index from which the search should start; and lParam, the address of the null-terminated string to search on. Since WinAPI calls require null-terminated strings, use either a PChar or an Array of Char to pass string values. It's more advantageous to use a an Array of Char if you know a string value won't exceed a certain length. You don't have to manually allocate and de-allocate memory with an Array of Char, as opposed to a PChar that requires you to use GetMem or New and FreeMem to allocate and de-allocate memory.

In any case, to convert a Pascal string to a null-terminated string, just use StrPCopy to copy the contents of the Pascal string into the null-terminated string. Once that's done, all we have to do is pass the address of the null- terminated string into the wParam parameter of LB_SELECTSTRING, and that's done by using the @ symbol.

When we use Perform to execute the LB_SELECTSTRING message, the message will return the item index of the matching list item. Then all that's left to do is assign the ItemIndex property of the list box to the return value of the message. The net result is that the list box will scroll to and select the list element that was found.

There are several list box messages you can perform in Delphi. If you bring up the help system and do a topic search, enter LB_ in the edit box, and peruse the list of messages.

Delphi Expert Eddie Shipman adds the following useful information:

This procedure can be applied to TComboBox by changing to this code:

procedure TForm1.ComboBox1Change(Sender: TObject);
var
  S: array[0..255] of Char;
begin
  StrPCopy(S, TComboBox(Sender).Text);
  with ComboBox1 do
    ItemIndex := Perform(CB_SELECTSTRING, 0, LongInt(@S));
end;

FoxPro limits

Problem/Question/Abstract:

FoxPro limits

Answer:

Table and Index Files
Max. # of records per table
1 billion*
Max. # of chars per record
65,000
Max. # of fields per record
255
Max. # of open DBFs
225
Max. # of chars per field
254
Max. # of chars per index key (IDX)
100
Max. # of chars per index key (CDX)
240
Max. # of open index files per table
unlimited**
Max. # of open index files in all work areas
unlimited**

* The actual file size (in bytes) cannot exceed 2 gigabytes for single-user or exclusively opened multi-user tables. Shared tables with no indexes or .IDX indexes cannot exceed 1 gigabyte. Shared tables with structural .CDX indexes cannot exceed 2 gigabytes.
** Limited by memory. In FoxPro for MS-DOS and FoxPro for Windows, also limited by available MS-DOS file handles. Each .CDX file uses only 1 file handle. The number of MS-DOS file handles is determined by the CONFIG.SYS FILES parameter.
Field Characteristics
Max. size of character fields
254
Max. size of numeric fields
20
Max. # of chars in field names
10
Digits of precision in numeric computations
16

How to create tables in Word

Problem/Question/Abstract:

Is is possible to create a table in Word via OLE Automation and to specify the value of each cell?

Answer:

Yes. If Doc is a TWordDocument, for example:

{ ... }
var
  Tbl: Table;
  R: Range;
  Direction: OleVariant;
  { ... }
Direction := wdCollapseEnd;
R := Doc.Range;
R.Collapse(Direction);
Tbl := Doc.Tables.Add(R, 2, 4, EmptyParam, EmptyParam);
Tbl.Cell(1, 1).Range.Text := 'Row 1, Col 1';
Tbl.Cell(1, 2).Range.Text := 'Row 1, Col 2';

But doing things with individual table cells in Word is extremely slow. If you can, it's better to enter the data as (for example) comma-separated values and convert it into a table only as the last step. Here's an example:

{ ... }
const
  Line1 = 'January,February,March';
  Line2 = '31,28,31';
  Line3 = '31,59,90';
var
  R: Range;
  Direction, Separator, Format: OleVariant;
{ ... }
R := Word.Selection.Range;
Direction := wdCollapseEnd;
R.Collapse(Direction);
R.InsertAfter(Line1);
R.InsertParagraphAfter;
R.InsertAfter(Line2);
R.InsertParagraphAfter;
R.InsertAfter(Line3);
R.InsertParagraphAfter;
Separator := ',';
Format := wdTableFormatGrid1;
R.ConvertToTable(Separator, EmptyParam, EmptyParam, EmptyParam, Format, EmptyParam,
  EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
  EmptyParam, EmptyParam);
{ ... }

How to calculate the minimum distance between two polygons

Problem/Question/Abstract:

Do you know how to calculate the minimum distance between two polygons if they don't overlap?

Answer:

Well, this is rather complex. I start with the basics (don't know if you already know). I use UPPER letters for vectors and lower letters for numbers. Well, and sorry that I repeat some things, I wrote the text and realized I forgot something you have to know for a later step, so I went back and added it, I didn't write this text line by line. If something isn't clear to you, I recommend to make some small drawings, I had to do many, too.

A plane is defined by (X - P) * N = 0 where P is a vector to any point in your plane and N is the normal vector of your plane. Sometimes another definition is used, which is easier to gain if you have the corners of a polygon: X = P + a * A + b * B (a, b are any real numbers). If you know 3 Points X1, X2, X3 of the plane (3 corners of the polygon), you can get A and B by A = X2 - X1 (subtract each component of the vector from the same component of the other vector) and B = X3 - X1 (and you can use P = X1).

Unfortunately this definition is not good to calculate distances, so you have to get N out of A and B. A * N must be 0 and B * N must be 0 (which means a1 * n1 + a2 * n2 + a3 * n3 = 0 and b1 * n1 + b2 * n2 + b3 * n3 = 0). Sorry I cannot remember how to do this, but you have 2 equations with three unknown variables, so you can choose one of them as you want (just be careful with 0 and not 0), the only difference is that the resulting N differs in its length.

A line is defined by X = P + v * V where P is any one point of your line and V is the line's direction (like A and B of the plane). Again if you know two points X1 and X2 of your line you get V by V = X2 - X1(and you can use P = X1).

The length of a vector V = (v1, v2, v3) is length = sqrt(sqr(v1) + sqr(v2) + sqr(v3)) (just 3-dimensional Pythagoras).

You add two vectors A = (a1, a2, a3) and B = (b1, b2, b3) like that: A + B = (a1 + b1, a2 + b2, a3 + b3) (which is a vector again).

You multiply two vectors A = (a1, a2, a3) and B = (b1, b2, b3) like that: A * B = (a1 * b1 + a2 *b2 + a3 * b3) (which is a NUMBER).

Use following formula to get the distance between any one point X and a plane: dist = 1 / n * (X - P) *N where X is a vector to the point you want to examine and n is the length of N (you don't need 1/n if N has alread length of 1). If X is (x1, x2, x3) this is

dist = 1 / n * ((x1 - p1) * n1 + (x2 - p2) * n2 + (x3 - p3) * n3)
n = sqrt(sqr(n1) + sqr(n2) + sqr(n3))

Now the distance between two polygons isn't that simple, because there are many different cases (and a polygon is more than just a simple plane, even if it's size is smaller).

What you also need is to calculate the distance between two lines. At first you need a plane, that is parallel to both lines and includes one of the lines:

P(plane) = P(line1)
A(plane) = V(line1)
B(plane) = V(line2)

where A and B are two vectors in the plane (N * A = 0 and N * B = 0), V is a vector in your line (for polygons, you can take V = X2 - X1 where X2 and X1 are two corners). Now calculate the distance between this plane and any one point of line2 using the formula above (any point because ALL points have the same distance to a plane that's parallel to the line - nice trick, isn't it?

The last thing we need is not only the minimum distance between two lines, but the points of the lines, that have minimum distance. You can do this (for the point of line1 M1 with minimum distance to line2) by calculating a plane again with

P(secondplane) = P(line2)
A(secondplane) = V(line2)
B(secondplane) = N(plane) <-- the plane we calculated above

The second plane includes line2 and the point of line1 with the minimum distance to line2. To get this point of minimum distance, set P(line1) + v * V(line1) = P(secondplane) + a * A(secondplane) + b * B(secondplane). Solve this, you should get the v and when you set this v into X = P + v * V of line1 you have the point X (=M1) of minimum distance.

The bad news: To get M2, you have to repeat this for line2. Another way would be to take the distance between the lines (I call it d) and do following: M2 = M1 + d * 1 / n * N(plane) (or M2 = M1 - d * 1 / n * N(plane), depends on the direction of N). The distance between two points X1 and X2 equals the length of the vector X2 - X1.

Okay, these were the basics. Now the different cases, you have to cope with:



1.) The planes of both polygons are parallel (N1 = x * N2):

Transform both polygons the following way: X' = X - P for each corner of the polygon (where P is any point in your plane). The new polygons should now be in the same plane. Test whether both polygons overlap (is not as simple as it sounds, to be honest I don't know how to do that).



1a) They overlap:

The minimum distance is the distance of the two planes (take any one point of one plane and use the formula above to get the distance to the other plane).



1b) They do not overlap:

Use 2) to calculate the minimum distance



2) The planes are not parallel (or case 1b):

Calculate the minimum distance of one line of one polygon and one line of the other polygon. Calculate the points of minimum distance from the lines. The edges of the polygons do not have infinite length (the lines do have), so check whether the points of minimum distance are within the polygons (I'd better say: within the edges of the polygons).



2a) Both points are within the polygons:

Store the minimum distance from the lines.



2b) One point or both points are not within the polygon:

Take the corner(s) of the polygon(s) within the line(s) you checked next to the point(s) of minimum distance. Calculate the distance between these points and store it. Now repeat this for each pair of lines (if you have 2 triangles you get 9 combinations (3 times 3). When you are ready compare all the minimum distances and take the smallest one.



Okay, this is quite much to do (realtime? difficult. perhaps if you don't have many polygons) and there are several problems (a vector (x1, x2, x3) and a vector (x1, x2, 0) may have to be treated different, for example when you try to get N out of A and B). If you really need the minimum distance, try it, but perhaps you find an easier way, that is not that exact (take the distance between the center of each polygon would be least exact, but very much easier).

I want to add, that I don't know of other solutions, perhaps there are better ones, and that I don't know if everything I told you is right, I haven't tested it, everything is just theoretically.

How to load a bitmap from a resource file without losing its palette

Problem/Question/Abstract:

How to load a bitmap from a resource file without losing its palette

Answer:

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
  HResInfo: THandle;
  BMF: TBitmapFileHeader;
  MemHandle: THandle;
  Stream: TMemoryStream;
  ResPtr: PByte;
  ResSize: Longint;
begin
  BMF.bfType := $4D42;
  HResInfo := FindResource(HInstance, 'BITMAP_2', RT_Bitmap);
  ResSize := SizeofResource(HInstance, HResInfo);
  MemHandle := LoadResource(HInstance, HResInfo);
  try
    ResPtr := LockResource(MemHandle);
    Stream := TMemoryStream.Create;
    try
      Stream.SetSize(ResSize + SizeOf(BMF));
      Stream.Write(BMF, SizeOf(BMF));
      Stream.Write(ResPtr^, ResSize);
      Stream.Seek(0, 0);
      Bmp := TBitmap.Create;
      try
        Bmp.LoadFromStream(Stream);
        Canvas.Draw(0, 0, Bmp);
      finally
        Bmp.Free;
      end;
    finally
      Stream.Free;
    end;
  finally
    FreeResource(MemHandle);
  end;
end;

Drag a row from a TDBGrid to a TMemo

Problem/Question/Abstract:

I have a TDBGrid with several rows of data in it. Is it possible to be able to drag one of the rows off of the grid and drop it on another control?

Answer:

procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if DragDetect(DBGrid1.Handle, Point(x, y)) then
    DBGrid1.BeginDrag(False);
end;

procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source = DBGrid1;
end;

procedure TForm1.Memo1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  i: Integer;
begin
  Memo1.Clear;
  for i := 0 to DBGrid1.Columns.Count - 1 do
    Memo1.Lines.Add(DBGrid1.Columns[i].Field.AsString);
  {or use DataSet}
end;

How to set a system-wide font for dialogs

Problem/Question/Abstract:

I have a custom dialog. So far I have set the font to Verdana. What I would like to do is to be able to set the dialog font to the one that's currently being used.

Answer:

This code sets the font of dialogs system-wide to Verdana:

procedure TForm1.Button1Click(Sender: TObject);
var
  ncm: TNonClientMetrics;
begin
  ncm.cbSize := SizeOf(TNonClientMetrics);
  {get old non client metrics}
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(TNonClientMetrics), @ncm, 0);
  {lfCaptionFont - regular captions
  lfSmCaptionFont - small captions
  lfMenuFont - menus
  lfStatusFont - status bars
  lfMessageFont - message boxes}
  ncm.lfMessageFont.lfFaceName := 'Tahoma';
  {set new non client metrics}
  SystemParametersInfo(SPI_SETNONCLIENTMETRICS, SizeOf(TNonClientMetrics), @ncm, 0);
end;

How to capture the Desktop and shade it

Problem/Question/Abstract:

How to capture the Desktop and shade it

Answer:

This unit takes the Desktop and makes it look like it does when you select Shutdown from the Start menu. You need a TForm with BorderStyle set to bsNone and a TImage component set to alClient.

procedure TForm1.FormShow(Sender: TObject);

  procedure Veil;
  var
    BrushBmp: TBitmap;
    X, Y: Integer;
  begin
    BrushBmp := TBitmap.Create;
    with BrushBmp do
    begin
      Width := 8;
      Height := 8;
      for X := 0 to 7 do
        for Y := 0 to 7 do
          if Odd(X + Y) then
            Canvas.Pixels[X, Y] := clWhite
          else
            Canvas.Pixels[X, Y] := clBlack;
    end;
    Image1.Canvas.Brush.Bitmap := BrushBmp;
    {The PatBlt function paints the given rectangle using the brush that is
                currently selected into the specified device context.
                The brush color and the surface color(s) are combined by using the
    given raster operation.}
    PatBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, $000A0329);
    BrushBmp.Free;
  end;

var
  ScreenDC: HDC;
  tmpRect: TRect;
  tmpBitmap: TBitmap;
begin
  {Set the form bounds}
  SetBounds(0, 0, Screen.Width, Screen.Height);
  {get our screen device context}
  ScreenDC := GetDC(0);
  {create our bitmap}
  tmpBitmap := TBitmap.Create;
  {get the screen area}
  tmpRect := Rect(0, 0, Screen.Width, Screen.Height);
  {set the bitmap to the screen area}
  tmpBitmap.Width := tmpRect.Right - tmpRect.Left;
  tmpBitmap.Height := tmpRect.Bottom - tmpRect.Top;
  try
    {transfer the screen pixels to the bitmap}
    BitBlt(tmpBitmap.Canvas.Handle, tmpRect.Left, tmpRect.Top, tmpBitmap.Width,
      tmpBitmap.Height, ScreenDC, tmpRect.Left, tmpRect.Top, SRCCOPY);
    {assign the bitmap image to our TImage}
    Image1.Picture.Bitmap.Assign(tmpBitmap);
  finally
    {free our bitmap}
    tmpBitmap.Free;
    {release our screen device context}
    ReleaseDC(0, ScreenDC);
  end;
  Veil;
end;

end.

Disable the close button on a floating dock form

Problem/Question/Abstract:

I want to know how to prevent an undocked control from destroying when I clicked on the X shaped close button on the right corner.

Answer:

You have to create your own docksite form:

type
  TNoCloseDockform = class(TCustomDockForm)
  private
    procedure WMSysCommand(var msg: TWMSyscommand); message WM_SYSCOMMAND;
  end;

  { TNoCloseDockform }

procedure TNoCloseDockform.WMSysCommand(var msg: TWMSyscommand);
begin
  if (msg.CmdType and $FFF0) = SC_CLOSE then
    Msg.result := 0
  else
    inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  panel1.FloatingDockSiteClass := TNoCloseDockform;
end;

Obtain the actual IP address

Problem/Question/Abstract:

How to obtain the actual IP address

Answer:

Solve 1:

uses
  Winsock;

function GetLocalIPs: string;
type
  PPInAddr = ^PInAddr;
var
  wsaData: TWSAData;
  HostInfo: PHostEnt;
  HostName: array[0..255] of Char;
  Addr: PPInAddr;
begin
  Result := '';
  if WSAStartup($0102, wsaData) <> 0 then
    exit;
  try
    if gethostname(HostName, SizeOf(HostName)) <> 0 then
      exit;
    HostInfo := gethostbyname(HostName);
    if HostInfo = nil then
      exit;
    Addr := Pointer(HostInfo^.h_addr_list);
    if (Addr = nil) or (Addr^ = nil) then
      exit;
    Result := StrPas(inet_ntoa(Addr^^));
    inc(Addr);
    while Addr^ <> nil do
    begin
      Result := Result + ^M^J  + StrPas(inet_ntoa(Addr^^));
      inc(Addr);
    end;
  finally
    WSACleanup;
  end;
end;


Solve 2:

uses
  winsock;

function localIP: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  I: Integer;
begin
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then
    Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
  begin
    result := StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
end;


Solve 3:

You can use the following code to retrieve your local addresses:

uses
  winsock;

procedure GetAllLocalIPs(var Address: string);
type
  TaPInAddr = array[0..255] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  pptr: PaPInAddr;
  I: Integer;
  WSAData: TWSAData;
  HostEnt: PHostEnt;
  Name: string;
begin
  Address := '';
  WSAStartup(MakeWord(1, 1), WSAData);
  SetLength(Name, 255);
  GetHostName(PChar(Name), 255);
  SetLength(Name, StrLen(PChar(Name)));
  HostEnt := GetHostByName(PChar(Name));
  with HostEnt^ do
  begin
    pptr := PaPInAddr(HostEnt^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do
    begin
      Address := Address + StrPas(inet_ntoa(pptr^[I]^)) + ';  ';
      Inc(I);
    end;
  end;
  WSACleanup;
end;

How to send files across the internet using FTP

Problem/Question/Abstract:

If I wish to send files to an FTP server how difficult is it to do?

Answer:

After HTTP, FTP is possibly the most used protocols. It allows files to be transferred to and from FTP servers. The only disadvantage with using FTP is that the username and password are sent unencrypted in plain text. Even Internet Explorer can handle FTP.

The FTP protocol is reasonably easy to implement if you know how to use Winsock, but it has already been done by many people so this is probably one wheel you do NOT need to reinvent. The following list includes source code and they are free. ICS (Francois Piette&#8217;s superb library at (http://overbyte.delphicenter.com/frame_index.html), Winshoes or Indy as it is now known (and soon to be included in Delphi 6 I believe) at http://www.nevrona.com/Indy/ and MonsterFtp which is on www.torry.net on the Internet part of the VCL section under FTP.

Of these I tried Monster FTP but found a bug using it within a firewall, but Winshoes version 7 (8 is now being released as Indy) worked fine and the code shown below shows just how simple it is to upload files using the FTP. I haven&#8217;t tried ICS or any other kits so apologies if I overlooked any.

For any FTP account you need the following:
Username
Password
Server URL (ftp:// &#8230;) or IP Address
And optionally, a folder to change to, after the connection is established.

In the code below, ftpObject is a Winshoes TSimpleFTPObject.FtpUpload is a record or class containing Server (Ip Address or Name), Username, Password, Timeout (in milliseconds) and optionally Directory (to change into).  The file transferred is passed in as FilenametoSend.Just add your own error Procedure to deal with errors.

procedure Error(const ErrorString: string);

Depending on the type of file transferred you may wish to transfer files as binary or as Ascii. The only difference is that Ascii transferred files have Carriage Return/Line Feeds added or stripped (according to direction of flow) if between Unix systems and Windows.

Note this needs to be slotted into a procedure or Method.


try
  FtpObject.Hostname := FtpUpload.Server;
  FtpObject.Username := FtpUpload.Username;
  FtpObject.Password := FtpUpload.Password;
  Ftpobject.ConnectTimeout := Ftpupload.Timeout * 1000;

  if not FTPObject.Connect then
  begin
    Error('failed to connect to server');
    exit;
  end;

except
  on E: Exception do
  begin
    Error(Format('Failed to connect to FTP server %s', [FTPUpload.Server]));
    EXIT;
  end;
end;

{ Change Working Directory }
try
  if FtpUpload.Directory <> '' then
    FtpObject.ChangeRemoteDir(FtpUpload.Directory);
except
  on E: Exception do
  begin
    Error(Format('Failed to switch to FTP folder %s', [FtpUpload.Directory]));
    EXIT;
  end;
end;

//FTPObject.Mode(MODE_BYTE);
FTPObject.Transfertype := ttBinary;
LocalFile := CommonExportFolder + FTPUpload.FileNameToSend;
{ Includes date/time in remote file name to keep name unique on a resend }
RemoteFile := Prefix + FormatDateTime('yyyymmddhhnnss', now) + NameList[i];
try
  FTpObject.PutQualifiedFile(LocalFile, RemoteFile);
except
  Error('Failed Copying File ' + Localfile + ' To ' + Remotefile);
end;


Component Download: http://www.nevrona.com/Indy/

To download files there is an equivalent .getQualifiedFile method.

How to modify the color of a TProgressBar

Problem/Question/Abstract:

How to modify the color of a TProgressBar

Answer:

If you have 4.71 or greater CommCtrl32.dll version, you can use this to set the bar color:



SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clLime);


or


SendMessage(ProgressBar1.Handle, PBM_SETBKCOLOR, 0, clGreen);


The messages are defined in COMMCTRL.pas.

How to close a non-responding application

Problem/Question/Abstract:

How to close a non-responding application

Answer:

{ ... }
const
  PROCESS_MURDER = $0001;
var
  pid: Cardinal;
  ProcessHandle: THandle;
begin
  { ... }
  GetWindowThreadProcessId(WindowHandleOfHangingApp, @pid);
  ProcessHandle := OpenProcess(PROCESS_MURDER, FALSE, pid);
  TerminateProcess(ProcessHandle, 4);
  { ... }

TDesktopCanvas - write on the desktop

Problem/Question/Abstract:

TDesktopCanvas - write on the desktop

Answer:

This canvas allows you to access the desktop:


type
  TDesktopCanvas = class(TCanvas)
  private
    DC: hDC;
    function GetWidth: Integer;
    function GetHeight: Integer;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
  end;

  { TDesktopCanvas object }

function TDesktopCanvas.GetWidth: Integer;
begin
  Result := GetDeviceCaps(Handle, HORZRES);
end;

function TDesktopCanvas.GetHeight: Integer;
begin
  Result := GetDeviceCaps(Handle, VERTRES);
end;

constructor TDesktopCanvas.Create;
begin
  inherited Create;
  DC := GetDC(0);
  Handle := DC;
end;

destructor TDesktopCanvas.Destroy;
begin
  Handle := 0;
  ReleaseDC(0, DC);
  inherited Destroy;
end;

Fill a listbox with file names

Problem/Question/Abstract:

Easy method to fill a listbox with file names

Answer:

Today I have read, that you can fill a listbox items with file names by one message only! Try it - it's cool:

var
  s: string;
begin
  s := 'c:\windows\*.bmp'#0;
  ListBox1.Perform(LB_DIR, DDL_READWRITE, LongInt(@s[1]));
end;

Note: this code only seems to work in Windows 2000... I used this code in 2k fine, but when I tested my proggy in WinME this bit of code did nothing... Few other ppl reported the same thing :\

How to set a TEdit or TMemo to overwrite instead of insert

Problem/Question/Abstract:

How to set a TEdit or TMemo to overwrite instead of insert

Answer:

Solve 1:

You have to fake it because the control does not natively support overtype mode. Provide overtype capability for edits and memos:

procedure TScratchMain.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if (Sender is TCustomEdit) and Odd(GetKeyState(VK_INSERT)) then
    with TCustomEdit(Sender) do
      if SelLength = 0 then
        case Key of
          ' '..#126, #128..#255:
            begin
              SelLength := 1;
              if (SelLength > 0) and (SelText[1] = #13) then
                SelLength := 2;
            end;
        end;
end;

With this handler the control will start out in insert mode since the state of VK_INSERT is not toggled by default. Pressing it once will toggle the key and put the control in overtype mode. If you want it to start out in overtype, use "not Odd(...)" in the If statement.

Solve 2:

I managed to simulate it by doing this (you need to declare the FOverwrite: boolean somewhere in the form):

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
type
  TSmallPoint = packed record
    case integer of
      0: (x, y: Smallint);
      1: (long: integer);
  end;
var
  CaretPos: TPoint;
  sCaretPos: TSmallPoint;
begin
  if (FOverwrite) and (Edit1.SelLength = 0) then
  begin
    GetCaretPos(CaretPos);
    sCaretPos.x := CaretPos.x;
    sCaretPos.y := CaretPos.y;
    Edit1.SelStart := SendMessage(Edit1.Handle, EM_CHARFROMPOS, 0, sCaretPos.long);
    Edit1.SelLength := 1;
    Edit1.SelText := Key;
    Key := #0;
  end;
end;

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_INSERT: FOverwrite := not FOverwrite;
  end;
end;

How to start a search upon an [Enter] key press in a TEdit

Problem/Question/Abstract:

I have a series of 6 edit boxes that users type info in that are then passed to params in my SQL TQuery. The search query is started by clicking on a button. However, users have asked that if they type in one of the edit boxes and then press 'Enter' that the system searches. I can use Key Press event to trigger it and then if key = #13 to make sure its the enter key but then i want it to trigger the procedure that does the search, usually triggered by the tool button. Any ideas?

Answer:

Solve 1:

The best solution is to use actions, which I'll describe below. But if you don't want to use actions, do this:

Move your search procedure into a separate procedure, and then call that from both the toolbutton OnClick and edit OnKeyPress events, like this:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    {Private Declarations}
    procedure PerformSearch;
  public
    {Public declarations}
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  PerformSearch;
end;

procedure TForm1.PerformSearch;
begin
  { Do search here }
  ShowMessage('Search performed');
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    PerformSearch;
    Key := #0;
  end;
end;

end.

To use actions, place a TActionList component onto your form, then create an action called something like "SearchAction". Then assign SearchAction to the ToolButton's Action property. Finally, call the action's Execute method from the edit, like this:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, StdCtrls, ActnList;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ActionList1: TActionList;
    SearchAction: TAction;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure SearchActionExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    SearchAction.Execute;
    Key := #0;
  end;
end;

procedure TForm1.SearchActionExecute(Sender: TObject);
begin
  { Do search here }
  ShowMessage('Search performed');
end;

end.

Solve 2:

I'll go one further than Rick. All event handlers should only delegate (unless they're one line long in which case they are delegating). In other words if you have

procedure TForm1btnSearch.Click(Sender: TObject);
begin
  {...many lines of code that actually implement the search}
end;

Change this to:

procedure TForm1btnSearch.Click(Sender: TObject);
begin
  FindInformation;
end;

procedure TForm1.FindInformation;
begin
  {...many lines of code that actually implement the search.}
end;

There are, of course, exceptions to this rule, however, for the greater part, you will not do wrong to treat an event handler as a proxy rather than placing the code directly in it. For one thing, it makes it easier to move the domain code into a separate object, so you could end up with:

procedure TForm1btnSearch.Click(Sender: TObject);
begin
  MyInformationFinder.Execute;
end;

Cancel that wrong drag operation

Problem/Question/Abstract:

Cancel that wrong drag operation

Answer:

Have you ever started moving a component while designing your form and realized you selected the wrong component?

No doubt, you can think of other instances when you would like to cancel a design-time drag operation you've already begun. Here's a tip that let's you do just that.

After you've begun the drag but before you release the mouse button, press the Esc key. The control will snap back to its original position!

Manipulate shapes and inline shapes in Word

Problem/Question/Abstract:

I'm trying to insert a picture in a document and sent it to the back, with the text over the picture using automation.

Answer:

If Doc is a Word document:

{ ... }
var
  Pic: Word2000.Shape;
  Left, Top: OleVariant;
  { ... }

{To add a pic and make it appear behind text}
Left := 100;
Top := 100;
Pic := Doc.Shapes.AddPicture('C:\Small.bmp', EmptyParam, EmptyParam, Left, Top,
  EmptyParam, EmptyParam, EmptyParam);
Pic.WrapFormat.Type_ := wdWrapNone;
Pic.ZOrder(msoSendBehindText);
{To get a watermark effect}
Pic.PictureFormat.Brightness := 0.75;
Pic.PictureFormat.Contrast := 0.20;
{To make any white in a picture transparent}
Pic.PictureFormat.TransparencyColor := clWhite;
Pic.PictureFormat.TransparentBackground := msoTrue;
Pic.Fill.Visible := msoFalse;
{ ... }

How to simulate combobox behaviour with a TEdit

Problem/Question/Abstract:

I'm trying to make a component that acts in certain cases like a combobox, i.e. when the user presses a button, a list box is shown and the user can select an item. The problem I have is that I need the list to hide itself whenever the user clicks the mouse outside the list (including clicks in non-windowed controls).

Answer:

One way you can do this is by listening for CM_CANCELMODE messages in the parent of your drop-down list (presumably an edit control or something similar). You will probably then have to work out whether the message originated from a click on the drop-down list or elsewhere. In the code below, FPopup points to the list component:

procedure TMyPopupEdit.CMCancelMode(var Message: TCMCancelMode);
var
  P: TPoint;
  R: TRect;
begin
  {Get the top-left coordinate of the Sender and see if it is within the popup
  control. If not, close the popup without changing the text in the edit box.}
  P.X := Message.Sender.Left;
  P.Y := Message.Sender.Top;
  R := Rect(0, 0, FPopup.Width, FPopup.Height);
  if not PtInRect(R, P) then
    if FPopupVisible then
      PopupCloseUp(FPopup, False);
end;

How to implement the RPos

Problem/Question/Abstract:

Sometime Pos is not enough, because you need to find the position of the first character of a sub string in a string from the end of that string. There's the solution.

Answer:

function RPos(Substr: string; S: string): Integer;
var
  i: Integer;
begin
  Result := 0;
  if ((Length(S) > 0) and (Length(Substr) > 0)) then
    if (Length(S) >= Length(Substr)) then
      for i:= (Length(S) - Length(Substr)) downto 1 do
        if (Copy(S, i, Length(Substr)) = Substr) then
        begin
          Result := i;
          Exit;
        end;
end;

How to set all tables linked to a TDatabase back to active

Problem/Question/Abstract:

Is there a way to set all tables linked to a particular TDatabase component back to active automatically?

Answer:

Not totally automatic but with just two lines of code. If you want certain tables that share DB1 to keep closed (shadow tables etc, only opened for special routines) use the Tag of the DataSets to determine which ones to open.

for i := 0 to pred(DB1.DataSetCount) do
  {if DataSets.Tag = 1 then}
  DataSets[i].Open;

How to form a DDE link with a Netscape browser

Problem/Question/Abstract:

How to form a DDE link with a Netscape browser

Answer:

unit Netscp1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DdeMan;

type
  TForm1 = class(TForm)
    DdeClientConv1: TDdeClientConv;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    LinkStatus: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    URLName: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  LinkOpened: Integer;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if LinkOpened = 0 then
  begin
    DdeClientConv1.SetLink(' Netscape ', ' WWW_OpenURL ');
    if DdeClientConv1.OpenLink then
    begin
      LinkStatus.Text := ' Netscape Link has been opened ';
      LinkOpened := 1;
    end
    else
      LinkStatus.Text := ' Unable to make Netscape Link ';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LinkOpened := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DdeClientConv1.CloseLink;
  LinkOpened := 0;
  LinkStatus.Text := ' Netscape Link has been closed ';
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  ItemList: string;
begin
  if LinkOpened <> 0 then
  begin
    ItemList := URLName.Text + ', , 0xFFFFFFFF, 0x3, , ,';
    DdeClientConv1.RequestData(ItemList);
  end;
end;

end.

How to use Randomize so that the same value is not chosen more than once (2)

Problem/Question/Abstract:

Would you mind to make me a random procedure to change the background of my program in an interval of 15 seconds?

Answer:

The best would be to store the names in an array:

const
  CaImgs: array[0..9] of string = ('image1.jpg', 'image2.jpg', ...);

This way, on start-up, you can check that the images are there. Then, if you merely want a random image from the array, you do:

myFileName = CaImgs[random(10)];

This means that you have one chance out of ten of repeating the same image - no visible change. If you want to show always different images, but in random order, then you need a shuffle function (see above). To shuffle your array of filenames (despite being declared a constant, it's actually a var), you do this:

procedure shuffleImages;
var
  a: array[0..high(CaImgs)] of integer;
  j: integer;
  s: string;
begin
  for j := low(a) to high(a) do
    a[j] := j;
  shuffle(a, 0);
  for j := low(a) to high(a) do
  begin
    s := CaImgs[j];
    CaImgs[j] := CaImgs[a[j]];
    CaImgs[a[j]] := s;
  end;
end;

You do this once at application start. This way, the 10 images will show in random order (but the order will repeat throughout the current run).

In both cases (random of shuffle), you should call Randomize just once, at the start of the application.

How to tell if a TPanel is moved outside the visible part of a TForm

Problem/Question/Abstract:

I use SC_DRAGMOVE so I can drag a TPanel around a form. Now, how do I tell the form when the panel is outside the form and the form should add some scrollbars?

Answer:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;

type
  TPanel = class(ExtCtrls.TPanel)
  private
    procedure WMExitSizeMove(var message: TMessage); message WM_EXITSIZEMOVE;
  end;

  TForm1 = class(TForm)
    StatusBar: TStatusBar;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    ComboBox1: TComboBox;
    CheckBox1: TCheckBox;
    Panel1: TPanel;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  Mouse.Capture := 0;
  sendmessage(panel1.handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;

{ TPanel }

procedure TPanel.WMExitSizeMove(var message: TMessage);
begin
  Left := Left + 1;
  Left := Left - 1;
end;

end.

One way to copy whole contents of an array into another array

Problem/Question/Abstract:

You have an array and you want to copy the value you have in it to another array.

Answer:

I just use a button to se if it compile and if I get an Error when I click it. There ar other ways, like copy an array in a for loop, but then you have to know how big it is. If you handle different arrays in an application and need to copy them into one, this is the way. As you can se, it works with just one index of the array too.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    Array1: array[0..40] of Integer;
    Array2: array[0..100] of Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Move(Array1, Array2, SizeOf(Array1)); {Moves/Copy the Array1 to Array2.}
end;

end.

Trapping Messages Sent to an Application

Problem/Question/Abstract:

I wrote code for the OnMessage event handler of Application object to trap all Windows messages sent to my application, but it doesn't seem to fire on all messages. Is there a way to trap all messages sent to my application?

Answer:

There sure is. And the answer to this "problem" is amazingly simple. But before I go into trapping messages at the application level, I should probably discuss some mechanics.

TApplication's "Hidden" Window
It's not a commonly known fact that the default Application object creates a hidden window when your application is started. But you can seen evidence of this by creating a new application saving it, then running it (make sure you don't rename anything - just keep the main form as "Form1" and the project as "Project1). When you run the application, you'll notice that the caption bar for your main form says, "Form1" while the icon displayed on the task bar says "Project1." That icon represents the application's hidden window, and it affects your program in many ways, especially when you're trying to handle messages sent to your application.
Delphi surfaces the OnMessage event for the Application object. The OnMessage event handler is "supposed" to allow you trap every message sent to your application. But there's a problem with this: OnMessage will only fire when there's something in the Application object's message queue. These messages are typically window management messages such as WM_PAINT or messages sent to the application from Windows through PostMessage, Broadcast or SystemMessage . However, messages sent directly to a window using SendMessage bypass the Application object's message queue, so OnMessage doesn't fire for those types of situations.
Some of you more familiar with handling windows messages might think that a solution to the problem above might be to override the WndProc method for the Application object. Unfortunately, that's not possible because TApplication's WndProc method is not only private, it's also declared as a static method which means it's not overrideable. So it's not only invisible, you can't create a TApplication subclass to override WndProc (not that you'd want either). But that doesn't mean that you can't get to the WndProc method using alternative means.

"Hooking" All Messages
Even though WndProc is all but closed to direct subclassing, TApplication does include a method called HookMainWindow that allows you to insert your own message handler at the top of WndProc to intercept messages sent to your application before they're handled by the Application object. This is convenient for all developers, and solves the problem of trapping any message sent to your application.
HookMainWindow is declared under TApplication as follows:

procedure HookMainWindow(Hook: TWindowHook);

Notice that HookMainWindow takes one parameter, Hook of type TWindowHook. TWindowHook is a method pointer type that's defined like so:

type
  TWindowHook = function(var Message: TMessage): Boolean of object;

Since TWindowHook is a method pointer, you can define your own method as the hook function as long as it follows the nomenclature defined for TWindowHook. Notice that the return value of the function is of type Boolean. This is the equivalent of the "Handled" parameter of OnMessage. If your function handles a particular message, you'd return true. This will be passed back to the Application's WndProc and message processing for that message will be terminated. Otherwise, you'd return False. Here's an example method:

function TForm1.AppHookFunc(var Message: TMessage): Boolean;
begin
  Result := False; //I just do this by default
  if Message.Msg = WM_ < SomethingOrOther > then
  begin
    ...DoSomething...
      Result := True;
  end;
end;

Okay, now that we've set up everything, we need to make the application hook the messages. This can be done in the main form's OnCreate method:

function TForm1.FormCreate(Sender: TObject);
begin
  HookMainWindow(AppHookFunc);
end;

I should mention that you need to clear the hook using, you guessed it, UnHookMainWindow, after you're done using it, and this can be done in the OnDestroy for the main form:

function TForm1.FormDestroy(Sender: TObject);
begin
  UnHookMainWindow(AppHookFunc);
end;

Okay, disgustingly simple. But I feel the best things in life are those that give maximum satisfaction for the least amount of cost (please don't read ANYTHING into that <G>). So, now you've got the tools to create your own message "hooker" (sorry, had to do that at least once). Until next time...

How to convert decimal numbers to fractions

Problem/Question/Abstract:

I'm looking for a function that I can pass in a decimal and return a fraction.

Answer:

Solve 1:

The "Denominators" parameter is an array of potential denominators that would be acceptable. For example, to get a fractional inch dimension with a power of 2 denominator, you'd pass [2, 4, 8, 16, 32] for that parameter, and the function will figure out which potential denominator will work best.

function ConvertFloatToFraction(const Value: Double;
  const Denominators: array of Integer): string;
var
  Index: Integer;
  TempDelta: Double;
  MinDelta: Double;
  TempNumerator: Integer;
  FracValue: Double;
  Numerator: Integer;
  Denominator: Integer;
  IntValue: Integer;
begin
  IntValue := Trunc(Value);
  FracValue := Abs(Frac(Value));
  MinDelta := 0;
  Numerator := 0;
  Denominator := 0;
  for Index := 0 to High(Denominators) do
  begin
    TempNumerator := Round(FracValue * Denominators[Index]);
    TempDelta := Abs(FracValue - (TempNumerator / Denominators[Index]));
    if ((Index = 0) or (TempDelta < MinDelta)) then
    begin
      MinDelta := TempDelta;
      Numerator := TempNumerator;
      Denominator := Denominators[Index];
    end;
  end;
  if (Numerator = Denominator) then
  begin
    IntValue := IntValue + Sign(IntValue);
    Numerator := 0;
  end;
  Result := '';
  if ((IntValue <> 0) or (Numerator = 0)) then
    Result := IntToStr(IntValue);
  if ((IntValue <> 0) and (Numerator <> 0)) then
    Result := Result + ' ';
  if (Numerator <> 0) then
    Result := Result + IntToStr(Numerator) + '/' + IntToStr(Denominator);
end;


Solve 2:

This function takes the number to convert, the fraction scale you want returned such as 8 for eighths or 10 for tenths, etc. and a boolean to tell it to round up or down the nearest fraction. It returns a string with the integer portion, a space and then the fraction portion. It will also reduce the fraction to the smallest common denominator. You can use the ErrorFactor variable to adjust the percentage of when to consider a number close enough to the next level to be close enough. I use 4 percent of the fractional scale value.

function ToFraction(num: double; scale: integer; RoundUp: boolean): string;

{Function to find greatest common denominator}
  function GCD(A, B: integer): integer;
  begin
    if (B mod A) = 0 then
      result := A
    else if (B mod A) = 1 then
      result := 1
    else
      result := GCD((B mod A), A);
  end;

var
  x, y: integer;
  ScaleFrac,
    NumFrac,
    ErrorFactor: double;
begin
  ScaleFrac := 1 / scale;
  NumFrac := Frac(Num);
  ErrorFactor := ScaleFrac * 0.04; {error factor of 4 percent}
  x := 0;
  while (((x + 1) * ScaleFrac) < (NumFrac + ErrorFactor)) do
    inc(x);
  if RoundUp then
    if (((((x + 1) * ScaleFrac) - NumFrac) / 2) > (ScaleFrac / 2)) then
      inc(x);
  if (x = 0) then {no fraction, just the integer portion}
  begin
    result := IntToStr(Trunc(Num))
  end
  else
  begin {reduce the fraction as much as possible}
    y := GCD(x, scale);
    while (y <> 1) do
    begin
      x := x div y;
      scale := scale div y;
      y := GCD(x, scale);
    end;
    result := IntToStr(Trunc(Num)) + ' ' + IntToStr(x) + '/' + IntToStr(scale);
  end;
end;

Create 32bit string resources with 16bit Resource Workshop

Problem/Question/Abstract:

Create 32bit string resources with 16bit Resource Workshop

Answer:

There is an easy way to do this (besides buying Resource Workshop version 4 :-)

create your strings as 16bit resource with Resource Workshop
store them as a *.RC text file (instead of *.RES)
compile the text file with BRCW32 (command line tool: BRC32) into a 32bit *.RES file