Pascal

Checking the number of components at runtime
Override of existing identical methods
Change location of hints
Set the mouse cursor at the focused button automatically
Cut, copy and paste: one method for different TEdit-controls
Enterkey instead of Tabkey
Alt-? key combination in an aboutbox
Bit-wise manipulation
Array of controls
Delay, pause, wait
Process Messages
Tab key handling
Changing font style problem
Testing event handler for existence
Toggle NumLock CapsLock Keys
Is a Bit set
Inherited free
Attach procedures to components created
Simulating a pause in a loop
Copying from a TEdit to an integer field
Using menu options to cut, copy, and paste
Overriding the Create method
Check whether mouse is over client area
Name / caption property & emulating the caption
Override vs Redefine
Why no free
Mouse Coordinates / Lost Focus
Overriding Virtual Methods
Copy one memo field to another
Sort a TStringList by Numerical Value
Canceling The Key Press
GetKeyBoardState
Obtain last digits in a number
Callback functions
Dynamically assigning event handlers
Sendkey function
Case Of Statement
Pointer Arithmetic in Delphi
Edit Mask for decimals
How to tell who Sender is
String property values
Object has a property
TList freeing it's items
Pionter arithmetic
Array of const
ReadLn longer than 255 characters
Dynamic memory allocation
Arrays, dynamically allocating
Object Pascal - Typecasting
Object Pascal - Typecasting (2)
multi-dimensional dynamic arrays
Dynamic array of records

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.