|
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.
|