Checking the number of components at runtime

Question

Is there a way of checking how many components exist (at runtime) for the
entire application without having to run through every other components
ComponentCount property.

Included in the above question is to find components that are on forms
that are only created at runtime.  (This can exclude any additional
components created on these created forms at runtime.).

I would have thought that TApplications ComponentCount property would
indicate this but it does not.

Answer

A:
You can find out how many Components your application uses (which
have already been created...)

Every form that is in existence is stored in Screen.Forms, which is an array of Forms.
Every form has a ComponentCount.
So, you would use a routine like this:

function GetTotalComponents : Integer;
var
  TotalComps,
  CurForm : Integer;
begin
  TotalComps := 0;

  for CurForm := 0 to (Screen.FormCount - 1) do begin
    TotalComps := TotalComps + Screen.Forms[CurForm].ComponentCount;
  end;

  Result := TotalComps;
end;

In fact, I just ran and compiled it and it worked... although I
didn't check it for components that are made at runtime.  I do know
that it doesn't give an accurate count for Forms that are in the .dpr
file, but which aren't autocreated. So I'll have to work on that.

Also, I did a check of what Application.ComponentCount gives me, and
it gives you the # of forms/windows that it has. This includes one
invisible window which is the application window.

Override of existing identical methods

Question

I need to add a couple of properties, methods and events to each of the standard components and override a couple of the existing methods. Since all of these except the overriden ones are identical for all or most of the components, it makes sense to write a class which handles these.

Answer

A:
You could write a unit in which you override each of the standard
components that you would like to modify.  However, instead of
copying virtually identical code into every component, just add
calls to a few standard procedures that all of the components
share.

E.g.:

procedure SharedProcedure(Sender : TComponent);
begin
  {do standard processing to manipulate Sender component}
end;

procedure TMyLabel.Whatever; {overridden method of TLabel descendant}
begin
  SharedProcedure(Self);
end;

procedure TMyListBox.Whatever; {overridden method of TListBox descendant}
begin
  SharedProcedure(Self);
end;

This way, all you duplicate are the procedure calls.  The bulk of
the code just resides in a single place.  This is almost as good
as having the multiple inheritance...almost.

Change location of hints

Question

I have been looking for the property that decides where the
popup hint window should locate itself. Is there a way
to change the location?

Answer

A:
There is a neat trick to popup hints.  You can bypass the popup altogether and control in code.  For example: have a panel with the visible property set to false.  Then have a routine at the form level that checks the item under the pointer.  If it passes over something you want then set the panel to be visible.  You can vary the size and location of the panel if you want to.  I think that should be done at
the form level.

You could also set up a status bar to show all hints.  I use a
combination of the popup hint and status bar.  To show both hint messages make the hint something like this:
This is the popup part of the hint|This is the status bar hint.

Set the mouse cursor at the focused button automatically

Question

I am trying to programmatically move the mouse to the currently focused button

Answer

A:
In the OnEnter event for the button(s)...

	cntl : TControl;
	...
	cntl := TControl( Sender );

1.  Calculate the center of the button ( x, y )

	Ex: if the button is Height 24 and Width 24 then the center
	    is 12 and 12.

	xCenter := cntl.Left + ( cntl.width / 2 );
	yCenter := cntl.Top + ( cntl.height / 2 );

2.  Place this value into a TPoint.

	ptBtn : TPoint;
	...
	ptBtn := Point( xCenter, yCenter );

3.  Obtain the Screen coordinates for the center of the button

	ptBtn := cntl.Parent.ScreenToClient( cntl.ClientToScreen( ptBtn ) );

4.  Set the mouse  ( cursor ) pos to ptBtn and it should move the cursor to
the center of the currently focused button.

	SetCursorPos( ptBtn.X, ptBtn.Y );

Cut, copy and paste: one method for different TEdit-controls

Question

The Delphi manual illustrates calling the cut, copy or paste methods of an
edit control using either a menu choice or the usual hotkeys. The example
goes like
  If Sender = Control then
  Control.CutToClipboard;
For forms with several edit controls, the suggestion is to use a case
statement to determine the sender and then access the method of the sender
as above. Is there another way that can be used to access any control in
one statement?

Answer

A:
The trouble is that sender is TObject. TObject does not have a cut to
clipboar method. If you think that TObject is a type which does have
such a method, you can convert it. For example,

procedure objectCutToClipboard(sender as TObject);
var
  myEdit : TEdit;
begin
  if sender is TEdit then myEdit := sender as TEdit;
  myEdit.cutToClipboard;
end;

You can also do this:

procedure objectCutToClipboard(sender as TObject);
begin
  if sender is TEdit then 
  (myEdit as TEdit).cutToClipboard;
end;

The first method is better if you will be using sender several times; 
that way you do not need to convert it to TEdit each time.

Try this:
(1) On a form place several edit boxes; names can be anything.  Put some 
text in each edit box.
(2) Add two more edit boxes named nEdit and rEdit.
(3) Add a list box named ListBox1 (default);

(4) Put this in the MOUSEUP routine for the first Edit box.

procedure TForm1.Edit1MouseUp(sender: TObject; Button: TMouseButton; 
Shift: TShiftState; x,y: integer);
var
  astr,aName: string;
  anEdit: TEdit;
begin
  if button <> mbRight then exit;
  if sender is TEdit then
    begin
      anEdit := sender as TEdit;
      clipboard.clear;
      anEdit.selectAll;
      anEdit.cutToClipboard;
      rEdit.text := '';
      rEdit.pasteFromClipboard;
      nEdit.text := anEdit.name;
      ListBox1.items.add(nEdit.text + ' : ' + rEdit.text);
    end;
end;

(5) Set the MOUSEUP routine for ALL of the edit boxes except for rEdit 
and nEdit to the routine for the first Edit box. (Just click on the down 
Arrow and choose it.)

Now a right click in any one of those Edit boxes will be processed by the 
same routine. The right click will select all of the text in the listbox, 
paste it into rEdit, get the name of the Edit that you clicked in, place 
the name into nEdit, and then place a carefully constructed combination 
of the two into the List Box.

(6) Now, add this routine to the MOUSEUP routine ( or click ) of List Box
1.  This routine shows you how to reverse the process and put the text 
back into the correct box.

procedure TForm1.ListBox1MouseUp(sender: TObject; Button: TMouseButton; 
Shift: TShiftState; x,y: integer);
var
  astr,lStr, cmptStr: string;
  anEdit: TObject;  {Must be TObject, not TEdit!}
  ii,aNo,l: integer;
begin
  {get the selected string }
  ii := ListBox1.itemIndex;
  lstr := ListBox1.items[ii];
  {split the string into a control name and the text }
  l := length(lstr);
  aNo := pos(':', lstr);
  cmptStr := copy(lstr,0,aNo-2);
  aStr := copy(lstr,aNo+2, l - (aNo + 1));
  nEdit.text := cmptStr;
  rEdit.text := astr;
  { These two lines are the really important ones! }
  anEdit := findComponent(cmptStr);
  (anEdit as TEdit).text := astr;
end;

If I have typed this all correctly, a click on any listBox line should 
put the text back into the listbox from whence it came.

Some notes:

You need to use MouseUp and NOT click in the Edit routine because you 
need to filter for the right button and click does not give you the info.
Unfortunately, a right click in a list box does not select a line.  Item 
index remains -1 and will give you an error.

FindComponent(aStr) returns a tObject; hence the need to type anEdit as 
TObject and cast it as TEdit later.

If you are going to use the (tObject as TEdit).something method, make 
sure that you use the parentheses.

I hope that this helps you out.  I really had to spend a lot of time 
struggling with it some time ago to figure it out.

Enterkey instead of Tabkey

Question

I would like the Enter key to work as the Tab key when an Entryfield is focused.

Answer

A:
First, make sure the Form's KeyPreview property is set to True, then attach
the following procedure to the form's OnKeyPress event (easiest way is go to
the form's events tab, then double-click in the OnKeyPress event, Delphi will
then create the procedure header and body for you):

  procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
  begin
     if (Key = #13) then
     begin
	Key := #0;                       { Eat the enter key }
	Perform(WM_NEXTDLGCTL, 0, 0);
     end;
  end;

Alt-? key combination in an aboutbox

Question

I'm trying to obtain the same that Delphi developers done in Delphi About
Box...I'd like to trap the ALT-? key pressing to show hidden information
such revision number etc...how can I do this?

Answer

A:
Anyway here's some code which does similar. However if you have the
shift=[ssalt] condition it means that the keypresses are intepreted by the
default handlers and every keypress generates a beep.
You need to set the previewkey option on the form.

In the key down event:

procedure TAboutBox.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
   i:integer;
   working:integer;
begin
     if (shift=[ssalt]) and (key>=$41) and (key<=$5A) then begin
     s:=s+chr(key);
     working:=0;
     for i:=1 to 4 do begin
         if (s=copy(strings[i],1,length(s))) then working:=-i;
         if (s=strings[i]) then working:=i;
         end;
     if working=0 then s:='';
     if working>0 then showmessage(strings[working]);
     end;
end;

In the form create event: {to ensure that the string is initially empty}

procedure TAboutBox.FormCreate(Sender: TObject);
begin
     s:='';
end;

At the top of the form to define the various messages:
type
    Tst=array[1..4] of string;
const
     strings:Tst= ('HELLO','BYE','VERSION','PROGRAMMER');


In the public section of the form:
  public
        s:string;

A:
Place a button off-screen that has a shortcut of Alt-?. Since it's an about
box, I assume that it's not resizeable and thus the user will never see this
button. Trigger your version and revision info off of the OnClick event of
this button.

Bit-wise manipulation

Question

Can some one explain how to do bit-wise manipulation?

Answer

A:
Ok I will give it a 4 bit example.
Bit masks are usually used for things like properties.

For a 4 bit number the max value is 1+2+4+8 = 15 (or 1111). If one
property is attached to each bit ( 1 = True, 0 = False) the resultant
number is always unique.

Now we wish to find the status of a particular bit. It would be
fairly tedious to convert to binary or write an algorithm to do this
in decimal. Lets assume we we have a number say 7 (0111) and  want the
setting of the third bit (from the right). The value we wish to check
for is 0100 (4 in decimal).

So we are comparing two values    0100 and 0111    literally bit by
bit. Here are some sample results which should show how to use
bitwise operators

0100               0111

4          AND       7          =  0100   (4)
                             (=4 so the bit we want is set to 1)
4           OR          7          = 0111   (7)
                             (not much use in this example)
4           XOR       7          =  0011  (3)

If you are following the thread I think you are AND is what you are
looking for. As you know exactly what you are checking for this is
the only bit that you set in your comparison value which means that
the only possible result is 0 or (in this example) 4

So your code would be
If  (YourCheckVar AND 4) = 4 Then
     3rd bit is set
Else
     3rd bit is not set;

Array of controls

Question

In VB when I make a Copy and Paste of a control, VB proposes to build an array
of controls. Do you know how to do something similar in Delphi? Warning: I
don't want to share a methode but to access to several controls in a loop.

Answer

A:
You can have an array of objects, but the visual designer won't build it for
you automatically. IMO, this is a "good thing", not a limitation. In every
case where I wanted to do this the array was more complex than a single
control (in one real world example it was a dynamic array of up to 26 bevels
that each had an image, a tick box, a label and a gauge within it) and the
layout on the form is typically more complex than a vector layout (in that
example it was a two-dimensional array which depended on the size of the
client area of the window at the moment and had to feedback adjustments to the
window size based on the existent suite of hardware and share devices).

My suggestion is to build the single prototype of the control complex that you
need on the form, but make it invisible and not enabled. Then define a
descendent of TObject that holds all of the various components involved (this
step may be omitted if the component structure has its own top level
hierarchical object like a TPanel). Finally, define an array of that object
and put a variable of this type on the form.

At execution time you can instantiate components to build each array entry
(copying the prototype to preset most properties) and set its attributes for
position. Remember to insert these dynamic components into their owner so that
they'll appear (the owners of the prototype are where to insert the new
controls). It may sound complex, but it is really simple and takes little code.
Yet it offers much more control than the VB array does -- that's the difference
between a real language like ObjectPascal and a RAP tool like VB.

Delay, pause, wait

Question

How do you get your Delphi app to do nothing for a period of time?

Answer

A:
Uses
     ....
     Winprocs
     ....;

Procedure delay(millisecs : longint);   { delay for given milliseconds }
var
     endtime   : longint;
begin
     endtime := gettickcount + millisecs;
     while endtime - gettickcount < 0 do
          Application.ProcessMessages;
     end; { delay }

A:
procedure Wait;
var oldTime: LongInt;
begin
  oldTime := GetCurrentTime;
  repeat
   { whatever}
  until GetCurrentTime - oldTime >= yourDelay;
end;

To which I would add:

As current Windows does not have pre-emptive multi-tasking,
it's normally good event-handling manners to allow Windows
to jump in to the gap, so the { whatever } above should
usually read:

          Application.ProcessMessages;


A:
Procedure Delay(DTime : LongInt);
Var
  L : LongInt;
Begin
  L := GetTickCount;
  While (Abs(L-GetTickCount) < DTime) do;
End;

The usage is "Delay(1000'th of a second)", for example
Delay(5000) will wait 5 seconds.

Process Messages

Question

Can anyone tell me is there an exact situation that
Application.ProcessMessages should be called, or do I just add
it in when I start getting some weird behaviour from my app.?

Answer

A:
In the normal course of events (unintentionally appropriate opening phrase)
we don't really need to call Application.ProcessMessages because the built-in
event loop provided by the Delphi framework hands control back to Windows
often enough anyway.

However, when coding a time-consuming loop it is sometimes advisable (and good
Windows manners) to insert a call to Application.ProcessMessages into the loop.
Without it everything will work, but the user will be prevented from
interacting with Windows (e.g. to switch to Program Manager and launch another
application) until the time-intensive activity is finished.

Inserting a call to Application.ProcessMessages into a time-consuming loop is
a particularly good idea if you want the user to be able to cancel the
operation. Without it your Cancel button won't get a look in.

A:
You would use it when some deep processing is occurring in your
app, like a deep loop, calculations, etc. This command say to Delphi to
let Windows manages his pending messages on his stack, so giving control
to other applications running simultaneously (remember, Windows 3.11 is
a using a cooperative multitasking, so your app must give control back
to Windows).

Tab key handling

Question

I am not able to trap the Tab key in my OnKeyDown Event handler.

Answer

A:
procedure YourFormName.FormKeyPress(Sender: TObject; var Key: Char);
begin
    {If Key = #13 Then
    {Begin
      if (ActiveControl is TEdit)
      or (ActiveControl is TDBEdit)
      or (ActiveControl is TDBListBox)
      or (ActiveControl is TDBComboBox)
      or (ActiveControl is TDBLookupList)
      or (ActiveControl is TDBLookupCombo) then
        begin
          SelectNext(ActiveControl as tWinControl, True, True );
          Key := #0;
        end;
    end;}
end;

Changing font style problem

Question

I have a routine for changing the font style of a TPanel caption to
Strike Out...BUT it doesn't work - I get a type mismatch error:

procedure PanelIgnore(cp : TPanel)
begin
  with cp do begin

     {various attributes set}
     Font.Style := fsStrikeOut;
  end;
  cp.Update;
end;

Answer

A:
Try the following...it should work:

with cp do begin
   { various attributes set }
   Font.Style := Font.Style + [fsStrikeOut];  { to add strike out }
   Font.Style := Font.Style - [fsStrikeOut];   [ to remove the strike out }
   end;

Note: this method will work for Bold, Italic and Underline, as well.

Testing event handler for existence

Question

I want to test (at runtime) whether an event has a handler attached to it.
However, if I try to write something like:

   if bitbtn1.onClick = nil then

it tries to execute the event (asks me for an argument).  I've also tried

   if not assigned(bitbtn1.onClick) then

but this gives me "Invalid Variable Reference".  I've tried assigning things
to pointers and trying to cast to a longint, all to no avail.  Is there any
way to do this?

Answer

A:
I wonder if the contraption

     if @bitbtn1.onClick = nil then

might work. This is what Borland recommends when you are dealing with a
procedural variable. After all, events are just procedural variables, although
8 bytes long.

A:
"bitbtn1.onClick" is defined as a _property_, not an actual pointer to a
method.  You can assign values to it (e.g., "bitbtn1.onClick :=
BitBtn1Click"), but I don't believe there is a simple way to read the
assigned value back again -- at least not that I'm aware of.  If there IS a
way, I hope someone will post it, as I'd like to know, too!

Anyway, I started screwing around with the stuff in the TypInfo unit, and I
came up with the following solution, which seems to work for me:

1.  Add the "TypInfo" unit to your "uses" clause.

2.  Try the following code on for size:

var
  MyPropInfoPtr:  PPropInfo;
  MyMethod:       TMethod;
begin
  MyPropInfoPtr := GetPropInfo(BitBtn1.ClassInfo, 'OnClick');

{    hopefully the following "if" statement will ALWAYS be TRUE! }
  if MyPropInfoPtr^.PropType^.Kind = tkMethod then begin
    MyMethod := GetMethodProp(BitBtn1, MyPropInfoPtr);
    if MyMethod.Code = @TForm1.BitBtn1Click
       then ShowMessage('equal') else ShowMessage('not equal');
    if MyMethod.Code = nil
       then ShowMessage('nil') else ShowMessage('not nil');
  end;
end;

A:
Try the following:
var
   OnClickAddr : TNotifyEvent;
begin
   OnClickAddr := bitbtn1.OnClick;
     { this is pointer to pointer assignment }

  if not Assigned(OnClickAddr) then
      { your stuff }
  {
   or
  if OnClickAddr = nil then
  }
end;

Toggle NumLock CapsLock Keys

Question

Has anyone programatically toggled the NumLock, CapsLock, etc. keys?

Answer

A:
const
     inserton     = 1 shl 7;
     capslockon   = 1 shl 6;
     numlockon    = 1 shl 5;
     scrolllocon  = 1 shl 4;
     

procedure chgkeys(whatkey : byte; want_on : boolean);
var
     keyflags  : byte absolute $40:$17;
begin
     if want_on then
          keyflags := keyflags or whatkey
     else
          keyflags := keyflags and not whatkey
     end;



Call with whatkeys set to one or more of the constants (added together) and
want_on true
or false depending of wheter you want to set or reset the state.

Is a Bit set

Question

Is a Bit set?
What is the most efficient way to see if a bit is set in an integer?
My main problem is finding out if the File Dialog box Readonly flag is set.

Answer

A:
AND is probably the most efficient.

   IF (filelistbox1.filetype AND ftreadonly)<>0 THEN read_only_flag_is_set;

A:
The expression after the 'IF' will always resolve to a boolean.
'A AND B' yields a boolean result (any non-zero value is 'TRUE') - so does '(A
AND B) <> 0'.  However in certain instances with range checking on I have had
to use a boolean() typecast.

A:
  IF (ftReadonly in filelistbox1.filetype) THEN read_only_flag_is_set;

According to the Object Pascal Language Guide, "Small set operations...are
generated inline using AND, OR, NOT, and TEST machine code instructions", so
chances are the code generated will be as efficient as the AND.

Inherited free

Question

If I derive a class from TObject and I define my own constructor and destructor
IE:

    MyClass = class(TObject)
      public
         constructor Create;
         destructor  Free;
    end;

Should the code in either my constructor or destructor call the inherited
create and free.  IE:

   destructor MyClass.Free;
   begin
      ... free my stuff ...

     { Call low-level free ???? }
      inherited Free;
   end;

Answer

A:
When deriving from TObject, you should have a Create and Destroy, not Create and
Free. Free is NOT a virtual method, and therefore cannot be overridden. Free
simply calls Destroy if the object is actually in existance. And yes, you
should *always* call the inherited Create and Destroy methods in your descendant
classes. So to clarify, use:

MyClass = class(TObject)
  public
    constructor Create; override;
    destructor  Destroy; override;
end;

constructor MyClass.Create;
begin
  inherited Create;
{do initialization}
end;

destructor MyClass.Destroy;
begin
{free up resources}
  inherited Destroy;
end;

A:
Yes, you should call the inherited Create method.
Free is a different story. You should not Override the free method, you should
override the destroy method, and also call the inherited destroy method. The
reson for this is the Free method automatically calls the Destroy method, IF
AND ONLY IF THE OBJECT IS NOT NIL.  Someone told me the Free method is some
kind of black-magic assembler function.

A:
You might want to note that you can't use the 'override' keyword with the
'constructor Create' or the 'destructor Free' as indicated below - or so
the compiler says when I attempt to do so. You can however use the
'virtual' keyword.  In fact you can use the 'virtual' keyword with both
'Create' and 'Free'.
The only hokey thing about using 'destructor Free' is that when your
procedure executes it automatically calls 'Destroy' on exit - so don't
explicitly call 'Destroy' when using 'destructor Free'. Maybe that is a
function of the 'destructor' keyword?

Attach procedures to components created

Question

I've created some components dynamically.  The problem is that I don't have
any idea on how to attach some common events such as "OnClick", "OnEnter"
to these components.

Answer

A:
I would recommend that you consider overriding the default KeyPress, Click,
DblClick (etc) events.
Here's a brief example of an override Click procedure:

(Declaration in protected section of class type definition)

     procedure Click ; override ;

(Code below, in implementation section)

procedure GOKButton.Click ;
begin
   inherited Click ;
   (Owner as TForm).Close ;
end ;

Simulating a pause in a loop

Question

I'm looking for some help in simulating a pause within a loop. This
is my scenario :
Form1.Procedure initiates a while..do loop which displays data on
Form2. When the Form2 is filled (part way through the Form1 loop) I
want to Show Form2. On Form2 are two buttons  and ,
which if the user selects  passes control back to the Form1
loop for continuation of processing.. but I DO NOT want to Close
Form2.. hence I cannot use ShowModal.
My attempts to date have been to pass control to a function in Form2
which will return true/false depending on the button selected, but I
still can't work out how, on a button click, to return info back to
the original function called in Form2 so it can return the
appropriate result ie I still need a 'wait until a button is pressed
on this form' loop (or equivalent) within the function.

Answer

A:
in response to the following:
what about this:
pass control to you funtion, and in you function,

buttonpressed:=0;
repeat
  Application.processmessages;
until buttonpressed<>0;
result:=buttonpressed;

in your on click methods, you could set the buttonpressed variable to a value
other than 0 to indicate which was pressed.

Copying from a TEdit to an integer field

Question

Can someone help me. I am trying to copy a Tedit (stringfield) to an
integerfield.
I am getting an error " Type mismatch"

Answer

A:
Try the follwing code :

     function IVal( Str : string ) : LongInt;
     var ErrCode : integer;
     begin
     
       result := 0;
       if ( Str = '' ) then
         exit;
       Val( Str, result, ErrCode );
     end;


     ....

     YourIntegwrField := IVal( YourStringField );


     if you are reading from a table or query component, You can also use:


        YourIntegwrField := YourStringField.AsInteger;

A:
MyIntField.Value := StrToInt(MyEditField.Text);

A:
That's because Tedit contains a string, not an integer, so you have to do a
conversion. Try something like:

    val(Tedit1.text, myinteger, code);

You need to trap an error if Tedit1.text is non-numeric, "code" will be set
if this is so, look it up in Help.

A:
integerfield.value := StrToInt(stringfield.value);
or
integerfield.AsString := stringfield.value;
or
integerfield.Value := stringfield.AsInteger;

Using menu options to cut, copy, and paste

Question

It's easy in Delphi to use the standard Windows keystrokes to cut, copy, and
paste in any component that holds text.  You don't even have to write code
to do it!
But if I want to add Cut, Copy, and Paste to my app's menu and have it work
no matter what component I'm in, is there an easy one-liner way to do this?

Answer

A:
If the component "knows" how to copy, cut and paste it's contents
to clipboard you can just send a message to it.

For example WM_COPY message:

if GetFocus <> 0 then  { if any window has a focus }
SendMessage( GetFocus, WM_COPY, 0, 0);   { send WM_COPY to it }

Note:
I prefer to use API's GetFocus insteed of ActiveControl property,
because ActiveControl not always points to a windows having a focus.

Overriding the Create method

Question

When creating a new TWindow descendant, overriding the create method to add
the object initilization is very easy, just:

Procedure TMyWinControl.create;
begin

inherited
...additional stuff

end;

But, when creating a TOBject descendant, the create method is not virtual, so...
How can I do the same to initialize my new object?
Is the following code rigtht?

Procedure TMyTojectDescendant.create;
begin
inherited; {is this right??}
{Initilization code}

end;

Answer

A:
Yes, but you cannot use inherited without a procedure name in these
places. You should write 'inherited Create. The difference is when
someone else (Delphi for example) calls your Create constructor.
Simplifying, caller is not able to create the correct instance of
TObject, because TObject's constructor is not virtual. More precisly
constructor is not a method of the object but of its' class.

Oh, following code will explaine it better:

type
  TComponentClass = class of TComponent;

procedure CreateInstanceExample(AClass : TComponentClass);
begin
  AClass.Create(nil).Show;
end;

begin
  CreateInstanceExample(TForm);
    { Here the procedure creates and shows a from }
end.

Check whether mouse is over client area

Question

I want my application to know when the mouse cursor is no longer
hovering over the Client area of my application window.

Answer

A:
On the Form's OnMouseMove do:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  P : TPoint;
begin
  P.X := X;
  P.Y := Y;
  if PtInRect (ClientRect,P) then {or boundsrect for whole window rect}
    MouseCapture := True
  else
    begin
      MouseCapture := False;
      ShowMessage ('It''s not over me anymore');
    end;
end;

Name / caption property & emulating the caption

Question

I need to use the name property to fill another property (like caption is
set by changing the name of a label) how is this done? I have to use a name
to create a link to another app for simplicity's sake I would like to
automatically use the component name. I would like to create the link at
create or load time but when I try, I get a blank for the name property

Answer

A:
Is something like this what you are looking for?

type
  TJJJ = class(TLabel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation

constructor TJJJ.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   Caption := Name;
end;

A:
1. Override the virtual SetName method that is inherited from TComponent
2. Make sure you call inherited SetName( NewValue ) to reuse the deafualt
name creation logic from Tcomponent
3. Augment the SetName Method with whatever code you need.


Example
-----------------------------------------------
unit edit;

interface

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

type
  TkeEdit = class(TDBEdit)
  private
    { Private declarations }
    FName : String;
  protected
    { Protected declarations }

 { override the virtual method }
    procedure SetName( const NewName : TComponentName ); override;

  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Keen Edge', [TkeEdit]);
end;

procedure TkeEdit.SetName( const NewName : TComponentName );
BEGIN
        { reuse default TComponent SetName Logic }
     inherited SetName( NewName );

        ( 3. Augment SetNAme Logic }
        { always add the string 'Test' to the name whenever it is changed. }
    Text := 'Test' + Name;
END;

Override vs Redefine

Question

On Compuserve, someone brought up that you cannot override a static
method, however, you can redefine it.  Functionally, what is the difference.
I can see that you do not have access to the overriden method, but are there
any other differences?

Answer

A:
Yes, there is one other important difference.  The difference is that if the
ancestor object calls the method then it won't be calling your method, it
will be calling its own method (or higher up the tree if not defined in that
object).  A common practice in OOP is to define a base class that has has
virtual methods that have no definition, that are meant to be overridden in
descendant objects.  The base class will actually call these methods even
though they have no code in them,  and if you did not create a descendant
class you would get a run-time error if that method was ever called.  That is
what polymorphism is all about.

Why no free

Question

My Pascal Ref manual states that calling Free is the correct (or better)
way to destroy these objects.

 TStage = class(TObject)
   constructor Create;
   destructor Destroy;
   ..
   ..
   ..
 end;

 *** NOTE that I did not override free!

So here is the question.  At program shutdown I call:  Stage.Free.  Stage
was created by  Stage := new TStage; I placed some debug output calls in
TStage.Destroy but I never see them!
If I call Stage.Destroy I do see them! What is the deal?

Answer

A:
You should declare your desctructor as
  destructor Destroy; override;

The Destroy method of TObject is a virtual method and can be overriden.  That
way when you call Free (even though you have not defined a Free method in
your class) it will, through the miracle of polymorphism, call the correct
Destroy method.

So, Stage.Free really executes TObject.Free.  Since you did not override the
definition of Destroy in TStage, TObject.Free calls TObject.Destroy.  If you
override Destroy in TStage then when TObject.Free calls Destroy, Delphi is
able to figure out that you wanted TStage.Destroy not TObject.Destroy.

Mouse Coordinates / Lost Focus

Question

I need to write an application in which I collect the absolute mouse
coordinates anywhere from the screen, on a mouse click, but my (always on
top) application does not cover the total screen. As soon as I click outside
the application I loose focus and can't update the new position.
Does anyone know an answer to one of these questions:
- how to prevent loosing focus or...
- how to get control over the mouse click events in windows or...
- how to make a application transparent, so I can maximise my window and see
the application below, but my application is in charge.

Answer

A:
Try to use:
  SetCapture(Form1.Handle);
  &
  ReleaseCapture;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetCapture(Handle);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Caption:=Caption+'.';
  if length(Caption)>40 then
    ReleaseCapture;
{ You should return the power back to system in the right time, or ...}
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SetCapture(Handle);
end;

Overriding Virtual Methods

Question

Anybody know what the difference is between OVERRIDING a virtual
method and REPLACING it? I'm confused on this point.

Answer

A:
Say you have a class
  TMyObject = class (TObject)
and a subclass 
  TOverrideObject = class (TMyObject)

Further, TMyObject has a Wiggle method:
  procedure Wiggle; virtual;
and TOverrideObject overrides Wiggle
  procedure Wiggle; override;
and you've written the implementations for both.

Now, you create a TList containing a whole bunch of MyObjects and 
OverrideObjects in the TList.Items[n] property.  The Items property is a 
pointer so to call your Wiggle method you have to cast Items.  Now you 
could do this:

  if TObject(Items[1]) is TMyObject then
    TMyObject(Items[1]).Wiggle
  else if TObject(Items[1]) is TOverrideObject then
    TOverrideObject(Items[1]).Wiggle;

but the power of polymorphism (and the override directive) allows you to 
do this:

  TMyObject(Items[1]).Wiggle;

your application will look at the specific object instance pointed to by 
Items[1] and say "yes this is a TMyObject, but, more specifically, it is 
a TOverrideObject; and since the Wiggle method is a virtual method and 
since TOverrideObject has an overridden Wiggle method I'm going to 
execute the TOverrideObject.Wiggle method NOT the TMyObject.Wiggle 
method."

Now, say you left out the override directive in the declaration of the 
TOverrideObject.Wiggle method and then tried 

  TMyObject(Items[1]).Wiggle;

The application would look and see that even though Items[1] is really a 
TOverrideObject, it has no overridden version of the Wiggle method so 
the application will execute TMyObject.Wiggle NOT TOverrideObject.Wiggle
(which may or may not be what you want).

So, overriding a method means declaring the method with the virtual (or 
dynamic) directive in a base class and then declaring it with the 
override directive in a sub class. Replacing a method means declaring it 
in the subclass without the override directive.  Overriden methods of a
subclass can be executed even when a specific instance of the subclass
is cast as its base class.  Replaced methods can only be executed if the
specific instance is cast as the specific class.

Copy one memo field to another

Question

How do I copy data in one memo field in Table1 to another memo field in
Table2?

Answer

A:
Table2..Text.Clear;
Table2..Text.Add(Table1..Text);

A:
MemoField1.Assign(MemoField2);
Make sure the dataset is in Edit mode.

A:
One of the most reliable ways we have found to implement this transfer is to
use a TMemoryStream for the actaul transfer:

Var
   T : TMemoryStream
Begin
     T := TMemoryStream.Create;
     Table1.SavetoStream(T);
     Table2.LoadFromStream(T);
     T.Destroy;
End;

Now Transfering Between 2 TMemo Fields is another Story.  There you can rely
on using the Text property.

A:
Table2.Memo1.Lines.Assign(Table1.Memo1.Lines);

Sort a TStringList by Numerical Value

Question

I cannot use the 'Sort' method in TStringList as I would like
to sort by Integer.
My TStringList is filled with numbers such as:
20
12
1
23
54
32
(of course, they're converted to string before being added to TStringList)
What is a fast algorithm to achieve this sort?  Thanks.
I normally have less than 50 items in my TStringList, if that is a factor.

Answer

A:
I think the implementation that I mailed out to a few people sorts an array
of integers, and so there would be no problem using it to sort a a string list
with integers. You'd end up doing a *lot* of conversions using StrToInt, which
is wasteful, so I would recommend that you create a

	type
		PInteger = ^Integer type,

store all of the StrToInt values in the TStringList.Objects array, and then when
you use the sort, do your comparisons based on

		PInteger(SL.Objects[Idx])^

The quicksort that TStringList uses (see CLASSES.PAS) uses a very simple
partition function, which is completely unaware of the data it's sorting.
It's using the midpoint index to begin to decide where to start partitioning,
which is just as reliable as picking a random number when deciding how to sort.
If, for example, you had a BIG list of items that was already sorted in the
reverse direction, and you used this quicksort on it, and would call itself
recursively once for every element in the list!  Now, when you take into account
that you're pushing a few items on the stack (the return address as well as the
parameters as well as the registers you are saving) it might not take too long
for your 16K of stack space to get eaten up (16,384 bytes divided by about maybe
32 bytes (and that's being pretty optimistic!) is about 2048 items before you
run the risk of killing the stack!).  The MaxListSize in CLASSES is 16380 (65520
div sizeof (Pointer)), so it's certainly possible to cause this problem.

I do want you guys to know that TStringList.Sort is declared as virtual, so if
you wanted to override it, you certainly could in a class derived from
TStringList.

I also want you to know that the odds of anyone having to sort this much data
(2000 items) seems pretty remote (correct me, anyone, if you've ever sorted more
than 2000 strings in an application).  The most reliable sort with the same
running time as QuickSort is a HeapSort.  They both run in O(N lg N) time,
whereas sorts like the InsertionSort (which someone mentioned) and BubbleSort
(which someone else mentioned) run in O(N^2) time, on the average.

The biggest differences between HeapSort and QuickSort, in terms of their run
time and storage are:

1) HeapSort only calls itself recursively at most lg N times, where as QuickSort
could call itself recursively N times (big difference, like 10 vs 1024, or 32 vs
2^32)

2) The worst case upper bound time on HeapSort is only O(N lg N), whereas in the
worst case for QuickSort, the running time is O(N^2).

Program follows:

{***********************************************************}

program H;

uses WinCrt, SysUtils;

  const
    min = 10;
    max = 13;
    maxHeap = 1 shl max;

  type
    heap = array [1..maxHeap] of integer;
    heapBase = ^heap;

  var
    currentSize, heapSize: integer;
    A: heapBase;

  procedure SwapInts (var a, b: integer);
  var
    t: integer;
  begin
    t := a;
    a := b;
    b := t
  end;

  procedure InitHeap (size: integer);
  var
    i: integer;
  begin
    heapSize := size;
    currentSize := size;
    Randomize;
    for i := 1 to size do
      A^[i] := Random(size) + 1; 
  end;

  procedure Heapify (i: integer);
  var
    left, right, largest: integer;
  begin
    largest := i;
    left := 2 * i;
    right := left + 1;
    if left <= heapSize then
      if A^[left] > A^[i] then
        largest := left;
    if right <= heapSize then
      if A^[right] > A^[largest] then
        largest := right;
    if largest <> i then
      begin
        SwapInts (A^[largest], A^[i]);
        Heapify (largest)
      end
  end;

  procedure BuildHeap;
  var
    i: integer;
  begin
    for i := heapSize div 2 downto 1 do
      Heapify (i)
  end;

  procedure HeapSort;
  var
    i: integer;
  begin
    BuildHeap;
    for i := currentSize downto 2 do
      begin
        SwapInts (A^[i], A^[1]);
        dec (heapSize);
        Heapify (1)
      end
  end;

type
  TAvgTimes = array [min..max] of TDateTime;
var
  sTime, eTime, tTime: TDateTime;
  i, idx, size: integer;
  avgTimes: TAvgTimes;
  

begin
  tTime := 0;
  i := min;
  size := 1 shl min;
  new (A);
  while i <= max do
    begin
      for idx := 1 to 10 do
        begin
          InitHeap (size);
          sTime := Time;
          HeapSort;
          eTime := Time;
          tTime := tTime + (eTime - sTime)
        end;
      avgTimes[i] := tTime / 10.0;
      inc (i);
      size := size shl 1;
    end;
end.

Canceling The Key Press

Question

I'm using the OnKeyDown event (NOT OnKeyPress) of a DBEdit to trap the
Num Key Pad's Plus Minus pressing, and that means that the user wants
to increace or decrease the value in the field.
My problem is that after performing the operation - the control adds
'+' or '-' to the edit box. I tried Key := 0; (because I know that in
OnKeyPress you do something similiar: Key := #0) but no results.

Answer

A:
To stop the + or - from appearing in your Tedit window:

Tformz.EditzKeyDown(Sender:Tobject;Var key:word;Shift:TshiftState);
var
    save_key:byte;
begin
save_key := key;
KEY := $0;
If ((save_key = VK_ADD)or(save_key=VK_SUBTRACT)) then do whatever...
else key := save_key;
..
..
end;

I am not sure if the VK_ADD, VK_SUBTRACT are the VK values for the
keypad, thier definition shows up just after the VK_NUMPAD values.

These VK key values are listed in APT help, Virtual Key Codes. Not all
are supported by DELPHI.

..
implementation
const
    proof:integer = 0;   {Just for testing}
var
    key_sig:integer;     {Was the key the Numeric KeyPad + or - ?}
                         {A simple way for KeyDown and KeyPress to}     
                     {communicate}

{**************** Sense the key*******************}
procedure Tformxyz.EditzzzKeyDown(...var key:word...);
var
    save_key:byte;
begin
key_sig := 0;             {default value]
save_key := key;          {save key press if needed later}
if (key = VK_ADD) then key_sig := +1;
if (key + VY_SUBTRACT) then key_sig := -1;
end;

procedure Tformxyz.EditzzzKeyPress(...var key:char...);
var
    save_key:char;
begin
save_key := key;
key := #0;                                {Suppress printing...for now}
if key_sig = 0 then key := char(save_key) {Print the character}

{I just noticed the cast to char..left over from earlier trials,}
{should not be necessary}

else
    begin
    proof := proof + key_sig;         {Demonstration that it works}
    edityyy.text := inttostr(proof);
    end;
end;
..
..
end.

GetKeyBoardState

Question

How do I get the VK_INSERT state?

Answer

A:
Hope the following code helps. It shows that indeed, VK_INSERT can be used.
Your program will need to track the status and adjust your program to overwrite
or insert text.

  TFormInstructor = class(TForm)
{   Must never absolutely change position! Code depends on this!
    PanelScrollLock, PanelINS, PanelCAPS, PanelNUM }
    PanelScrollLock: TPanel;
    PanelINS: TPanel;
    PanelCAPS: TPanel;
    PanelNUM: TPanel;
    procedure Timer1Timer(Sender: TObject);
  private
    stToggles: array[0..3] of Bool;
  end;

{ Check keystate @ every timer tick.
  Won't receive any Windows messages informing that keystate has changed! }
procedure TFormInstructor.Timer1Timer(Sender: TObject);
const
 vkconsts: array[0..3] of Word=(vk_Scroll, vk_Insert, vk_Capital, vk_NumLock);
 PanelColor: array[Boolean] of TColor=(clGray, clBlack);
var
{ tmScrollLock, tmNumLock, tmCapital, tmInsert: Bool; }
 Toggles: array[0..3] of Bool; { Maybe able to use
[Low(vkconsts)..High(vkconsts)] }
 Panels: array[0..3] of TPanel absolute PanelScrollLock;
 I: Integer;
begin
 for I := Low(vkconsts) to High(vkconsts) do
  begin
   Toggles[I] := Bool(GetKeyState(vkconsts[I]) and 1);
   if stToggles[I]<>Toggles[I] then
    begin
     stToggles[I] := Toggles[I];
     Panels[I].Font.Color := PanelColor[Toggles[I]];
    end;
  end;
end;

Obtain last digits in a number

Question

I want to obtain the last 3 digits of a number
This is the code:

procedure TForm1.Button1Click(Sender: TObject);
var
  MyNumber: Word;
  TempNumber: LongInt;
begin
  TempNumber := 555444;
  MyNumber := Trunc(Frac(TempNumber / 1000) * 1000);
  ShowMessage(IntToStr(MyNumber));
end;

1- Why ShowMessage tell me 443 while 444 is the correct number?
2- Is there an easy way to obtain the last n digits?

Answer

A:
Convert your number to a string (IntToStr - if number is an integer)
then:
Assuming converted number is held in StringValue
Var
	tmpStr := String;
	LastThree := Integer;
Begin
	tmpStr := Copy(StringValue, len(StringValue)-4,3);
	LastThree := StrToInt(tmpStr);
End;

This should work with integers only.

A:
The 443 occurs because you're doing floting point operations, the
easy way to obtain the last three digits is:

MyNumber := MyNumber MOD 1000;

A:
1. The fraction is not safe due to the limited accuracy of the intermediate
real number. If you get, e.g. 999999/1000 = 999.99899, your algorithm
will result in : .9989 * 1000 = 998.9 which truncates to 998. It would be
better to calculate:
MyNumber := Trunc(0.5 + Frac(TempNumber / 1000.0 ) * 1000)
or simply the equivalent:
MyNumber := Round(Frac(TempNumber / 1000.0 ) * 1000)
Alternatively, calculate:
MyNumber := TempNumber - Trunc(TempNumber / 1000.0 ) * 1000;

A:
procedure TForm1.Button1Click(Sender: TObject);
var
  MyNumber: Word;
  TempNumber: LongInt;
  tString : array[0..15] of Char;
  iLen : word;
begin
  TempNumber := 555444;
  StrPCopy(tString, IntToStr(TempNumber));
  iLen := Length(StrPas(tString));
  MyNumber := StrToInt(StrPas(@tString[iLen-3]));
  ShowMessage(IntToStr(MyNumber));
end;

A:
function ReadDigits(TheNumber:LongInt;NumDigits:byte):longint;
{Reads the last NumDigits of TheNumber}
var
   TempStr : string;
   TempInt : longint;
   ErrorCode : integer;
begin
  TempStr := IntToStr(TheNumber);
   val(copy(TempStr,length(TempStr)-(NumDigits-1),length(TempStr)),
          TempInt,ErrorCode);
  if ErrorCode = 0 then
    ReadDigits := TempInt
  else
    {do something about the error here}
end;

{as an example, I created this OnClick method to show the results in a 
label}

procedure TForm1.Button1Click(Sender: TObject);
begin
   {Read the last 2 digits of the number 555444}
   Label1.Caption := IntToStr(ReadDigits(555444,2));
end;

Callback functions

Question

Could someone explain to me how to setup callback functions?

Answer

A:
{function FindWindowHandle (HuntFor: string): HWnd;}
{----------------------------------------------------------------}
{ Hunts for a parent window with title containing the HuntFor    }
{ string.  Returns the window handle or 0 if none found.         }
{----------------------------------------------------------------}
    { The following indented code is logically a part of  }
    { FindWindowHandle but is placed here above the real  }
    { FindWindowHandle function heading as Borland do not }
    { allow nesting of callback functions.                }
    {-----------------------------------------------------}
     type
       PHuntRec = ^THuntRec;
       THuntRec = record
         HuntingFor: string;
         WindowFound: HWnd;
       end;

     function EnumWindowsFunc (WindowHandle: HWnd;
                         lParam: Longint): WordBool; export;
    {-----------------------------------------------------}
    { Callback function used by FindWindowHandle.         }
    {-----------------------------------------------------}
     var
       ATitle: array[0..255] of Char;
     begin
       GetWindowText(WindowHandle, PChar(@ATitle), 255);
       if StrContains(StrPas(PChar(@ATitle)),
         PHuntRec(lParam)^.HuntingFor, CaseInsensitive) then
       begin
         PHuntRec(lParam)^.WindowFound := WindowHandle;
         EnumWindowsFunc := false;     {stop looking}
       end
       else
         EnumWindowsFunc := true   {continue looking}
     end; {EnumWindowsFunc}

 function FindWindowHandle (HuntFor: string): HWnd;
 var
   Proc: TFarProc;
   HuntRec: PHuntRec;
 begin
   GetMem(HuntRec, SizeOf(THuntRec));
   HuntRec^.HuntingFor := HuntFor;
   HuntRec^.WindowFound := 0;
   Proc := MakeProcInstance(@EnumWindowsFunc, HInstance);
   EnumWindows(Proc, Longint(HuntRec));
   FreeProcInstance(Proc);
   FindWindowHandle := HuntRec^.WindowFound;
   FreeMem(HuntRec, SizeOf(THuntRec));
 end; {FindWindowHandle}

Dynamically assigning event handlers

Question

If I dynamically create a decendant of a PopUp Menu how do I designate the
OnClick event handler?

Answer

create a procedure that handles the event (must have the same
signature as the default event handler).  Then assign it to the
OnClick property:

procedure MyPopUpClick(Sender : TObject);
begin
 {Handle the event}
end;

then assign it with:

MyPopUp.OnClick = MyPopUpClick;

A:
It is not difficult to assign event handler on the fly. For example, to assign
the OnClick event of a PopUp menu to a event handler, as below:

procedure TForm1.PopupMenusClickHandler(Sender: TObject);
begin
  :
  :
end;

procedure TForm1.TestButtonClick(Sender: TObject);
begin
  :
  PopupMenu1.OnClick := PopupMenusClickHandler;
  :
  :
end;

Sendkey function

Question

Is there anybody have information on the function especially how to program
it in Delphi ?

Answer

It's attached one freeware sendkeys component from Makoto Muramatsu
( and )

unit Sendkey;
{
      This is a procedure named "SendKeys".
      This function like the same named statment of Visual Basic.
      It provide the like features by VB's function.
      This version not use "wait" flg.

                     CopyRights 1995, Makoto Muramatsu

      Para ejecuatar la funcion:
        SendKeys(VentDestino,Teclas,False);
              VentDestino: 0: Ventana acticava actualmente,
              si el destino es una pantalla Delphi se puede activar
              la ventana de destino y con la funci=F3n GetActiveWindow
              recoger el valor de la ventana, tambien se puede usar
              FindWindow(NombreVentana,nil) para buscar el numero de
              ventana de un determinado programa.
              Teclas:  Son las teclas tal cual, para mandar un Control seel
                       antepone ^ (es decir Ctrl+ C seria ^C), para simular
                       Alt+Tecla es %Tecla ; para Mayusculas+Tecla es +Tecla,
                       adem=E1s se pueden simular las teclas especiales
                       poniendo los siguientes textos entre llaves:
                       BS, BACKSPACE, BKSP'
                           BREAK
                           CAPSLOCK
                           CLEAR
                           DEL, DELETE
                           DOWN
                           END
                           ENTER
                           ESC, ESCAPE
                           HELP
                           HOME
                           INSERT
                           LEFT
                           NUMLOCK
                           PGDN
                           PGUP
                           PRTSC
                           RIGHT
                           SCROLLLOCK
                           TAB
                           UP
                           F1
                           F2
                           F3
                           F4
                           F5
                           F6
                           F7
                           F8
                           F9
                           F10
                           F11
                           F12
                           F13
                           F14
                           F15
                           F16
                           F17
                           F18
                           F19
                           F20
                           F21
                           F22
                           F23
                           F24

         1.996 Juan Davi Evora H=E4nggi
}

interface

uses  WinTypes;

procedure SendKeys( h: HWND; const keys: string; wait: boolean );

implementation

uses WinProcs, Messages, SysUtils, Forms, Dialogs ;

type
  TWindowObj = class( TObject )
  private
    windowHandle : HWND;
    TargetClass : PChar;
    NameLength : Integer;
    Buffer : PChar;
  public
    constructor Create;
    destructor Destroy;
    procedure SetTargetClass( className : string );
    procedure SetWindowHandle( hWnd: HWND );
    function GetWindowHandle: hWnd;
    function Equal( handle: HWND ): boolean;

  end;

const
     OPENBRACE = '{';
     CLOSEBRACE = '}';
     PLUS = '+';
     CARET = '^';
     PERCENT = '%';
     SPACE = ' ';
     TILDE = '~';
     SHIFTKEY = $10;
     CTRLKEY = $11;
     ALTKEY = $12;
     ENTERKEY = $13;
     OPENPARENTHESES  = '(';
     CLOSEPARENTHESES = ')';
     NULL = #0;
     TargetControlClass = 'Edit';

{================ GetTextWindow ===============================}
function  EnumChildProc( hWnd: HWND; lParam: LongInt ):Bool;export;
var
   continueFlg : boolean;
   HObj : TWindowObj;
begin
   HObj := TWindowObj( lParam );
   if HObj.Equal( hWnd ) then begin
      HObj.SetWindowHandle( hWnd );
      continueFlg := false;
   end;
   result := continueFlg;   { Stop Enumerate}
end;


function GetFocusWindow( h: HWnd ): hWnd;
{ GetFocus and if return 0 then search Edit Control in Children of the window}
var
   EnumFunc : TFarProc;
   Param : LongInt;
   proc: TFarProc;
   ok : Boolean;
   hObj :  TWindowObj;
   targetWindow : HWnd;

begin
   targetWindow := GetFocus;
   if targetWindow <> 0 then begin
      result := targetWindow;
      exit;
   end;
   h := GetActiveWindow;
   Proc := @EnumChildProc;
    EnumFunc := MakeProcInstance( proc, HInstance );
    If Not Assigned(EnumFunc ) then begin
       MessageDlg( 'MakeprocInstanceFail', mtError, [mbOK],0 );
       exit;
    end;
    hObj := TWindowObj.Create;
    hObj.SetTargetClass(TargetControlClass);
    Param := LongInt( hObj );
    result := 0;
    try
       ok := EnumChildWindows(h, EnumFunc, Param );
       targetWindow := hObj.GetWindowHandle;
    finally
      FreeProcInstance( EnumFunc );
      hObj.Free;
    end;
    result := h;
    if targetWindow <> 0 then begin
        if IsWindowEnabled( targetWindow ) then begin
            result := targetWindow;
        end;
    end;
end;

{================ TWindowObj ===============================}
{transfer User Data from EnumChildWindow to EnumChildProc }
constructor TWindowObj.Create;
begin
     TargetClass := nil;
end;

destructor TWindowObj.Destroy;
begin
     if Assigned( TargetClass ) then begin
        StrDispose( TargetClass ) ;
     end;
     if Assigned( Buffer ) then begin
        StrDispose( Buffer ) ;
     end;
end;

function TWindowObj.Equal(handle: HWND ): boolean;
var
   classNameLength : integer;
begin
   result := false;
   classNameLength := GetClassname( handle, Buffer, NameLength + 1 );
   if classNameLength = 0 then exit;
   if StrLIComp( TargetClass, Buffer, NameLength ) = 0 then begin
      result := true;
   end;
end;

procedure  TWindowObj.SetTargetClass( ClassName: String );
begin
     if Assigned( TargetClass ) then begin
        StrDispose( TargetClass ) ;
     end;
     if Assigned( Buffer ) then begin
        StrDispose( Buffer ) ;
     end;
     NameLength := Length( ClassName );
     TargetClass := StrAlloc( NameLength + 1 );
     StrPCopy( TargetClass, ClassName );
     Buffer := StrAlloc( NameLength + 1 );
end;

procedure TWindowObj.SetWindowHandle( hWnd: HWND );
begin
     windowHandle := hWnd;
end;

function TWindowObj.GetWindowHandle: hWnd;
begin
     result := windowHandle;
end;

{=============  SendKeys =============================}
procedure SendOneKey( window: HWND; virtualKey: WORD; repeatCounter: Integer;
          shift: BOOLEAN; ctrl: BOOLEAN; menu: BOOLEAN; wait: BOOLEAN);
{ Send One VirtualKey, to other Window }
var
    lparam: LongInt;
    counter: integer;
    keyboardState: TKeyBoardState;
    test: BYTE;
begin
    window := GetFocusWindow( window );
    for counter := 0 to repeatCounter - 1 do begin
          lparam := $00000001;
          if menu then begin
             lparam := lparam or $20000000;
          end;
          if shift or ctrl or menu then begin
             { Set KeyboardState }
             GetKeyBoardState( keyboardState );
             if menu then begin
                if VirtualKey = 220 then { Si es '\' no es SYSKEY}
                 PostMessage( window, WM_KEYDOWN, ALTKEY, lparam )
                else
                 PostMessage( window, WM_SYSKEYDOWN, ALTKEY, lparam );
                keyboardState[ALTKEY] := $81;
             end;
             if shift then begin
                PostMessage( window, WM_KEYDOWN, SHIFTKEY, lparam );
                keyboardState[SHIFTKEY] := $81;
             end;
             if ctrl then begin
                PostMessage( window, WM_KEYDOWN, CTRLKEY, lparam );
                keyboardState[CTRLKEY] := $81;
             end;
             SetKeyBoardState( keyboardState );
          end;
          if menu and (VirtualKey <> 220) then begin
              PostMessage( window, WM_SYSKEYDOWN, virtualKey, lparam );
          end
          else begin
              PostMessage( window, WM_KEYDOWN, virtualKey, lparam );
          end;
          Application.ProcessMessages;
          lparam := lparam or $D0000000;
          if menu and (VirtualKey <> 220) then begin
              PostMessage( window, WM_SYSKEYUP, virtualKey, lparam );
          end
          else begin
              PostMessage( window, WM_KEYUP, virtualKey, lparam );
          end;
          if shift or ctrl or menu then begin
             {unSet KeyBoardState }
             GetKeyBoardState( keyboardState );
             if ctrl then begin
                PostMessage( window, WM_KEYUP, CTRLKEY, lparam );
                keyboardState[CTRLKEY] := $00;
            end;
             if shift then begin
                PostMessage( window, WM_KEYUP, SHIFTKEY, lparam );
                keyboardState[SHIFTKEY] := $00;
             end;
             if menu then begin
                lparam := lparam and $DFFFFFFF;
                if (VirtualKey = 220) then
                  PostMessage( window, WM_KEYUP, ALTKEY, lparam )
                else
                 PostMessage( window, WM_SYSKEYUP, ALTKEY, lparam );
                keyboardState[ALTKEY] := $00;
             end;
             SetKeyBoardState( keyboardState );
          end;
    end;
end;

procedure SendOneChar( window: HWND; oneChar: Char; wait: BOOLEAN);
{ Send One Character to target Window }
var
    lparam: LongInt;
    counter: integer;
    key : WORD;
begin
    window := GetFocusWindow( window );
    lparam := $00000001;
    key := Word( oneChar );
    PostMessage( window, WM_CHAR, key, lparam );
    Application.ProcessMessages;
end;

function RecognizeChar( s : string ): BYTE;
{ Recognize Virtual Key by KEYWORD }
begin
     if (CompareText( s, 'BS') = 0) OR
        (CompareText(s, 'BACKSPACE') = 0) or
        ( CompareText(s,'BKSP') = 0 ) then begin
          result := $08;
     end
     else if CompareText(s, 'BREAK') = 0 then begin
          result := $13;
     end
     else if CompareText(s, 'CAPSLOCK') = 0 then begin
          result := $14;
     end
     else if CompareText(s,  'CLEAR') = 0 then begin
          result := $0C;
     end
     else if (CompareText(s, 'DEL') = 0 ) or
             (CompareText(s ,'DELETE') = 0) then begin
          result := $2E;
     end
     else if CompareText(s, 'DOWN') = 0 then begin
          result := $28;
     end
     else if CompareText(s, 'END') = 0 then begin
          result := $23;
     end
     else if CompareText(s,  'ENTER') = 0 then begin
          result := $0D;
     end
     else if (CompareText(s, 'ESC') = 0) OR
            ( CompareText(s, 'ESCAPE') = 0 ) then begin
          result := $1B;
     end
     else if CompareText(s, 'HELP') = 0 then begin
          result := $2F;
     end
     else if CompareText(s, 'HOME') = 0 then begin
          result := $24;
     end
     else if CompareText(s, 'INSERT') = 0 then begin
          result := $2D;
     end
     else if CompareText(s, 'LEFT') = 0 then begin
          result := $25;
     end
     else if CompareText(s, 'NUMLOCK') = 0 then begin
          result := $90;
     end
     else if CompareText(s, 'PGDN') = 0 then begin
          result := $22;
     end
     else if CompareText(s, 'PGUP') = 0 then begin
          result := $21;
     end
     else if CompareText(s, 'PRTSC') = 0 then begin
          result := $2C;
     end
     else if CompareText(s,  'RIGHT') = 0 then begin
          result := $27;
     end
     else if CompareText(s, 'SCROLLLOCK') = 0 then begin
          result := $91;
     end
     else if CompareText(s, 'TAB') = 0 then begin
          result := $09;
     end
     else if CompareText(s, 'UP') = 0 then begin
          result := $26;
     end
     else if CompareText(s, 'F1') = 0 then begin
          result := $70;
     end
     else if CompareText(s, 'F2') = 0 then begin
          result := $71;
     end
     else if CompareText(s, 'F3') = 0 then begin
          result := $72;
     end
     else if CompareText(s, 'F4') = 0 then begin
          result := $73;
     end
     else if CompareText(s, 'F5') = 0 then begin
          result := $74;
     end
     else if CompareText(s, 'F6') = 0 then begin
          result := $75;
     end
     else if CompareText(s, 'F7') = 0 then begin
          result := $76;
     end
     else if CompareText(s, 'F8') = 0 then begin
          result := $77;
     end
     else if CompareText(s, 'F9') = 0 then begin
          result := $78;
     end
     else if CompareText(s, 'F10') = 0 then begin
          result := $79;
     end
     else if CompareText(s,  'F11') = 0 then begin
          result := $7A;
     end
     else if CompareText(s, 'F12') = 0 then begin
          result := $7B;
     end
     else if CompareText(s, 'F13') = 0 then begin
          result := $7C;
     end
     else if CompareText(s, 'F14') = 0 then begin
          result := $7D;
     end
     else if CompareText(s, 'F15') = 0 then begin
          result := $7E;
     end
     else if CompareText(s, 'F16') = 0 then begin
          result := $7F;
     end
     else if CompareText(s, 'F17') = 0 then begin
          result := $80;
     end
     else if CompareText(s, 'F18') = 0 then begin
          result := $81;
     end
     else if CompareText(s, 'F19' ) = 0 then begin
          result := $82;
     end
     else if CompareText(s, 'F20') = 0 then begin
          result := $83;
     end
     else if CompareText(s,  'F21') = 0 then begin
          result := $84;
     end
     else if CompareText(s, 'F22') = 0 then begin
          result := $85;
     end
     else if CompareText(s, 'F23') = 0 then begin
          result := $86;
     end
     else if CompareText(s, 'F24') = 0 then begin
          result := $87;
     end
     else begin
         result := 0;
     end;
end;

function CharToVirtualKey( source: Char; var shift: boolean; var ctrl:
boolean; var menu: boolean): WORD;
var
    resultCode: WORD;
    upperWord : WORD;
begin
    resultCode := VkKeyScan( Word(source) );
    upperWord := resultCode shr 8;
    case upperWord of
       1,3,4,5: shift := true;
       6 : begin
             ctrl := true;
             menu := true;
           end;
       7 : begin
             shift := true;
             ctrl := true;
             menu := true;
           end;
    end;
    result := resultCode and $00ff;
end;

function GetSpecialChar(specialChar: PChar; var repeatCount: Integer;
         var shift: boolean; var ctrl: boolean; var menu: boolean ): WORD;
{ In Brace String Parser}
var
    p : PChar;
    s : string;
    virtualKey : BYTE;
begin
    p := StrScan( specialChar, SPACE );
    if p <> nil then begin
       p^ := NULL;
       Inc(p);
       s := StrPas( p );
       repeatCount := StrtoInt( s );
    end
    else begin
       repeatCount := 1;
    end;
    s := StrPas( specialChar );
    virtualKey := RecognizeChar( s );
    if virtualKey = 0 then begin
       result := CharToVirtualKey(specialChar^, shift, ctrl, menu);
    end
    else begin
       result := virtualKey;
    end;
end;

procedure Parser( window: HWND; chars: PChar; wait:Boolean);
{Parse String Line and Send keys }
var
     p : PChar;
     specialChar: PChar;
     shift, ctrl, menu: Boolean;
     parenthese : Boolean;
     repeatCounter : Integer;
     oneChar : Char;
     vertualKey : Word;

     procedure ClearAddKey;
     begin
          shift := false;
          ctrl := false;
          menu := false;
     end;
begin
     p := chars;
     ClearAddKey;
     parenthese := false;
     while p^ <> NULL do begin
           if p^ = OPENBRACE then begin
               {Control Code }
               Inc( p );
               specialChar := p;
               while p^ <> NULL do begin
                   if p^ = CLOSEBRACE then begin
                      if (p + 1)^ = CLOSEBRACE then begin
                         Inc(p);
                      end;
                      break;
                   end;
                   Inc(p);
               end;
               if p^ = NULL then begin
                  MessageDlg('Illegal string ', mtError, [mbOK], 0 );
                   break;
               end;
               p^ := NULL;
               vertualKey := GetSpecialChar(specialChar, repeatCounter,
               shift, ctrl, menu);
               SendOneKey(window, vertualKey, repeatCounter, shift, ctrl,
               menu, wait);
               if not parenthese then begin
                     ClearAddKey;
               end;
           end
           else if p^ = PLUS then begin
                shift := true;
           end
           else if p^ = CARET then begin
                ctrl := true;
           end
           else if p^ = PERCENT then begin
                menu := true;
           end
           else if p^ = TILDE then begin
               SendOneKey( window, ENTERKEY, 1, shift, ctrl, menu, wait);
               if not parenthese then begin
                  ClearAddKey;
               end;
           end
           else if (shift or ctrl or menu ) and ( p^ =  OPENPARENTHESES)
           then begin
                parenthese := true;
           end
           else if parenthese and ( p^ = CLOSEPARENTHESES ) then begin
                parenthese := false;
           end
           else begin
               if  ($80 and BYTE(p^)) > 0 then begin
                   { 2 Bytes Char}
                   SendOneChar(window, p^, wait);
                   Inc(p);
                   SendOneChar(window, p^, wait );
               end
               else begin
                   vertualKey := CharToVirtualKey( p^,shift,ctrl,menu);
                   SendOneKey(window, vertualKey, 1, shift, ctrl, menu, wait);
               end;
               if not parenthese then begin
                  ClearAddKey;
               end;
           end;
           Inc(p);
     end;
end;

procedure SendKeys( h: HWND; const keys: string; wait:Boolean );
{ SendKeys send strings to Window by specific HWND.
  Before sending keys,  activate the window.
  if h = 0 then send string to current activate Window
  sorry, this version not use wait.}
var
     window: HWND;
     focusControl: HWND;
     chars: PChar;
begin
     { handle check}
     if h = 0 then begin
        window := GetActiveWindow;
     end
     else begin
        window := h;
        SetActiveWindow( window );
     end;

     chars := StrAlloc( length( keys ) + 1 );
     StrPCopy( chars, keys );
     Parser( window, chars, wait );
     StrDispose( chars );
end;


end.

Case Of Statement

Question

Can someone help me with "CASE" function like this:
The user have an inputbox where they can type digits
from 1 to 100, now I would like to check what digit the
typed and start some action depending on what the typed.
Somthing like this:

 Case I OF
   '10'..'20' : Showmessage('Test 10-20');
   '21'..'30' : Showmessage('Test 21-30');
 and so on...

What should "I" be and integer or string or what...

Answer

A:
Longint is out in Borlandish Pascal; according to the Delphi on-line
help for "Case":
  The selector must be a byte-sized or word-sized ordinal type, so
  strings and the integer type Longint are invalid selector types.

Note that this DOES permit "user defined" enumerated types to be case
selectors (booleans will also work). So the following is valid:

type
  TMyType = ( mt1, mt2, mt3 ) ;

var
  MyType : TMyType ;

begin
  { ... code assigning a value to MyType }
  case MyType of
    mt1 : DoMT1Stuff ;
    mt2 : DoMT2Stuff ;
    mt3 : DoMT3Stuff ;
  end ;

This fact, along with Delphi's Run-Time Type Information facilities,
actually allows you to effectively use strings as case selectors as
well.  If anyone's interested in that technique, they can see how it's
done in my entry for the "Tricks and Tips" column in the May issue of
_The Delphi Magazine_; or (if there's sufficient interest) I can post a
write-up to the list.

Anyhoo, the original poster has a couple of options for doing what he
described; probably the most straightforward way is to convert the
numeric string into an integer value:

var
  I : string ;
begin
  { ... code that assigns I a string representation of a numeric value }
  Case StrToInt( I ) OF
    10..20 : Showmessage('Test 10-20');
    21..30 : Showmessage('Test 21-30');
  end ;

Or, alternatively:

var
  I : integer ;
begin
  I := StrToInt( { ...code that gets the string value from the user } ) ;
  Case I of
    10..20 : Showmessage('Test 10-20');
    21..30 : Showmessage('Test 21-30');
  end ;

The individual cases in the body of the CASE must be INTEGRAL type
constants.
Right, or constants of an enumerated type (boolean or user defined);
from the on-line help again:
  All case constants must be unique and of an ordinal type compatible
  with the selector type.

They cannot be variables (unfortunately).  If you want to compare strings,
you have to do this with IF..THEN..ELSE statements.
AFAIK, this is a limitation of "case" type control structures in all
modern procedural languages (e.g. C, Basic, Ada), and is not special to
Pascal.  If the expected strings are fairly well defined beforehand, the
RTTI method mentioned above could serve as an alternative to multiple
if-then-else statements.

A:
How to use Delphi's Run Time type information to use strings as case
selectors:

Delphi's RTTI facilities aren't well documented, sometimes you have to 
dig a bit; but I have found that it's possible to convert a string into 
an enumerated type constant via the GetEnumValue() function that is 
(briefly) documented in the TYPINFO.INT file which is found in the 
\DELPHI\DOCS directory/folder of a standard install of Delphi 1.0 (you 
2.0 folks will have to look around if it's not in the same place there, 
as I don't have 2.0 yet to check; and this technique should be used in 
2.0 with the caveat that I haven't tried it to know if it works).

Anyhoo, let's suppose we've defined a enumerated type like so:

....
type
  TMyEnumType = ( metItem1, metItem2, metItem3 ) ;
....

I can use string input of some kind (from an editbox, a listbox, a file, 
wherever) to select on this type in a case statement like so:

....
{ be sure to add the TypInfo unit to your uses clause! }

var
  S : string ;
  MyType : TMyEnumType ;
begin
{ 
  first get a string that duplicates an enumerated constant; 
  e.g. 'metItem1' from someplace 
}
  GetString( S ) ; 

{ 
  now convert that string into a constant of TMyEnumType 
}
  
  MyType := TMyEnumType( GetEnumValue( TypeInfo( TMyEnumType ), S ) ;

{
  Now use MyType as a case selector
}

  case MyType of
    metItem1 : DoItem1Stuff ;
    metItem2 : DoItem2Stuff ;
    metItem3 : DoItem3Stuff ;
  end ;
....

So what's going on here?  I'll break down the GetEnumValue() expression 
by parts:

  TMyEnumType( GetEnumValue( TypeInfo( TMyEnumType ), S ) ;

The GetEnumValue() call takes two parameters, the first is a pointer to 
the RTTI record for the type in question, the second is merely a Pascal 
string.  The TypeInfo() function is a system routine (along the lines of 
TypeOf() and SizeOf()) that expressly returns the RTTI pointer for a 
type.  GetEnumValue() returns an integer that is the ordinal value of 
the particular constant of the set; it returns -1 if it can't resolve
the string to a constant of that type (nice! often low level routines 
like this throw an exception or something instead).  Finally, the 
returned integer is converted to an enumerated constant by typecasting 
it to a TMyEnumType.  

Of course, you can manipulate the string before passing it to 
GetEnumValue(), so the strings don't have to start out LOOKING like 
Enumeration constants; say you had a list box with items like so:

Item 1
Item 2
Item 3

Then (assuming you have a routine Strip() that removes spaces from a 
string) you could do something like this:

GetString( S ) ;
S := 'met' + Strip( S ) ;

then pass it to GetEnumValue.


BTW, here's some New Orleans Style Lagniappe ("something extra"):
there's an inverse RTTI function GetEnumName() turns an Enumeration 
constant into its string representation, you use it like so:

var
  S : string ;

begin
  S := GetEnumName( TypeInfo( TMyEnumType ), Ord( metItem1 ))^ ;

which should return 'metItem1' into S.  Note that the pointer
dereference operator at the end of the GetEnumName() call is NOT a typo,
GetEnumName() returns a PString, which has to be dereferenced to assign
it into a string. 

Hope this is useful for someone, and not too annoying a waste of
bandwidth for everyone else; I'd appreciate it if someone would try
these under 2.0 and let me know how it works.

Pointer Arithmetic in Delphi

Question

How does one manipulate pointer values in Delphi?  For Example, suppose I
have a pointer defined by Pt:^Integer and I want to offset it by 4, say Pt
:= Pt + 4*sizeof(Integer). How can I do that?

Answer

type
PReal = ^Real;
TMoment = CLASS(TOBject)
PUBLIC
  PROCEDURE Append( Datum : Real);
  PROCEDURE Get(index : integer) : Real;
  PROCEDURE Replace( index: integer; Datum : Real);
PRIVATE
   nextItem : integer;
   Data : PReal;
END;

PROCEDURE TMoment.Append( Datum : Real);
VAR
  aPointer : PReal;
BEGIN
  inc(nextItem);
  ReAllocMem(Data,sizeof(REAL)*nextItem);
  aPointer := PReal(LongInt(Data) +  sizeof(REAL)*(nextItem - 1));
  aPointer^ := Datum;
  END; { Append }

FUNCTION  TMoment.Get( index : integer) : Real;
VAR
  aPointer : PReal;
BEGIN
  aPointer := PReal(LongInt(Data) +  sizeof(REAL)*(index - 1));
  Result := aPointer^;
  END; { Get }

PROCEDURE TMoment.Replace( index: integer; Datum : Real);
VAR
  aPointer : PReal;
  i        : INTEGER;
BEGIN
 aPointer := PReal(LongInt(Data) + ( index - 1));
 aPointer^ := Datum;
 END;

Ofcourse you probably don't need the TYPED pointer ...

Edit Mask for decimals

Question

Could someone explain how to include decimal places in an edit mask ?

Answer

You can try; # ###.##;0;_

How to tell who Sender is

Question

If I have this procedure defined and assigned to, say, 20 TEditBoxes,
How do I tell which one activated the procedure?

Answer

You can use the Tag property - set up your TEdits with a unique Tag for each
one, say 1..20 then in the proc they all call you can do something like

with Sender as TEdit do
    begin
    case Tag of
        1: do something
        2: do something else
    end; {case}
    end;

String property values

Question

I am developing a component with a property Name of type String. I need to
provide the user with a dynamic list of possible values for Name (this list
will vary at design time).
The TTable component has a property DatabaseName (of type string) that
lists the available databases when the user opens the drop down list. The
TMediaPlayer component has a property FileName (of type string) that
displays the file open dialog.
I cannot see anything special in the VCL source code to activate the list
or the file open dialog.
How do I create and display the list of possible string values for the
string property?

Answer

Just set up your "Names" property the same as the "Lines" property and it
should work fine.
Delphi will automatically use the default Property Editor for a TStrings
component.  This will allow you to enter lines, load/save to/from files,
etc. at design time.

{Begin Source Code}
Unit Memodlg;

interface

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

type
  TGumpMemoDlg = class(TComponent)
  private
    { Private declarations }
    FLines : TStrings;
    procedure SetLines(Value : TStrings);
    function GetLines : TStrings;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Lines : TStrings read GetLines write SetLines;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('STUFF', [TGumpMemoDlg]);
end;

Constructor TGumpMemoDlg.Create(AOwner : TComponent);
begin
  Inherited Create(AOwner);
  FLines := TStringList.Create;
end;


Destructor TGumpMemoDlg.Destroy;
begin
  FLines.Free;
  Inherited Destroy;
end;


function TGumpMemoDlg.GetLines : TStrings;
begin
  Result := FLines;
end;

Procedure TGumpMemoDlg.SetLines(Value : TStrings);
begin
  FLines.Assign(Value);
end;

end.

Object has a property

Question

Is there a function to determine if an object has a particular property? I
would prefer not to use this way:

	if MyObject is TEdit then ... else ... ;

but would like to use:

	if MyObject has Caption then Myobject.caption:='hello';

Answer

A:
Yes but only for published properties.

Here are a few functions I've written using RTTI.
The first hasprop will return True if a property of name prop exists.

eg. hasprop(MyLabel,'Caption') will return true
while hasprop(MyEdit,'Caption') will return false

The second one will set property prop to string value s if it exists and is a string type property

function hasprop(comp : TComponent;const prop: string) : boolean;
var proplist : PPropList;
    numprops,i : Integer;
begin
        result:=false;
  getmem(proplist,getTypeData(comp.classinfo)^.propcount*Sizeof(Pointer));
  try
    NumProps:=getproplist(comp.classInfo,tkProperties,proplist);
    for i:= 0 to pred (NumProps) do
    begin
      if comparetext(proplist[i]^.Name,prop)=0 then
      begin
        result:=true;
        break;
      end;
    end;
  finally
    freemem(proplist,getTypeData(comp.classinfo)^.propcount*Sizeof(Pointer));
  end;
end;

procedure setcomppropstring(comp : TComponent;const prop,s : string);
var proplist : PPropList;
    numprops,i : Integer;
begin
  getmem(proplist,getTypeData(comp.classinfo)^.propcount*Sizeof(Pointer));
  try
    NumProps:=getproplist(comp.classInfo,tkProperties,proplist);
    for i:= 0 to pred (NumProps) do
    begin
      if (comparetext(proplist[i]^.Name,prop)=0) and (comparetext(proplist[i]^.proptype^.name,'string')=0 then
      begin
        setStrProp(comp,proplist[i],s);
        break;
      end;
    end;
  finally
    freemem(proplist,getTypeData(comp.classinfo)^.propcount*Sizeof(Pointer));
  end;
end;

TList freeing it's items

Question

I read in Delphi docs that when we use the FREE method for a TList object,
the TList "destroys the object and frees its associated memory". Does it
means that it FREEs every item left in it when we free the TList, or that
it frees the memory of the TList object itself?

Answer

A:
It just frees the tList object itself.  You have to free the items in the
tList yourself.

A:
You must free each element of the TList.

The same is true if you use addobject for any list control (TListBox,
TComboBox, etc.)

Pionter arithmetic

Question

How do I do pointer arithmetic in Delphi?

Answer

First a brief explanation of pointer arithmetic.  When you 
are dealing with dynamic memory locations and all you have is a 
pointer to where it all begins, you want to have the ability to 
traverse that line of memory to be able to perform whatever 
functions you have in mind for that data.  This can be 
accomplished by changing the place in memory where the pointer 
points.  This is called pointer arithmetic.

The main idea that must be kept in mind when doing your pointer 
arithmetic is that you must increment the pointer's value by 
the correct amount.  (The correct amount is determined by the 
size of the object receiving the pointer.  e.g.  char = 1 byte; 
integer = 2 bytes; double = 8 bytes;  etc.)  The Inc() and 
Dec() functions will alter the amount by the correct amount.  
(The compiler knows what the correct size is.)  

For an example of the practical application of pointer 
arithmetic, download the BreakAApart() TI2905.

If you are doing dynamic memory allocation, it is done like this:

uses WinCRT;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyArray: array[0..30] of char;
  b: ^char;
  i: integer;
begin
  StrCopy(MyArray, 'Lloyd is the greatest!'); {get something to point to}
  b := @MyArray; { assign the pointer to the memory location }
  for i := StrLen(MyArray) downto 0 do
  begin
    write(b^);   { write out the char at the current pointer location. }
    inc(b);      { point to the next byte in memory }
  end;
end;

The following code demonstrates that the Inc() and Dec() functions 
will increment or decrement accordingly by size of the type the pointer
points to:

var
  P1, P2 : ^LongInt;
  L : LongInt;
begin
  P1 := @L; { assign both pointers to the same place }
  P2 := @L;
  Inc(P2);  { Increment one }

{ Here we get the difference between the offset values of the 
two pointers.  Since we originally pointed to the same place in 
memmory, the result will tell us how much of a change occured 
when we called Inc(). }

  L := Ofs(P2^) - Ofs(P1^); { L = 4; i.e. sizeof(longInt) }
end;

You can change the type to which P1 and P2 point to something other than a 
longint to see that the change is always the correct value (SizeOf(P1^)).

Array of const

Question

How do I use "array of const"?

Answer

An array of const is in fact an open array of TVarRec (a 
predeclared Delphi type you can look up in the online help). So 
the following is Object Pascal psuedocode for the general battle
plan:

procedure AddStuff( Const A: Array of Const );
Var i: Integer;
Begin
  For i:= Low(A) to High(A) Do
  With A[i] Do
    Case VType of
    vtExtended: Begin
       { add real number, all real formats are converted to 
         extended automatically }
      End;
    vtInteger: Begin

       { add integer number, all integer formats are converted 
         to LongInt automatically }
      End;
    vtObject: Begin
        If VObject Is DArray Then
          With DArray( VObject ) Do Begin
            { add array of doubles }
          End
        Else If VObject Is IArray Then
          With IArray( VObject ) Do Begin
            { add array of integers }
          End;
      End;
    End; { Case }
End; { AddStuff }

For further information see "open arrays" in the on-line help.


DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.

ReadLn longer than 255 characters

Question

How can I readln() from a file when the lines are longer than 255 bytes?

Answer

ReadLn will accept an array [0..something] of Char as 
buffer to put the read characters in and it will make a proper 
zero-terminated char out of them. The only limitation is this: 
the compiler needs to be able to figure out the size of the 
buffer at compile time, which makes the use of a variable 
declared as PChar and allocated at run-time impossible.

Workaround:

 Type
   {use longest line you may encounter here}
   TLine = Array [0..1024] of Char; 

   PLine = ^TLine;

 Var
   pBuf: PLine;
 ...
   New( pBuf );

 ...
   ReadLn( F, pBuf^ );

To pass pBuf to functions that take a parameter of type Pchar, 
use a typecast like PChar( pBuf ).

Note:  you can use a variable declared as of type TLine or an 
equivalent array of char directly, of course, but I tend to 
allocate anything larger than 4 bytes on the heap...



DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.

Dynamic memory allocation

Question

How do I reduce the amount of memory taken from the data segment?  (or How do I allocate memory dynamically?)

Answer

Let's say your data structure looks like this:

 type
   TMyStructure = record
     Name: String[40];
     Data: array[0..4095] of Integer;
   end;

That's too large to be allocated globally, so instead of 
declaring a global variable,

 var
   MyData: TMyStructure;

you declare a pointer type,

 type
   PMyStructure = ^TMyStructure;

and a variable of that type,

 var
   MyDataPtr: PMyStructure;

Such a pointer consumes only four bytes of the data segment.

Before you can use the data structure, you have to allocate it 
on the heap:

 New(MyDataPtr);

and now you can access it just like you would global data. The 
only difference is that you have to use the caret operator to 
dereference the pointer:

 MyDataPtr^.Name := 'Lloyd Linklater';
 MyDataPtr^.Data[0] := 12345;

Finally, after you're done using the memory, you deallocate it:

 Dispose(MyDataPtr);


DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.

Arrays, dynamically allocating

Question

Is it possible to create a dynamically-sized array in Delphi?

Answer

First, you need to create an array type using the largest
size you might possibly need.  When creating a type, no memory
is actually allocated.  If you created a variable of that type,
then the compiler will attempt to allocate the necessary memory
for you.  Instead, create a variable which is a pointer to that
type.  This causes the compiler to only allocate the four bytes
needed for the pointer.

Before you can use the array, you need to allocate memory for
it.  By using AllocMem, you will be able to control exactly how
many bytes are allocated.  To determine the number of bytes
you'll need to allocate, simply multiply the array size you
want by the size of the individual array element.  Keep in mind
that the largest block that can be allocated at one time in a
16-bit environment is 64KB.  The largest block that can be
allocated at one time in a 32-bit environment is 4GB.  To
determine the maximum number of elements you can have in your
particular array (in a 16-bit environment), divide 65,520 by
the size of the individual element.
Example:  65520 div SizeOf(LongInt)

Example of declaring an array type and pointer:

type
  ElementType = LongInt;

const
  MaxArraySize = (65520 div SizeOf(ElementType));
    (* under a 16-bit environment *)

type
  MyArrayType = array[1..MaxArraySize] of ElementType;

var
  P: ^MyArrayType;

const
  ArraySizeIWant: Integer = 1500;

Then when you wish to allocate memory for the array, you could
use the following procedure:

procedure AllocateArray;
begin
  if ArraySizeIWant <= MaxArraySize then
    P := AllocMem(ArraySizeIWant * SizeOf(LongInt));
end;

Remember to make sure that the value of ArraySizeIWant is less
than or equal to MaxArraySize.

Here is a procedure that will loop through the array and set a
value for each member:

procedure AssignValues;
var
  I: Integer;
begin
  for I := 1 to ArraySizeIWant do
    P^[I] := I;
end;

Keep in mind that you must do your own range checking.  If you
have allocated an array with five members and you try to assign
a value to the sixth member of the array, you will not receive
an error message.  However, you will get memory corruption.

Remember that you must always free up any memory that you
allocate.  Here is an example of how to dispose of this array:

procedure DeallocateArray;
begin
  P := AllocMem(ArraySizeIWant * SizeOf(LongInt));
end;

Below is an example of a dynamic array:

}

unit Unit1;

interface

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

type
  ElementType = Integer;

const
  MaxArraySize = (65520 div SizeOf(ElementType));
    { in a 16-bit environment }

type
  { Create the array type.  Make sure that you set the range to
    be the largest number you would possibly need. }
  TDynamicArray = array[1..MaxArraySize] of ElementType;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  { Create a variable of type pointer to your array type. }
  P: ^TDynamicArray;

const
  { This is a typed constant.  They are actually static
    variables hat are initialized at runtime to the value taken
    from the source code.  This means that you can use a typed
    constant just like you would use any other variable.  Plus
    you get the added bonus of being able to automatically
    initialize it's value. }
  DynamicArraySizeNeeded: Integer = 10;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Allocate memory for your array.  Be very careful that you
    allocate the amount that you need.  If you try to write
    beyond the amount that you've allocated, the compiler will
    let you do it.  You'll just get data corruption. }
  DynamicArraySizeNeeded := 500;
  P := AllocMem(DynamicArraySizeNeeded * SizeOf(Integer));
  { How to assign a value to the fifth member of the array. }
  P^[5] := 68;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  { Displaying the data. }
  Button1.Caption := IntToStr(P^[5]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  { Free the memory you allocated for the array. }
  FreeMem(P, DynamicArraySizeNeeded * SizeOf(Integer));
end;

end.


DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.

Object Pascal - Typecasting

Question

1.  (Sender as TButton).Enabled := True;
2.  TButton(Sender).Enabled := True;

Answer

A:
My understanding is that the difference between these is that 1. uses RTTI
(Run Time Type Information)  to check the validity of the cast before
carrying on and that 2. is a hard cast (there is no overhead of checking
the RTTI.

I rarely use the style in 1. because I am usually doing something like
this:

if (Sender is TButton) then
  TButton(Sender).Enabled := TRUE;

A:
There is a very important difference between the two forms which on the
surface both appear to be perfroming a type cast. Taking the second form
first, this form is exactly identical to a C/C++ type cast. It will
perform the type cast even if the result type is not an appropriate type
for the object or data structure.

The first form applies only to objects, and uses Run Time Type
Information (RTTI) to verify that the object is capable of being cast to
the result type. If it is not, an exception will be generated.
Additionally, no temporary variable is required, as the result with any
object is still simply a pointer. The difference is a difference in
syntax between the two languages, Delphi allows and expects implicit
pointer references, while C/C++ still requires explicit pointer
references.

Object Pascal - Typecasting (2)

Question

Can I assign the TField returned by FindField to my own variable?  For
instance:

Procedure TestFind(MyTable: TTable);
begin
  MyField: TField;
  MyField := MyTable.FindField('Customer Name');
  if MyField <> nil then begin
    MyTable.Edit;
    MyField.AsString := 'Jon Robertson';
    MyTable.Post;
  end;
end;

Answer

This example shows the same confusion you where having with type casts.
You can do what you show in the example, however I do not think you will
get the expected results. Effectively what you have done is to assign
MyField to point at the result of FindField which is also a pointer. You
have not created a new instance of TField. To create a new instance you
must use the Create constructor as follows:

MyField := TMyField.Create(Self)

You could now copy the result object to the newly created object, but
again to probably unexpected results. In fact the example shown would
not have the desired results, as the field value, as far as MyTable is
concerned has not changed. 

What you probably want to do is to double-click your table object
(MyTable), then right click the dialog box and select add. This will
create a variable such as:

  MyTableCustomerName

Then you simply modify your code as follows:

  MyTable.Edit;
  MyTableCustomerName.AsString := 'Jon Robertson';
  MyTable.Post;

If this does not do what you had in mind, you are probably better off
copying those fields or attributes of interest to you into simple types,
or a simple record, as most attributes will become meaningless when
disassociated with the table object.

All of this is covered both in the Delphi help system and the associated
manuals (the confusion is common among people coming from C++ so I am
not implying RTFM).

multi-dimensional dynamic arrays

Question

(1)  How do you use multi-dimensional arrays that are dynamic?
(2)  How do you use a multi-dimensional array for a user-defined type?

Answer

A:
  Try declaring an array of ^byte with the dimenstions [0..0] and using
getmem to get her to work...ie:

type
  pfun  = ^tfun;
  tfun  = record
            a,b,c       : integer;
            d           : string;
          end;
  afun  = array[0..0] of pfun;

var
  fun   : afun;

begin
  getmem (, sizeof(tfun));
  ..
  freemem (, sizeof(tfun));
end;

  be sure range checking is off (default anyhow), and it should work.

A:
To use dynamic arrays define a BIG array (to avoid range checking) and
a pointer to it and then declare a variable that is a pointer to this
array and use GetMem to allocate memory for it. This works for pre-defined
types, user-defined types, classes, etc.

   For instance:

type
  TMyType = class;

  TMyBigArray = array[0..MaxInt div SizeOf(TMyType) - 1] of TMyType;
  PMyBigArray = ^TMyBigArray;

var
  ary: TMyBigArray;
  t: TMyType;

begin
  GetMem(ary, 100 * SizeOf(TMyType));

  ary^[12] := TMyType.Create;  // writing array position
  t := ary^[12];               // reading array position
end.

 
   In Delphi 2.0 you can access the array without the pointer operator, 
like a static array:

  ary[12] := TMyType.Create;  // writing array position
  t := ary[12];               // reading array position


It works very, very well for single-dimensional arrays. I tried to
use multi-dimensional arrays this way but I had no success.

Dynamic array of records

Question

Using the following code:

 type
   TDetailRec = Record
     value1       : Integer;
     value2       : Integer;
   end;

    PTDetailRec = ^DetailRec;

  var
    detailArray: PTDetailRec;

How would I allocate and reference a dynamic array of TDetailRec?

Answer

Unless memory usage and speed are paramount, I would recommend that you
use a TList as follows:

var
  MyList: TList;

procedure AllocateIt(HowMany: Integer);

  var
    PMyRec: PDetailRec;
    I: Integer;

  begin
    MyList := TList.Create;
    for I := 1 to HowMany do
      begin
      New(PMyRec);
      with PMyRec^ do
        {assign initial values} 
      MyList.Add(PMyRec);
      end;
  end;

Then when you want to reference an item use for example

  with PMyList(TList.Items[n]) do
    {reference the individual fields}

If you really want to maintain your own array of pointers, you can do
that as follows:

type
  TDetailArray = array[0..1] of PDetailRec;
  PDetailArray = ^TDetailArray;

var
  DetailArray: PDetailArray;

procedure AllocateIt(HowMany: Integer);

  var
    I: Integer;

  begin
    GetMem(DetailArray, SizeOf(TDetailRec) * HowMany);
    for I := 0 to (HowMany - 1) do
      begin
      New(DetailArray^[I]);
      with DetailArray^[I] do
        {Assign initial values}
      end;
  end;

Then to reference an item use:

  with DetailArray^[n]
    {reference the individual fields}

I do not believe the run time will catch the subrange of 0..1 even with
range checking on. And certainly will not if you turn range checking
{$R-} off around the references. Alternatively, you could make the upper
range an arbitrarily large number, larger than would ever be allocated.
No storage is ever generated for a type declaration. I have seen a few
ways to represent this more elegantly syntactically, but this is a the
basic concept.


A:
This is where typecasting comes in and where you will sooner or
later find the need to derive a custom class from tlist that will hide that
task from you.

but lets start at the beginning.

the 3rd item in a tlist is at index 2 and you get a pointer to it through

var
  l:tlist;
  o:tobject;

o:=l[2];

though typecasting you can let the compiler assign that tobject to a TDetailRec:

var
  l:tlist;
  t:TDetailRec;

t:=TDetailRec(l[2]);

and so you can get the answer..

var 
  i:integer

i:=TDetailRec(l[2]).value2;


.... to make matters just a little more formal, you would now look at how to
add properties to an object and declare a custom layer that derived from
Tlist wich would be TMyList and introduce

private
  GetMyRev
  SetMyRec   code that would basically call the 'built-in' Get/Set methods
through one line of code each to just recast the pointers.

and 
published
  property myrec: TDetailRec read GetMyRec write GetMyrec


some headscratching later you'll have a simple way of putting any type of
custom data into a list.

BUT caveat.

internally TList uses a procedure 'Grow' that is not the very most efficient
thing at allocating room and you need to be aware of that. If you know HOW
MANY items you may need, then TELL THE TLIST ahead of time by setting it's
Capacity property in advance. This will allocate room without reshuffling
things as you go on adding items. It's not really a that big of a deal, but
it's great practice to think these things through.