Shift, Ctrl, Alt Key checking

Problem/Question/Abstract:

How to detect if Ctrl, Alt or Shift key is pressed

Answer:

function CtrlDown: Boolean;
var
  State: TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[vk_Control] and 128) <> 0);
end;

function ShiftDown: Boolean;
var
  State: TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[vk_Shift] and 128) <> 0);
end;

function AltDown: Boolean;
var
  State: TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[vk_Menu] and 128) <> 0);
end;

The following example demonstrates checking if the Shift key is pressed during a Button Click.

procedure TForm1.Button1Click(Sender: TObject);
begin
  if ShiftDown then
    Form1.Caption := 'Shift'
  else
    Form1.Caption := 'No Shift';
end;

Validating email addresses in Delphi

Problem/Question/Abstract:

Is an email address valid?

Answer:

Nowadays it's very common that our programs store email addresses in databases as part of the data of personnel, customers, providers, etc. When prompting the user for an email address, how do we know if the entered value is formally correct? In this article I'll show you how to validate email addresses using a variation of the RFC #822.

The RFC #822 rules the "STANDARD FOR THE FORMAT OF ARPA INTERNET TEXT MESSAGES".

According to this rule, the following are valid email addresses:

  John Doe johndoe@server.com
  John Doe
  "John Doe" johndoe@server.com
  "John Doe"

The purpose of my code is not to validate such things, but strictly what is necessary to reach a single recipient (like "johndoe@server.com"), that in the specification is referred as an "addr-spec", which has the form:

  local-part@domain

  local-part = one "word" or more, separated by periods
  domain = one "sub-domain" or more, separated by periods

A "word" can be an "atom" or a "quoted-string":

  atom = one or more chars in the range #33..#126 except ()<>@,;:\/".[]
  quoted-string = A text enclosed in double quotes that can contain 0 or
    more characters (#0..#127) except '"' and #13. A backslash ('\')
    quotes the next character.

A "sub-domain" can be a "domain-ref" (an "atom") or a "domain-literal":

  domain-literal = A text enclosed in brackets that can contain 0 or
   more characters (#0..#127) except '[', ']' and #13. A backslash ('\')
   quotes the next character.

According to the RFC 822, extended characters (#128..#255) cannot be part of an email address, however many mail servers accept them and people use them, so I'm going to take them into account.

The RFC 822 is very open about domain names. For a real Internet email address maybe we should restrict the domain part. You can read more about domain names in the RFC #1034 and RFC #1035.
  
For the RFC 1034 and the RFC 1035, a domain name is formed by "sub-domains" separated by periods, and each subdomain starts with a letter ('a'..'z', 'A'..'Z') and should be followed by zero or more letters, digits and hyphens, but cannot end with a hyphen. We are going to consider that a valid domain should have at least two "sub-domains" (like "host.com").

Now that we have the rules clear, let's get to the work. The algorithm for the function resembles a states-transition machine. Characters of the string are processed in a loop, and for each character first we determine in which state the machine is and then we process the character accordingly, to determine if the machine should continue in that state, switch to a different state or produce an error (breaking the loop). These kind of algorithms are extensively treated in programming-algorithms textbooks, so let's get right to the code:

function ValidEmail(email: string): boolean;
// Returns True if the email address is valid
// Author: Ernesto D'Spirito
const
  // Valid characters in an "atom"
  atom_chars = [#33..#255] - ['(', ')', '<', '>', '@', ',', ';', ':',
    '\', '/', '"', '.', '[', ']', #127];
  // Valid characters in a "quoted-string"
  quoted_string_chars = [#0..#255] - ['"', #13, '\'];
  // Valid characters in a subdomain
  letters = ['A'..'Z', 'a'..'z'];
  letters_digits = ['0'..'9', 'A'..'Z', 'a'..'z'];
  subdomain_chars = ['-', '0'..'9', 'A'..'Z', 'a'..'z'];
type
  States = (STATE_BEGIN, STATE_ATOM, STATE_QTEXT, STATE_QCHAR,
    STATE_QUOTE, STATE_LOCAL_PERIOD, STATE_EXPECTING_SUBDOMAIN,
    STATE_SUBDOMAIN, STATE_HYPHEN);
var
  State: States;
  i, n, subdomains: integer;
  c: char;
begin
  State := STATE_BEGIN;
  n := Length(email);
  i := 1;
  subdomains := 1;
  while (i <= n) do
  begin
    c := email[i];
    case State of
      STATE_BEGIN:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_ATOM:
        if c = '@' then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else if not (c in atom_chars) then
          break;
      STATE_QTEXT:
        if c = '\' then
          State := STATE_QCHAR
        else if c = '"' then
          State := STATE_QUOTE
        else if not (c in quoted_string_chars) then
          break;
      STATE_QCHAR:
        State := STATE_QTEXT;
      STATE_QUOTE:
        if c = '@' then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else
          break;
      STATE_LOCAL_PERIOD:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_EXPECTING_SUBDOMAIN:
        if c in letters then
          State := STATE_SUBDOMAIN
        else
          break;
      STATE_SUBDOMAIN:
        if c = '.' then
        begin
          inc(subdomains);
          State := STATE_EXPECTING_SUBDOMAIN
        end
        else if c = '-' then
          State := STATE_HYPHEN
        else if not (c in letters_digits) then
          break;
      STATE_HYPHEN:
        if c in letters_digits then
          State := STATE_SUBDOMAIN
        else if c <> '-' then
          break;
    end;
    inc(i);
  end;
  if i <= n then
    Result := False
  else
    Result := (State = STATE_SUBDOMAIN) and (subdomains >= 2);
end;

Any collaboration to improve this function will be welcome.


Copyright (c) 2001 Ernesto De Spirito
Visit: http://www.latiumsoftware.com/delphi-newsletter.php

How to copy RTF text to a TMemo via a TStringStream

Problem/Question/Abstract:

How to copy RTF text to a TMemo via a TStringStream

Answer:

Here is a method to copy the formatted text to a memo via a stringstream. The same approach should work to store it in a database field that takes a string.

procedure TForm1.Button1Click(Sender: TObject);
var
  ss: TStringStream;
begin
  ss := TStringStream.Create(EmptyStr);
  try
    richedit1.plaintext := false;
    richedit1.lines.savetostream(ss);
    memo1.text := ss.DataString;
  finally
    ss.free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ss: TStringStream;
begin
  ss := TStringStream.Create(memo1.text);
  try
    richedit1.plaintext := false;
    richedit1.lines.LoadFromstream(ss);
  finally
    ss.free;
  end;
end;

To simply copy formatted text from a TRichEdit to a string, you could also use:

function GetRawRTFText(aRichedit: TRichedit): string;
var
  SS: TStringstream;
begin
  SS := TStringstream.Create(EmptyStr);
  try
    aRichedit.plaintext := False;
    arichedit.Lines.SaveToStream(SS);
    Result := SS.DataString;
  finally
    SS.Free
  end;
end;

How to check if Netscape or IExplorer is running and get the current URL

Problem/Question/Abstract:

How can I find out if Netscape is running or not? And if it is running, how can I get the current URL address that is displaying? The same with IE.

Answer:

Here's an example which gets you both the URL and the title of the page into one string. For explorer replace 'Netscape' with 'IExplorer':


uses
  DdeMan;

procedure TForm1.Button1Click(Sender: TObject);
var
  DDE: TDdeClientConv;
begin
  DDE := TDdeClientConv.Create(self);
  if DDE.SetLink('Netscape', 'WWW_GetWindowInfo') then
    Edit1.Text := DDE.RequestData('0xFFFFFFFF, sURL, sTitle')
  else
    ShowMessage('Netscape is not running');
  DDE.Free;
end;

How to split a wave file

Problem/Question/Abstract:

I have a very big wave file and I want to split it into two separately files. But, this two files have to stand alone. You should can  play and edit them like another wave files.

Answer:

If you know how wave files work, this is very easy.
First you need the complete file header of the old wave file:


type
  TWaveHeader = record
    ident1: array[0..3] of Char;       // Must be "RIFF"
    len: DWORD;                        // remaining length after this header
    ident2: array[0..3] of Char;       // Must be "WAVE"
    ident3: array[0..3] of Char;       // Must be "fmt "
    reserv: DWORD;                     // Reserved Size
    wFormatTag: Word;                  // format type
    nChannels: Word;                   // number of channels (i.e. mono, stereo, etc.)
    nSamplesPerSec: DWORD;             //sample rate
    nAvgBytesPerSec: DWORD;            //for buffer estimation
    nBlockAlign: Word;                 //block size of data
    wBitsPerSample: Word;              //number of bits per sample of mono data
    cbSize: Word;                      //the count in bytes of the size of
    ident4: array[0..3] of Char;       //Must be "data"
end;


You can load the file header with this function:


function GetWaveHeader(FileName: TFilename): TWaveHeader;
const
  riff = 'RIFF';
  wave = 'WAVE';
var
  f: TFileStream;
  w: TWaveHeader;
begin
  if not FileExists(Filename) then
    exit;

  try
    f := TFileStream.create(Filename, fmOpenRead);
    f.Read(w, Sizeof(w));

    if w.ident1 <> riff then
    begin
      Showmessage('This is not a RIFF File');
      exit;
    end;

    if w.ident2 <> wave then
    begin
      Showmessage('This is not a valid wave file');
      exit;
    end;

  finally
    f.free;
  end;

  Result := w;
end;


Now we have all for creating the code for spliting the wave file:



function SplitWave(Source, Dest1, Dest2: TFileName; Pos: Integer): Boolean;
var
  f1, f2, f3: TfileStream;
  w: TWaveHeader;
  p: Integer;
begin
  Result:=False

  if not FileExists(Source) then
    exit;

  try
    w := GetWaveHeader(Source);

    p := Pos - Sizeof(TWaveHeader);

    f1 := TFileStream.create(Source, fmOpenRead);
    f2 := TFileStream.create(Dest1, fmCreate);
    f3 := TFileStream.create(Dest2, fmCreate);

    {++++++++++Create file 1 ++++++++++++++++}
    w.len := p;
    f2.Write(w, Sizeof(w));
    f1.position := Sizeof(w);
    f2.CopyFrom(f1, p);
    {++++++++++++++++++++++++++++++++++++++++}

    {+++++++++++Create file 2 +++++++++++++++}
    w.len := f1.size - Pos;
    f3.write(w, Sizeof(w));
    f1.position := Pos;
    f3.CopyFrom(f1, f1.size - pos);
    {++++++++++++++++++++++++++++++++++++++++}
  finally
    f1.free;
    f2.free;
    f3.free;
  end;

  Result:=True;
end;

How to change the font color of all components on a form at runtime

Problem/Question/Abstract:

I would like to change the font color on all components on a form at runtime (and the components owned by the components etc). I devised a recursive algorithm using RTTI that accepts a TComponent as a parameter. It works to some extent, but I still have to use 'if' statements to cast the object to a particular descendant, resulting in about 30 lines of code to test for all of the components I use. Also, some objects (TColumnTitle), are not descended from TComponent, even though they have a font property.

Answer:

This may do the trick (with D6 and maybe D5):

uses
  TypInfo;

{ ... }
var
  i: integer;
  aFont: TFont;
begin
  for i := 0 to aComponent.ComponentCount - 1 do
  begin
    aFont := TFont(GetOrdProp(aComponent.Components[i], 'Font'));
    if assigned(aFont) then
      aFont.Color := clWhite;
  end;
end;


With D4:

{ ... }
var
  i: integer;
  aFont: TFont;
  pi: PPropInfo;
begin
  for i := 0 to aComponent.ComponentCount - 1 do
  begin
    pi := GetPropInfo(aComponent.Components[i].ClassInfo, 'Font');
    if assigned(pi) then
      TFont(GetOrdProp(aComponent.Components[i], pi)).Color := clWhite;
  end;
end;

How do I create a file association for my win32 application

Problem/Question/Abstract:

How do I create a file association for my win32 application (Update for 98/ME/NT5(2000)/ME) ?

Answer:

In Win32, create a new registry entry under the HKEY_CLASSES_ROOT root key that points to the file extension, the command line to invoke, and the icon to display.

Update:

Windows will execute '\shell\open\command' from the KEY pointed in (Default) value.

So you can :

Clear Default value of extention key with itself ex: .jpg -> .jpg. This make windows use '\shell\open\command' from the proper KEY. (As shown in example)

Create enother key like "MyProgExt" with '\shell\open\command' and point any extension you need to it. This way the extension key default value will be: MyProgExt.

Example:

uses Registry,

procedure TForm1.FileFormatAssociations;
var
  reg: TRegistry;
  FileExt: string;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  reg.LazyWrite := false;

  FileExt := '.jpg';

  //Clear Key - This is important !!!
  reg.OpenKey(FileExt, true);
  reg.WriteString('', FileExt);
  reg.CloseKey;

  //Invoke the program passing the file name as the first parameter
  reg.OpenKey(FileExt + '\shell\open\command', true);
  reg.WriteString('', Application.ExeName + ' "%1"');
  reg.CloseKey;

  //Use the first icon in the executable to display
  reg.OpenKey(FileExt + '\DefaultIcon', true);
  reg.WriteString('', Application.ExeName + ',0');
  reg.CloseKey;

  reg.free;
end;

How to make caption blink?

Problem/Question/Abstract:

How to make caption blink?

Answer:

If you want to have your form's caption bar blink, you may think of using a timer and owner-drawing the non-client area :-) But there is a much easier way:

Use the API function

FlashWindow(h: hWnd; bInvert: boolean);

How to sort directory entries by date / time

Problem/Question/Abstract:

How to sort directory entries by date / time

Answer:

type
  PEntryItem = ^TEntryItem;
  TEntryItem = record
    FName: string;
    FDate: TDateTime;
    FSize: Integer;
  end;

function SortList(item1, item2: Pointer): integer;
var
  i1: PEntryItem absolute Item1;
  i2: PEntryItem absolute Item2;
begin
  if (i1^.fdate > i2^.fdate) then
    result := 1 {greater}
  else if (i1^.fdate < i2^.fdate) then
    result := -1 {smaller}
  else
    result := 0; {equals}
end;

procedure DoTheJob;
var
  List: TList;
  i: Integer;

  procedure GetDirEntries(Path: string);
  var
    Dta: TSearchRec;
    P: PEntryItem;
  begin
    if (Path <> '') and (Path[Length(Path)] = '\') then
      setlength(Path, Pred(Length(Path)));
    if FindFirst(Path + '\*.*', faAnyFile, Dta) <> 0 then
      exit; {Nothing}
    repeat
      {remove next line if you want these two as well}
      if (Dta.Name = '.') or (dta.name = '..') then
        continue;
      New(P);
      P^.FName := Dta.Name;
      P^.FSize := Dta.Size;
      P^.FDate := FileDateToDateTime(Dta.Time);
      List.Add(P);
    until
      (FindNext(Dta) <> 0);
    FindClose(Dta);
  end;

begin
  List := TList.Create;
  List.Clear;
  try
    GetDirEntries('C:\Windows');
    if (list.Count > 0) then
      List.Sort(SortList);
    {Now you have a list with all the files in the directory
                        sorted by its date/time field. To access them do as follows:}
    for i := 0 to list.count - 1 do
    begin
      with PEntryItem(List.Items[i])^ do
      begin
        {I assume you have a Form called MainFrm with a Listbox1}
        MainFrm.ListBox1.Items.Add(Format('%s  %d  %s', [FName, FSize,
          FormatDateTime('dd/mm/yyyy HH:NN:SS', FDate)]));
      end;
    end;
  finally
    {make sure to relase the memory allocated}
    while (list.count > 0) do
    begin
      Dispose(PEntryItem(List.Items[0]));
      List.Delete(0);
    end;
    List.Free;
  end;
end;

How to specify a message subject for an email

Problem/Question/Abstract:

When I click on a button, I would like to have a message prepared with some information (just a few words). How can I specify this information in the message part or in the subject part of the email?

Answer:

uses
  ShellApi;

procedure TForm1.Button1Click(Sender: TObject);
var
  mail: string;
begin
  mail := 'mailto:you@you.com' + '?subject=hello' + '&cc=me@me.com' + '&body=Delphi is cool! ;)';
  ShellExecute(Self.Handle, 'open', PChar(mail), nil, nil, SW_SHOWNORMAL);
end;

How to detect a mouse movement over a word in a TRichEdit

Problem/Question/Abstract:

How to detect a mouse movement over a word in a TRichEdit

Answer:

Solve 1:

How can I detect when the mouse runs over a word or an expression in a TRichEdit?

You start by adding a handler to the TRichEdit's OnMouseMove event. In the handler you get to the character under the mouse with:

uses
  richedit; {for EM_EXLINEFROMCHAR}

var
  pt: TPoint;
  charindex, lineindex, charoffset: Integer;
begin
  pt := Point(X, Y);
  charindex := richedit.perform(Messages.EM_CHARFROMPOS, 0, integer(@pt));
  if charindex >= 0 then
  begin
    lineindex := richedit.perform(EM_EXLINEFROMCHAR, 0, charindex);
    charoffset := charindex - richedit.perform(EM_LINEINDEX, lineindex, 0);
  end;
end;

Lineindex and charoffset now allow you to get the line out of the richedit.Lines array and look at the characters value. Note that you have to use charoffset+1 as index into the string, e.g.:

S := richedit.lines[lineindex];
charundercursor := S[charoffset + 1];

If charundercursor is a letter (IsCharAlpha( charundercursor )) you could now walk backwards in S to find the start of the word and forward to find its end. Similar for an "expression" (whatever that may mean in your context).


Solve 2:

Using the source code above, how can I determine, whether the mouse is over a phrase like 'Inprise Delphi', which has the text attribute Bold and the colour Lime?

Well, you have to jump through some hoops, I'm afraid. The TRichEdit component has a method FindText that can be used to search for text, ignoring any text attributes. It would go something like this:

{additional vars required}
S: string;
foundPos, oldSelStart: Integer;

{after determining charindex as above}
S := 'Inprise Delphi'; {text to search for}
foundpos := richedit.FindText(S, charindex - Length(S) + 1, charindex + Length(S),
  [stWholeWord, stMatchCase]);
if foundpos > = 0 then
begin
  {found the text, check attributes}
  {for this we need to select the text}
  oldSelStart := richedit.SelStart;
  richedit.SelStart := foundPos;
  richedit.SelLength := Length(S);
  with richedit.SelAttributes do
    if ((ConsistentAttributes * [caBold, caColor]) = [caBold, caColor]) and
      (Color = clLime) and (fsBold in Style) then
      {we have a match!}
    else
      SelStart := oldSelStart;
end;


Solve 3:

How can I tell from a WM_MOUSEMOVE message that the mouse cursor is over a particular character or line of a TRichedit? I am simulating a very simplistic browser and want to know when the user is over a "hyperlink" which is really just a TRichedit with some of the text underlined. That way I can tell the cursor to change from crHand and back.

uses
  richedit;

var
  pt: TPoint;
  charindex, row, col: Integer;

{ ... }
GetCursorPos(pt);
pt := richedit.screentoclient(pt);
charindex := richedit1.perform(Messages.EM_CHARFROMPOS, 0, integer(@pt));
Row := richedit1.PerForm(EM_EXLINEFROMCHAR, 0, charindex);
Col := charindex - richedit1.Perform(EM_LINEINDEX, Row, 0);


Solve 4:

Looking for a way to find the character position the mouse is over during a TRichEdit.onMouseMove event.

var
  msg: TMessage;
  pt: TPoint;
  pos: integer; {offset into RichEdit.Text}

{ ... }
pt.x := X;
pt.y := Y;
msg.Result := SendMessage(RichEdit.handle, EM_CHarFromPos, 0, Integer(@pt));
pos := msg.ResultLo;
if RichEdit.Text[pos] = '?' then
  { ... }

How to return a variant type property value based on the text name of the property

Problem/Question/Abstract:

I am looking for code that returns a property value (presumably as a variant type) based on the text name of the property, similar to the TTable.FieldByName function.

Answer:

This should get you started. You need to study the comments "typinfo.pas" for more info.

unit MorePropInfo;

interface

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

type
  TFrmMorePropInfo = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMorePropInfo: TFrmMorePropInfo;

implementation

{$R *.DFM}

uses
  TypInfo;

procedure GetPropertyValues(AObj: TObject; AValues: TStrings);
var
  count: integer;
  data: PTypeData;
  default: string;
  i: integer;
  info: PTypeInfo;
  propList: PPropList;
  propInfo: PPropInfo;
  propName: string;
  value: variant;
begin
  info := AObj.ClassInfo;
  data := GetTypeData(info);
  GetMem(propList, data^.PropCount * SizeOf(PPropInfo));
  try
    count := GetPropList(info, tkAny, propList);
    for i := 0 to count - 1 do
    begin
      propName := propList^[i]^.Name;
      propInfo := GetPropInfo(info, propName);
      if propInfo <> nil then
      begin
        case propInfo^.PropType^.Kind of
          tkClass, tkMethod:
            value := '$' + IntToHex(GetOrdProp(AObj, propInfo), 8);
          tkFloat:
            value := GetFloatProp(AObj, propInfo);
          tkInteger:
            value := GetOrdProp(AObj, propInfo);
          tkString, tkLString, tkWString:
            value := GetStrProp(AObj, propInfo);
          tkEnumeration:
            value := GetEnumProp(AObj, propInfo);
        else
          value := '???';
        end;
        if propInfo.default = longint($80000000) then
          default := 'none'
        else
          default := IntToStr(propInfo.default);
        AValues.Add(Format('%s: %s [default: %s]', [propName, value, default]));
                                {$80000000 apparently indicates "no default"}
      end;
    end;
  finally
    FreeMem(propList, data^.PropCount * SizeOf(PPropInfo));
  end;
end;

procedure TFrmMorePropInfo.Button2Click(Sender: TObject);
var
  count: integer;
  data: PTypeData;
  i: integer;
  info: PTypeInfo;
  propList: PPropList;
  propInfo: PPropInfo;
  propName: string;
  propVal: variant;
  tmpS: string;
begin
  info := Button2.ClassInfo;
  data := GetTypeData(info);
  GetMem(propList, data^.PropCount * SizeOf(PPropInfo));
  try
    count := GetPropList(info, tkAny, propList);
    ListBox1.Clear;
    for i := 0 to count - 1 do
    begin
      propName := propList^[i]^.Name;
      propInfo := GetPropInfo(info, propName);
      if propInfo <> nil then
      begin
        case propInfo^.PropType^.Kind of
          tkClass, tkMethod:
            propVal := '$' + IntToHex(GetOrdProp(Button2, propInfo), 8);
          tkFloat:
            propVal := GetFloatProp(Button2, propInfo);
          tkInteger:
            propVal := GetOrdProp(Button2, propInfo);
          tkString, tkLString, tkWString:
            propVal := GetStrProp(Button2, propInfo);
          tkEnumeration:
            propVal := GetEnumProp(Button2, propInfo);
        else
          propVal := '...';
        end;
        tmpS := propVal;
        ListBox1.Items.Add(Format('%s: %s [default: %s]', [propName, tmpS, '$'
          + IntToHex(propInfo.default, 8)]));
                        {$80000000 apparently indicates "no default"}
      end;
    end;
  finally
    FreeMem(propList, data^.PropCount * SizeOf(PPropInfo));
  end;
end;

end.

How to close another application (2)

Problem/Question/Abstract:

I'm using the command CreateProcess(nil, PChar('PKUNZIP ..."),nil,nil,false,0,nil,nil,SI,PI) to execute PKUNZIP inside my program. But after the execution of PKUNZIP the window remains opened. How do I detect if PKUNZIP finishes its execution and how do I close the window after that?

Answer:

Closing it gently :

{ ... }
var
  Handle: THandle;
begin
  Handle := FindWindow(classname, windowname); {Look this one up in the help file ...}
  if Handle <> 0 then
    if MessageBox(Handle,
      PChar('Do you really want me to try to kill this application ?'),
      'Please Confirm', MB_YESNO) = mrYES then
    begin
      PostMessage(Handle, WM_QUIT, 0, 0);
    end;
end;

To close it with more brute force:

procedure TggProcessViewer.KillProcess(hProcess: THandle);
var
  PH: THandle;
  lpExitCode: DWord;
begin
  PH := OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION, false, hProcess);
  if PH <> 0 then
  begin
    if GetExitCodeProcess(PH, lpExitCode) then
    begin
      if MessageBox(Handle,
        PChar('Do you really want me to try to kill this process ?'),
        'Please Confirm', MB_YESNO) = mrYES then
      begin
        TerminateProcess(PH, lpExitCode);
        MessageBox(Handle, PChar('should be dead now...'), PChar('Check it out...'),
          MB_OK);
      end;
    end
    else
      MessageBox(Handle, PChar('Could not retreive the ExitCode for this process.' +
        #13 + #13 + SysErrorMessage(GetLastError)),
        PChar('Something went wrong...'), MB_OK);
    CloseHandle(PH);
  end
  else
    MessageBox(Handle, PChar('Could not get access to this process.' + #13 + #13
      + SysErrorMessage(GetLastError)), PChar('Something went wrong...'),
      MB_OK);
  Refresh;
end;

Determine if ColCount has changed in a TStringGrid

Problem/Question/Abstract:

I'm writing a TStringGrid descendant in which I would like to know, if the ColCount is being changed, because I have some other objects hidden in the component, that should be updated, when the ColCount changes. How can I accomplish that?

Answer:

You can try the following:

unit MyStringGrid;

interface

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

type
  TMyStringGrid = class(TStringGrid)
  private
    FColCount: Integer;
    FOnColCountChanged: TNotifyEvent;
    procedure SetColCount(Value: Integer);
  protected
    procedure ColCountChanged; virtual;
  public
    constructor Create(aOwner: TComponent); override;
  published
    property ColCount: Integer read FColCount write SetColCount default 5;
    property OnColCountChanged: TNotifyEvent read FOnColCountChanged
      write FOnColCountChanged;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Test', [TMyStringGrid]);
end;

constructor TMyStringGrid.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FColCount := 5;
end;

procedure TMyStringGrid.SetColCount(Value: Integer);
begin
  if FColCount <> Value then
  begin
    FColCount := Value;
    inherited ColCount := FColCount;
    ColCountChanged;
  end;
end;

procedure TMyStringGrid.ColCountChanged;
begin

  {do dependend stuff here}

  if Assigned(FOnColCountChanged) then
    FOnColCountChanged(Self);
end;

end.

Retrieve icons from the system image list

Problem/Question/Abstract:

Having the system image list in a TImageList, how can I get the index for special icons like floppy disk, hard drive, removable drive, etc., which do not represent file types? I can see that these icons are actually present (for example, 11 = CD-ROM, 8 = Hard-Drive on my machine ...). But I would prefer not to use hard-coded constants.

Answer:

uses
  ShellAPI;
var
  sfi: TSHFileInfo;
begin
  SHGetFileInfo("DUMMY.ABC", FILE_ATTRIBUTE_NORMAL, sfi, sizeof(sfi),
    SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
  Index := sfi.iIcon;
end;

By using the second parameter you can get icons for file system items that do not physically exist in the first parameter, which is not completely obvious in the help for SHGetFileInfo. For example.

SHGetFileInfo(" * .DOC", FILE_ATTRIBUTE_NORMAL, sfi, sizeof(sfi),
  SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);

gets the icon associated with DOC files. To get drives use

SHGetFileInfo("A: \", FILE_ATTRIBUTE_NORMAL, sfi, sizeof(sfi),
  SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);

etc.

Note that this retrieves the LARGE icon.  See the help on getting small icon with other flags.

Convert a UNIX linefeed delimited text file to a DOS CR/LF delimited file

Problem/Question/Abstract:

I'm having an issue converting a Unix 1.15 GB text file to a Windows file. It always seems my application runs out of memory during the conversion. Does anyone have any ideas as to how to accomplish this?

Answer:

It sounds like you're trying to read the whole file into memory or something. How does this work:

program unix2dos;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  fp1: file;
  fp2: TextFile;
  buffer, buf2: array[1..8192] of Char;
  numread: Integer;
  i: Integer;
begin
  if paramcount <> 2 then
  begin
    writeln('USAGE : UNIX2DOS <input file> <output file>');
    writeln(' Takes UNIX text file (linefeed delimited) and');
    writeln(' converts it to a DOS (CR/LF) delimited text file.');
    halt(10);
  end;
  if FileExists(Paramstr(1)) then
  begin
    AssignFile(fp1, paramstr(1));
    Reset(fp1, 1);
    AssignFile(fp2, paramstr(2));
    SetTextBuf(fp2, buf2);
    rewrite(fp2);
    repeat
      BlockRead(fp1, buffer, sizeof(buffer), Numread);
      if Numread <> 0 then
      begin
        for i := 1 to Numread do
        begin
          if buffer[i] = #10 then
            writeln(fp2)
          else
            write(fp2, buffer[i]);
        end;
      end;
    until
      NumRead = 0;
    close(fp1);
    close(fp2);
  end
  else
    writeln('Could not find file : ', paramstr(1));
end.

How to copy data from a TMemoryStream to a string without using an array of char as buffer

Problem/Question/Abstract:

How to copy data from a TMemoryStream to a string without using an array of char as buffer

Answer:

var
  S: string;
begin
  SetLength(S, MemStream.Size);
  MemStream.Read(S[1], MemStream.Size);
end;

Search and replace

Problem/Question/Abstract:

Search and replace

Answer:

Almost every text editor / word processor has the ability to search for a given string and replace it with another. If you're planning on adding similar functionality to your application, here's an example of where all of it can start:

function SearchAndReplace(
  sSrc, sLookFor, sReplaceWith
  : string)
  : string;
var
  nPos, nLenLookFor: integer;
begin
  nPos := Pos(sLookFor, sSrc);
  nLenLookFor := Length(sLookFor);
  while (nPos > 0) do
  begin
    Delete(sSrc, nPos, nLenLookFor);
    Insert(sReplaceWith, sSrc, nPos);
    nPos := Pos(sLookFor, sSrc);
  end;
  Result := sSrc;
end;

For example, let's say you have a string -- 'this,is,a,test' -- and you want to replace the commas with spaces. Here's how you'd call SearchAndReplace():

SearchAndReplace('this,is,a,test', ',', ' ')

SearchAndReplace() will now return the string 'this is a test'.

How to specify a DefaultExpression for a TField object

Problem/Question/Abstract:

How to specify a DefaultExpression for a TField object

Answer:

If you set up a field attribute set and associate that set with a field in your table that will work. If you set the value in the object inspector it will let you enter in a string but it will not reflect the value at runtime. If you try to set the TField.DefaultExpression property at runtime like this:

MyField.DefaultExpression := 'MyValue'; // (Wrong)

It will compile but you will not get a default value at runtime when you create a new record in the table by, say, clicking on the + on the DBNavigator. To get the default value to take at runtime the code assignment needs to be:

MyField.DefaultExpression := '''MyValue'''; // (Correct)

In the Object Inspector you just need to put "MyValue". Use single quotes in the Object Inspector.

Note: The default value support for the BDE dataset's is implemented in BDE itself and is not currently supported in the ADOExpress components. If you want to set defaults in your application using ADO I suggest writing a OnNewRecord event.

Converting To and From Hexadecimal Numbers

Problem/Question/Abstract:

I have seen quite a few articles on how to convert a decimal number to hexa-decimal, yet none have used the most obviuos function. Delphi offers the solution already!

Answer:

The solution is quite simple.

If you have an Integer intX and you want to convert it into an hexadecimal number use IntToHex(intNumber, intDigits)

Expample 1:

strHex = IntToHex(intX, 2);

Delphi will create a hexadecimal string representing intX with at least two digits. Therefore if intX is 10, strHex will Hold 0A.

To convert back to decimal you can use either StrToInt or StrToIntDef. However, you must ensure that the string contains a leading dollar-sign ($).

Example 2.1 (Completting this article using Example 1):

intX = StrToInt('$' + strHex);

Delphi will take strHex (0A), you may have to provide the leading $ and will return the Decimal Value 10.

Example 2.2 (Completting this article using Example 1):

intX = StrToIntDef('$' + strHex, -1);

Delphi will take strHex (0A), you may have to provide the leading $ and will return the Decimal Value 10. If the function fails, it will return the pre-defined value -1.

How to check if a string contains accented characters

Problem/Question/Abstract:

Our compiler does not support characters with accents. What is the best way to check if the strings we pass to the compiler have accents or not?

Answer:

If you check to see that every character in the string falls in the range of #$00 to #$7F, you can be sure that it contains no accented letters. Something like this will do:

function ContainsAccents(const S: string): Boolean;
var
  I: Integer;
begin
  for I := 1 to Length(S) do
    if S[I] > #$7F then
    begin
      Result := True;
      Exit;
    end;
  Result := False;
end;

How to create isometric maps

Problem/Question/Abstract:

I'm planning to make an isometric map based game. Now, to do this, I need to know if the user clicked on one (or more) squares, for example, a building or a creature. I cannot figure out how to do this.

Answer:

Create a new project. On the form, create a TImage and align it to client. Also assign the form's OnCreate event, and the Image's OnMouseUp and OnMouseDown events. Paste this code into Unit1 and run. A 10x10 grid will be drawn. Click in it to highlight a square.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
  public
  end;

var
  Form1: TForm1;

implementation

uses
  Math;

{$R *.DFM}

var
  XC: Integer;
  YC: Integer;
  LastX: Single;
  LastY: Single;

const
  Scale = 20;

procedure Map(const WorldX: Single; const WorldY: Single; out DisplayX: Integer;
  out DisplayY: Integer);
begin
  DisplayX := Round(XC + Scale * (WorldX - WorldY) * 0.5 * Sqrt(3));
  DisplayY := Round(YC + Scale * (WorldX + WorldY) * 0.5);
end;

procedure UnMap(const DisplayX: Integer; const DisplayY: Integer; out WorldX: Single;
  out WorldY: Single);
var
  Sum: Single;
  Diff: Single;
begin
  Diff := (DisplayX - XC) / (0.5 * Scale * Sqrt(3));
  Sum := (DisplayY - YC) / (0.5 * Scale);
  WorldY := (Sum - Diff) / 2;
  WorldX := Sum - WorldY;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  X1: Integer;
  Y1: Integer;
  X2: Integer;
  Y2: Integer;
begin
  XC := ClientWidth div 2;
  YC := ClientHeight div 2;
  with Image1.Picture.Bitmap do
  begin
    Width := Image1.Width;
    Height := Image1.Height;
  end;
  for I := -5 to 5 do
  begin
    Map(I, 5, X1, Y1);
    Map(I, -5, X2, Y2);
    with Image1.Picture.Bitmap.Canvas do
    begin
      MoveTo(X1, Y1);
      LineTo(X2, Y2);
    end;
    Map(5, I, X1, Y1);
    Map(-5, I, X2, Y2);
    with Image1.Picture.Bitmap.Canvas do
    begin
      MoveTo(X1, Y1);
      LineTo(X2, Y2);
    end;
  end;
end;

procedure ColorizeCell(const Color: TColor);
var
  PolygonData: array[0..3] of TPoint;
begin
  if ((Abs(LastX) < 5) and (Abs(LastY) < 5)) then
  begin
    Map(Floor(LastX), Floor(LastY), PolygonData[0].X, PolygonData[0].Y);
    Map(Floor(LastX), Ceil(LastY), PolygonData[1].X, PolygonData[1].Y);
    Map(Ceil(LastX), Ceil(LastY), PolygonData[2].X, PolygonData[2].Y);
    Map(Ceil(LastX), Floor(LastY), PolygonData[3].X, PolygonData[3].Y);
    with Form1.Image1.Picture.Bitmap.Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := Color;
      Polygon(PolygonData);
    end;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Unmap(X, Y, LastX, LastY);
  ColorizeCell(clRed);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ColorizeCell(clWhite);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  ColorizeCell(clWhite);
  Unmap(X, Y, LastX, LastY);
  ColorizeCell(clYellow);
end;

end.

Swapping two variables without pointers or a third one

Problem/Question/Abstract:

How to swap two integers without a temporary variable or pointers?

Answer:

Solve 1:

Yes, it�s possible to swap the values of two variables without using a third one or swapping pointers.

How??? The answer is: using xor!!!

Place a label and a button on a form, and put this on Button�s click event.

procedure TForm1.Button1Click(Sender: TObject);
var
  var1: integer;
  var2: integer;
begin

  var1 := 19;
  var2 := 564;

  var1 := var1 xor var2;
  var2 := var1 xor var2;
  var1 := var1 xor var2;

  // They�re swapped!!!

  Label1.Caption := 'Var1 = ' + IntToStr(var1) + '; Var2 = ' + IntToStr(var2);
end;


Solve 2:

// ========================================
// This is a FAST swap routine that swaps
// the contents of any 2 variables.
// The variables may be of any type but
// the sizeof the VARS must be passed in Len
//
// eg.  X1,X2 : integer;
//
//        SwapMem(X1,X2,SizeOf(Integer));
//
// ======================================== }

procedure SwapMem(var Source, Dest; Len: integer);
begin
  asm
         push edi
         push esi
         mov esi,Source
         mov edi,Dest
         mov ecx,Len
         cld
     @1:
         mov al,[edi]
         xchg [esi],al
         inc si
         stosb
         loop @1
         pop esi
         pop edi
  end;
end;

Open a local HTML file with HTML component

Problem/Question/Abstract:

Open a local HTML file with HTML component

Answer:

The following snippet shows what does not work and how to do it instead:


begin
  // this one does not work:
  HTML1.RequestDoc('file://C:\help.htm');

  // these two will do the trick:
  HTML1.RequestDoc('file:///C:\help.htm');
  HTML1.RequestDoc('file://localhost/C:\help.htm');
end.

Sending data from database by portions

Problem/Question/Abstract:

Some times we need send hugo quantity of data from MiddleWare Server to client application. If we do it one portion than user mast wait long time, but we can send this data by portions, when user is needed in it.

Answer:

Some times we need send hugo quantity of data from MiddleWare Server to client application. If we do it one portion than user mast wait long time, but we can send this data by portions, when user is needed in it.

This is sample about getting portion of data from DataSetProvider and adding it to CLientDataSet.

In my article "Accessing DataBase via 3th server" you can read how send data between applications usin INDY components.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB, DBTables, Provider, DBClient, Grids,
  DBGrids, ExtCtrls, DBCtrls, IdBaseComponent,
  IdAntiFreezeBase, IdAntiFreeze, JvSpecialProgress;

type
  TForm1 = class(TForm)
    DataSetProvider1: TDataSetProvider;
    Table1: TTable;
    BitBtn1: TBitBtn;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    ClientDataSet1: TClientDataSet;
    BitBtn2: TBitBtn;
    DBNavigator1: TDBNavigator;
    IdAntiFreeze1: TIdAntiFreeze;
    BitBtn3: TBitBtn;
    JvSpecialProgress1: TJvSpecialProgress;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    data: OleVariant;
    records: integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  recs: integer;
  j: integer;
begin
  ClientDataSet1.Active := False;
  data := DataSetProvider1.GetRecords(1, recs, ResetOption + MetaDataOption);
  Showmessage(format('get %d Records', [recs, i]));
  ClientDataSet1.AppendData(data, False);
  ClientDataSet1.Active := True;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  records := DataSetProvider1.DataSet.RecordCount;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  recs: integer;
  j: integer;
begin
  data := DataSetProvider1.GetRecords(-1, recs, ResetOption + MetaDataOption);
  ClientDataSet1.AppendData(data, False);
  ClientDataSet1.Active := True;
end;

procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
var
  recs: integer;
begin

  case Button of
    nbNext:
      begin
        if DBNavigator1.DataSource.DataSet.RecordCount data :=
          DataSetProvider1.GetRecords(1, recs, ResetOption + MetaDataOption);
        ClientDataSet1.AppendData(data, False);
      end;
  end;
  nbPrior:
  begin
  end;
  nbLast:
  begin
    if DBNavigator1.DataSource.DataSet.RecordCount data :=
      DataSetProvider1.GetRecords(-1, recs, ResetOption + MetaDataOption);
    ClientDataSet1.AppendData(data, False);
  end;
end;
nbFirst:
begin
end;
end;

end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  recs: integer;
begin
  JvSpecialProgress1.Maximum := records;
  JvSpecialProgress1.Position := 1;
  while ClientDataSet1.RecordCount data := DataSetProvider1.GetRecords(1, recs,
    ResetOption + MetaDataOption);
  ClientDataSet1.AppendData(data, False);
  JvSpecialProgress1.Position := JvSpecialProgress1.Position + 1;
end;
end;

end.

New to Delphi 5 - some properties are missing

Problem/Question/Abstract:

I just found out that Ctrl3D property is not showing in IDE in all components.I tried with TDBEdit, TEdit, TStringGrid. The code has Ctrl3D published, but it wouldn't show on any of components in Delphi 5.

Answer:

The Object Inspector can now hide properties based on categories. The Ctl3D property is part of the "Legacy" category, which is hidden by default.

Right click on the Object Inspector, and select the View submenu. Click on 'Legacy' to show the Ctl3D property. You can also select 'All' to show all properties.

You can tell exactly how many properties are currently hidden by looking closely at the statusbar at the bottom of the D5 Object Inspector window.

How to get a list of all available Truetype fonts

Problem/Question/Abstract:

I have a situation where I'd like to loop through about 100 font files and extract their friendly name from the file. Has anyone ever done this?

Answer:

Assuming that all fonts are already installed, you need to use EnumFontFamilies and a callback function:

{the callback function prototype}

function FontEnumProc(LogFont: PEnumLogFont; TextMetrics: PNewTextMetric;
  FontType: Integer; lParam: LPARAM): Integer; stdcall;

implementation

function FontEnumProc(LogFont: PEnumLogFont; TextMetrics: PNewTextMetric;
  FontType: Integer; lParam: LPARAM): Integer; stdcall;
begin
  {add the font name and its font type to a list box}
  Form1.ListBox1.Items.AddObject(TEnumLogFont(LogFont^).elfLogFont.lfFaceName,
    TObject(FontType);
    {continue enumeration}
    Result := 1;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  EnumFontFamilies(Form1.Canvas.Handle, nil, @FontEnumProc, 0);
end;

If the fonts are not installed, you can install them temporarely.

Show images in the cells of a TStringGrid

Problem/Question/Abstract:

How to show images in the cells of a TStringGrid

Answer:

Solve 1:

The following example uses a TStringGrid to display the bitmaps from the filename strings stored in each cell. In the TStringGrid, I set the DefaultRowHeight to 96 and the DefaultColWidth to 128 (with ColCount = 1).

Here's the OnDrawCell that does all the work:

procedure TForm1.StringGridImageSourceDrawCell(Sender: TObject;
  Col, Row: Integer; Rect: TRect; State: TGridDrawState);
var
  Bitmap: TBitmap;
  Filename: string;
begin
  Filename := (Sender as TStringGrid).Cells[Col, Row];
  if Filename <> NoImagesLoaded then {special "kludge" case}
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.LoadFromFile(Filename);
      (Sender as TStringGrid).Canvas.StretchDraw(Rect, Bitmap);
    finally
      Bitmap.Free
    end;
    {Draw blue outline around selected row}
    if Row = (Sender as TStringGrid).Row then
    begin
      with (Sender as TStringGrid).Canvas do
      begin
        Pen.Color := clBlue;
        Pen.Width := 5;
        MoveTo(Rect.Left + 2, Rect.Top + 2);
        LineTo(Rect.Right - 2, Rect.Top + 2);
        LineTo(Rect.Right - 2, Rect.Bottom - 2);
        LineTo(Rect.Left + 2, Rect.Bottom - 2);
        LineTo(Rect.Left + 2, Rect.Top + 2)
      end;
    end;
  end;
end;


Solve 2:

In your StringGrid's OnDrawCell event handler, place some code that resembles:

with (Sender as TStringGrid) do
  with Canvas do
  begin
    {...}
    Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
    {...}
  end;

Using the Draw() or StretchDraw() method of TCanvas should do the trick. BTW, Image1 above is a TImage with a bitmap already loaded into it.

How to draw a bitmap between the checkbox and the label in a TCheckListBox

Problem/Question/Abstract:

How to draw a bitmap between the checkbox and the label in a TCheckListBox

Answer:

This should do the trick. It is also possible to place a bitmap in the middle, i.e. The checkbox, then some text, the graphic, then more text, on the same line. The Checklistbox style must be set to lbOwnerDrawVariable for this to work.

procedure TForm1.Button2Click(Sender: TObject);
begin
  {Bit1 is called from a resource file}
  CheckListBox1.Items.AddObject('Test this bitmap', Bit1);
end;

procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
begin
  Offset := 12;
  with (Control as TCheckListBox).Canvas do
  begin
    FillRect(Rect);
    Bitmap := TBitmap(CheckListBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width, Bitmap.Height),
        Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    end;
    TextOut(Rect.Left + Offset, Rect.Top, CheckListbox1.Items[Index])
  end;
end;

procedure TForm1.CheckListBox1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  height := 16;
end;

Block-mode in the editor

Problem/Question/Abstract:

Block-mode in the editor

Answer:

In order to copy/delete rectangles ('columns') of text in the editor, press ALT, then use the left mousebutton to mark the rectangle. Afterwards, you can insert this text rectangle as a block!

How to join multiple tables

Problem/Question/Abstract:

I am trying to connect a table in Delphi 3 (using Paradox) to receive data from multiple tables. Up till now, I thought using LEFT OUTER JOIN would do the trick, unfortunately, as soon as I hook up the third table, no data is send to the grid. The join has to be in a way of lookup.

Answer:

If your tables have the same struct (or you can force the same structure via SELECT) you can use UNION:

SELECT * FROM Table1
UNION
SELECT * FROM Table2

If your tables have different structs, try FULL OUTER JOIN instead of LEFT following from localsql.hlp:

SELECT * FROM customer C
FULL OUTER JOIN orders O
on(C.custno = O.custno)
FULL OUTER JOIN items I
on(O.orderno = I.orderno)