Welcome to my "Delphi Doodles" web page.
Here you will find some clever and useful tips to improve your Delphi Programming.
These were "lifted" from various sources. I take no credit for them.
Beginner's Tips
messageBeep(0);
Display the mouse's hourglass (and then go back to an arrow).
try
Screen.Cursor := crHourGlass;
{do something here}
finally
Screen.Cursor := crDefault;
end;
Application.ProcessMessages;
Scanning through a Data Table
Table1.First;
x := 0;
while not(Table1.Eof) do
begin
{do what you have to do here}
Table1.Next;
end;
Setting focus on a specific field of a TDBGrid
DBGrid1.SelectedField := Table1Field1;
DBGrid1.SetFocus;
Navigator control use
I have a form that uses several TDBGrids. It has only one navigator control.
How do I write it so that I can use the navigator control so that it works with
whatever grid is active?
Use this line in the Enter event of each grid:
TDBNavigator1.dataSource := (sender as TDBGrid).dataSource;
Dynamically update DBGrid row color
Versions: Delphi 2, 3
The DBGrid is a great user interface tool for displaying data. This
technique demonstrates how to dynamically change the color of text in a
DBGrid.
For example, we want our grid to display rows of country information. If a
country's population is greater than 20 million, we'll display its row in
blue colored text. We test the values and update the text color in the
OnDrawColumnCell event of the grid.
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if Table1.FieldByName('Population').AsInteger > 20000000 then
DBGrid1.Canvas.Font.Color := clBlue;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
This is a simple but visually profound technique. In addition to just data
content, you can display the meaning of the information; e.g. a lot of
people, account overdrawn, parts have arrived.
Getting the network user name without using the BDE.
A:
This way uses the 32 bit API:
function GetNetUserName: string;
const
NetUserNameLength: integer = 50;
begin
SetLength(result, NetUserNameLength);
GetUserName(pChar(result), NetUserNameLength);
SetLength(result, StrLen(pChar(result)));
end;
This way uses the registry: It reads the key groups under the network\persistent
section into a TStringList. Then, we traverse the list until we find a UserName
key and grab that value. If we don't find that name, we keep looking until we
run out of entries in that list. If nothing is found, an empty string is returned.
function GetNetUserName: string;
var
reg: TRegIniFile;
RegKeys: TStringList;
s: string;
i: integer;
begin
reg := TRegIniFile.create('network\persistent');
try
RegKeys := TStringList.create;
try
reg.ReadSections(RegKeys);
i := 0;
repeat // Make sure that there is a UserName key.
s := reg.ReadString(RegKeys[i], 'UserName', '');
inc(i);
until (s <> '') or (i = RegKeys.count);
result := s;
finally
RegKeys.free;
end;
finally
reg.free;
end;
end;
Putting the current time on the title bar of my form
Note: The placement of the time varies according to whether it is
Win95 or below, as well as the form's size. If the form is too
narrow, this may write the time over the top of the control buttons
(maximize, minimize, etc).
unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
dc: hDC;
implementation
{$R *.DFM}
procedure TForm1.Timer1Timer(Sender: TObject);
var
TheTime: array[0..80] of char;
begin
StrPCopy(TheTime, TimeToStr(time));
TextOut(dc, width DIV 2, 5, TheTime, StrLen(TheTime));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
dc := GetWindowDC(handle);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ReleaseDC(handle, dc); {This *must* be manually released.}
end;
end.
Conserving resources with a TTabbedNotebook?
A: The TTabbedNotebook is created with only the page showing actually in memory.
As tabs are selected, the pages to be shown are instantiated into memory. The trick
is to release the last page from memory so that only one page at a time exists. There
are two examples of doing this below.
This version recycles controls by changing the parent property as the pages are turned:
procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
var
CurrentPage, NewPage: TWinControl;
begin
if sender is TTabbedNotebook then
with TTabbedNotebook(sender) do begin
CurrentPage := TWinControl(pages.objects[PageIndex]);
LockWindowUpdate(handle);
NewPage := TWinControl(pages.objects[NewTab]);
while PresentPage.ControlCount > 0 do
PresentPage.Controls[0].Parent := NewPage;
LockWindowUpdate(0);
end;
end;
This version is a bit more elegant and releases he window handle of the control
while keeping all the other properties intact. (i.e. You don't have to worry about
losing the information contained in that window just because the window went away.)
procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
var
CurrentPage: TWinControl;
begin
if sender is TTabbedNotebook then
with TTabbedNotebook(sender) do begin
CurrentPage := TWinControl(pages.objects[PageIndex]);
LockWindowUpdate(handle);
TWinControl(pages.objects[NewTab]).HandleNeeded;
LockWindowUpdate(0);
end;
end;
File Copy Routine
File Copy Routine that keeps Attributes and File Date/Time the same
function FileCopy(source,dest: String): Boolean;
var
fSrc,fDst,len: Integer;
size: Longint;
buffer: packed array [0..2047] of Byte;
begin
Result := False; { Assume that it WONT work }
if source <> dest then begin
fSrc := FileOpen(source,fmOpenRead);
if fSrc >= 0 then begin
size := FileSeek(fSrc,0,2);
FileSeek(fSrc,0,0);
fDst := FileCreate(dest);
if fDst >= 0 then begin
while size > 0 do begin
len := FileRead(fSrc,buffer,sizeof(buffer));
FileWrite(fDst,buffer,len);
size := size - len;
end;
FileSetDate(fDst,FileGetDate(fSrc));
FileClose(fDst);
FileSetAttr(dest,FileGetAttr(source));
Result := True;
end;
FileClose(fSrc);
end;
end;
end;
Scrolling your form with pgUP and pgDn.
How can you do scrolling functions in a TForm component
using keyboard commands? For example, scrolling up and down
when a PgUp or PgDown is pressed. Is there some simple way to
do this or does it have to be programmed by capturing the
keystrokes and manually responding to them?
Form scrolling is accomplished by modifying the
VertScrollbar or HorzScrollbar Postion properties of the
form. The following code demonstrates how to do this:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
const
PageDelta = 10;
begin
With VertScrollbar do
if Key = VK_NEXT then
Position := Position + PageDelta
else if Key = VK_PRIOR then
Position := Position - PageDelta;
end;
TMediaPlayer - What CD Track am I on?
Here's an easy way to do it:
create a timer and put this code in the OnTimer event:
var Trk, Min, Sec: Word;
begin
with MediaPlayer1 do
begin
Trk:= MCI_TMSF_TRACK(Position);
Min:=MCI_TMSF_MINUTE(Position);
Sec:=MCI_TMSF_SECOND(Position);
Label1.Caption:=Format('%.2d',[Trk]);
Label2.Caption:=Format('%.2d:%.2d',[Min,Sec]);
end;
end;
Add MMSystem to the uses clause in Unit1
This will show current track and time.
Printing Directly to a Printer
by Robert Vivrette - [email protected]
Several readers have in the past inquired about how to print directly to a printer without going through
the Windows printing engine. The key use for such a technique is when the user wants to send raw
data (from a text file for example) directly to the printer without having to mess with fonts
or formatting. Also, sometimes you may have directed some print output to a file rather than the
printer. This technique allows you to send such a file directly to the printer.
The technique is really quite simple. All you need to do is use AssignFile to open a file with the
filename specified as 'LPT1' (or any other printer port). The operating system recognizes this as a
special file type and directs all the output to that printer port. The Write & Writeln procedures are
used to actually send the data. If you need to eject the page when you are done, just send a
ASCII code of #12. Most printers recognize this as a formfeed code.
var
F : TextFile;
begin
AssignFile(F,'LPT1');
Rewrite(F);
Writeln(F,'Hello');
Writeln(F,'There!');
Writeln(F,#12);
CloseFile(F);
end;
Printing Bitmaps
procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
var
Info: PBitmapInfo;
InfoSize: Integer;
Image: Pointer;
ImageSize: Longint;
begin
with Bitmap do
begin
GetDIBSizes(Handle, InfoSize, ImageSize);
Info := MemAlloc(InfoSize);
try
Image := MemAlloc(ImageSize);
try
GetDIB(Handle, Palette, Info^, Image^);
with Info^.bmiHeader do
StretchDIBits(Printer.Canvas.Handle, X, Y, Width,
Height, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;
Copying a Table Record
Useful for copying a single record from one table to
another provided the tables have the same structure.
Procedure CopyRecord(const SourceTable, DestTable : TTable);
var
I : Word;
begin
DestTable.Append;
For I := 0 to SourceTable.FieldCount - 1 do
DestTable.Fields[I].Assign(SourceTable.Fields[I]);
DestTable.Post;
end;