Vertical scrollbar in the TDBGrid
Question
I've noticed that the vertical scroll bar in the TDBGrid doesn't
behave as it should (cannot guage the current record's position in
the table by the scroll bar). I would like to know if there is any
way to get the scroll bar to work like the one in the Paradox TableFrame.
Answer
A:
Well.... yes and no. The problem with the scroll bar is that not all
data formats (in fact, almost none) support record order No's. In
other words, there is no unique identifier within a table that
specifies where in the table a record appears. For example in dBase
tables, the records have a recNo based upon the order they were
entered. If you put an index on the fields, these numbers are totally
out of whack. SQL tables & queries on the other hand has never heard
of a record order no and never will. Paradox tables are the only ones
that include a logical sort order no in each index that they create.
For whatever reason, Borland choose to make the scroll bar behave the
same regardless of whether or not you were using Paradox tables. You
can get around this by turning off the scroll bars and using a
TScrollBar component to simulate the behaviour that you want.
Main difference between tabsets with notebooks and TabbedNoteBook
Question
Can someone tell me what the main difference is between using these
two types of components. Tabsets with notebooks and TabbedNoteBook
component? Is one a lot heavy on resources? I suspect that the
Tabbed Notebook would be since it does everything for you.
Answer
A:
As I see it, the Tabbed Notebook
+ is easier to work with (design time) thanks to the integration of the
tabset and the notebook
- is lacking the option to place the tabset where you like
Considering that Borland (a) within Delphi mostly uses the bottom-attached
style, and (b) didn't supply the sources even in the full VCL source kit,
one might wonder a bit, but I'll leave that to you.
The Orpheus VCL components has a "tabbed multi-page form" using which you
may put the tabset where you like plus more features.
A:
Resource-wise, they appear to be virtually identical. The biggest difference
(other than the obvious aesthetic difference in terms of the placement of the
tabs) is that you are forced to have all tabs visible when using the
TabbedNotebook. When using the Tabset and Notebook combination, you can allow
horizontal scrolling to show additional tabs (a la Component Palette).
Depending upon the situation, that may be preferable.
Lost the highlight color for the selected cell in a TStringGrid
Question
I have a StringGrid component with an over-rided OnDrawCell event. The problem is that I have lost the Highlight color for the selected cell(s).
What do I need to add to gain this back?
Answer
A:
Obviously you have changed DefaultDrawing to false. This is a bad
move, in my opinion, since you lose almost all the nice drawing that
the TGrids take care of for you. When I created my TWrapGrid, I
initially turned it off, colored the grids the way I wanted, but then
realized that it was better to just output text and let
DefaultDrawing handle the rest.
If you really insist on coloring your cells differently AND have the
highlight color for the selected cell, you should take a look at the
Grids source code and extract it from there.
Include a combo box in a TDBGrid
Question
I have in my app a TDBGrid, and one of their fields is a selection of predetermined values (like a boolean one, with True or False). I want to put a combo box in that line to give a more confortable way to the user to enter the data. How can i obtain that?
Answer
A:
Basically what you want to accomplish is
1. Create and draw a TComboBox every time you enter one of the cells
in your grid in that column
2. Get the current value from the field (if any) and put it into the
CB
3. After done, put the new value from the CB into the field
4. get rid of the CB
Dynamically identifiers for checkboxes
Question
My code looks something like this...
if CheckBox(var).checked=True then....
where (var) is a counter in a for loop.
Is the number of checkboxes not known when coding ? ie created only at run
time?
Answer
A:
When in design mode, you (the programmer) really should know how many
checkboxes are on a given form. When the App is running...
Use Delphi's Run Time Type Information (RTTI).
For a given form, try the following code snippet:
var
i : Integer
begin
for i := 0 to ComponentCount - 1 do:
if Components[i] is TCheckBox then
(Components[i] as TCheckBox).Checked then
begin
... insert your code here ...
end;
end;
In addition, the following code is a valid statement in Delphi:
if Components[i] = CheckBox5 then
DoSomething;
Also, each component in Delphi has a Published Property called 'Tag',
you can use this to your advantage by setting the Tag to some non-zero
number at design time, then using it at run-time, ie:
var
i : Integer
begin
for i := 0 to ComponentCount - 1 do:
if Components[i] is TCheckBox then
with (Components[i] as TCheckBox) do
Case Tag of
1 : if Checked then DoSomethingOnBox1;
2 : if Checked then DoSomethingOnBox2;
... etc ...
end;
end;
For more info, keyword search Delphi's help on "ComponentCount".
Create listbox on runtime
Question
I'll like to create a list box dynamically at run-time that fills half the size of the form ..... and I'll like it to be adjusted too when the form resizes (so that there will be no scroll-bars on the form).
How can I determine the size of the form and create this list box dynamically? also, can list boxes take more than 5,000 items ??
Answer
A:
Setting the ListBox alignment to alLeft will cause the ListBox to be resized
whenever the form is resized. Setting the width is easy (remember that the
Width you see on the right side of the assignment is the Form's
Width property).
The number of elements that a ListBox will hold is limited only by available
memory.
procedure TForm1.CreateListBox;
var
LB : TListBox;
begin
LB := TListBox.Create;
LB.Align := alLeft;
LB.Width := Width div 2;
end;
A:
Here's logic that creates the list box dynamically and resizes it when the
window is resized. I hope it is helpful. Also, I believe that a listbox is
limited to 32K of data.
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs,
StdCtrls { you'll need this for the ListBox } ;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
listbox: TListBox ;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
listbox := TListBox.Create(self) ;
listbox.Parent := self ;
listbox.Top := 0 ;
listbox.Left := 0 ;
listbox.Width := self.Width div 2 ;
listbox.Height := self.Height div 2 ;
listbox.items.add('test 1') ;
listbox.items.add('test 2') ;
{ etcetera ... }
end;
procedure TForm1.FormResize(Sender: TObject);
begin
listbox.Width := self.Width div 2 ;
listbox.Height := self.Height div 2 ;
end;
end.
Store variables in a listbox
Question
In a delphi listbox is there any way to store a variable with each entry (in a sorted list box).
Answer
A:
A TListBox has a TStringList to store the strings. TStringList conatins an items property (or something like that) that stores a pointer (or anything the size of a pointer or smaller). So, for example, you can store an object, component, record, or a variable to correspond to each string in the
TListBox.
Name property during runtime
Question
It looks like Sender is looking at the value in the 'Name' property. Is there a way to map the value in Sender to a component type ( such as TEdit, TCheckbox, Tlabel, etc. )?
Answer
A:
If ( Sender is TLabel ) then..
or if you know it is going to be something you can
TLabel( Sender ).Caption
A: To access the name property, use the either one of the following
examples:
formname:=(myform as tobject).name;
or
formname:=(myform as tcontrol).name;
this should do it for you. The reason why delphi does not want you to
do this is because it has certain controls that do not have specific
names and therefore, the compiler would have to check each call to
see if it is valid.
A:
If you use the ClassName property like this.
with Sender as TForm do
Label1.Caption := copy(ClassName,2,length(ClassName)-1);
This will give the desired effect without extra coding in the Form's create
method.
A:
'Sender' may well not be the form in question, and your program will throw an
exception on the invalid typecast. I'm not sure under which conditions (if
any) Sender actually would be the Form itself.
Anyway, you can protect yourself by bracketing the call with a exception
handler or just a simple test, like so:
If Sender is TForm then
Label1.Caption := (Sender as TForm).Name ;
If what you're trying to accomplish is the following:
Label1.Caption := Form1.Name ;
That's a whole different kettle of fish. I've read a lot of complaints
that this or that property of a Form isn't available at run time, most
of the cases seem to be linked to a misapprehension regarding class
initialization. If you read the Delphi docs carefully, you'll note that
setting a property in the Object Inspector does NOT automatically set
that property for run-time purposes. The answer to THIS situation is to
explicitly set the property (.Name in this case) in the Form's .Create
method. So, some code like the following WILL work:
procedure TForm1.Create( Sender : TObject ) ;
begin
Form1.Name := 'Form1' ;
end ;
procedure TForm1.Button1Click( Sender : TObject ) ;
begin
Label1.Caption := Form1.Name ;
end ;
A:
var
TC: TComponent;
begin
TC := label1.Owner;
label1.Caption := TC.ClassName;
end;
A:
I added a button to my form and in its event handler I put:
name := 'AName';
Then after clicking on the button, I could then click on the form and
the label's caption changed to 'AName'.
The solution is to define the property Name in the form's create event.
I.E. if you have a form named MyForm then in its OnCreate event you
should have:
name := 'MyForm';
This will solve your problem, but I agree its a little abnoxious.
Handle click for several buttons, using the caption
Question
I want to write one piece of code to handle click for several buttons, using
the caption (or name) property of each button.
I can't, have had to use a long series of IFs with specific names for each
button: IF sender = button1 THEN... ...button1.caption....button2...button.
This is very inelegant, and I'm sure there's a cleaner way of doing it.
Answer
A:
It sounds like you have, but, first make sure that you have the OnClick
event for each button on the calculator ( numeric buttons 0..9 ) pointing a
common event handler.
In the common event handler for the numeric buttons extract the button
caption with something like:
Edit1.Text := TButton(Sender).Caption;
A:
In this case I think it would be perfect to use the Tag property of each
button:
1) assign a unique Tag to each button (e.g. it's Arabic equivalence)
2) procedure TForm1.Button1Click(Sender: TObject);
begin
if (Sender is TButton) then
with (Sender as TButton) do
{use Tag}
end;
A:
If all you want is the caption, then there is indeed a very elegant way
to do it. Attach this event handler to all of your buttons and use typecasting:
procedure TForm1.Edit1Click(Sender: TObject);
begin
edit1.text := (sender as TButton).caption ;
end;
It will not suffice to say:
sender.caption
because the compiler has no way of knowing if "sender" will have a caption
property.
Text in vertical direction
Question
I am in need of displaying text in the vertical direction from either upward - downward or downward - upward directions, as well as inclined texts (that is, in non-horizontal directions). How could I do it?
Answer
A:
var
Hfont: Thandle;
logfont:TLogFont;
font: Thandle;
count: integer;
begin
LogFont.lfheight:=30;
logfont.lfwidth:=10;
logfont.lfweight:=900;
LogFont.lfEscapement:=-200;
logfont.lfcharset:=1;
logfont.lfoutprecision:=out_tt_precis;
logfont.lfquality:=draft_quality;
logfont.lfpitchandfamily:=FF_Modern;
font:=createfontindirect(logfont);
Selectobject(Form1.canvas.handle,font);
SetTextColor(Form1.canvas.handle,rgb(0,0,200));
SetBKmode(Form1.canvas.handle,transparent);
{textout(form1.canvas.handle,10,10,'Rotated',7);}
for count:=1 to 100 do
begin
canvas.textout(Random(form1.width),Random(form1.height),'Rotated');
SetTextColor(form1.canvas.handle,rgb(Random(255),Random(255),Random(255)));
end;
deleteobject(font);
end;
Displaying memo field in DBGrid
Question
I'm trying to display the first 100 bytes of a TMemoField in a DBGrid. To do
that, I created a calculated string field and tried the following code:
procedure TfrmDiario.Query1CalcFields(DataSet: TDataset);
var
s : String;
p : ^Char;
begin
with Query1Historico do begin {Query1Historico is the TMemoField}
if DataSize>0 then begin
GetMem(p, DataSize);
GetData(p);
StrCopy(PChar(p), @(s[1]));
s[0] := #100;
FreeMem(p, DataSize)
end
else
s := '';
Query1StrHistorico.AsString := s; {Query1StrHistorico is the calculated
TStringField}
end;
end;
The problem is that Query1Historico.DataSize is ALWAYS zero! I even
tried Query1Historico.SaveToFile and it indeed created a zero length file.
Answer
A:
I also finally loose the hope to see TMemoField.DataSize has another value
than zero. Maybe meaning of the DataSize is size of the part of Memo field
which saved in the .db file. Instead of this I using now the TBlobStream
object which works perfectly. It looks like :
Var
pBuffer : PChar ;
Blob : TBlobStream ;
begin
{FDataField is the TMemoField}
Blob := TBlobStream.Create( FDataField, bmRead ) ;
try
if Blob.Size > 0 then
try
GetMem( pBuffer, Blob.Size ) ;
Blob.Read( pBuffer^, Blob.Size ) ;
{ do something }
FreeMem( pBuffer, Blob.Size ) ;
except
ShowMessage( 'Out of memory' );
end ;
finally
Blob.Free
end ;
Multiselect in a stringgrid
Question
I have just started to work with the stringgrid component and want to try
to do a multiselect (as in a listbox). This is where a user can select
multiple (non-adjacent) rows or cells and copy some data from an editbox or
combobox to them. The help and literature on this are very sparse.
Is this possible or is there a component available which does this?
Answer
A:
I did the same thing with a DBGrid. (Not implemented the Shift-MouseDown,
Ctrl-MouseDown staff yet).
For the TStringGrid I think the idea is as following :
1. Then you filling the grid set the Objects[0, ARow] with a some
Boolean object
like TBooleanObject = class(TObject)
public
Flag : Boolean ;
end ;
2. In OnMouseDown and OnKeyDown events change the flag as needed.
3. In OnDrawCell event draw the row according to Objects[0,ARow] flag.
Center text in cells of TStringGrid
Question
How justify the text inside the cell of a grid?
Answer
A:
Supply your own drawcell method here's an example that we've used.
procedure Tsearchfrm.Grid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var l_oldalign : word;
begin
if (row=0) or (col<2) then
grid1.canvas.font.style:=grid1.canvas.font.style+[fsbold]; {set the headings in bold}
if col<>1 then
begin
l_oldalign:=settextalign(grid1.canvas.handle,ta_right);
{NB use the righthand side of the drawing rectangle}
grid1.canvas.textrect(rect,rect.right-2, Rect.top+2,grid1.cells[col,row]);
settextalign(grid1.canvas.handle,l_oldalign);
end
else
begin
grid1.canvas.textrect(rect,rect.left+2,rect.top+2,grid1.cells[col,row]);
end;
grid1.canvas.font.style:=grid1.canvas.font.style-[fsbold];
end;
Change the number of tabs in a TTabSet at runtime
Question
I want to be able to change the number of tabs in a TTabSet at runtime.
According to the documentation, this can be done by adding/deleting strings to
the 'Tabs' property.
Answer
A:
Assuming that somewhere in your code is a line like:
TabSet1: TTabSet; { assume it is in form Form1 }
then the code that you need to clear all of the tab labels is:
Form1.TabSet1.Tabs.Clear;
In order to add a new tab label just use this code:
Form1.TabSet1.Tabs.Add('some label');
Please note that I have only qualified the name on the assumption
that you are referencing it from within the same unit where it is
defined [but ignored the possibility that it might be in an event
handler or method that might partially qualify it -- the extra
qualification won't hurt]. If you need to refer to it from some
other unit then add the unit name (and add unit to "uses"), e.g.
Unit1.Form1.TabSet1.Tabs.Add('a label');
Since "TabSet1.Tabs" is of type TStrings you can also use all of
the methods (AddObject, LoadFromFile, et cetera) that apply to
the TStrings type on that property.
More than one line in a cell of TStringGrid
Question
Can i write more than one line in a cell? How make it?
Answer
A:
Yes but you have to overwrite the OnDraw Event.
here's a sample that has a multiple line heading which gets centered and
"Bolded"
procedure TForm1.grid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var l_oldalign : word;
l_YPos,l_XPos,i : integer;
s,s1 : string;
l_col,l_row :longint;
begin
l_col := col;
l_row := row;
with sender as tstringgrid do
begin
if (l_row=0) then
canvas.font.style:=canvas.font.style+[fsbold];
if l_row=0 then
begin
l_oldalign:=settextalign(canvas.handle,ta_center);
l_XPos:=rect.left + (rect.right - rect.left) div 2;
s:=cells[l_col,l_row];
while s<>'' do
begin
if pos(#13,s)<>0 then
begin
if pos(#13,s)=1 then
s1:=''
else
begin
s1:=trim(copy(s,1,pred(pos(#13,s))));
delete(s,1,pred(pos(#13,s)));
end;
delete(s,1,2);
end
else
begin
s1:=trim(s);
s:='';
end;
l_YPos:=rect.top+2;
canvas.textrect(rect,l_Xpos,l_YPos,s1);
inc(rect.top,rowheights[l_row] div 3);
end;
settextalign(canvas.handle,l_oldalign);
end
else
begin
canvas.textrect(rect,rect.left+2,rect.top+2,cells[l_col,l_row]);
end;
canvas.font.style:=canvas.font.style-[fsbold];
end;
end;
Events for runtime created components
Question
That is I created new component inherited from TSpeedbutton. This new button
is created runtime and that is OK, I can change it's properties etc. The
problem is I don't seem to get the idea how to respond to it's events because
at design time the component doesn't exist and therefor Object Inspector is
worthless in this case.
Answer
A:
Here's some code I wrote just now, I used a new project, with a button and a
menu.
(If you like, just create a new project, and add a button and a menu ... :)
{The procedure to create a new menu item ...}
procedure TForm1.Button1Click(Sender: TObject);
var
NewItem: TMenuItem;
begin
NewItem := TMenuItem.Create(Form1);
NewItem.Caption := 'Dynamic Item ...';
NewItem.OnClick := xyz;
MainMenu1.Items.Insert(0, NewItem); <- Note: have a look at the Delphi
end; example for Insert ...
{Any old 'xyz' procedure (can also be a currently defined one eg
Form1.DblClick)}
procedure TForm1.xyz(Sender: TObject);
begin
showmessage('Running this procedure !!');
end;
Note : If you use an un-defined procedure, you'll need to declare it.
I did mine right at the top in the form's type declaration like so:
private
{ Private declarations }
public
{ Public declarations }
procedure xyz(Sender: TObject); <- Events other than Form1 can
access the code here ...
A:
Just set the event handler property (eg. OnClick, OnDblClick, OnMouseDown etc)
to the procedure which you have written to handle the events. You need to make
sure that the parameters match those expected by the specific event handler.
eg.
MySpeedButton.OnClick := MyClickEventHandler;
where...
procedure MyClickEventHandler(Sender: TObject);
begin
end;
Shared Controls on a TTabbedNotebook
Question
How do I get Controls on a TTabbedNotebook to be shared among all pages or a
subset thereof?
Answer
A:
You could give the same impression by putting the controls into a panel or
some other holder wich is not a child of the notebook but is on top. As it
is not a child - changing the tabs will have no effect other than what code
you want to control it. Visibly it gives the impression that each tab /
notebook has the same page of controls.
A:
What I do is place the shared controls on the Form rather than
on a particular page of the TTabbedNotebook. To do this, you
need to set the TTabbedNotebook's Align property to something
other than alClient -- e.g. if the common controls are towards
the bottom of the Form, use alTop for the TTabbedNotebook, and
then move the bottom of the TTabbedNotebook up a bit from the
bottom of the Form, leaving a gap for the "shared" controls.
I you want to make the "shared" controls _look_ as if they are
on each page of the TTabbedNotebook, leave them on the Form,
but Bring them to the Front, and then move the bottom of the
TTabbedNotebook back down to the bottom of the Form.
This works for me. I havn't yet had a need for shared
controls on a _subset_ if the pages, but my first idea would
be to change the Visible property of such Controls to
true/false in the TTabbedNotebook's OnChange event.
Screen sizes and stringgrids
Question
I have an application with several screens. The application runs on
several PC's with various display capabilities. If I set the scale
property of the form to True then some of my stringgrids do not display
correctly, and some of my text won't fit like it should. I am missing
something simple, or is this the best that can be done?
Answer
A:
I've encountered the same problem you describe. I've observed that, while
Delphi scales the StringGrid's font properly, it doesn't change the
StringGrid's "DefaultColWidth" and "DefaultRowHeight" properties. Thus the
StringGrid itself does not actually change size.
I've worked around this by changing these properties myself:
with StringGrid1 do begin
DefaultColWidth := DefaultColWidth * MyScaleFactor;
DefaultRowHeight := DefaultRowHeight * MyScaleFactor;
end;
Aligning cells in stringgrid
Question
I need to allign cells in a stringgrid, first cell to the left ,second to the
right and so on ...
Answer
A:
Here is some code that should do what you want.
procedure WriteText(ACanvas: TCanvas; const ARect: TRect; DX, DY: Integer;
const Text: string; Format: Word);
var
S: array[0..255] of Char;
B, R: TRect;
begin
with ACanvas, ARect do
begin
case Format of
DT_LEFT : ExtTextOut(Handle, Left + DX, Top + DY, ETO_OPAQUE or ETO_CLIPPED,
@ARect, StrPCopy(S, Text), Length(Text), nil);
DT_RIGHT : ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,
ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
Length(Text), nil);
DT_CENTER : ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div 2,
Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
StrPCopy(S, Text), Length(Text), nil);
end;
end;
end;
procedure TBEFStringGrid.DrawCell(Col, Row: Longint; Rect: TRect; State: TGridDrawState);
var
procedure Display(const S: string; Alignment: TAlignment);
const
Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
WriteText(Canvas, Rect, 2, 2, S, Formats[Alignment]);
end;
begin
{ test the Col and Row arguments here and format the cells as you want }
case Row of
0 : { Center column headings }
if (Col < ColCount) then
Display(Cells[Col,Row], taCenter)
else
{ Right justify all other entries }
Display(Cells[Col,Row], taRight);
end;
end;
Coloured StringGrid
Question
Presently working on a project which has to display differently colored cells
in a grid. Nothing fancy like formulas and printing, just displaying
time-related activities in hour or half-hour cells and color-coding these
activities on a per-cell-basis. I must also be able to read back color codes
by clicking in a cell. The grid must allow multiple area selections.
Answer
A:
You can try using a StringGrid. It has an Objects property that you
can assign objects. Create an object which contains a TColor variable
and assign it to Objects[col,row], so you can retrieve it any time. You
must assign an OnDrawCell Event to the StringGrid, drawing the text on
the Correct color. To retrieve the selection, you can use Selection
property, that contains the user Selection. This should be something like that:
type
TStrColor = class(TObject)
public
Color : TColor; {you could also define a private variable and
public access methods}
end;
...
procedure TForm1.FormCreate(Sender:TObject)
var
i,j : Integer;
begin
With StringList1 do
for i := 0 to ColCount-1
for j := 0 to RowCount-1
Objects[i,j] := TStrColor.Create;
end;
...
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var
OldColor : TColor;
begin
with StringGrid1.Canvas do begin
OldColor := Font.Color;
Font.Color := (StringGrid1.Objects[col,row] as TStrColor).Color;
TextOut(Rect.Left+2,Rect.Top+2,StringGrid1.Cells[Col,Row]);
Font.Color := OldColor;
end;
end;
...
procedure TForm1.ProcessSelection(Sender: TObject);
var
i,j : Integer;
begin
With StringGrid1.Selection do
For i := left to right do
for j := top to bottom do
MessageDlg(IntToStr(i)+','+IntToStr(j)+'-'+
IntToStr((StringGrid1.Objects[i,j] as TStrColor).Color),
mtInformation,[mbOk],0);
end;
This component cannot allow multiple selections....
Testing for the existence of a Component Property
Question
I would like to iterate through all my components on a form, at form
activation time, and if a particular component has a Font property, I would
like to set the Font.Pitch value at that time. In general, how do I test to
see if a component has a particular property?
Answer
{you'll probably want to replace the "is TButton.." with some kind of set
that you define on your own.. then you just ask.. if Components[i] in myset
then}
{gee i dont know ... i just looked up TFont and it applies to 40 some
different objects, and everything that has a TFont also has a TPitch ...
there must be an easier way}
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 0 to ComponentCount -1 do
if Components[i] is TButton then
TButton(Components[I]).Font.Pitch :=fpFixed ;
end;
Set event-handler at run-time
Question
I need to set the onTimer property of a TTimer-component at run-time.
Lets say I have a procedure called ThisOne and I , want it to be the
eventhandler - how is that done?
Answer
A:
It's pretty straightforward: you define the procedure (say ThisOne) that
takes the same parameter list as onTimer, then when you want it to be
attached to the timer you say:
Timer1.onTimer := ThisOne;
To turn off the event, use:
Timer1.onTimer := nil;
The procedure (ThisOne) does not need to be in the same class as the timer,
but it _must_ take the same parameters in the same order or you risk things
going off into la-la land.
A:
The way I'd do it is to put the component on the form and create the
appropriate event. (this gets better - honest). Then copy the procedure line
of the event, rename it and put it in the public section. This ensures that
the event has the right parameters - with some of the longer event lines,
typing the correct definition can be a real hassle.
Remove the component from the form if you don't want it. Put the code you
want called in the new event handler you've defined. When you create the
object put the address of the code into the ONevent handler of the object.
I think the appropriate line of code is:
Timer1.ontimerevent:=formdynamictimerevent;
Application events
Question
I am trying to allow my program to accept file manager drops...I have it
working OK with The Main window opened, but not minimised. The Accept files
works OK, but I am not sure how to get the WM_Drop message. I reallize it must
be somewhere in the OnMessage handler (I know how to create event Handlers for
Application events), but, in the OnMessage handler, how do I get the message?
Msg is NOT one of the parameters.
Answer
A:
The problem here is that when your Delphi application is minimized, it is a
different window handle than at other times. The Application object actually
has its own window handle! Application.Handle is the window that is active when
your app is minimized. When you minimize the app, all the forms are actually
just hidden. Notice the Application methods Minimize and Restore. Also notice
that there are two undocumented events in TApplication, OnMinimize and
OnRestore. These are there because there is no event handler in TForm that will
fire when you minimize the main window. Kind of bizarre. I think it is done
this way to support SDI applications.
ReleaseDC and TCanvas
Question
I have a canvas that I create, and set the Handle using GetWIndowDC.
I do explicitly destroy the Canvas, is is automatically calling RealeseDC?
Is this a safe method of doing this?
Answer
A:
TCanvas will not automatically call ReleaseDC. To create a canvas with
a WindowDC as its handle, probably the best idea would be to create a
descendant of TCanvas (modeled on TControlCanvas):
type
TWindowCanvas = class(TCanvas)
private
FWinControl: TWinControl;
FDeviceContext: HDC;
procedure SetWinControl(AControl: TWinControl);
protected
procedure CreateHandle; override;
public
destructor Destroy; override;
procedure FreeHandle;
property WinControl: TWinControl read FWinControl write =
SetWinControl;
end;
implementation
destructor TWindowCanvas.Destroy;
begin
FreeHandle;
inherited Destroy;
end;
procedure TWindowCanvas.CreateHandle;
begin
if FControl = nil then inherited CreateHandle else
begin
if FDeviceContext = 0 then
FDeviceContext := GetWindowDC(WinControl.Handle);
Handle := FDeviceContext;
end;
end;
procedure TControlCanvas.FreeHandle;
begin
if FDeviceContext <> 0 then
begin
Handle := 0;
ReleaseDC(WinControl.Handle, FDeviceContext);
FDeviceContext := 0;
end;
end;
procedure TControlCanvas.SetWinControl(AControl: TWinControl);
begin
if FWinControl <> AControl then
begin
FreeHandle;
FWinControl := AControl;
end;
end;
Obviously, you should be careful to destroy the TWindowCanvas (or free
its handle) before destroying the control associated with it. Also,
note that the DeviceContext handle will not be released automatically
after completing the processing of each message (as happens with the
handles of TControlCanvas); you must explicitly call FreeHandle (or
destroy the Canvas) to release the handle. Finally, note that
"WindowCanvas.Handle:= 0" will not release the handle, you must call
FreeHandle to release it.
Using TStringList in a visual component
Question
I need to build a buffer for queuing output requests to be handled by a
component I am trying to build. I thought I would just use a TStringList,
add to it's end and using and deleting the first entry when possible... It
doesn't seem to be this simple... does anyone know the difference between
TStrings and TStringList and which I should be using.... any tips????
Answer
A:
TStrings is an abstract base class used by many of the visual controls such
as TListBox. What you want is TStringList, or if all you need to keep track
of is objects, use TList instead. To add to the end of either, use the Add
method. To insert at a specific place in the list, use Insert. To get a
string from the list, use the Items property. Keep in mind that it is
zero-based, so the last item in the list is referenced by Count-1 (Count is
another property). To delete a string, use the Delete method. To find a
string in the list, use IndexOf. TStringList can be made to keep the list in
alphabetical order. To do that, set the Sorted property to true before you
add anything to it. It can also be used to keep an object for every string,
using AddObject and the Objects property. TList does most of the above, just
without the strings. To create a TStringlist, do this:
procedure MakeList;
var
aList: TStringList;
begin
aList := TStringList.Create;
aList.Sorted := true; {optional}
aList.Duplicates := dupIgnore; {or dupAccept or dupError}
aList.Add('String 1');
aList.Add('String 2');
Edit1.Text := aList.Items[0]; {Edit1 now says 'String 1'}
aList.Delete(0);
aList.Free;
end;
StringGrid Masks
Question
I have a column in a string grid that I need to be displayed like the
"comma" format of any Spreadsheet:
User types: 123456.7
Grid displays: 123,456.70
Answer
A:
What you want is tricky, but doable cause I've got a right aligned, floating
point, editable grid working right now (albeit a DrawGrid, but the concepts
should be the same).
You'll need a couple of things:
- An OnDrawCell handler to display the formatted, right-justified data.
- The cells of your stringgrid loaded with unformatted string representations of
your data.
In your OnDrawCell handler you will need to do something like this. This
code displays right justified comma-tized values:
begin
if (Row > 0) and (Col > 0) and (grdDivBudget.Cells[Col, Row] <> '') then
begin
{Format floating point string}
strText := FloatToStrF(StrToFloat(grdDivBudget.Cells[Col, Row]),
ffNumber, 13,2);
{Set font}
grdDivBudget.Canvas.Font.Name := 'Courier';
if StrToFloat(grdDivBudget.Cells[Col, Row]) < 0 then
grdDivBudget.Canvas.Font.Color := clRed;
grdDivBudget.Canvas.Font.Style := grdDivBudget.Canvas.Font.Style -
[fsBold];
{Center the text in the cell from top to bottom, right justify it and
move the right margin to the left two pixels.}
X := Rect.Right - grdDivBudget.Canvas.TextWidth(strText);
Y := Rect.Top + ((Rect.Bottom - Rect.Top -
grdDivBudget.Canvas.TextHeight(strText)) div 2);
Dec(Rect.Right, 2);
grdDivBudget.Canvas.TextRect(Rect, X, Y, strText);
end;
Make sure you have DefaultDrawing := True so you only have to write code to
draw the cells which need to be specially formatted.
That should do it. When the user tries to edit the number in a cell it
should be displayed in its non-formatted state. If not the you'll need an
OnGetEditText handler.
Also, you'll find that validation of the data can be problematic (i.e.
what if the user enters 'TX' in a numeric column). It's made worse by the
fact that the grid (well, the DrawGrid anyway) does not exhibit consistent
behavior for different ways of navigating the grid (i.e. it triggers
different events if you use the arrow keys, versus the mouse, versus simply
hitting enter). If this becomes a problem post another message and I'll
give you my solution (which I'm not proud of, but it works).
StringGrid right alignment
Question
To right align the cells in a string grid, and have the numeric cells
containing comma, I did the following.
- Made all the contents of the cells the same length. Padded with spaces
to ensure all were the same.
- This will enable you to right-align the cells. Just make sure you use
a TT font else certain letters such as the letter i will take less space
than a letter such as M. I used Courier New as the grids font.
Answer
A:
I suppose this one is better method
procedure TForm1.GridSumaDrawCell(Sender: TObject; ACol, ARow: Longint;
ARect: TRect; State: TGridDrawState);
var
dx : integer;
begin
with (Sender as TStringGrid).Canvas do begin
Font := GridSuma.Font;
Pen.Color := clBlack;
if (ACol = 0) or (ARow = 0) then begin
{ Draw header }
Brush.Color := clBtnFace;
FillRect(ARect);
TextOut(ARect.Left, ARect.Top, GridSuma.Cells[ACol, ARow])
end
else begin
{ Draw right aligned cell }
Brush.Color := clWhite;
FillRect(ARect);
dx := TextWidth (GridSuma.Cells[ACol, ARow]) + 2;
TextOut(ARect.Right - dx, ARect.Top, GridSuma.Cells[ACol, ARow])
end
end
end;
FileName property in non-visual component
Question
I'm trying to get a new non-visual component created, and one of the properties
will be a FileName property. How can I set it up so that at design time the
user will get the ellipses button on the property manager and get the file
open box if they click on it and then be able to select a file name that way?
Answer
A:
The following code is taken out of dsgnintf.pas (a file
worth exploring!) for the TMPLayer.filename
property, with help for C.Calvert..
In the component unit file header...
TFileNameProperty = class (TStringProperty)
public
function getattributes: TPropertyattributes; override;
procedure Edit; override;
end;
add to the register function...
RegisterPropertyEditor(Typeinfo(String),
TMyComponent, 'Filename', TFileNameProperty);
and the code...
function TFileNameProperty.GetAttributes;
begin
Result := [paDialog];
end;
Procedure TFilenameProperty.edit;
var
MFileOpen: TOpenDialog;
begin
MFileOpen := TOpenDialog.Create(Application);
MFileOpen.Filename := GetValue;
MFileOpen.Filter := 'The Right Kind Of Files|*.*'; (* Put your own filter
here...*)
MFileOpen.Options := MFileOpen.Options + [ofPathMustExist,ofFileMustExist];
try
if MFileOpen.Execute then SetValue(MFileOpen.Filename);
finally
MFileOpen.Free;
end;
end;
Call the Hint method directly
Question
Is it possible to call the Hint method directly?
I've a case where I want to click on a Button, and the Hint for
another component (eg, an edit box) will appear for 1 second or
so, and then it will disappear after the button is released. I
saw something like "ActivateHint" but it seemed that I
couldn't make a direct call.
Answer
A:
function RevealHint (Control: TControl): THintWindow;
{----------------------------------------------------------------}
{ Pops up Hint window for the specified Control, and returns a }
{ reference to the hint object so it may subsequently be removed }
{ with RemoveHint (see below). }
{----------------------------------------------------------------}
var
ShortHint: string;
AShortHint: array[0..255] of Char;
HintPos: TPoint;
HintBox: TRect;
begin
{ Create the window: }
Result := THintWindow.Create(Control);
{ Get first half of hint up to '|': }
ShortHint := GetShortHint(Control.Hint);
{ Calculate Hint Window position & size: }
HintPos := Control.ClientOrigin;
Inc(HintPos.Y, Control.Height + 6); <<<< See note below
HintBox := Bounds(0, 0, Screen.Width, 0);
DrawText(Result.Canvas.Handle,
StrPCopy(AShortHint, ShortHint), -1, HintBox,
DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
OffsetRect(HintBox, HintPos.X, HintPos.Y);
Inc(HintBox.Right, 6);
Inc(HintBox.Bottom, 2);
{ Now show the window: }
Result.ActivateHint(HintBox, ShortHint);
end; {RevealHint}
procedure RemoveHint (var Hint: THintWindow);
{----------------------------------------------------------------}
{ Releases the window handle of a Hint previously popped up with }
{ RevealHint. }
{----------------------------------------------------------------}
begin
Hint.ReleaseHandle;
Hint.Free;
Hint := nil;
end; {RemoveHint}
The line marked <<<< above is the one that positions the hint
window below the control. This could obviously be altered if
you want a different position for some reason.
Edit in StringGrid
Question
An annoying problem with StringGrid:
I'm using a stringgrid to display some data, and i start the stringgrid with
GoEditing set to false (The user can't edit the data in the stringgrid),
and selectrow to true (The user can select only whole row).
I placed an "EDIT" button so when the user presses it, i set the GoEditing to
true & selectrow to false and now the user can edit the data in the table.
All is well up to now.
The problem:
When the user pressed EDIT, and edits a cell, then presses EDIT again to
switch back to normal row selecting mode, the cell that was last edited, stays
in an inverted color, meaning , if the focused cell is blue and the rest is
white, then after the user edits a cell and presses EDIT again , the whole line
is blue EXCEPT the cell that was last edited, which remains white.
I should add that the stringgrid i'm using is a modified stringgrid which each
col. can be alligned diffrently (first col. can be rightjustified, second left
justified, third centered justified and so on...) but i don't think this has
anything to do with my problem.
Answer
A:
Haven't tried these, but two possibilities come to mind:
1) On the second edit press, change focus to another field (eg. x.focus
where x is not the grid), reset goEditing and selectRow, then change
focus back to the grid. (This technique has worked for me in several
places, eg. grids, memos.)
2) On the second Edit press, after resetting goEditing and selectRow,
try creating a tGridRect spanning the row you want to highlight, the
doing grid.Selection := gridRect;
How to detect a row focus change in TDBGrid
Question
There is (very surprisingly) no event triggered when the user changes the
focus from one row to another in a TDBGrid. Am I missing something here? Has
anyone got an easy way?
Answer
A:
You use the OnDataChange event of the Datasource to which the DBGrid is attached.
If the State in the event is dsBrowse then you've gone to a new row (or just
opened the table).
Why not have an event in the grid? Because the grid may not be the only control
displaying data from the current row and might not be the only way to move from
row to row. Using the Datasource give centralized event handling.
As to your question about a single click, not sure what you're trying to do, but
you can use TDatasource.OnDataChange to capture row changes and
TDBGrid.OnColEnter/Exit to capture column changes.
A:
The following works for me:
1. To detect row change, use the TDataSource's OnDataChange event.
OnDataChange occurs whenever scrolling or clicking on a different row
happens. The event handler is something like this:
procedure Form1.DSrc1DataChange(Sender: TObject; Field: TField);
where Field is the column in which change occured.
The TTable's fields can be used for comparing the currently selected
row's fields (key) with whatever your requirement is. The TDBGrid's
Fields property can also be used the same way. For instance:
if tbl1.Fields[0].AsString = 'BlaBlaBla' then ...
or, if dbGrid1.Fields[I].IsNull then ...
2. For column change, use TDBGrid's OnColExit & OnColEnter. The
TDBGrid's properties SelectedField and SelectedIndex can be used to
determine the currently selected column.
When a different column on a different row is selected, you get
OnColExit, OnColEnter, and then OnDataChange.
3. You can also do some fancy stuff by using the TDBGrid's
OnDrawDataCell event which occurs when a cell is selected or
when the grid is scrolled. The event handler looks like:
procedure Form1.dbGrid1DrawDataCell(Sender: TObject; Rect: TRect;
Field: TField; State: TGridDrawState);
But of course you get a lot of draw events when cell changes, and
you have to do your own filtering.
4. If you don't have a problem in creating "101 variations" on the
standard components - which I don't 8-) then try this. It is
easier.
To access row or column index of the selected cell, you can
derive a class from TCustomGrid and publish its Row, Col
run-time properties (current grid row and column, not table's!!):
type
TSampleDBGrid = class(TCustomGrid)
public
property Col;
property Row;
end;
in some procedure or event handler, do a typecasting:
var
G: TSampleDBGrid;
begin
G := TSampleDBGrid(myDBGrid1);
if G.Row = I then ...
if G.Col = J then ...
This is because TDBGrid is a descendant of TCustomGrid, which
has several properties on the grid coordinates, but aren't
published in TDBGrid.
A:
From what I can see, you have to do it programmatically. OTTOMH,
assuming the grids already exist and you have access to the
underlying ttable::
grid.colcount := dbGrid.fieldcount;
table.first;
row := 0;
while not table.eof do begin
grid.rowcount := row + 1;
for i := 0 to grid.colcount-1 do
grid.cells[i,row] := dbGrid.fields[i].asString;
table.next;
inc (row);
end;
May be some latent bugs in this, but it should do the trick.
A:
Look at the following code and see if it will help. It takes the 'Name'
property of a control and then places it into the 'Caption' property of a
label.
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Edit2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Label1.Caption := TEdit(Sender).Name;
end;
procedure TForm1.Edit2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Label1.Caption := TEdit(Sender).Name;
end;
end.
Change Grid Cell Color
Question
I have a dbeGird wich displays a lot of numbers. How can I change the color
of the cells which has a value below zero.
Answer
A:
Attach the following code to the DBGrid's OnDrawCell event handler:
procedure TForm1.DBGridDrawDataCell(....);
begin
if Table1.FieldByName( 'SomeField').AsFloat < 0 then
DBGrid1.Canvas.Font.Color := clRed
else DBGrid1.Canvas.Font.Color := clBlack;
DBGrid1.DefaultDrawDataCell( Rect, Field, State );
end;
[Patrick Allen, patrick@blueridge.com]
A:
In the dbgOrdRegDrawDataCell put the next lines.
if ((Field.FieldName = 'CalcAmout') and (tbOrdCalcAmount.AsFloat < 0)) then
dbgOrdReg.Canvas.Font.Color := clRed
dbgOrdReg.DefaultDrawDataCell(Rect,Field,State);
This is working at my place and if you make a if .. else if ... else if..
you can test every grid cell and change the colors.
[Rene Groothuis, steelcover@dataweb.nl]
A:
Well I've found the solution. It's like this:
In the dbgOrdRegDrawDataCell put the next lines.
if ((Field.FieldName = 'CalcAmout') and (tbOrdCalcAmount.AsFloat < 0)) then
dbgOrdReg.Canvas.Font.Color := clRed
dbgOrdReg.DefaultDrawDataCell(Rect,Field,State);
This is working at my place and if you make a if .. else if ... else if..
you can test every grid cell and change the colors.
TEdit and OnEnter event
Question
I would like to write a TEdit component, where on the OnEnter event,
it will display a hint in a specified label. My question is how do
override the OnEnter event in my component to do the extra bit that I
want.
Answer
A:
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TNewComponent = class(TEdit)
private
{ Private declarations }
protected
{ Protected declarations }
procedure DoEnter; OverRide;
public
{ Public declarations }
constructor Create(AOwner: TComponent); OverRide;
destructor Destroy; Override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure TNewComponent.DoEnter;
begin
inherited DoEnter;
end;
destructor TNewComponent.Destroy;
begin
inherited destroy;
end;
constructor TNewComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
procedure Register;
begin
RegisterComponents('Samples', [TNewComponent]);
end;
end.
How do I create a component like TField
Question
I'd like to create component (subclass of TComponent) which will be
not visible on a form at design time just like subclasses of TField.
More precisely I want to have to non-window component types: first
called TListComponent and the second TListElement. Now I can write
the component editor for TListComponent and the editor can create
a plenty of TListElement components. The problem is:
1. If I do not RegisterComponent for TListElement then creating
it's instance at design time raises GPF.
2. If I do RegisterComponent for TListElement then creating the
instance of TListElement creates an icon placed on the form and
I do not want it. I prefer to keep TListElement invisible at design time
just like TTable does with TField.
Answer
A:
Have you considered not making it a component, but a class? A class is
programmatic, not part of a form. If you put the class in a unit (say
myclass.pas) and then in your program put "uses myclass;", then you can just
use it as a class, eg.
type
aninstance: tMyclass;
begin
new (aninstance);
{equivalent to aninstance := tMyclass.create; }
...
{ use aninstance here }
...
dispose (aninstance);
{ equivalent to aninstance.free; }
end;
Change delete behavior in Memo
Question
I need to change the behavior of the delete key in a memo
box. The new behavior will stop the CR/LF from being deleted if delete is
pressed at the end of a line, or, backspace is pressed from the beginning of a
line. I want each character pressed to remain on the line it was intitially
input. There will always be 6 lines in the memo, and line 3 cannot be moved to
line 2. I still would like to be able to delete characters, just not the
CR/LF.
Answer
A:
Just change the Memo's OnKeyDown event handler to look like:-
if Key = VK_DELETE then
begin
do whatever you want in here
end;
if Key = VK_BACK then
begin
do whatever
end;
Probably better to use a CASE here but I'm not sure if CASE allows VK_?? in it.
May also need to include the Inherited for the keys you don't handle. Anyone
want to
clarify this ?
Also look up the SelStart to determine where you are in the line like so:-
var
Lpos, Cpos : Integer;
Lpos := SendMessage(memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);
Cpos := SendMessage(memo1.Handle,EM_LINEINDEX,Lpos,0);
CPos := Memo1.SelStart-CPos;
A:
since VK_? stuff are integers this will work :
case Key of
VK_DELETE :
begin
Key := 0; {this stops the keydown message from going any
farther, for ex. the form and its components}
stuff to do;
end;
VK_BACK:
begin
Key := 0; {this stops the keydown message from going any
farther, for ex. the form and its components}
stuff to do;
end;
end;
Listbox with graphic
Question
Has anyone done something like putting a .BMP graphic besides text within a
listbox? something you see when you click on "Options"-"Environment"->
"Palette".
Answer
A:
This is a sample code. You need to set the ListBox property
Style to lbOwnerDrawFixed. Then you draw the bitmap on the event
DrawItem (see OwnerDraw at the Delphi Help File).
unit Listemas;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TLTemas = class(TForm)
ListBox1: TListBox;
procedure FormActivate(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
LTemas: TLTemas;
implementation
{$R *.DFM}
procedure TLTemas.FormActivate(Sender: TObject);
var
Dibujo: TIcon;
begin
with ListBox1.Items do
begin
Dibujo := TIcon.create;
Dibujo.LoadFromFile('.\ICO\justic.ico');
AddObject('Poder Legislativo y Partidos Politicos',Dibujo);
Dibujo := TIcon.create;
Dibujo.LoadFromFile('.\ICO\justic.ico');
AddObject('Poder Ejecutivo Nacional',Dibujo);
end;
end;
procedure TLTemas.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Icon: TIcon;
Offset: Integer; { text offset width }
begin
with (Control as TListBox).Canvas do { draw on the control canvas, not on the form }
begin
FillRect(Rect); { clear the rectangle }
Offset := 2; { provide default offset }
Icon := TIcon((Control as TListBox).Items.Objects[Index]); { get the Icon for this item }
if Icon <> nil then
begin
Draw(Rect.Left+1,Rect.Top+2,TIcon((Control as ListBox).Items.Objects[Index]));
Offset := Icon.width + 9; { add four pixels between Icon and text }
end;
TextOut(Rect.Left + Offset, Rect.Top+7, (Control as TListBox).Items[Index]) { display the text }
end;
end;
end.
A:
Check out the OnDrawItem event for the listbox (or combobox etc).
There you will see that drawing graphics is as easy as writing text.
(Once you are comfortable with that check out OnMeasureItem event)
procedure ListDrawItem(Control: TWinControl; Index:
Integer;
Rect: TRect; State: TOwnerDrawState);
var
BitMap : TBitMap;
begin
{Initialize Bitmap here.... i.e. load a graphic onto it}
With (Control as TListBox).Canvas do
begin
FillRect(Rect);
Draw(Rect.Left, Rect.Top, BitMap);
TextOut(Rect.Left + 2 + BitMap.Width, Rect.Top,
DstList.items.strings[index]); {DstList is the name of the
list}
end;
end;
Masked Find in TStringList
Question
I am trying to do a masked find or search in a TStringList Object. Something
like MyList.Find('LeftPelvic*') to find all strings that start with LeftPelvic
and have it return a TStringList or find the first and have a findnext method.
Answer
A:
list : tStringList; { the tStringList to search }
target: string; { the string to search for, eg. 'LeftPelvic' }
{ set start to where you want to start from, eg. 0 to start at the top
or some integer to start within the list, eg. the last value of i + 1 }
{ following is case insensitive, to make it case sensitive remove the calls
to ansiUpperCase }
target := ansiUpperCase (target);
for i := start to list.count-1 do
if ansiUpperCase(copy(list.item[i], 1, length(target))) = target then
found it!
If you want to do a looser search, eg. find 'LeftPelvic' anywhere in the
list item rather than just at the beginning, change the if statement to:
if pos (target, ansiUpperCase(list.item[i])) > 0 then found it;
Dual list box
Question
Could anyone give me some hints on how to create a dual list box (add
and remove items betweem 2 listboxes) with the items of the src list come
from a table.
I have tried the dual list box template, but it is a listbox with
pre-entered items. I want to hv the items from a table instead. Which one
(ListBox, DBListBox or ...) should I use?
Answer
A:
I placed two listboxes on the screen and used the following code to fill one
of them
with data from a table.
tableName.Refresh; {this may or may not be necessary in your case}
tableName.First; {Make sure you are looking at the first record}
while not tableName.Eof do {loop through table}
begin
listbox1.items.add(tableName.FieldByName('USRID').AsString); {add the item
to the listbox1}
tableName.Next; {go to the next record}
end;
this is an actual procedure from some code that I am using to accomplish the
same thing.
I pass it a tablename and listbox1 name and listbox2 name. I use several
tables that
have the same type of fields that is why I use this routine:
procedure TTemplateFrm.buildList(tableName: TTable; SelBox, AvailBox: TListBox);
begin
{we are going to add data to listboxes in this procedure}
{pick up any new data}
tableName.Refresh;
{make sure we are looking at the first record}
tableName.First;
{Now clear the list boxes}
SelBox.Clear;
AvailBox.Clear;
{Now add the Stations}
while not tableName.EOF do
begin
AvailBox.Items.Add(tableName.fieldByName('USRID').AsString +
' ' + tableName.fieldByName('DESCRIPTION').AsString);
tableName.Next;
end;
end;
How do you want to move data between the two boxes? If you want to drag and
drop then
use begindrag in your mousedown event of the source table like this:
if Button = mbLeft then
Tlistbox(sender).BeginDrag(false);
Then in your other listbox, the one receiving the data you type in the
follow code in DragOver event:
if Source = ListBox1 then
Accept := true
else
Accept := false;
Do not use "Accept := (Source is TListbox)" as most examples show, because
you have two list boxes
you need to refer to the name of the object and not the type or you will
confuse your program.
Finally in your dragDrop you can use the following code to add the data to
listbox2 and remove it from list
box1.
Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
Listbox1.Items.Delete(Listbox1.ItemIndex);
Finally add a save button if you want to loop through the listbox2 and save
it to a database.
I hope this is what you were looking for and that you find this useful. If
you want to be able to move
data from listbox2 to listbox1 as well then use the same code but REVERSE
which boxes you place them in
and make sure you reference the correct boxes in the code.
OnClose proc
Question
Just wanted to be sure of something...If an application is shut down, by
any method within the program, it DOES call the OnClose procedure for any
open forms, right? But if by chance it was shut down by Windows, like a
situation where Task Manager was called and it is shut down from there,
then although the program itself is over, any Forms that might have been
open and were not created in the project source file, could still be lost
in memory, is that right?
Answer
A:
My experience is that OnClose is only called when Close is called.
OnDestroy, however is always called when the form being freed or
destroyed. I had put my Table.Post stuff in OnClose, but it was not
always called. Try putting MessageBeep into OnClose, then close your
app a few different ways to see exactly when it is called.
A:
I ran a test that suggested an Application.Terminate will fire the Destroy
event for the form but NOT the OnClose or OnCloseQuery events, unlike VB.
A:
It's my understanding that the Task Manager does not actually close
the application. It just tells the application to close itself, by
way of sending messages directly to the application. I would hope
that the default window proc. that Delphi puts into your application
would handle going through the list of child components that your
application has and tells them all to close as well.
You should be able to test this by starting something you've written
in Delphi and having the Task Manager close it. Do this several
times and see if you free system resources decreases.
Colouring fields in DBGRIDS
Question
I currently have an application using a DBGRID. I want to display a memofield
in the grid in red if the memo has text in it, Default colour if not.
I have tried doing this by setting the default font for the grid to red
if the field about to be drawn is the required one and the memofield is
not null.
Answer
A:
Here's an example that uses the demo COUNTRY table and draws
the text of each row in red where the population is less than 10 million.
Hope it helps.
Respond to an OnDrawDataCell event.
begin
if Table1.FieldByName('Population').AsFloat < 10000000 then
DBGrid1.Canvas.Font.Color := clRed;
dbGrid1.DefaultDrawDataCell(Rect,Field,State);
end;
"Autosizing" StringGrids
Question
Is there a way to make my Stringgrids "Autosize columns? I
am loading the stringgrid from static code and would like to
hae the column widths autosize to fit the text loaded.
Answer
A:
Not really, but OTTOMH you can do it programmatically like this (do this
after you've loaded the data, or if you're loading the data in columns you
can do it within this loop too):
i,j,temp,max: integer;
for i := 0 to grid.colcount-1 do begin
max := 0;
for j := 0 to grid.rowcount-1 do begin
temp := grid.canvas.textWidth (grid.cells[i,j]);
if temp > max then max := temp;
end;
grid.colWidths[i] := max + grid.gridLineWidth +1;
end;
You may need to fudge with the +1 to give each column a little border space.
Which button on panel is the Sender
Question
I've a panel on my application that has about 5 buttons.
A popup menu is attached to the Panel
When I right-click on the panel, how do I know which
button the right click fell on, and triggered the popup?
It seems that the Sender of the PopupMenu is the Panel.
But I need to know which button the click fell on.
I tried to put this in the button's OnMouseDown code but
it didn't work.
procedure TTBar2.ToolBarSpdBtn1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Shift = [ssRight] then ShowMessage('Right button!');
end;
Answer
A:
I think you might have to get rid of the PopupMenu property in the panel and
use the mouse down event of the button to do what you did above. Also, I
think you could try to turn off the Auto property. Then put this in your
OnMouseDown:
procedure TForm1.BitBtn1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
with Sender as TBitBtn do
if Button = mbRight then
begin
P := Self.ClientToScreen (
Point (Left + (Width div 2), Top + (Height div 2)));
PopupMenu1.Popup (P.X,P.Y);
end;
end;
Publishing properties that are sets
Question
I need to publish a property that is a set such as
type
myset = set of (msThis, msThat, msThese, msEtc);
myClass = class(TComponent)
fMySetProperty : myset;
published
MySetProperty : myset read fMySetProperty write fMySetProperty;
end;
the compiler lets me put this guy in the public portion of the
declaration, but not published. Says that it can't be published.
Answer
I think your problem is that any field or method that is not explicitly
put under another kind of protection is assumed to be published, I
suspect what you meant to do was:
myClass = class(TComponent)
private { !! you omitted this protection directive }
fMySetProperty : myset;
published
MySetProperty : myset read fMySetProperty write fMySetProperty;
end;
Right Text Alignment in edit box
Question
One of these involved a form with a dbEdit box (TdbEdit) to
display the value of a float field) together with a standard
edit box (TEdit) to display the value of a float variable
(formatted as a text string).
The dbEdit box displayed the numerical value right-aligned,
which was most suitable indeed. I therefore also wanted the
standard edit box to do the same. However, I was unable to
get its text string to align itself in any other way than to
the left.
Can any of you Delphi gurus point me in the right direction
please. (How, for example, does Borland pull this stunt off
for dbEdit).
Answer
TEdit1 = class(TEdit)
public
procedure CreateParams(var Params: TCreateParams); Override;
end;
procedure TEdit1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or ES_RIGHT;
end;
TTimer question
Question
I try to make a scheduler for starting an application at a certain time. To
be more specific, this scheduler should call a certain phone number and
leave a message. So I used a tTimer, set the Interval to a large value
(longint), only to discover that this value always put the phone ringing
after about 1 minute, yes, 65.535 milliseconds.
Is there a way to build a timer that uses a longint value for the interval?
Or does anybody know of an example or a component I can use to reactivate a
program after a longer period of time?
Answer
A:
Interval is defined as a word, so 65,535 is the most you're going to get
into it. Don't know about other components, but to use the timer for over
one minute try this:
var
numOfMinutes: integer;
...
numOfMinutes := 30;
timer1.interval := 60000;
timer1.enabled := true;
...
procedure Timer1Timer;
begin
dec (numOfMinutes);
if numOfMinutes = 0 then begin
{ do whatever needs to be done }
end;
end;
A:
unit Alarm;
{
Copyright (c) 1996 Eric Nielsen. All Rights Reserved.
Permission to use, copy, modify, and distribute this software for
NON-COMMERCIAL or COMMERCIAL purposes and without fee is hereby granted.
}
interface
uses
SysUtils, WinTypes, WinProcs, StdCtrls, Controls, Classes, ExtCtrls, Forms;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure FormAlarm(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
TAlarm=class(TComponent)
private
FAlarmTime : TDateTime;
FOnAlarm: TNotifyEvent;
FTimer : TTimer;
FEnabled : Boolean;
procedure SetOnAlarm(Value: TNotifyEvent);
procedure SetEnabled(Value: Boolean);
procedure SetAlarm(Value: TDateTime);
procedure AlarmTimer(Sender: TObject);
protected
procedure Alarm; dynamic;
procedure UpdateAlarm;
public
property AlarmTime : TDateTime read FAlarmTime write SetAlarm;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnAlarm: TNotifyEvent read FOnAlarm write SetOnAlarm;
property Enabled: Boolean read FEnabled write SetEnabled default False;
end;
procedure TAlarm.SetOnAlarm(Value: TNotifyEvent);
begin
FOnAlarm := Value;
UpdateAlarm;
end;
procedure TAlarm.SetEnabled(Value : Boolean);
begin
FEnabled := Value;
UpdateAlarm;
end;
procedure TAlarm.SetAlarm(Value: TDateTime);
begin
FAlarmTime := Value;
UpdateAlarm;
end;
procedure TAlarm.Alarm;
begin
If Assigned(FOnAlarm) then FOnAlarm(Self);
end;
procedure TAlarm.UpdateAlarm;
begin
If Assigned(FOnAlarm) and FEnabled
Then
FTimer.Enabled := True
Else
FTimer.Enabled := False;
end;
constructor TAlarm.Create(AOwner: TComponent);
begin
FTimer := TTimer.Create(Self);
With FTimer do
Begin
Enabled := False;
Interval := 250;
OnTimer := AlarmTimer;
End;
end;
destructor TAlarm.Destroy;
begin
FEnabled := False;
UpdateAlarm;
FTimer.Free;
end;
procedure TAlarm.AlarmTimer(Sender: TObject);
begin
If Now >= FAlarmTime
Then
Alarm;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption := DateTimeToStr(Now);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label2.Caption := 'Waiting...';
With TAlarm.Create(Self) do
begin
AlarmTime := StrToDateTime(Edit1.Text);
OnAlarm := FormAlarm;
Enabled := True;
end;
end;
procedure TForm1.FormAlarm(Sender: TObject);
begin
(Sender as TAlarm).Free;
Label2.Caption := 'BEEP!';
end;
end.
Make TAB act like ENTER in StringGrid
Question
I've tried putting code in the
OnKeyPress event of the Grid, but it does not make the focuseed cell
moved to the next cell as the TAB key does.
Answer
A:
This code moves it to next column. On reaching end of column, it moves
to a new row. On reaching very end of grid, it goes back to the very top -
of course, you can modify it to go to the next control.
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
with StringGrid1 do
if Col < ColCount-1 then {next column!}
Col := Col + 1
else if Row < RowCount-1 then begin {next Row!}
Row := Row + 1;
Col := 1;
end else begin {End of Grid! - Go to Top again!}
Row := 1;
Col := 1;
{or you can make it move to another Control}
end;
end;
Cycle through list of components
Question
procedure TForm1.OnCreate(whatever)
var i : Integer
begin
for i := 1 to 5 do
Edit[i].X := 10; {received compiler error here, didn't recognize the Edit
control}
end;
What wrong here??
Answer
A:
procedure TForm1.FormCreate(Sender: TObject);
var
I : integer;
begin
for I:= 0 to ComponentCount -1 do
if (Components[I] IS TEdit) then
(Components[I] AS TEdit).{Yourparameter} := {your value};
end;
If you need to identify a particular set of edit components, you can put
them on a panel & use something like
procedure TForm1.FormCreate(Sender: TObject);
var
I : integer;
begin
with MyPanel do
for I:= 0 to ControlCount -1 do
if (Controls[I] IS TEdit) then
(Controls[I] AS TEdit).{Yourparameter} := {Your value};
end;
A:
The major one is that Edit1, Edit2 ect is not the same as
Edit[1], Edit[2]. If you want to access a series of controls as an array,
you have to put them into a TList.
MyArr := TList.Create;
MyArr.Add(Edit1);
MyArr.Add(Edit2);
...
For i := 0 To MyArr.count - 1 Do
(MyArr.items[i] As TEdit).Enabled := False;
MyArr.Free;
A:
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
for I := 0 to ComponentCount -1 do
if Components[I] is TEdit then
TEdit(Components[I]).Whatever := 10;
end;
A:
To access them just use:
TButton(mylist.items[i]).property := sumpin;
or
TButton(mylist.items[i]).method;
This is great for doing batch operations on the components or accessing them
in a linear fashion. For doing what you want there is a much easier way of
handling the problem and one that can be done at design time. Set the tag
property and take advantage of the fact that all components are derived from
TComponent.
Procedure TMyForm.MyButtonHandler(Sender: TObject);
Begin
Case (Sender As TComponent).Tag Of
1 : { do something }
2 : { do something else }
.
.
End;
End;
Just point the OnClick event to MyButtonHandler for all the buttons you want
to use this common handler.
Popup menu in dependence on mouse position
Question
I need to pop up a popup menu when a user stops highlighting text in a
TMemo.. Problem is i can not figure out who to get the mouse coordinates
with which to call PopUp (i want the menu to pop up at the place the mouse
is release).
Answer
A:
procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var ClientPoint,ScreenPoint: TPoint;
begin
if Memo1.SelLength>0 then
begin
ClientPoint.X := X;
ClientPoint.Y := Y;
ScreenPoint := ClientToScreen (ClientPoint);
PopupMenu1.Popup (ScreenPoint.X, ScreenPoint.Y);
end;
end;
TabbedNotebook and common components on all pages
Question
I want to know how to define some component common to all the
pages on a tabbedNotebook without having to define them on every page
(like the OK and the Cancel Button from the TabbedNotebook template).
I would like to have some labels and entry fields to be available on
all pages.
Answer
A:
The components that you want to appear on all pages have to be owned by
the parent of the TTabbedNotebook (often the TForm on which it appears),
and, apparently, also need to be created AFTER the TTabbedNotebook. The
simplest way I've found to get this to happen is to place the
TTabbedNotebook, but be sure that you can still get at the parent (i.e.
don't set the .Align property yet), then place the buttons (or whatever)
on the parent area, then set the .Align property for the
TTabbedNotebook, the controls you placed after the TTabbedNotebook,
should then appear on all pages (actually, they exist "on top" of the
TTabbedNotebook as a whole. If you have already placed components,
I've found that using the "Edit/Send to Back" command with the
TTabbedNotebook selected, will bring the desired components on top. You
can also edit the .DFM file directly to make sure the creation order is
what you want.
Insert text in MEMO
Question
Can it be true, that you can't insert a text in a TMemo at the cursor
position?
I wanted to use some buttons to insert standard phrases in a Memo field.
I solved the problem by using TEdit instead of TButton. Then I select the
text, copy it to the clipboard, and paste from the clipboard to the
Memo.
That's OK, but I don't like to use the clipboard in the program. The user
might have stored something there too.
Answer
A:
Use the Windows API message-EM_REPLACESEL: (from Windows API Help)
EM_REPLACESEL
wParam = 0; /* not used, must be zero */
lParam = (LPARAM) (LPCSTR) lpszReplace; /* address of new string */
An application sends an EM_REPLACESEL message to replace the current
selection in an edit
control with the text specified by the lpszReplace parameter.
Parameter Description
lpszReplace Value of lParam. Points to a null-terminated string containing the
replacement text. { Pointer to the string }
Returns
This message does not return a value.
Comments
Use the EM_REPLACESEL message when you want to replace only a portion of the
text in an edit control.
If you want to replace all of the text, use the WM_SETTEXT message.
If there is no current selection, the replacement text is inserted at the
current cursor location.
A:
Make a list with your standard phrases and use the "OnClick" or
the "OnMouseDown" Event in combination with "Alt", "Shift" or
"Ctrl". Example: When the user press the "Alt" key in combination
with the Right button of your mouse, pop-up the phrases list and
insert the selected phrase in your TMemo component.
A:
to insert a string into a memo :
procedure TForm1.Button1Click(Sender: TObject);
begin
with Memo1 do begin
SelStart:=10;
SelLength:=0;
SelText:='This is a string inserted into a memo, at 10th char position ';
end;
end;
to insert a string AND replace some existing text :
procedure TForm1.Button1Click(Sender: TObject);
begin
with Memo1 do begin
SelStart:=10;
SelLength:=20;
SelText:='This is a string inserted, at 10th char position replacing 20 chars ';
end;
end;
A:
Put the text you want to insert into a PChar variable, then insert
the text into the memo, using the SetSelTextBuf command, where
SelStart is set to the postion of the cursor in the TMemo.
It works great ..
Another thing, you can get around the 32K limit on the TMemo
component, if you by-pass the Lines.LoadfromFile method/command. Its
has an inbuilt limit of 32K. If you load the file you want into a
pointer, and using the SetTexBuf command/method, you can load up to
64K of text into a TMemo.
Sync'ing Tabset with Listbox
Question
I have a form with a tabset and a listbox. The tabset has the strings
'A' - 'Z'. The listbox has a list of name strings Ex. Holmes, Shane A
Doe, John D.
Doe, Jane J.
How does one syncronizr the tabset with the listbox.
For example:
If the letter 'D' was chosen from the tabset, the listbox would
highlight the first item in the listbox beginning with the letter 'D'.
Answer
I've done something similar in the past, however, instead of using a Listbox,
I used a dbGrid with the following options:
[dgAlwaysShowEditor,dgTabs,dgRowSelect,dgAlwaysShowSelection,dgConfirmDelete,
dgCancelOnExit]
In addition, this is what I used when the tab was clicked upon.Thus changing
to the record in the dbgrid.
procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
Table1.FindNearest([Chr(NewTab+65)]);
Table2.FindNearest([Chr(NewTab+65)]);
end;
A:
procedure TForm1.TabSet1Click(Sender: TObject);
var
I: integer;
begin
with TabSet1 do
begin
if TabIndex > -1 then
begin
with ListBox1 do
begin
for I := 0 to Items.Count - 1 do
begin
if Pos(Tabs[TabIndex], Items[I]) = 1 then
begin
ItemIndex := I;
break;
end;
end;
end;
end;
end;
end;
TDBGrid - Vertical Scrollbar
Question
I use the TDBGrid frequently for display of tables. The only real
inconveniance is that slider of the vertical scrollbar in Delphi 1 and
2 only has three positions (top, middle, bottom).
Answer
There are several good reasons for this behavior. First, the program needs
to be consistant. Second, Delphi deals with a number of different DBs,
engines, and sizes of databases. If it were to present a slider which
represented position in the database in a more realistic manner, it would
have to know how many records were in the database. However, because the
access methods differ so much, that information is in some cases difficult
or very slow to retrieve. Thus, I was told, Borland decided not to have that
be the behavior.
If you have source, you may be able to inherit and modify...
Variable control-names
Question
I have a form with (let's say..) 100 labels. Then there is a function
generating a integer value between 1 and 100; The value identicates the
number of the label which caption I want to change. How can I manage this
without writing very long code.
Answer
Here is a sample code I just made to test dynamic component creation;
I hope this helps you...:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, Buttons;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
arr : array [1..30] of TBitBtn;
procedure BitButtonClick(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.BitButtonClick(Sender: TObject);
begin
if TBitBtn(Sender).Font.Style = [] then
begin
TBitBtn(Sender).Font.Style := [fsBold];
TBitBtn(Sender).Font.Color := clRed;
end
else
begin
TBitBtn(Sender).Font.Style := [];
TBitBtn(Sender).Font.Color := clBlack;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
x, y,
f : integer;
begin
x := 20;
y := 20;
for f := 1 to 30 do
begin
arr [f] := TBitBtn.Create (Form1);
if arr [f] <> nil then
begin
arr [f].Parent := Form1;
arr [f].left := x;
arr [f].top := y;
arr [f].width := 35;
arr [f].Height := 25;
arr [f].caption := IntToStr (f);
arr [f].tag := f;
arr [f].OnClick := BitButtonClick;
inc (x, arr [f].width + 20);
if (x + arr [f].width) > form1.width then
begin
x := 20;
inc (y, arr [f].height + 20);
end;
end;
end;
end;
end.
A:
There are two ways I can think of:
(1) Using FindComponent. Will have to use the components name:
var
lab: TLabel;
begin
lab := TLabel(FindComponent('Label1'));
lab.Caption := 'Hey!'
end;
(2) Using the Tag property. Set each label's Tag property (ie: 1 to 100)
and then
you will be able to do something like:
procedure TForm1.Button2Click(Sender: TObject);
var
i: smallint;
begin
for i := 0 to ComponentCount-1 do
if (Components[i] is TLabel) AND (Components[i].Tag = 3) then
begin
TLabel(Components[i]).Caption := 'This is the one!';
break;
end;
end;
A:
How about iterating through all your components (Check your form's
Components property).
Use something like this:
var
I: Integer;
begin
for I := 0 to ComponentCount -1 do
if Components[I] is TLabel then
TLabel(Components[I]).Caption := 'This is the one!';
end;
A:
Put the labels into a TList. You can then use :
TLabel(mylist.items[MyValue]).Caption := 'This is the one!';
A:
function LabelCaption(MyValue: Integer; Text: string) : Boolean;
function LabelCaption(MyValue: Integer; Text: string) : Boolean;
var
LabelCount,
Loop: Integer;
begin
Result := False;
LabelCount := 0;
for Loop := 0 to ComponentCount - 1 do
begin
if Components[Loop] is TLabel then { is it a label ? }
begin
INC(LabelCount);
if LabelCount = MyValue then { does it match my index value ? }
begin
Component[Loop].Caption := Text;
Result := True;
end;
end;
end;
end;
Call it as follows:-
if LabelCaption(10, 'This is the one!') then
WriteLn('Found it!');
The other approach which is more in line with what you want would be to
use a
StringList of some sort in which case you could do an IndexOf on the list
to find
your label. You could use the above Loop to add the label names to the
StringList.
This would allow you to do a lookup as follows:-
MyLabels[MyLabels.IndexOf(Label10)].Caption := 'This is the one!';
Alignment in Listbox
Question
I'm developing a KWIC index and need to display the results in a listbox.
They have to line up around the central keyword, eg.
If I'm using a fixed font, this is easy, just blank pad on the left. But if
I'm using a proportional font, it's much harder. I could blank pad on the
left and used textWidth to check whether I'm near the middle, but because
character widths vary my keyword alignment is going to be off by a few pixels.
Answer
You could take the TextWidth of the string before the keyword and
adjust the position based on that.
i.e.
var
J, TempInt, LongPrefixLen, CurrPrefixLen: Integer;
begin
{Calculate the TextWidth of the widest pre-keyword string}
{Set CurrPrefixLen to the TextWidth of the pre-keyword of the
Indexth string}
LongPrefixLen := 0;
for J := 0 to ListBox1.Items.Count-1 do
with ListBox1.Canvas do
begin
TempInt:= TextWidth(Copy(Items[J],1,Pos(KeyString,Items[J]-1)));
if LongPrefixLen < TempInt then
LongPrefixLen:= TempInt;
if J = Index then
CurrPrefixLen:= TempInt;
end;
{PrevTextLeft - TextLeft = Where we want to write new item}
TextOut(LongPrefixLen-CurrPrefixLen,Y,Items[I]);
end;
Cells' Position on DBGrid
Question
Is there any way to get the position of the selected cell (wich has the
focus) of a TDBGrid Component, in D1. For example: left, top, rigth,
etc.
Answer
TCustomGrid defines the method CellRect, which is protected,
unfortunately. This means that it can only be called by TCustomGrid
itself or a descendant of TCustomGrid. There is way, though, to call
the method, though it's a bit tricky:
type
TMyDBGrid = class(TDBGrid)
public
function CellRect(ACol, ARow: Longint): TRect;
end;
function TMyDBGrid.CellRect(ACol, ARow: Longint): TRect;
begin
Result := inherited CellRect(ACol, ARow);
end;
Then you can do the conversion by typecasting your DBGrid to
TMyDBGrid (This is possible, because the new CellRect is a static
method) and call CellRect:
Rectangle := TMyDBGrid(SomeDBGrid).CellRect(SomeColumn, SomeRow);
A:
procedure TfmLoadIn.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
const
Disp = 2; //Displacement to cause component to line up properly
begin
inherited;
if (gdFocused in State) then begin
if (Column.FieldName = 'TYPEDescription') then begin
dlTYPEDescription.Left := Rect.Left + DBGrid1.Left + Disp;
dlTYPEDescription.Top := Rect.Top + DBGrid1.top + Disp;
dlTYPEDescription.Width := Rect.Right - Rect.Left;
dlTYPEDescription.Height := Rect.Bottom - Rect.Top;
dlTYPEDescription.Visible := True;
end;
end;
end;
Listbox - OnChange
Question
I recently noticed the most annoying thing about TListBox -- no OnChange
event. I'v simulated the onchange event using the TTimer component, is
there an easier way?
Answer
I ran into that a few months back. I found one on the Supersite that
addressed this problem. There's not much to it.
UNIT Lbox;
INTERFACE
USES
SysUtils, WinTypes, Messages, Classes, Controls, Graphics, Forms,
Menus, StdCtrls;
Type
TCngListBox = Class(TListBox)
private
FOnChange : TNotifyEvent;
FLastSel : integer;
procedure Click; override;
protected
procedure Change; Virtual;
published
property OnChange : TNotifyEvent read FOnChange write FOnChange;
public
constructor create(AOwner : TComponent); override;
End;
Procedure Register;
IMPLEMENTATION
procedure TCngListBox.Change;
begin
FLastSel := ItemIndex;
if assigned(FOnChange) then FOnChange(self);
end;
procedure TCngListBox.Click;
begin
inherited Click;
if FLastSel <> ItemIndex then
Change;
end;
constructor TCngListBox.Create;
begin
Inherited Create(AOwner);
FLastSel := -1;
end;
procedure Register;
begin
RegisterComponents('FreeWare',[TCngListBox]);
end;
END.
Different colors in DBGrid
Question
Can anyone tell me how to put different colors, in D1: DBGrid's row or cell,
when each time a customer buys a product a for example?
Answer
A:
Set defaultDrawing to false, then write your own onDrawDataCell to set the
color. Something like this:
procedure Tform1.DBgrid1DrawDataCell
(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
begin
{ decide color of text (font.color) and background (brush.color) }
if (field = table1Status) then begin { white on red }
DBgrid1.canvas.font.color := clWhite;
DBgrid1.canvas.brush.color := clRed;
end
else begin { black on white }
DBgrid1.canvas.brush.color := clWhite;
DBgrid1.canvas.font.color := clBlack;
end;
{ draw the cell }
DBgrid1.canvas.textrect
(rect,rect.left+2,rect.top+2,field.asString);
end;
A:
procedure TMainForm.CharGridDrawCell(Sender: TObject;
Col, Row: Longint; Rect: TRect; State: TGridDrawState);
var
TheText: string;
begin
TheText := CharGrid.Cells[Col, Row];
with CharGrid.Canvas do
begin
{ Deal with background colour: }
if gdFocused in State then
Brush.Color := clYellow {Focused background colour}
else if gdSelected in State then
Brush.Color := clOlive {Selected background colour}
else {cell is not focused or selected}
if IntFromStr(TheText) <> 0 then
Brush.Color := clNavy {Highlighted background colour}
else
Brush.Color := clWhite; {Normal background colour}
{ Deal with foreground colour: }
if IntFromStr(TheText) <> 0 then
Font.Color := clRed {Highlighted foreground colour}
else
Font.Color := clNavy; {Normal foreground colour}
TextRect(Rect, Rect.Left + 2, Rect.Top + 2, TheText);
end; {with CharGrid.Canvas}
end;
Cursor Pos in TRichEdit
Question
How can I determine the **current** Row and Col of a cursor in a TRichEdit?
Answer
Procedure TForm1.GetPosition(Sender: TRichEdit);
var
iX,iY : Integer;
TheRichEdit : TRichEdit;
begin
iX := 0; iY := 0;
TheRichEdit := TRichEdit(Sender);
iY := SendMessage(TheRichEdit.Handle, EM_LINEFROMCHAR, TheRichEdit.SelStart,
0);
iX := TheRichEdit.SelStart - SendMessage(TheRichEdit.Handle, EM_LINEINDEX,
iY, 0);
Panel1.Caption := IntToStr(iY + 1) + ':' + IntToStr(iX + 1) ;
end;
procedure TForm1.RichEditMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
GetPosition(RichEdit);
end;
procedure TForm1.RichEditKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
GetPosition(RichEdit);
end;
OnDraw Event for TStringGrid
Question
I want to be able to truncate strings in TStringGrid whenever it is longer
than the cell length. (for example: 'this string is way way too long for my
cell' --> 'this strin...' However, I am not very experienced in drawing the
grid lines, etc... Does someone have some code for drawing the grid lines?
I would then fill in the necessary code for drawing the text. Anyways, if no
code, I'd appreciate some help?
Answer
A:
This is code that I use to print a TMemoField into a TDBGrid. Override
the DrawCell method.
Canvas.FillRect(ARect);
R := ARect;
WITH TMemoField(Field) DO
DrawText(Canvas.Handle, PChar(Value), Length(Value), R,
DT_WORDBREAK OR DT_NOPREFIX);
A:
I think this code which I wrote with Delphi 1.0 may help you
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
var bufB : array[0..79] of Char; algn : Word;
begin
algn := 0;
if (Col = NumbColK) or (Col = PrceColK) or
(Col = TtlColK) then algn := dt_Right;
if Row = 0 then algn := dt_Center;
if algn = 0 then Exit;
StringGrid1.Canvas.FillRect(Rect);
StrPCopy(bufB, StringGrid1.CellS[Col, Row]);
Rect.Top := Rect.Top+2; Rect.Right := Rect.Right-2;
DrawText(StringGrid1.Canvas.Handle, bufB, -1, Rect, algn);
end;
1) The first part is to set alignment if you want,
and clear old text.
2) The number -1 means bufB must be null terminate string
you can put any number such as 10 so it will limit your string to 10,
which is you want.
A:
Actually, depending on your application, you don't need to go that far. If
you're filling the grid from another source, then just do this:
grid.cells[col,row] :=
trimWithDots (myString, form1.canvas, grid.widths[col]-2);
where trimWithDots is a function you write that trims myString based on the
width of the grid (in pixels) using the canvas's textWidth function,
something like this:
function trimWithDots (const myString: string; canvas: tCanvas; wid: integer):
string;
begin
result := myString;
while canvas.textWidth (result) > wid do
delete (result, length(result), 1);
end;
Of course, you can make it more sophisticated by trimming a bit more and
adding '...'. For some funny reason, grid.canvas seems to give me improper
results, I've always used form1.canvas with good results.
If you aren't loading your grid from another source, you can do the same
thing but put it in your onDrawDataCell event. This way the grid draws all
the lines for you, you only have to worry about drawing the contents.
Accessing memo field data
Question
My app has entry into a memo field (D1) and at times (like hitting arrow
keys, backspace, etc.) I need to go back and find the closest whitespace to
where the caret was.
I know that SelStart returns an integer of the position in the memo, but when
I try Text[SelStart] I get bogus answers if SelStart > 255.
Answer
Either use GetTextBuf method to retreive the entier buffer, or use the
follwing piece of code (modified to fit your needs ofcource).
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
LineNo : integer;
ColNo : integer;
begin
LineNo:=SendMessage(Memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0);
ColNo:=Memo1.SelStart;
if LineNo>0 then begin
While SendMessage(Memo1.Handle,EM_LINEFROMCHAR,ColNo,0)=LineNo do
ColNo:=ColNo-1;
ColNo:=Memo1.SelStart-ColNo-1;
end else
ColNo:=Memo1.SelStart;
Panel1.Caption:='Row '+IntToStr(LineNo)+' ; Col '+IntToStr(ColNo);
{Here you can get the text via Memo1.Lines[LineNo].Text[ColNo] ...}
end;
Warning! This code was developed under WinNT/D2 using a richedit
control. I have tested doing the same with a Memo Control in D1, but
that piece of code is at home. The code above is translated from memory
and not tested, but I think it should work. If you ever move to D2,
change the sendmessage calls to:
SendMessage(Memo1.Handle,EM_EXLINEFROMCHAR,0,ColNo)
^^ ^^^^^^^
Added Order Changed.
TextOut to a control's parent
Question
I have written and used a TEdit control that has its own caption. I did
this by creating a TLabel. The control works fine, but I would like to
eliminate the TLabel overhead and write the text directly to the TEdit's
parent (TForm, TScrollBox, TPanel, etc). I have tried:
With TCustomControl(parent).canvas.textout(x,y,'xxxxx');
but this gives the compile error that canvas is undeclared. In the
documentation, canvas is a property of TCustomControl. Typecasting to
TWinControl gives the same error.
Answer
The Canvas property exists in TCustomControl but is protected.
Since the canvas property encapsulates the windows HDC (Canvas.Handle) you
can create a TCanvas object and assign the device context of the control
you want to draw on to the Handle property.
For example:
procedure AControl.DrawLabel(ACaption: TCaption);
var
ACanvas: TCanvas;
DC: HDC;
begin
ACanvas:= TCanvas.Create;
try
WindowHandle:= parent.Handle;
DC := GetDeviceContext(WindowHandle);
ACanvas.Handle:= DC;
with ACanvas do
begin
end;
ACanvas.Handle:= 0;
ReleaseDC(WindowHandle, DC);
finally
ACanvas.free;
end;
end;
StatusBar - How to display Clock/Date/Keyboard Status
Question
I can't figure out how to display the system clock/date/keyboard stastus on
the Status Bar?
Answer
A:
Assuming you have you have a status bar with 4 panels defined, plus a timer
you can do this:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
with StatusBar1 do
begin
if GetKeyState(VK_CAPITAL) <> 0 then
panels[0].text := ' CAP'
else
panels[0].text := '';
if GetKeyState(VK_NUMLOCK) <> 0 then
panels[1].text := ' NUM'
else
panels[1].text := '';
if GetKeyState(VK_SCROLL) <> 0 then
panels[2].text := ' SCRL'
else
panels[2].text := '';
panels[3].text := ' ' +DateTimeToStr(now);
end;
end;
To format the date in different ways see the on line help under Date
routines. Note that the Text property is a string type thus you can't do
panels[0].text := DateTime(now); which is a double type.
A:
unit Status;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, Menus, Gauges;
type
TStatus = class(TCustomPanel)
private
FDate : Boolean;
FKeys : Boolean;
FTime : Boolean;
FResources : Boolean;
DateTimePanel : TPanel;
ResPanel : TPanel;
ResGauge : TGauge;
CapPanel : TPanel;
NumPanel : TPanel;
InsPanel : TPanel;
HelpPanel : TPanel;
UpdateWidth : Boolean;
FTimer : TTimer;
procedure SetDate(A: Boolean);
procedure SetKeys(A: Boolean);
procedure SetTime(A: Boolean);
procedure SetResources(A: Boolean);
procedure SetCaption(A: String);
Function GetCaption: String;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetupPanelFields(ThePanel: TPanel);
procedure SetupPanel(ThePanel: TPanel; WidthMask: String);
procedure UpdateStatusBar(Sender: TObject);
published
property ShowDate: Boolean read FDate write SetDate default True;
property ShowKeys: Boolean read FKeys write SetKeys default True;
property ShowTime: Boolean read FTime write SetTime default True;
property ShowResources: Boolean read FResources write SetResources
default True;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderStyle;
property BorderWidth;
property Caption: string read GetCaption write SetCaption;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ParentColor;
property ParentCtl3d;
property ParentFont;
property ParentShowHint;
property PopUpMenu;
property ShowHint;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TStatus]);
end;
procedure TStatus.SetupPanelFields(ThePanel: TPanel);
begin
with ThePanel do
begin
Alignment := taCenter;
Caption := '';
BevelInner := bvLowered;
BevelOuter := bvNone;
{Set all these true so they reflect the settings of the TStatus}
ParentColor := True;
ParentFont := True;
ParentCtl3D := True;
end;
end;
procedure TStatus.SetupPanel(ThePanel: TPanel; WidthMask: String);
begin
SetupPanelFields(ThePanel);
with ThePanel do
begin
Width := Canvas.TextWidth(WidthMask);
Align := alRight;
end;
end;
constructor TStatus.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := TWinControl(AOwner);
FTime := True;
FDate := True;
FKeys := True;
FResources := True;
{Force the status bar to be aligned bottom}
Align := alBottom;
Height := 19;
BevelInner := bvNone;
BevelOuter := bvRaised;
{When UpdateWidth is set TRUE, status bar will recalculate panel widths once}
UpdateWidth := True;
Locked := True;
TabOrder := 0;;
TabStop := False;
Font.Name := 'Arial';
Font.Size := 8;
{Create the panel that will hold the date & time}
DateTimePanel := TPanel.Create(Self);
DateTimePanel.Parent := Self;
SetupPanel(DateTimePanel,' 00/00/00 00:00:00 am ');
{Create the panel that will hold the resources graph}
ResPanel := TPanel.Create(Self);
ResPanel.Parent := Self;
SetupPanel(ResPanel,' ');
{Create the 2 Gauges that will reside within the Resource Panel}
ResGauge := TGauge.Create(Self);
ResGauge.Parent := ResPanel;
ResGauge.Align := alClient;
ResGauge.ParentFont := True;
ResGauge.BackColor := Color;
ResGauge.ForeColor := clLime;
ResGauge.BorderStyle := bsNone;
{Create the panel that will hold the CapsLock state}
CapPanel := TPanel.Create(Self);
CapPanel.Parent := Self;
SetupPanel(CapPanel,' Cap ');
{Create the panel that will hold the NumLock state}
NumPanel := TPanel.Create(Self);
NumPanel.Parent := Self;
SetupPanel(NumPanel,' Num ');
{Create the panel that will hold the Insert/Overwrite state}
InsPanel := TPanel.Create(Self);
InsPanel.Parent := Self;
SetupPanel(InsPanel,' Ins ');
{Create the panel that will hold the status text}
HelpPanel := TPanel.Create(Self);
HelpPanel.Parent := Self;
SetupPanelFields(HelpPanel);
{Have the help panel consume all remaining space}
HelpPanel.Align := alClient;
HelpPanel.Alignment := taLeftJustify;
{This is the timer that will update the status bar at regular intervals}
FTimer := TTimer.Create(Self);
If FTimer <> Nil then
begin
FTimer.OnTimer := UpdateStatusBar;
{Updates will occur twice a second}
FTimer.Interval := 500;
FTimer.Enabled := True;
end;
end;
destructor TStatus.Destroy;
begin
FTimer.Free;
HelpPanel.Free;
InsPanel.Free;
NumPanel.Free;
CapPanel.Free;
ResGauge.Free;
ResPanel.Free;
DateTimePanel.Free;
inherited Destroy;
end;
procedure TStatus.SetDate(A: Boolean);
begin
FDate := A;
UpdateWidth := True;
end;
procedure TStatus.SetKeys(A: Boolean);
begin
FKeys := A;
UpdateWidth := True;
end;
procedure TStatus.SetTime(A: Boolean);
begin
FTime := A;
UpdateWidth := True;
end;
procedure TStatus.SetResources(A: Boolean);
begin
FResources := A;
UpdateWidth := True;
end;
{When we set or get the TStatus caption, it is affecting the HelpPanel
caption instead}
procedure TStatus.SetCaption(A: String);
begin
HelpPanel.Caption := ' '+A;
end;
function TStatus.GetCaption: String;
begin
GetCaption := HelpPanel.Caption;
end;
{This procedure sets the captions appropriately}
procedure TStatus.UpdateStatusBar(Sender: TObject);
begin
if ShowDate and ShowTime then
DateTimePanel.Caption := DateTimeToStr(Now)
else
if ShowDate and not ShowTime then
DateTimePanel.Caption := DateToStr(Date)
else
if not ShowDate and ShowTime then
DateTimePanel.Caption := TimeToStr(Time)
else
DateTimePanel.Caption := '';
if UpdateWidth then with DateTimePanel do
if ShowDate or ShowTime then
Width := Canvas.TextWidth(' '+Caption+' ')
else
Width := 0;
if ShowResources then
begin
ResGauge.Progress := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);
if ResGauge.Progress < 20 then
ResGauge.ForeColor := clRed
else
ResGauge.ForeColor := clLime;
end;
if UpdateWidth then
if ShowResources then
ResPanel.Width := Canvas.TextWidth(' ')
else
ResPanel.Width := 0;
if ShowKeys then
begin
if (GetKeyState(vk_NumLock) and $01) <> 0 then
NumPanel.Caption := ' Num ' else NumPanel.Caption := '';
if (GetKeyState(vk_Capital) and $01) <> 0 then
CapPanel.Caption := ' Cap ' else CapPanel.Caption := '';
if (GetKeyState(vk_Insert) and $01) <> 0 then
InsPanel.Caption := ' Ins ' else InsPanel.Caption := '';
end;
if UpdateWidth then
if ShowKeys then
begin
NumPanel.Width := Canvas.TextWidth(' Num ');
InsPanel.Width := Canvas.TextWidth(' Ins ');
CapPanel.Width := Canvas.TextWidth(' Cap ');
end
else
begin
NumPanel.Width := 0;
InsPanel.Width := 0;
CapPanel.Width := 0;
end;
UpdateWidth := False;
end;
{This allows font changes to be detected so the panels will be adjusted}
procedure TStatus.CMFontChanged(var Message: TMessage);
begin
inherited;
UpdateWidth := True;
end;
end.
interface
implementation
end.
Icons in a Popup menus
Question
I would like to know how to implement icons on a popup menu in Delphi 2
similar to what windows 95 does from the start menu. Any one know how
to do this?
Answer
A:
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem; /**** Item in the Menu Bar ****/
Open1: TMenuItem; /**** Item int Menu File ****/
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{private declarations}
public
{public declarations}
Icn, Txt, MnuItm: TBitmap;
end;
procedure TForm2.FormCreate(Sender: TObject);
var R: TRect;
HIcn: HIcon;
Ic: TIcon;
Index: Word;
FileName: PChar;
begin
/** Get the icon from some application **/
Ic:=TIcon.Create;
Ic.Handle:=ExtractAssociatedIcon(Hinstance, /* some path and filename
*/, Index);
/** Create the bitmap for the text **/
Txt:=TBitmap.Create;
with Txt do
begin
Width:=Canvas.TextWidth(' Test');
Height:=Canvas.TextHeight(' Tes');
Canvas.TextOut(0,0,' Test');
end;
/** Copy the Icon to a bitmap to resize it. You can't resize a Icon **/
Icn:=TBitmap.Create;
with Icn do
begin
Width:=32;
Height:=32;
Brush.Color:=clBtnFace;
Canvas.Draw(0,0,Ic);
end;
/** Create the final bitmap where you put the icon and the tex **/
MnuItm:=TBitmap.Create;
with MnuItm do
begin
Width:=Txt.Width+18;
Height:=18;
with Canvas do
begin
Brush.Color:=clBtnFace;
Pen.Color:=clBtnFace;
Brush.Style:=bsSolid;
Rectangle(0,0,Width,Height);
CopyMode:=cmSrcAnd;
StretchDraw(Rect(0,0,16,16),Icn);
CopyMode:=cmSrcAnd;
Draw(16,8-(Txt.Height div 2),Txt);
end;
end;
end;
procedure TForm2.FormShow(Sender: TObject);
var
ItemInfo: TMenuItemInfo;
hBmp1 : THandle;
begin
HBmp1:=MnuItm.Handle;
with ItemInfo do
begin
cbSize := SizeOf( ItemInfo );
fMask := MIIM_TYPE;
fType := MFT_BITMAP;
dwTypeData := PChar(MakeLong( hBmp1, 0 ));
end;
/** Replace the MenuItem Open1 with a final bitmap **/
SetMenuItemInfo( GetSubMenu( MainMenu1.Handle, File1.MenuIndex ),
Open1.MenuIndex, true, ItemInfo );
end;
There is some problems on stretching the Icon and in the colors of the icon
in the Menu.
I'm also trying a better way but in this moment is this what I can get.
A:
The listing has been
modified to put the icons into the checked state of the menu (just like 95
does). This also allows you to have a checked and unchecked state.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus,ShellAPI;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Icn, MnuItm : TBitmap;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var R: TRect;
HIcn: HIcon;
Ic: TIcon;
Index: Word;
begin
{ /** Get the icon from some application **/}
Index := 0; { 11th icon in file }
Ic:=TIcon.Create;
Ic.Handle:=ExtractAssociatedIcon(Hinstance,
'c:\win95\system\shell32.dll', Index);
{ /** Copy the Icon to a bitmap to resize it. You can't resize a Icon
**/}
Icn:=TBitmap.Create;
with Icn do
begin
Width:=32;
Height:=32;
Canvas.Brush.Color := clbtnface;
Canvas.Draw(0,0,Ic);
end;
{ /** Create the final bitmap where you put the icon and the tex **/}
MnuItm:=TBitmap.Create;
with MnuItm do
begin
Width :=18;
Height:=18;
with Canvas do
begin
Brush.Color:=clbtnface;
Pen.Color:=clbtnface;
CopyMode:=cmSrcAnd;
StretchDraw(Rect(0,0,16,16),Icn);
end;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
ItemInfo: TMenuItemInfo;
hBmp1 : THandle;
begin
HBmp1:=MnuItm.Handle;
with ItemInfo do
begin
cbSize := SizeOf( ItemInfo );
fMask := MIIM_CHECKMARKS;
fType := MFT_BITMAP;
hBmpunChecked := HBmp1; { Unchecked State }
hBmpChecked := HBmp1; { Checked State }
end;
{ /** Replace the MenuItem Open1 with a final bitmap **/}
SetMenuItemInfo( GetSubMenu( MainMenu1.Handle, File1.MenuIndex ),
Open1.MenuIndex, true, ItemInfo );
end;
end.
Incrementing String Field
Question
I have a TStringfield that contains a letter that indicates a revision such
as 'A', 'B' ect. When adding a new revision I would like to automatically
increment this field to the next charcater. This seems like it should be easy
but since the field is of type 'string' and not 'char' I can't get it to work.
I tried the following:
RevField.Text := chr(ord((RevTxt) + 1))
This fails because RevTxt is 'not of ordinal type' which I assume means it
must be type char.
I tried typecasting:
RevField.Text := chr(ord(Char(RevTxt) + 1)))
and got an illegal typecast. Is their an easy way that I'm missing?
Answer
A:
The text property of controls is a string which is a special array of
char. You cannot typecast a char into a string. You can, however, access
each character in the string through its index.
Try this.
var
s : string;
begin
s := RevField.text;
s[1] := chr(ord(s[1]) + 1);
RevField.text := s;
end;
A:
The 2 problems are:
1. You need to extract the char from the string to be able to
increment it.
2. Whilst you can access the individual characters of a string
by subscripting, this is not allowed with properties such as
TStringField's Text property.
It would probably be best to write a small function. For
example, if the revision letter is always the final character
in the string you could write:
function IncrementTrailingVersionLetter(Str: string): string;
begin
Str[Length(Str)] := Char(Ord(Str[Length(Str)]) + 1);
IncrementTrailingVersionLetter := Str;
end;
and then use it as follows:
with RevField do
Text := IncrementTrailingVersionLetter(Text);
Removing the vertical scrollbar from a TDBGrid
Question
How to remove the vertical scrollbar from a TDBGrid?
Answer
{
In order to remove the vertical scrollbar from a TDBGrid component,
you must override its Paint method. Inside the Paint method you
must call the SetScrollRange API procedure to set the min and max
scroll values to zero (this disables the scrollbar), and then call
the inherited Paint. The code below is a unit containing a new
component called TNoVertScrollDBGrid that does this. You can copy
the code into a file called NEWGRID.PAS, and add it to the component
library as a custom component.
}
unit Newgrid;
interface
uses
WinTypes, WinProcs, Classes, DBGrids;
type
TNoVertScrollDBGrid = class(TDBGrid)
protected
procedure Paint; override;
end;
procedure Register;
implementation
procedure TNoVertScrollDBGrid.Paint;
begin
SetScrollRange(Self.Handle, SB_VERT, 0, 0, False);
inherited Paint;
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TNoVertScrollDBGrid]);
end;
end.
Disabling DBNavigator buttons
Question
How to disable DBNavigator buttons?
Answer
{ DBNavigator enhancement: allows developer to enable and disable
individual buttons via EnableButton and DisableButton methods }
unit GNav;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DBCtrls;
type
TMyNavigator = class(TDBNavigator)
public
procedure EnableButton(Btn : TNavigateBtn) ;
procedure DisableButton(Btn : TNavigateBtn) ;
end;
procedure Register;
implementation
procedure TMyNavigator.EnableButton(Btn : TNavigateBtn) ;
begin
Buttons[Btn].Enabled := True ;
end ;
procedure TMyNavigator.DisableButton(Btn : TNavigateBtn) ;
begin
Buttons[Btn].Enabled := False ;
end ;
procedure Register;
begin
RegisterComponents('Samples', [TMyNavigator]);
end;
end.
DBGrid that shows images
Question
Answer
{
// DBPICGRD.PAS (C) 1995 W. Raike
// ALL RIGHTS RESERVED.
//
// DESCRIPTION:
// Data-aware grid that can display graphic fields.
// REVISION HISTORY:
// 15/04/95 Created. W. Raike
}
unit DBPicGrd;
interface
uses
DBGrids, DB, DBTables, Grids, WinTypes, Classes, Graphics;
type
TDBPicGrid = class(TDBGrid)
protected
procedure DrawDataCell(const Rect: TRect;
Field: TField; State: TGridDrawState); override;
public
constructor Create(AOwner : TComponent); override;
published
property DefaultDrawing default False;
end;
procedure Register;
implementation
constructor TDBPicGrid.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
DefaultDrawing := False;
end;
procedure TDBPicGrid.DrawDataCell(const Rect: TRect; Field: TField;
State: TGridDrawState);
var
bmp : TBitmap;
begin
with Canvas do
begin
FillRect(Rect);
if Field is TGraphicField then
try
bmp := TBitmap.Create;
bmp.Assign(Field);
Draw(Rect.Left, Rect.Top, bmp);
finally
bmp.Free;
end
else
TextOut(Rect.Left, Rect.Top, Field.Text);
end;
end;
procedure Register;
begin
RegisterComponents('Custom', [TDBPicGrid]);
end;
end.
Accessing other components from a base component
Question
How do I access other components in my application from within [my Base] component?
Answer
The Components[] list property exists in all descendants of TComponent
and is used to store references to any owned components. When one
calls "mycomponent := TSomeComponent.Create(aComponent)", mycomponent
is placed in aComponent's Components[] list. In most cases, the form
is specified as a component's owner in the Create method, in which case
the component is placed in the form's Components[] list.
The FindComponent() method (mentioned elsewhere) only searches the current
component's Components[] list. If the object you want to find is owned
by a different component, you will have to scan the other component's
list.
Depending on how you create your Base and other components, you may have
to implement a recursive search algorithm that starts at the top of the
ownership tree (probably with the form), and then descends into the tree,
searching the Components[] list of each component it finds until the desired
object is reached.
A nice alternative is just to always specify your Base component as the
owner of all your other sub-components when you create them. Then your
search of the Base component's Components[] list should work.
Extending DBGrid
Question
How to extend DBGrid?
Answer
{
Here's a TDBGrid derivative that exposes the Col, Row and Canvas properties
as well as the CellRect method. This is extremely useful if you would like
to, for example, pop a dropdown list over a cell when the user enters.
}
unit VUBComps;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, DBGrids, DB, Menus;
type
TDBGridVUB = class(TDBGrid)
private
{ Private declarations }
protected
{ Protected declarations }
public
property Canvas;
function CellRect(ACol, ARow: Longint): TRect;
property Col;
property Row;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('VUBudget', [TDBGridVUB]);
end;
function TDBGridVUB.CellRect(ACol, ARow: Longint): TRect;
begin
Result := inherited CellRect(ACol, ARow);
end;
end.
Creating a resizeable (elastic) panel
Question
How to realize a resizeable (elastic) panel?
Answer
{
Here's the source code for a resizable panel. Give the panel an align
property of alClient, throw some controls on it, and watch them resize
at run time when you resize the form. There is some code that prohibits
resizing during design time, but this can be taken out. This may not be
perfect, because I threw it together in a few minutes, but it's worked
for me so far.
}
unit Elastic;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
type
TElasticPanel = class( TPanel )
private
FHorz, FVert: boolean;
nOldWidth, nOldHeight: integer;
bResized: boolean;
protected
procedure WMSize( var message: TWMSize ); message WM_SIZE;
public
nCount: integer;
constructor Create( AOwner: TComponent ); override;
published
property ElasticHorizontal: boolean read FHorz write FHorz default TRUE;
property ElasticVertical: boolean read FVert write FVert default TRUE;
end;
procedure Register;
implementation
constructor TElasticPanel.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
FHorz := TRUE;
FVert := TRUE;
nOldWidth := Width;
nOldHeight := Height;
bResized := FALSE;
end;
procedure TElasticPanel.WMSize( var message: TWMSize );
var
bResize: boolean;
xRatio: real;
i: integer;
ctl: TWinControl;
begin
Inc( nCount );
if Align = alNone then
bResize := TRUE
else
bResize := bResized;
if not ( csDesigning in ComponentState ) and bResize then
begin
if FHorz then
begin
xRatio := Width / nOldWidth;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Left := Round( ctl.Left * xRatio );
ctl.Width := Round( ctl.Width * xRatio );
end;
end;
if FVert then
begin
xRatio := Height / nOldHeight;
for i := 0 to ControlCount - 1 do
begin
ctl := TWinControl( Controls[i] );
ctl.Top := Round( ctl.Top * xRatio );
ctl.Height := Round( ctl.Height * xRatio );
end;
end;
end
else
begin
nOldWidth := Width;
nOldHeight := Height;
end;
bResized := TRUE;
nOldWidth := Width;
nOldHeight := Height;
end;
procedure Register;
begin
RegisterComponents('Additional', [TElasticPanel]);
end;
end.
Setting boundaries for newly created controls
Question
How to set boundaries for newly created controls?
Answer
If you are designing a new Delphi control and you need to catch
or limit changes to Left, Top, Width, or Height, there is one
simple way to do it. However, I have yet to see the slightest
hint of how to do it in the Delphi documentation (including
the CWG).
The key to catching changes to Left, Top, Width, Height, and
even BoundsRect in Delphi is the SetBounds() method (found
in TControl and all descendants). SetBounds() is a virtual
function used to set the position and size of a control
all in one easy step. However, what they do not tell you
in the documentation is that TControl.SetBounds() is called
by TControl's SetLeft(), SetTop(), SetWidth(), and SetHeight()
property access methods every time a value is assigned to
the Left, Top, Width, Height, and BoundsRect properties.
Thus, to catch changes to these properties, simply override
the SetBounds() method, do whatever you need with the new
values, and then pass them on to the inherited SetBounds()
method.
In the following example, I have a control that automatically
updates its X & Y custom properties to refer to the center
of the control whenever Left, Top, Width, Height, or BoundsRect
are changed. Conversely, Left and Top will be updated whenever
X & Y are changed:
type
TMyControl = class(TControl)
private
FX, FY : integer;
{property access methods}
procedure SetX(value : integer);
procedure SetY(value : integer);
...
public
procedure SetBounds(aLeft, aTop, aWidth, aHeight : integer); override;
...
property X : integer read FX write SetX;
property Y : integer read FY write SetY;
end;
...
procedure TMyControl.SetX(value : integer);
begin
if FX <> value then
SetBounds(value - Width div 2, Top, Width, Height);
end;
procedure TMyControl.SetY(value : integer);
begin
if FY <> value then
SetBounds(Left, value - Height div 2, Width, Height);
end;
procedure TMyControl.SetBounds(aLeft, aTop, aWidth, aHeight : integer);
begin
{Go ahead and let SetBounds() do its thing...}
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
{Now adjust FX and FY according to our new bounds.}
FX := Width div 2;
FY := Height div 2;
end;
Also not mentioned in the documentation is the fact that the
FLeft, FTop, FWidth, and FHeight private fields that TControl
uses to keep track of its bounding rectangle are not updated
in the corresponding SetLeft(), SetTop(), etc. property access
methods. These variables, in fact, do not get updated anywhere
except in TControl's SetBounds() method (as with FX and FY in
the above example).
So, to limit changes to the bounds of your control, you can
override SetBounds() to check and modify any of the properties
before passing the values on to the inherited SetBounds()
method.
In the following example, I have a control that limits its
width and height to no more than 100 pixels:
type
TMyControl = class(TControl)
...
public
procedure SetBounds(aLeft, aTop, aWidth, aHeight : integer); override;
...
end;
...
procedure TMyControl.SetBounds(aLeft, aTop, aWidth, aHeight : integer);
begin
if aWidth > 100 then
aWidth := 100;
if aHeight > 100 then
aHeight := 100;
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;
Expanding a path to a TUutlineNode referenced by index
Question
How to expand a path to a TOutlineNode referenced by index?
Answer
The purpose I wrote this routine was, that I had an index from a TOutlineNode
(which was the result of search) and wanted to expand a path to the node
without expanding unnecessary trees.
The following routine accepts an index as a parameter and expands the path
to the TOutlineNode with this index.
The routine assumes a TOutline object named Outline.
var
Outline: TOutline;
procedure TSearchDlg.ExpandPathToFoundItem(const FoundItemIndex: Longint);
{------------------------------------------------------------------------------
Expands a path to a given item (item is specified by the index number). Only
the parents needed to get to the specified item will be expanded.
-----------------------------------------------------------------------------}
var
ItemIndex: Longint;
Found: Boolean;
LastCh: Longint;
Path: String;
ItemText: String;
SepPos: Integer;
OldSep: String;
begin
{Save the old ItemSpearator}
OldSep:=Outline.ItemSeparator;
{Set the new ItemSeparator}
Outline.ItemSeparator:='\';
{Get the full path to the TOutlineNode and add a '\'. This is done, because it
simplifies the whole algorithm}
Path:=Outline.Items[FoundItemIndex].FullPath+'\';
{As long as the end of the path has not been reached}
while Length(Path) > 0 do begin
{Determine the position of the first '\' in the path}
SepPos:=Pos('\',Path);
{Isolate the TOutlineNode item}
ItemText:=Copy(Path,1,SepPos-1);
{Determine the index of the TOutlineNode}
ItemIndex:=Outline.GetTextItem(ItemText);
{Expand it}
Outline.Items[ItemIndex].Expand;
{Cut the expanded TOutlineNode from the string}
Path:=Copy(Path,SepPos+1,Length(Path)-SepPos+1);
end;
{Restore original ItemSeparator}
Outline.ItemSeparator:=OldSep;
end;
DETAILS
Let's assume the full path to the desired item is:
"My Computer\Hardware\SoundCard\Base Adress"
The first step returns the above path. Then the substring "My Computer" is
isolated. Then the index of the TOutlineNode "My Computer" is determined by
using the "GetTextItem" method. The "Expand" method expands this tree.
Afterwards "My Computer" is cut from the path resulting in the new path
"Hardware\SoundCard\Base Adress".
Then the index of "Hardware" is determined, expanded and again, cut away.
This procedure repeats until there is no path left to expand. Then the path
to the given TOutlineNode will be expanded.
Associating a string with each component
Question
Is there a way to associate a string with each component?
Answer
Since the Tag property is a longint, you can type cast it
as a Pointer or PChar. So, you can basically store a pointer
to a record by using the Tag property.
Note: You're not going to be able to store the string, or
pointer rather, at design time. This is something you'll have
to do at run time. Take a look at this example:
var
i: integer;
begin
for i := 0 to ComponentCount - 1 do
if Components[i] is TEdit then
Components[i].Tag := LongInt(NewStr('Hello '+IntToStr(i)));
end;
Here, I loop through the components on the form. If the
component is a TEdit, I assign a pointer to a string to its Tag
property. The NewStr function returns a PString (pointer to a
string). A pointer is basically the same as a longint or
better, occupies the same number of bytes in memory. Therefore,
you can type cast the return value of NewStr as a LongInt and
store it in the Tag property of the TEdit component. Keep in
mind that this could have been a pointer to an entire record.
Now I'll use that value:
var
i: integer;
begin
for i := 0 to ComponentCount - 1 do
if Components[i] is TEdit then begin
TEdit(Components[i]).Text := PString(Components[i].Tag)^;
DisposeStr(PString(Components[i].Tag));
end;
end;
Here, again I loop through the components and work on only the
TEdits. This time, I extract the value of the component's Tag
property by typecasting it as a PString (Pointer to a string)
and assigning that value to the TEdit's Text property. Of
course, I must dereference it with the caret (^) symbol. Once
I do that, I dispose of the string stored in the edit
component. Important note: if you store anything in the
TEdit's Tag property as a pointer, you are responsible for
disposing of it also.
FYI, Since Delphi objects are really pointers to class
instances, you can also store objects in the Tag property. As
long as you remember to Free them.
Three methods spring to mind to use Tags to access strings that
persist from app to app.
1. If your strings stay the same forever, create a string
resource in Resource Workshop (or equiv) and use the Tags as
indexes into your string resource.
2. Use TIniFile and create a section for your strings, and
give each string a name with number so that your ini file has a
section like this:
[strings]
string1=Aristotle
string2=Plato
string3=Well this is Delphi, after all
Then you can fetch them back out this way:
var s1: string;
...
s1 := IniFile1.ReadString('strings', 'string'+IntToStr(Tag), '');
3. Put your strings into a file, with each followed by a
carriage return. Read them into a TStringList. Then your Tags
become an index into this stringlist:
StringList1.LoadFromFile('slist.txt');
...
s1 := StringList1[Tag];
Given the way Delphi is set up, I think the inifile method is easiest.
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.
Populating TDBComboBoxes and TDBListBoxes
Question
Answer
Most of Delphi's data aware components will populate
themselves after they are wired up to a open dataset. However
DbListboxes and DbComboboxes do not display this characteristic.
These two components are not for displaying your datasets, but
filling them. Use of these components is straight forward.
When you update your table, the value of the DbListbox or
DbCombobox will be posted in the appropriate field.
Filling the DbCombobox or DbListbox the same as filling normal
comboboxs or listboxes. The lines of text in a listbox or
combobox are really a tstring list. The "Items" property of
the given component holds this list. Use the "Add" method for
adding items to a tstring. If you want to use data types other
than strings they must be converted at run time. If your list
has a blank line at the end, consider setting the
"IntegralHeight" property to True.
Filling a DbListbox with 4 lines programmatically might look
similar to this:
DbListbox1.items.add('line one');
DbListbox1.items.add('line two');
DbListbox1.items.add('line three');
DbListbox1.items.add('line four');
Filling a DbListbox at design time requires using the object
inspector. By double clicking on the components "Items"
property, you can bring up the "String List Editor" and input
the desired rows.
Unfortunately, if a combobox is filled this way, there is not
default value. Setting a DbComboboxs "text" property will
achieve this result. (the "text" property is not available in
the object inspector, so it must be set programmatically).
Setting the default value to the first value in the
DbCombobox's list looks like this:
DbCombobox1.text := DbCombobox1.items[0];
Often it is useful to fill a DBListBox from a dataset. This
can be done using loop:
procedure TForm1.FormCreate(Sender: TObject);
begin
with table2 do begin
open;
while not EOF do
begin
DBlistbox1.items.add(FieldByName('name').AsString);
next;
end;
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.
Click and move components at run-time
Question
How can I program a component, such as a TPanel, so that I
can move it around with a click and drag of the mouse?
Answer
This code goes on the OnMouseDown event of the component in
question (a TPanel in this case):
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
panel1.perform(WM_SysCommand, SC_DragMove, 0);
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.
Validating input in TEdit components
Question
How can I validate input in my TEdit components?
Answer
Assuming you're using regular TEdit components (as opposed to TDBEdit
components), the best place to validate input is the OnExit event of
the TEdit. This event fires whenever focus leaves the component.
Typically, when the user enters some invalid text into the control,
you want to issue a warning to the user, and set the focus back
to the control. A difficulty arises, however, when you attempt
to set focus to a particular control from an OnExit event handler.
Since Windows is "in the middle of" setting focus from one control
to another during OnExit, you will see irregular behavior from
controls if you attempt to change focus at that time.
The solution is to post a message to your form in the TEdit's OnExit
event handler. This user-defined posted message will indicate that
the coast is clear to begin validating input. Since posted messages
are placed at the end of the message queue, this gives Windows the
opportunity to complete the focus change before you attempt to
change the focus back to another control.
Attatch is a unit and text representation of a DFM (form) file
which demonstrates this technique.
{ *** BEGIN CODE FOR UNIT1.PAS *** }
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Mask;
const
{ User-defined message }
um_ValidateInput = wm_User + 100;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Button1: TButton;
MaskEdit1: TMaskEdit;
procedure Edit1Exit(Sender: TObject);
private
{ User-defined message handler }
procedure ValidateInput(var M: TMessage); message um_ValidateInput;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ValidateInput(var M: TMessage);
begin
{ The following line is my validation. I want to make sure the }
{ first character is a lower case alpha character. Note the }
{ typecast of lParam to a TEdit. }
if not (TEdit(M.lParam).Text[1] in ['a'..'z']) then begin
ShowMessage('Bad input'); { Yell at the user }
TEdit(M.lParam).SetFocus; { Set focus back }
end;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
{ Post a message to myself which indicates it's time to }
{ validate the input. Pass the TEdit instance (Self) as }
{ the message lParam. }
PostMessage(Handle, um_ValidateInput, 0, longint(Sender));
end;
end.
{ *** END CODE FOR UNIT1.PAS *** }
{ *** BEGIN CODE FOR UNIT1.DFM *** }
object Form1: TForm1
Left = 200
Top = 99
Width = 318
Height = 205
Caption = 'Form1'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
TextHeight = 16
object Edit1: TEdit
Left = 32
Top = 32
Width = 121
Height = 24
TabOrder = 0
Text = 'Edit1'
OnExit = Edit1Exit
end
object Edit2: TEdit
Left = 160
Top = 32
Width = 121
Height = 24
TabOrder = 1
Text = 'Edit2'
OnExit = Edit1Exit
end
object Edit3: TEdit
Left = 32
Top = 64
Width = 121
Height = 24
TabOrder = 2
Text = 'Edit3'
OnExit = Edit1Exit
end
object Edit4: TEdit
Left = 160
Top = 64
Width = 121
Height = 24
TabOrder = 3
Text = 'Edit4'
OnExit = Edit1Exit
end
object Button1: TButton
Left = 112
Top = 136
Width = 89
Height = 33
Caption = 'Button1'
TabOrder = 4
end
end
{ *** END CODE FOR UNIT1.DFM *** }
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.
Different colored characters in a string grid
Question
Answer
This unit will show how to have text in a string grid where the
characters are different colors.
unit Strgr;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Grids, StdCtrls, DB;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
Rect: TRect; State: TGridDrawState);
const
CharOffset = 3;
begin
with StringGrid1.canvas do
begin
font.color := clMaroon;
textout(rect.left + CharOffset, rect.top + CharOffset, 'L');
font.color := clNavy;
textout(rect.left + CharOffset + TextWidth('L'),
rect.top + CharOffset, 'loyd');
end;
end;
end.
ISBN validation
Question
Answer
ISBNs (or International Standard Book Numbers) are mystical code numbers
that uniquely identify books. The purpose of this article is to remove the
mystery surrounding the structure of the ISBN, allowing applications to
perform data validation on entered candidate ISBNs.
ISBNs are composed of thirteen characters, limited to the number
characters "0" through "9", the hyphen, and the letter "X". This thirteen-
character code is divided into four parts, each separated by hyphens:
group identifier, publisher identifier, book identification for the
publisher, and the check digit. The first part (group identifier) is used
to identify countries, geographical regions, languages, etc. The second
part (publisher identifier) uniquely identifies the publisher. The third
part (book identifier) uniquely identifies a given book within a
publisher's collection. The fourth and final part (check digit) is used
with the other digits in the code in an algorithm to derive a verifiable
ISBN. The number of digits in the first three parts of an ISBN may contain
a variable number of digits, but the check digit will always consist of a
single character (between "0" and "9", or "X" for a value of 10) and the
ISBN as a whole will always consists of thirteen characters (ten numbers
plus the three hyphens dividing the four parts of the ISBN).
The ISBN 3-88053-002-5 breaks down into the parts:
Group: 3
Publisher: 88053
Book: 002
Check Digit: 5
An ISBN can be verified to be a valid code using a simple mathematical
algorithm. This algorithm takes each of the nine single digits from the
first three parts if the ISBN (sans the non-numeric hyphens), multiplies
each single digit by a number that is less than eleven the number of
positions from the left each digit that is in the ISBN, adds together the
result of each multiplication plus the check digit, and then divides that
number by eleven. If that division by eleven results in no remainder
(i.e., the number is modulo 11), the candidate ISBN is a valid ISBN. For
example, using the previous sample ISBN 3-88053-002-5:
ISBN: 3 8 8 0 5 3 0 0 2 5
Digit Multiplier: 10 9 8 7 6 5 4 3 2 1
Product: 30+72+64+00+30+15+00+00+04+05 = 220
Since 220 is evenly divisible by eleven, this candidate IDBN is a valid
ISBN code.
This verification algorithm is easily translated into Pascal/Delphi code.
String manipulation functions and procedures are used to extract the
check digit and the remainder of the ISBN from the String type value
passed to a validation function. The check digit is converted to Integer
type, which forms the start value of the aggregate variable onto which the
multiplication of each digit in the remainder of the ISBN (the single
digits that comprise the first three parts of the ISBN) will be added. A
For loop is used to sequentially process each digit in the remainder,
ignoring the hyphens, multiplying each digit times its position in the
ISBN remainder relative to the other digits in the remainder. The final
value of this aggregate variable is then checked to see whether it is
evenly divisible by eleven (indicating a valid ISBN) or not (indicating an
invalid candidate ISBN).
Here is an example of this methodology applied in a Delphi function:
function IsISBN(ISBN: String): Boolean;
var
Number, CheckDigit: String;
CheckValue, CheckSum, Err: Integer;
i, Cnt: Word;
begin
{Get check digit}
CheckDigit := Copy(ISBN, Length(ISBN), 1);
{Get rest of ISBN, minus check digit and its hyphen}
Number := Copy(ISBN, 1, Length(ISBN) - 2);
{Length of ISBN remainder must be 11 and check digit between 9 and 9 or
X}
if (Length(Number) = 11) and (Pos(CheckDigit, '0123456789X') > 0) then
begin
{Get numeric value for check digit}
if (CheckDigit = 'X') then
CheckSum := 10
else
Val(CheckDigit, CheckSum, Err);
{Iterate through ISBN remainder, applying decode algorithm}
Cnt := 1;
for i := 1 to 12 do begin
{Act only if current character is between "0" and "9" to exclude
hyphens}
if (Pos(Number[i], '0123456789') > 0) then begin
Val(Number[i], CheckValue, Err);
{Algorithm for each character in ISBN remainder, Cnt is the nth
character so processed}
CheckSum := CheckSum + CheckValue * (11 - Cnt);
Inc(Cnt);
end;
end;
{Verify final value is evenly divisible by 11}
if (CheckSum MOD 11 = 0) then
IsISBN := True
else
IsISBN := False;
end
else
IsISBN := False;
end;
This is a simplified example, kept simple to best demonstrate the
algorithm to decode ISBNs. There are a number of additional features that
would be desirable to add for use in a real-world application. For
instance, this example function requires the candidate ISBN be passed as a
Pascal String type value, with the hyphens dividing the four parts of the
ISBN. Added functionality might accommodate evaluating candidate ISBNs
entered without the hyphens. Another feature that might be added is
checking that ensures three hyphens are properly included, as opposed to
just thirteen number characters.
Selecting multiple records in TDBGrid
Question
How to select multiple record in TDBGrid?
Answer
When you add [dgMultiSelect] to the Options
property of a DBGrid, you give yourself the ability
to select multiple records within the grid.
The records you select are represented as bookmarks
and are stored in the SelectedRows property.
The SelectedRows property is an object of type
TBookmarkList. The properties and methods are
described below.
// property SelectedRows: TBookmarkList read FBookmarks;
// TBookmarkList = class
// public
{* The Clear method will free all the selected records
within the DBGrid *}
// procedure Clear;
{* The Delete method will delete all the selected rows
from the dataset *}
// procedure Delete;
{* The Find method determines whether a bookmark is
in the selected list. *}
// function Find(const Item: TBookmarkStr;
// var Index: Integer): Boolean;
{* The IndexOf method returns the index of the
bookmark within the Items property. *}
// function IndexOf(const Item: TBookmarkStr): Integer;
{* The Refresh method returns a boolean value to notify
whether any orphans were dropped (deleted) during the
time the record has been selected in the grid. The
refresh method can be used to update the selected list
to minimize the possibility of accessing a deleted
record. *}
// function Refresh: Boolean; True = orphans found
{* The Count property returns the number of currently
selected items in the DBGrid *}
// property Count: Integer read GetCount;
{* The CurrentRowSelected property returns a boolean
value and determines whether the current row is
selected or not. *}
// property CurrentRowSelected: Boolean
// read GetCurrentRowSelected
// write SetCurrentRowSelected;
{* The Items property is a TStringList of
TBookmarkStr *}
// property Items[Index: Integer]: TBookmarkStr
// read GetItem; default;
// end;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids, DB, DBTables;
type
TForm1 = class(TForm)
Table1: TTable;
DBGrid1: TDBGrid;
Count: TButton;
Selected: TButton;
Clear: TButton;
Delete: TButton;
Select: TButton;
GetBookMark: TButton;
Find: TButton;
FreeBookmark: TButton;
DataSource1: TDataSource;
procedure CountClick(Sender: TObject);
procedure SelectedClick(Sender: TObject);
procedure ClearClick(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure SelectClick(Sender: TObject);
procedure GetBookMarkClick(Sender: TObject);
procedure FindClick(Sender: TObject);
procedure FreeBookmarkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Bookmark1: TBookmark;
z: Integer;
implementation
{$R *.DFM}
//Example of the Count property
procedure TForm1.CountClick(Sender: TObject);
begin
if DBgrid1.SelectedRows.Count > 0 then
begin
showmessage(inttostr(DBgrid1.SelectedRows.Count));
end;
end;
//Example of the CurrentRowSelected property
procedure TForm1.SelectedClick(Sender: TObject);
begin
if DBgrid1.SelectedRows.CurrentRowSelected then
showmessage('Selected');
end;
//Example of the Clear Method
procedure TForm1.ClearClick(Sender: TObject);
begin
dbgrid1.SelectedRows.Clear;
end;
//Example of the Delete Method
procedure TForm1.DeleteClick(Sender: TObject);
begin
DBgrid1.SelectedRows.Delete;
end;
{*
This example iterates through the selected rows
of the grid and displays the second field of
the dataset.
The Method DisableControls is used so that the
DBGrid will not update when the dataset is changed.
The last position of the dataset is saved as
a TBookmark.
The IndexOf method is called to check whether or
not the bookmark is still existent.
The decision of using the IndexOf method rather
than the Refresh method should be determined by the
specific application.
*}
procedure TForm1.SelectClick(Sender: TObject);
var
x: word;
TempBookmark: TBookMark;
begin
DBGrid1.Datasource.Dataset.DisableControls;
with DBgrid1.SelectedRows do
if Count > 0 then
begin
TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;
for x:= 0 to Count - 1 do
begin
if IndexOf(Items[x]) > -1 then
begin
DBGrid1.Datasource.Dataset.Bookmark:= Items[x];
showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);
end;
end;
end;
DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);
DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);
DBGrid1.Datasource.Dataset.EnableControls;
end;
{*
This example allows you to set a bookmark and
and then search for the bookmarked record within
selected a record(s) within the DBGrid.
*}
//Sets a bookmark
procedure TForm1.GetBookMarkClick(Sender: TObject);
begin
Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;
end;
//Frees the bookmark
procedure TForm1.FreeBookmarkClick(Sender: TObject);
begin
if assigned(Bookmark1) then
begin
DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);
Bookmark1:= nil;
end;
end;
//Uses the Find method to locate the position of the
//bookmarked record within the selected list in the DBGrid
procedure TForm1.FindClick(Sender: TObject);
begin
if assigned(Bookmark1) then
begin
if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then
showmessage(inttostr(z));
end;
end;
end.
Moving in a TMemo Field
Question
I'm working with a TMemo Field, and I insert several lines in it using the
Addlines procedure, with the lines attribute. The problem is that after the
inserting is done, the field looks empty because the cursor is at the bottom
of the field, so I have to scroll up manually in order to be able to see what
has been inserted. My question is: Is there any way to do this scrolling up
automatically? Or in other words, How can I move to the begining of the TMemo
Field?
Answer
A:
procedure MemoCursorTo(Memo:TMemo; MemoLine, MemoCol: Integer);
begin
Memo.SelStart := SendMessage (Memo.Handle, EM_LINEINDEX, MemoLine, 0)
+ MemoCol - 1;
end;
Copy of component properties
Question
Is there an easy way to copy all the properties of a component into another one
of the same class, when the class is known only at run time?
Answer
Because of D1/D2 VCL internal object semantics and your own additional
semantics and D2 strings, you cannot just make a shallow copy (that
is, a copy the memory contents of the object, as is) of components.
There are two ways to make deeper copies:
(1) If there is an ASSIGN method, that may do what you want.
(2) You can use the same code the VCL uses to copy things to and from
the clipboard. You stream the component into memory and then read it
back in using the provided methods to create a new component. It
enables you to put in a new Owner and Parent, which is typically what
you want to do, and you can specify some hooks to handle other issues.
It is pretty fast.
Using the clipboard technique creates a new instance of the component,
and that may not be what you want if you have already created the
component. In that case, you need to write your own ASSIGN method.
Mask Edit
Question
I need to be able to validate that every thing a person inputs in to an edit
box is a numeric value. I was using and edit box allowing them to input
numbers then hit the enter key (set to default) on their key boards to enter
the value.
Answer
My suggestion is to set the OnKeyPress event to something like this:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if NOT (Key in ('0'..'9', '.', #8, #13)) // acceptable keys
OR ( (Key = '.') // user pressed '.'
AND (POS ('.', Edit1.Text) > 0)) // already has a decimal point
then
begin
Key := #0;
MessageBeep (MB_OK);
end;
end;
This checks to see if the key you pressed was a digit, a [Tab] or an
[Enter]. Anything else is not accepted (by setting Key to null) and the
computer beeps.
If you need to don't need to accept a decimal point you can take out the OR
clause in the if statement and the '.' in the first condition. If you want
to check that the entered field in between LowLimit and HighLimit you could
use this:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if NOT (Key in ('0'..'9', #8, #13))
OR (StrToInt (Edit1.Text + Key) < LowLimit)
OR (StrToInt (Edit1.Text + Key) > HighLimit)
then
begin
Key := #0;
MessageBeep (MB_OK);
end;
end;
List Box Horizontal Scroll
Question
In D1, for a tListBox, does anyone know how to either
A) Get a horizontal scroll bar to appear when the data within the list box is
too long for box OR failing that
B) Just get a horizontal scroll bar in the thing at all
Answer
Try adding this in the Create event for your listboxes parent form:
{enable horizontal scroll box in example titles list box}
SendMessage(lstInclude.Handle, LB_SETHORIZONTALEXTENT, 1000, LongInt(0));
1000 is just some arbitrarily big number to force a scrollbar. You could
calculate this based on some TextWidth('widest item') calculation
TProgressBar in TStatusPanel
Question
Anyone found a way to put a TProgressBar in a TStatusPanel?
Answer
unit adStatba;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls;
type
TAdrockStatusBar = class(TStatusBar)
private
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(Aowner : TComponent); override;
published
{ Published declarations }
end;
procedure Register;
implementation
Constructor TAdrockStatusBar.Create(Aowner : TComponent);
begin
inherited Create(Aowner);
ControlStyle := ControlStyle + [csAcceptsControls];
end;
procedure Register;
begin
RegisterComponents('Adrock', [TAdrockStatusBar]);
end;
end.
It allows you to put a control into the panel. But it does not support the
sub panels. You might need to align the control yourself over a sub panel
to make it look right. But that is not too hard to do...
TTreeView slow down
Question
When I add about 60 items (& subitems) to a TTreeView component it takes
about 3 seconds. This seems far too slow, since the windows explorer
can do it almost instantly.
It seems that when I add the items all at once the TTreeView tries to
redraw everytime an item is added (this is my theory!). Is there a way
to halt any redrawing until I've add all my items? Or is there somthing
else I should look at?
Answer
A:
Try
LockWindowUpdate(TreeView1.Handle);
...
finally
LockWindowUpdate(0);
A:
Set the sort property on off.
A:
I've done alot of work with TTreeView. I typically add and manipulate
hundreds, sometimes thousands of nodes at a time. The biggest time-savers
have been:
-Using TreeView1.BeginUpdate and TreeView1.EndUpdate before and after I make
a large number of changes or additions.
-Setting SortType to stNone by default. (Preventing the tree from
automatically sorting items every time they are added or modified. This
will probably be your biggest time-saver.)
If you need your items to be sorted, you can save time by sorting nodes only
when they are visible. Since you add items to the tree yourself, you can
choose to sort whatever you make visible by default, then sort children as
they are exposed (their parent is expanded). I do this by attaching the
following code to the OnExpanded event:
procedure TForm1.TreeView1Expanded(Sender: TObject; Node: TTreeNode);
begin
Node.Alphasort; {Sort Node's children and -only- Node's children}
end;
That will take care of sorting for every level except the root level. To my
knowledge, there is no way to tell a TTreeView to just sort it's root nodes.
TreeView1.Alphasort sorts -every- item in the tree (big time-cruncher). If
you need to sort items on the root level without sorting every item on the
tree, you'll have to do it yourself. I'd probably start with QuickSort or
InsertionSort, and the method TTreeNode.MoveTo.
A:
Put your TreeView-Add's between a call to TreeView1.Items.BeginUpdate and
TreeView1.Items.EndUpdate.
Also make sure the treeview is unsorted.
