Delphi Tips

Tip 1 – Change the TFont object so that it can draw rotated text Arthur Hoornweg

procedure SetTextAngle(F:Tfont; angle: Word);
var
LogRec: TLOGFONT;
begin
GetObject(f.Handle,SizeOf(LogRec),Addr(LogRec));
LogRec.lfEscapement := angle;
f.Handle := CreateFontIndirect(LogRec);
end;

Note that the angle is in 1/10 of degrees. Any attempt to manipulate font.size or font.color will reset the angle to zero degrees.

Tip 2 How to create an array of buttons that work Mr. D.F. Hartley

Here is a unit that creates a row of buttons and a label at run time and displays which button is clicked on. Thanks go to a number of people who pushed me in the right direction. Like all things in programing ‘it’s obvious when you know how’!

All you need to do is start a new project, then paste all the code below into Unit1.

unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure ButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
b = 4; {Total number of buttons to create}

var
ButtonArray : Array[0..b-1] of TButton; {Set up an array of buttons}
MessageBox: TLabel; {…and a label!}

procedure TForm1.FormCreate(Sender: TObject);
var
loop : integer;
begin
ClientWidth:=(b*60)+10; {Size the form to fit all the}
ClientHeight:=65; {components in.}

MessageBox:=TLabel.Create(Self); {Create a label…}
MessageBox.Parent:=Self;
MessageBox.Align:=alTop; {…set up it’s properties…}
MessageBox.Alignment:=taCenter;
MessageBox.Caption:=’Press a Button’;

for loop:= 0 to b-1 do {Now create all the buttons}
begin
ButtonArray[loop]:=TButton.Create(Self);
with ButtonArray[loop] do {Note the use of the with command.}
begin {This lets you leave out the first}
Parent :=self; {bit of the description and}
Caption :=IntToStr(loop); {(I think) makes the code easier}
Width :=50; {to read.}
Height :=25;
Top :=30;
Left :=(loop*60)+10;
Tag :=loop; {Used to tell which button is pressed}
OnClick :=ButtonClick; {The important bit!}
end;
end;
end;

procedure TForm1.ButtonClick(Sender: TObject);
var
t : Integer;
begin
t:=(Sender as TButton).Tag; {Get the button number}
MessageBox.Caption:=’You pressed Button ‘+IntToStr(t);
end;

end.

Tip 3 ASCII to HEX / math Greg Carter

{
ASCII to HEX / math
These work on byte array to strings, also look at the Ord and Chr functions in Delphi.
BytesToHexStr does this [0,1,1,0] of byte would be converted to string := ‘30313130’;
HexStrToBytes goes the other way.
}

unit Hexstr;

interface
uses String16, SysUtils;

Type
PByte = ^BYTE;

procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);
procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);
procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);

implementation
procedure BytesToHexStr(var hHexStr: String; pbyteArray: PByte; InputLength: WORD);
Const
HexChars : Array[0..15] of Char = ‘0123456789ABCDEF’;
var
i, j: WORD;
begin
SetLength(hHexStr, (InputLength * 2));
FillChar(hHexStr, sizeof(hHexStr), #0);
j := 1;
for i := 1 to InputLength do begin
hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]); inc(j);
hHexStr[j] := Char(HexChars[pbyteArray^ and 15]); inc(j);
inc(pbyteArray);
end;
end;

procedure HexBytesToChar(var Response: String; hexbytes: PChar; InputLength: WORD);
var
i: WORD;
c: byte;
begin
SetLength(Response, InputLength);
FillChar(Response, SizeOf(Response), #0);
for i := 0 to (InputLength – 1) do begin
c := BYTE(hexbytes[i]) And BYTE($f);
if c > 9 then
Inc(c, $37)
else
Inc(c, $30);
Response[i + 1] := char(c);
end;{for}
end;

procedure HexStrToBytes(hHexStr: String; pbyteArray: Pointer);
{pbyteArray must point to enough memory to hold the output}
var
i, j: WORD;
tempPtr: PChar;
twoDigits : String[2];
begin
tempPtr := pbyteArray;
j := 1;
for i := 1 to (Length(hHexStr) DIV 2) do begin
twoDigits := Copy(hHexStr, j, 2); Inc(j, 2);
PByte(tempPtr)^ := StrToInt(‘$’ + twoDigits); Inc(tempPtr);
end;{for}
end;

end.

UNIT String16.
interface
{$IFNDEF Win32}
procedure SetLength(var S: string; Len: Integer);
procedure SetString(var Dst: string; Src: PChar; Len: Integer);
{$ENDIF}
implementation
{$IFNDEF Win32}
procedure SetLength(var S: string; Len: Integer);
begin
if Len > 255 then
S[0] := Chr(255)
else
S[0] := Chr(Len)
end;

procedure SetString(var Dst: string; Src: PChar; Len: Integer);
begin
if Len > 255 then
Move(Src^, Dst[1], 255)
else
Move(Src^, Dst[1], Len);
SetLength(Dst, Len);
end;
{$ENDIF}
end.

Tip 4 Associate filetype (extension) Jeremy Collins

Basically, you need to add two keys to the registry under HKEY_CLASSES_ROOT. Say yourextension in “.ext”, then the first key you add is the extension itself:

HKEY_CLASSES_ROOT
.ext

and set the “default” string value of this key to an “internal name” for your file type – for example MyApp.Document:

HKEY_CLASSES_ROOT
.ext
Default = “MyApp.Document”

You then create another key with this name:

HKEY_CLASSES_ROOT
MyApp.Document

Create a sub-key of this called “shell”, a sub-key of *this* called “open” and a further sub-key of “open” called “command”. The default value uder this key is the location and name of your your application folled by “%1” which represents the filename parameter that Windows will pass to your executable:

HKEY_CLASSES_ROOT
MyApp.Document
shell
open
command
Default = “C:myappmyapp.exe %1”

You can do this in code with the TRegistry object, or use InstallShield, which can make registry changes for you. I’d advise doing both, in case the user trashes your registry entry.

Tip 5 Associate filetype (extension) – another version Rodney E Geraght

{The easiest way I’ve found to do this is to modify the Extensions section of the win.ini file that is located in the Windows directory. This also works under Win 95 and will update the registry automatically under Win95. Look at the extensions section of the win.ini to see the format you have to use. Put IniFiles in your uses clause and then use something like this: }

var
INIFile: TIniFile;
begin
try
INIFile := TInifile.Create(‘WIN.INI’);
INIFile.WriteString(‘Extensions’,’txt’,’c:windowsnotepad.exe ^.txt’);
finally
INIFile.Free;
end;
end;

{This would associate *.txt files with Windows Notepad. If you had an app named MyApp in the c:MyApps directory and your extension was *.MAP then you would change it like this: }

var
INIFile: TIniFile;
begin
try
INIFile := TInifile.Create(‘WIN.INI’);
INIFile.WriteString(‘Extensions’,’map’,’c:myappsmyapp.exe ^.map’);
finally
INIFile.Free;
end;
end;

{This will work in both Win 3.11 and Win 95 and saves you from having to modify the Reqistry under Win 95. Not sure about Win NT (or Win95b) since I don’t have a test machine available. Note that this is only the first part of the solution though since it will open the associated application but it won’t load the file you clicked. To do this you have to read ParamStr(1), which would hold the full path of the file you clicked, and run the file name through your file opening routine. }

Tip 6 variable to the path of the Windows systems directory

{Use the API call GetSystemDirectory to assign a given string variable to the path of the Windows systems directory i.e. ‘c:windowssystem’}

var
Dir: array[0..200] of Char; // use MAXFILEPATH or something like this instead of 200
begin
GetSystemDirectory(Dir, SizeOf(Dir)-1); // don’t know if -1 is necessary, but using is no error
end;

Tip 7 run Netscape or Explorer from Delphi application ?

{Is there a way to run Netscape or Explorer from Delphi application and open
that file? Because I think it is very boring for the user to start looking for it each
time. The easiest way is to do:}

uses ShellAPI;

ShellExecute(0,’open’,’Report.html’,Nil,Nil,SW_SHOWNORMAL);

{You can track down the file association for the .html extension from the registry to tell which browser is the current default. If all you want to do is launch the browser with a URL, though, it’s much easier this way: Just remember to add ShellAPI to your uses clause.}

ShellExecute(0, ‘open’, ‘http://www.yoursite.com’, nil, nil, SW_NORMAL);

Tip 8 How to get the disk serial Number in Delphi. Use the GetVolumeInformation API function ?

{How to get the disk serial Number in Delphi. Use the GetVolumeInformation API function. For ex: }

var
VolSerNum: DWORD;
Dummy1, Dummy2: DWORD;
begin
if GetVolumeInformation(‘c:’, NIL, 0, @VolSerNum, Dummy1, Dummy2, NIL, 0) then
ShowMessage(Format(‘%.4x:%.4x’, [HiWord(VolSerNum), LoWord(VolSerNum)]));

Tip 9 Automatic Year in a date edit

{Automatic Year in a date edit}

PROCEDURE TForm1.Edit1Exit(Sender: TObject);
BEGIN
IF Edit1.Text” THEN BEGIN
TRY
StrToDate(Edit1.Text);
EXCEPT
Edit1.SetFocus;
MessageBeep(0);
raise Exception.Create(‘”‘+Edit1.Text
+'” is no valid Date’);
END{try};
Edit1.Text:=DateToStr(StrToDate(Edit1.Text));
END{if};
END;

Tip 10 Beeping when Enter key is Pressed Paul Motyer

{ Beeping when is pressed}

procedure TForm1.EditKeyPress(Sender: TObject; var Key:Char);
begin
if Key = Chr(VK_RETURN) then
begin
Perform(WM_NEXTDLGCTL,0,0);
key:= #0;
end;
end;

Tip 11

Method 1
This is how to detect if there is already another copy running and exit if that is the case.
Create a unit called PrevInst and add it to your uses clause. Here’s the code:

unit PrevInst;

interface

uses
WinTypes, WinProcs, SysUtils;

type
PHWND = ^HWND;
function EnumFunc(Wnd:HWND; TargetWindow:PHWND): bool; export;
procedure GotoPreviousInstance;

implementation

function EnumFunc(Wnd:HWND; TargetWindow:PHWND): bool;
var
ClassName : array[0..30] of char;
begin
Result := true;
if GetWindowWord(Wnd,GWW_HINSTANCE) = hPrevInst then
begin
GetClassName(Wnd,ClassName,30);
if StrIComp(ClassName,’TApplication’) = 0 then
begin
TargetWindow^ := Wnd;
Result := false;
end;
end;
end;

procedure GotoPreviousInstance;
var
PrevInstWnd : HWND;
begin
PrevInstWnd := 0;
EnumWindows(@EnumFunc,longint(@PrevInstWnd));
if PrevInstWnd < 0 then
if IsIconic(PrevInstWnd) then
ShowWindow(PrevInstWnd, SW_RESTORE)
else
BringWindowToTop(PrevInstWnd);
end;

end.

And then make the main block of your *.DPR file look something like this–

begin
if hPrevInst < 0 then
GotoPreviousInstance
else
begin
Application.CreateForm(MyForm, MyForm);
Application.Run;
end;
end.

Method 2

From: "David S. Lee"

In the begin..end block of the .dpr:

begin
if HPrevInst 0 then begin
ActivatePreviousInstance;
Halt;
end;
end;

Here is the unit I use:

unit PrevInst;

interface

uses
WinProcs,
WinTypes,
SysUtils;

type
PHWnd = ^HWnd;

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;

procedure ActivatePreviousInstance;

implementation

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;
var
ClassName : array[0..30] of char;
begin
Result := true;
if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then begin
GetClassName(Wnd, ClassName, 30);
if STRIComp(ClassName,’TApplication’)=0 then begin
TargetWindow^ := Wnd;
Result := false;
end;
end;
end;

procedure ActivatePreviousInstance;
var
PrevInstWnd: HWnd;
begin
PrevInstWnd := 0;
EnumWindows(@EnumApps,LongInt(@PrevInstWnd));
if PrevInstWnd 0 then
if IsIconic(PrevInstWnd) then
ShowWindow(PrevInstWnd,SW_Restore)
else
BringWindowToTop(PrevInstWnd);
end;

end.

Method 3

From: “The Graphical Gnome”

Taken from Delphi 2 Developers Guide by Pacheco and Teixeira with heavy modifications.

Usage: In the Project source change to the following

if InitInstance then
begin
Application.Initialize;
Application.CreateForm(TFrmSelProject, FrmSelProject);
Application.Run;
end;
unit multinst;
{ Taken from Delphi 2 Developers Guide by Pacheco and Teixeira With heavy Modifications.

Usage:
In the Project source change to the following

if InitInstance then
begin
Application.Initialize;
Application.CreateForm(TFrmSelProject, FrmSelProject);
Application.Run;
end;

That’s all folks ( I hope ;()}

interface

uses Forms, Windows, Dialogs, SysUtils;

const
MI_NO_ERROR = 0;
MI_FAIL_SUBCLASS = 1;
MI_FAIL_CREATE_MUTEX = 2;

{ Query this function to determine if error occurred in startup. }
{ Value will be one or more of the MI_* error flags. }

function GetMIError: Integer;
Function InitInstance : Boolean;

implementation

const
UniqueAppStr : PChar; {Change for every Application}

var
MessageId: Integer;
WProc: TFNWndProc = Nil;
MutHandle: THandle = 0;
MIError: Integer = 0;

function GetMIError: Integer;
begin
Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam,
lParam: Longint): Longint; StdCall;
begin

{ If this is the registered message… }
if Msg = MessageID then begin
{ if main form is minimized, normalize it }
{ set focus to application }
if IsIconic(Application.Handle) then begin
Application.MainForm.WindowState := wsNormal;
ShowWindow(Application.Mainform.Handle, sw_restore);
end;
SetForegroundWindow(Application.MainForm.Handle);
end
{ Otherwise, pass message on to old window proc }
else
Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
{ We subclass Application window procedure so that }
{ Application.OnMessage remains available for user. }
WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));
{ Set appropriate error flag if error condition occurred }
if WProc = Nil then
MIError := MIError or MI_FAIL_SUBCLASS;
end;

procedure DoFirstInstance;
begin
SubClassApplication;
MutHandle := CreateMutex(Nil, False, UniqueAppStr);
if MutHandle = 0 then
MIError := MIError or MI_FAIL_CREATE_MUTEX;
end;

procedure BroadcastFocusMessage;
{ This is called when there is already an instance running. }
var
BSMRecipients: DWORD;
begin
{ Don’t flash main form }
Application.ShowMainForm := False;
{ Post message and inform other instance to focus itself }
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageID, 0, 0);
end;

Function InitInstance : Boolean;
begin
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
if MutHandle = 0 then
begin
{ Mutex object has not yet been created, meaning that no previous }
{ instance has been created. }
ShowWindow(Application.Handle, SW_ShowNormal);
Application.ShowMainForm:=True;
DoFirstInstance;
result := True;
end
else
begin
BroadcastFocusMessage;
result := False;
end;
end;

initialization

begin
UniqueAppStr := Application.Exexname;
MessageID := RegisterWindowMessage(UniqueAppStr);
ShowWindow(Application.Handle, SW_Hide);
Application.ShowMainForm:=FALSE;
end;

finalization
begin
if WProc Nil then
{ Restore old window procedure }
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
end;
end.

Tip 12

Heres a function to reverse characters in a string:

function ReverseString( s : string ) : string;
var
i : integer;
s2 : string;
begin
s2 := ”;
for i := 1 to Length( s ) do
begin
s2 := s[ i ] + s2;
end;
Result := s2;
end;

Tip 13

MessageDlg( ‘screen width = ‘ + IntToStr( Screen.Width )+
‘, screen height = ‘ + IntToStr( Screen.Height ), mtInformation,[mbOk], 0 );

Tip 14

procedure TMainForm.RestartWindowsBtnClick(Sender: TObject);
begin
if not ExitWindows(EW_RestartWindows, 0) then
ShowMessage(‘An application refused to terminate’);
end;

Tip 15

procedure TMainForm.RebootSystemBtnClick(Sender: TObject);
begin
if not ExitWindows(EW_RebootSystem, 0) then
ShowMessage(‘An application refused to terminate’);
end;

Tip 16

Turn monitor off :
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

Turn monitor on :
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

Tip 17

Include the MMSystem unit in your uses clause.

To open the CD-ROM:
mciSendString(‘Set cdaudio door open wait’, nil, 0, handle);

To close the CD-ROM:
mciSendString(‘Set cdaudio door closed wait’, nil, 0, handle);

Tip 18

Removing icon on taskbar
ShowWindow (Application.Handle, SW_HIDE);

Tip 19
Here’s how I center my forms – Add this code to your FormCreate Event.

Form1.Left := (Screen.Width div 2) – (Form.Width div 2);
Form1.Top := (Screen.Height div 2) – (Form.Height div 2);

Tip 20

This is a nice little trick I use in all my programs that provides the user with a hotlink to my site. When they move their mouse over it, the link changes colour. When they click on it, their default browser is launched & the site is connected.

Add ShellAPI to your uses clause

Create a label component with the URL as it’s caption. Change the colour to make it stand out. In the on the OnClick even for the label, enter the following code:

procedure TTOKAboutBox.URLLabelClick(Sender: TObject);
var TempString : array[0..79] of char;
begin
StrPCopy(TempString,URLLabel.Caption);
ShellExecute(0, Nil, TempString, Nil, Nil, SW_NORMAL);
end;

In the mousemove event, put the following code to change the color of the text

URLLabel.Font.Color := clRed;

& in the mousemove event for the surrounding form/panel etc do the same again but this timechange the color

URLLabel.Font.Color := clBlue;

Set the URLLabel.Cursor property to crHandMove.

Tip 21

{Convert binary to decimal
Can someone give me an idea of a simple way to convert binary (base2) to decimal(base10).
Solution 1 by [Anatoly Podgoretsky, [email protected]]}

////////////////////////////////////////////////
// convert 32 bit base2 to 32 bit base10 //
// max number = 99 999 999, return -1 if more //
////////////////////////////////////////////////

function Base10(Base2:Integer) : Integer; assembler;
asm
cmp eax,100000000 // check upper limit
jb @1 // ok
mov eax,-1 // error flag
jmp @exit // exit with -1
@1:
push ebx // save registers
push esi
xor esi,esi // result = 0
mov ebx,10 // diveder base 10
mov ecx,8 // 8 nibbles (10^8-1)
@2:
mov edx,0 // clear remainder
div ebx // eax DIV 10, edx mod 10
add esi,edx // result = result + remainder[I]
ror esi,4 // shift nibble
loop @2 // loop for all 8 nibbles
mov eax,esi // function result
pop esi // restore registers
pop ebx
@exit:
end;

{
Solution 2
[Oliver Townshend, [email protected]]
}

function IntToBin(Value: LongInt;Size: Integer): String;
var
i: Integer;
begin
Result:=”;
for i:=Size downto 0 do begin
if Value and (1 shl i)0 then begin
Result:=Result+’1′;
end else begin
Result:=Result+’0′;
end;
end;
end;

function BinToInt(Value: String): LongInt;
var
i,Size: Integer;
begin
Result:=0;
Size:=Length(Value);
for i:=Size downto 0 do begin
if Copy(Value,i,1)=’1′ then begin
Result:=Result+(1 shl i);
end;
end;
end;

{
Solution 3
[Demian Lessa, [email protected]]
Give this function any decimal value, specify a base (1..16) and it will return you a string
containing the proper value, BaseX. You can use a similar method for Arabic/Roman
conversion (see below).
}

function DecToBase( Decimal: LongInt; const Base: Byte): String;
const
Symbols: String[16] = ‘0123456789ABCDEF’;
var
scratch: String;
remainder: Byte;
begin
scratch := ”;
repeat
remainder := Decimal mod Base;
scratch := Symbols[remainder + 1] + scratch;
Decimal := Decimal div Base;
until ( Decimal = 0 );
Result := scratch;
end;

{
Give this function any decimal value (1…3999), and it will return you a string containing
the proper value in Roman notation.
}

function DecToRoman( Decimal: LongInt ): String;
const
Romans: Array[1..13] of String =
( ‘I’, ‘IV’, ‘V’, ‘IX’, ‘X’, ‘XL’, ‘L’, ‘XC’, ‘C’, ‘CD’, ‘D’, ‘CM’, ‘M’ );

Arabics: Array[1..13] of Integer =
( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

var
i: Integer;
scratch: String;
begin
scratch := ”;
for i := 13 downto 1 do
while ( Decimal >= Arabics[i] ) do
begin
Decimal := Decimal – Arabics[i];
scratch := scratch + Romans[i];
end;
Result := scratch;
end;

Tip 22

//Disable alt-tab and ctrl+esc keys

procedure TurnSysKeysOff;
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (True), @OldVal, 0)
end;

procedure TurnSysKeysBackOn;
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (False), @OldVal, 0)
end;

Tip 23

Many thanks go to A.Louwerens for optimising this code to make it 3/4 times faster.

Original Code
//How Do I turn the Caps Lock or Num Lock keys on/off?

procedure TMyForm.Button1Click(Sender: TObject);
Var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
if (KeyState[VK_NUMLOCK] = 0) then
KeyState[VK_NUMLOCK] := 1
else
KeyState[VK_NUMLOCK] := 0;
SetKeyboardState(KeyState);
end;

for caps lock substitute VK_CAPITAL for VK_NUMLOCK.

Modified Code

//How Do I turn the Caps Lock or Num Lock keys on/off?

procedure TMyForm.Button1Click(Sender: TObject);
Var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
KeyState[VK_NUMLOCK] = 1-Keystate[VK_NUMLOCK];
SetKeyboardState(KeyState);
end;

Tip 24

{ Is there a way to hide the Windows 95 Taskbar when i start my application made in delphi 2.01. When the user close the application the statusbar must become visible again.}

Method 1
1.First declare a variable of type HWND to store the Window handle of the
Windows 95 taskbar.

TForm1 = class(TForm)
…
private
hTaskBar: HWND;
…
end;

2.In your main form’s OnCreate() event handler, place some code that resembles:

hTaskBar := FindWindow(‘Shell_TrayWnd’, nil);
ShowWindow(hTaskBar, SW_HIDE);

3.Finally, in your main form’s OnDestroy() event handler, code something like:

ShowWindow(hTaskBar, SW_SHOW);

Method 2

PROCEDURE HideWin95TaskBar;
VAR
WindowHandle: hWnd;
BEGIN
{Hide the Windows 95 Taskbar}
WindowHandle := FindWindow(‘Shell_TrayWnd’, ”);
IF WindowHandle 0
THEN ShowWindow(WindowHandle, SW_HIDE)
END {HideWin95TaskBar};

PROCEDURE ShowWin95TaskBar;
VAR
WindowHandle: hWnd;
BEGIN
{Allow the Windows 95 Taskbar to appear}
WindowHandle := FindWindow(‘Shell_TrayWnd’, ”);
IF WindowHandle 0
THEN ShowWindow(WindowHandle, SW_RESTORE)
END {ShowWin95TaskBar};

Tip 25

//How do I capture the Screen?

type
LogPal = record
lpal : TLogPalette;
dummy:Array[1..255] of TPaletteEntry;
end;

procedure Tmainform.CapturebuttonClick(Sender: TObject);
var
InstanceID : THandle;
SysPal : LogPal;
image3: TImage;
hpal: HPalette;
imageDC: HDc;
imageCanvas: TCanvas;
imageRect: TRect;
visibility: word;
begin

imageDC := getDC( ? .handle)
{change the ? to whatever you want to capture.}
{application, panel1, screen, whatever has a handle will do}
syspal.lPal.palVersion:=$300;
syspal.lPal.palNumEntries:=256;
GetSystemPaletteEntries(imageDC,0,256,SysPal.lpal.PalpalEntry);
hpal:=CreatePalette(Syspal.lpal);
imageCanvas := TCanvas.Create;
imageCanvas.Handle := imageDC;
imageRect := Rect(0,0,Screen.Width,Screen.Height);
image3:=TImage.create(self);

with image3 do
begin
Height := your object height;
Width := your object width;
Canvas.CopyRect(imageRect,imageCanvas,imageRect);
ReleaseDC(GetDeskTopWindow,imageDC);
picture.bitmap.palette:=hpal;
end;

if savedialog1.execute then image3.picture.savetofile(savedialog1.filename);

image3.free;
releaseDC(GetDeskTopWindow, imageDC);
releaseDC(panel1.handle, imagecanvas.handle);
end;

//Second Method
//Capturing the screen can be done as follows:

function ScreenCapture:TBitmap;
var
ScreenDC: HDC;
ARect:TRect;
begin
Result := TBitmap.Create;
ARect := Rect(0,0,Screen.Width,Screen.Height);
with Result, ARect do
begin
Width := Right – Left;
Height := Bottom – Top;
ScreenDC := GetDC( 0 );
try
BitBlt( Canvas.Handle, 0, 0, Width, Height, ScreenDC,
Left, Top, SRCCOPY );
finally
ReleaseDC( 0, ScreenDC );
end;
end;
end;

Tip 26

// Calling Windows DialUp Connection Dialog
// To call Windows DialUp Connection Dialog, you can use WinExec, like this:
// I can’t get this bugger to work. If you do, please mail me any corrections – Toto

procedure TForm1.Button1Click(Sender: TObject);
begin
winexec(PChar(‘rundll32.exe rnaui.dll,RnaDial ‘+Edit1.Text),sw_show);
end;

Tip 27

{Conversion from ICO to BMP
From: [email protected] (Michael Vincze)}

var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile(‘c:picture.ico’);
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0, 0, Icon );
Bitmap.SaveToFile(‘c:picture.bmp’);
Icon.Free;
Bitmap.Free;
end;

Tip 28

{Converting the first letter of an EditBox to uppercase
To convert the first letter of an EditBox to uppercase this code can be used:}

procedure TForm1.Edit1Change(Sender: TObject);
var
OldStart : Integer;
begin
With Edit1 do
if Text ” then begin
OnChange := NIL;
OldStart := SelStart;
Text := UpperCase(Copy(Text,1,1))+LowerCase(Copy(Text,2,Length(Text)));
SelStart := OldStart;
OnChange := Edit1Change;
end;
end;

Tip 29

{Creating non rectangular windows (D2/D3)
To create a non rectangular window, you must create a Windows Region and use the API function SetWindowRgn, like
this (this works only in D2/D3): }

var
hR : THandle;
begin
{creates an Elliptic Region}
hR := CreateEllipticRgn(0,0,100,200);
SetWindowRgn(Handle,hR,True);
end;

Tip 30

{Detecting Windows Shutdown
To detect Windows Shutdown, you must trap WM_EndSession message. These steps should be taken: Declare a message handling procedure in your Form’s Private section: }

Procedure WMEndSession(var Msg : TWMEndSession); message WM_ENDSESSION;
//Add the procedure to the implementation section of your Unit:

procedure TForm1.WMEndSession(var Msg : TWMEndSession);
begin
if Msg.EndSession = TRUE then
ShowMessage(‘Windows is shutting down ‘ + #13 + ‘at ‘ +
FormatDateTime(‘c’, Now));
inherited;
end;

{Detecting Windows shutdown
When Windows is shutting down, it sends a WM_QueryEndSession to all open applications. To detect (and prevent shutdown), you must define a message handler to this message. Put this definition on the private section of the main form:}

procedure WMQueryEndSession(var Msg : TWMQueryEndSession); message
WM_QueryEndSession;

// And put this method in the implementation section of the unit:

procedure TForm1.WMQueryEndSession(var Msg : TWMQueryEndSession);
begin
if MessageDlg(‘Close Windows ?’, mtConfirmation, [mbYes,mbNo], 0) = mrNo then
Msg.Result := 0
else
Msg.Result := 1;
end;

Tip 31

//How can I tell from my Delphi Application if the maximize button is raised?

protected
procedure WMSize (var msg: TWMSize);
message WM_SIZE;
.
.
.
procedure TForm1.WMSize (var msg: TWMSize);
begin
inherited;
if (msg.SizeType = SIZE_MAXIMIZED) or (msg.SizeType = SIZE_RESTORED)
then …
end

(*I added this when I discovered that a form I’d placed off the screen was being brought into visible range when the user clicks Minimize All Windows on the taskbar, then clicks Undo Minimize All. Cripes, that isn’t clicking the command menu OR the minimize box–but the program detects it all the same.*)

Tip 32

//How I get delphi to display ascii values of each key that I press?

(*Supposing you have e Tedit (where the user inputs the text) and a TLabel (where you show the ASCII value), respectively Edit1 and Label1. Supply an event handler for OnKeyPress of Edit1. in the handle write :*)

var i:integer;
begin
Label1.caption := ”;
for i:=1 to length(edit1.text ) do
label1.caption := label1.caption+’ ‘+ord(edit1.text[i]);
end;

Tip 33

//How do I convert the coordinates from the “GetCursorPos” function to get the mouse position into two integer type variables.

var
Mouse: TPoint;
begin
if GetCursorPos(Mouse) then
Label1.Caption := ‘Mouse: x=’+IntToStr(Mouse.x)+’ y=’+IntToStr(Mouse.y);

Tip 34

//For hiding the program from the taskmanager i´ve found this code:

procedure TForm1.FormCreate(Sender: TObject);
var
dummy:integer;
begin
SystemParametersInfo(97, Word(True), @Dummy, 0);
ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
dummy:integer;
begin
SystemParametersInfo(97, Word(False), @Dummy, 0);
end;

Tip 35

(*How do I open a child form that is not otherwise accessible in my app by using a series of predefined key stroked — i.e. if user presses CTRL + private*)

//In the formkeydown of your application::

// Trap for Ctrl-F2 key combo

if ((ssCtrl in Shift) AND (Key = VK_F2)) then
begin
{Create your second form here}
end;

Tip 36

(*I need to know how to find out my own IP address when I’m connected to the
Internet, using D3.

Using winsock this piece of code will do what you want:*)

program NetInfo;

uses WinSock, Windows, SysUtils;

var
wVersionRequested : WORD;
wsaData : TWSAData;
p : PHostEnt;
s : array[0..128] of char;
p2 : pchar;
OutPut:array[0..100] of char;
begin
{Start up WinSock}
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);

{Get the computer name}
GetHostName(@s, 128);
p := GetHostByName(@s);

{Get the IpAddress}
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
StrPCopy(OutPut,’Hostname: ‘+Format(‘%s’, [p^.h_Name])+#10#13+
‘IPaddress: ‘+Format(‘%s’,[p2])
);
WSACleanup;
MessageBox(0,OutPut,’NetInfo’,mb_ok or mb_iconinformation);
end.

Tip 37

//Is there any function can detect the current status of the CDROM door, (that is, opened or closed)?

//You may use the MediaPlayer for this:
if MediaPlayer.Mode = mpOpen then
CDTrayOpen
else
CDTrayClosed;

//Another way is to trap WM_DEVICECHANGE message:

procedure WMDeviceChange(var Msg: TMsg); message WM_DEVICECHANGE;

procedure TForm1.WMDeviceChange(var Msg: TMsg);
begin
if Msg.wParam = DBT_DEVICEREMOVEPENDING then
// user has started to eject CD
// Tell Windows it’s OK.
Msg.Result := True;
end;

(*See also:
DBT_DEVICEARRIVAL
DBT_DEVICEREMOVECOMPLETE

Where is DBT_DEVICEREMOVEPENDING defined? — I can’t find any hint
of this (except in the help files…..)
Sorry, seems that there isn’t any declaration in Delphi. dbt_
constants are declared in dbt.h, in Delphi it would be:

const
DBT_QUERYCHANGECONFIG = $0017;
DBT_CONFIGCHANGED = $0018;
DBT_CONFIGCHANGECANCELED = $0019;
DBT_DEVICEARRIVAL = $8000;
DBT_DEVICEQUERYREMOVE = $8001;
DBT_DEVICEQUERYREMOVEFAILED = $8002;
DBT_DEVICEREMOVEPENDING = $8003;
DBT_DEVICEREMOVECOMPLETE = $8004;
DBT_DEVICETYPESPECIFIC = $8005;
DBT_USERDEFINED = $FFFF;
*)

Tip 38

(*
I would like to have the whole row in a listbox in say blue or red. But only certain rows. In addition I want to be able to select other rows by highlighting them.

Make sure the “MultiSelect” property in the Object Inspector (F11)
is set to true if you want to highlight more than one.
*)

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
R1: TRect;
I: integer;
S: string; // SubItem String;
D: string; // Direction String
begin
Canvas.Font := TListView( Sender ).Font;
R1 := Item.DisplayRect( drBounds );

// Add the all the column widths together …
for I := 0 to SubItem – 1 do
R1.Left := R1.Left + TListView( Sender ).Columns[ I ].Width;

with Sender do
begin
s:=Item.SubItems[ SubItem – 1 ];
d:=Item.SubItems[ 0 ];
<<‘ then <<<=== My Conditional for
<<<=== changing the colors
begin
Canvas.Brush.Color := clLtGray;
if SubItem = 1 then Canvas.FillRect( R1 );

Canvas.Font.Color := clBlack;
Canvas.Font.Style := [ fsBold ];

Canvas.Brush.Color := Color;
end
else
begin
Canvas.Font.Color := clRed;
end;
Canvas.TextOut(R1.Left, R1.Top, S );
end;
DefaultDraw := False;
end;

procedure TForm1.ListView1CustomDraw(Sender: TCustomListView;
const ARect: TRect; var DefaultDraw: Boolean);
begin
//
end;

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
// This must be present for CustomDrawSubItem to be called…
end;

Tip 39

(*This code creates a tray icon which when right-clicked, pops up a menu, and
when double-clicked, displays the main form. You simply need to create a new
Delphi project, drop a PopupMenu on the form and copy the event handler
code, copy the WndProc procedure and declaration code (including the
"procedure WndProc…
Begin
…
End;")
and copy the FormCreate code. You will have a system tray icon with your
app's icon, and its title as a tooltip.The form will not have a button on
the taskbar.

This code should work with D3, it works with D2 standard.
*)

unit MainForm;

interface

uses
Windows, ShellAPI, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
Menus;

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
ShowMainForm1: TMenuItem;
ExitApplication1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure ShowMainForm1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ExitApplication1Click(Sender: TObject);
private
{ Private declarations }
procedure WndProc(var Msg : TMessage); override;
public
{ Public declarations }
IconNotifyData : TNotifyIconData;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
showwindow(Application.Handle, SW_HIDE); {Comment out if you want a taskbar
button}
//Now set up the IconNotifyData structure so that it receives
//the window messages sent to the application and displays
//the application's tips
with IconNotifyData do begin
hIcon := Application.Icon.Handle;
uCallbackMessage := WM_USER + 1;
cbSize := sizeof(IconNotifyData);
Wnd := Handle;
uID := 100;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
end;
//Copy the Application's Title into the tooltip for the icon
StrPCopy(IconNotifyData.szTip, Application.Title);
//Add the Icon to the system tray and use the
//the structure and its values
Shell_NotifyIcon(NIM_ADD, @IconNotifyData);

end;

procedure TForm1.WndProc(var Msg : TMessage);
var p : TPoint;
begin
case Msg.Msg of
WM_USER + 1:
case Msg.lParam of
WM_RBUTTONDOWN:
begin
GetCursorPos(p);
PopupMenu1.Popup(p.x, p.y);
end;
WM_LBUTTONDBLCLK: Form1.Show;
end;
end;
inherited;
end;

procedure TForm1.ShowMainForm1Click(Sender: TObject);
begin
Form1.Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//when the user clicks the close button in the corner,
//only hide the form, not exit the app.
Action := caNone;
Form1.Hide;
end;

procedure TForm1.ExitApplication1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
Application.ProcessMessages;
Application.Terminate;
end;

end.

Tip 40

//An easy to use example of the implementation of the createprocess() API.

function TForm1.Shellprogram(sExeName,sCmdLine: PChar): boolean;
var
SI:TStartupInfo; PI: TProcessInformation;
begin
result:= true;
Fillchar(SI,SizeOf(SI),#00); Fillchar(PI,SizeOf(PI),#00);
with SI do begin
dwFlags:=STARTF_USESHOWWINDOW;
wShowWindow:=SW_SHOWMINIMIZED;
end;
If not CreateProcess(sExeName, sCmdLine, nil,nil,false,0,nil,nil,SI,PI) then
result:= false;
else
WaitForSingleObject(PI.hProcess,INFINITE);
end;

Supplied by Rudy

Rudy

(*Heres a proceedure for you all :o) – use it just like WinExec….
( ie. RunAProgram('c:windowsnotepad.exe', SW_SHOWNORMAL); )*)

procedure RunAProgram(CmmdRun: string; How2Show: Word);
var
pi : TProcessInformation;
si : TStartupInfo;
begin
with si do begin
cb := SizeOf(si);
lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwFlags := 0;
wShowWindow := How2Show;
cbReserved2 := 0;
lpReserved2 := nil;
end;
Chdir(ExtractFilePath(CmmdRun));
CreateProcess(nil, PChar(cmmdRun), nil, nil, False, 0, nil, nil, si, pi);
Chdir(ExtractFilePath(ParamStr(0)));
end;

Tip 41

From: "Stephen Brown"
Subject: Re: GetTimeZoneInformation

function UTCTimeNow: TDateTime;
begin
//UTC time = local time + Bias + Standard/Daylight bias
Result := Now + CurrentLocalBias;
end;

function CurrentLocalBias: TDateTime;
const
MinsInDay = 1440;
var
TZInfo: TTimeZoneInformation;
begin
//Get the between UTC and time for this locale and convert
//to TDateTime by dividing by MinsInDay
//NB: If local time is ahead of UTC, bias is negative
case GetTimeZoneInformation(TZInfo) of
TIME_ZONE_ID_DAYLIGHT:
Result := (TZInfo.Bias + TZInfo.DaylightBias) / MinsInDay;
TIME_ZONE_ID_STANDARD:
Result := (TZInfo.Bias + TZInfo.StandardBias) / MinsInDay;
TIME_ZONE_ID_UNKNOWN:
Result := TZInfo.Bias / MinsInDay;
else
Result := TZInfo.Bias / MinsInDay;
end;
end;

Another way: –

var
MyTZI : TTimeZoneInformation;
i : integer;
MyString : string[32];
MyTime : TDateTime;
begin
Time_ID := GetTimeZoneInformation(MyTZI);
with ListBox1.Items, MyTZI do begin
Add(‘Bias : ‘ + IntToStr(Bias));
for i := 0 to 31 do
MyString[i+1] := char(StandardName[i]);
Add(‘Standard Name : ‘ + MyString);
Add(‘Standard Bias : ‘ + IntToStr(StandardBias));
for i := 0 to 31 do
MyString[i+1] := char(DaylightName[i]);
Add(‘Daylight Name : ‘ + MyString);
Add(‘Daylight Bias : ‘ + IntToStr(DaylightBias));
with DaylightDate do
MyTime := EncodeDate(1999,
wMonth,
wDay)
+ EncodeTime(wHour, 0, 0, 0);
{end; with DaylightDate}
Add(‘Daylight Date : ‘ + FormatDateTime(‘d mmmm : hh00’,MyTime));
end; {with ListBox.Items}
end;

Tip 42

How can i send escape codes to the printer?

uses Printers;

procedure TForm1.Print1Click(Sender: TObject);
var
Line: Integer;
PrintText: TextFile; {declares a file variable}
begin
if PrintDialog1.Execute then
begin
AssignPrn(PrintText); {assigns PrintText to the printer}
Rewrite(PrintText); {creates and opens the output file}
Printer.Canvas.Font := Memo1.Font; {assigns Font settings to the canvas}
for Line := 0 to Memo1.Lines.Count – 1 do
Writeln(PrintText, Memo1.Lines[Line]); {writes the contents of the Memo1 to the printer object}

// now to send an escape code is as easy as
Writeln(PrintText, #27); // #27 is the code for Escape

// #27 is usually followed by your printers actual commands, e.g.. on my printer I use
Writeln(PrintText, #27 + ‘B1’);
// to turn BOLD print on,and
Writeln(PrintText, #27 + ‘B0’);
// to turn BOLD print off
// but these codes most likely wont work on your printer :), check your manual for the actual ones
CloseFile(PrintText); {Closes the printer variable}
end;
end;

Tip 43
How to force a window ‘always on top’ without interference with other programs

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure SetStayOnTop(OnTop: Boolean);
procedure WinMsg(var Msg: TMsg; var Handled: Boolean);
public
property StayOnTop: boolean read FStayOnTop write SetStayOnTop;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
WM_ALWAYSONTOP = 99;

procedure TForm1.FormCreate(Sender: TObject);
begin
inherited Create(AOwner);
Application.OnMessage := WinMsg;
AppendMenu(GetSystemMenu(Handle, False), MF_SEPARATOR, 0, ”);
AppendMenu(GetSystemMenu(Handle, False), MF_BYPOSITION, WM_ALWAYSONTOP,
‘Always on &Top’);
end;

procedure TForm1.WinMsg (var Msg: TMsg; var Handled: Boolean);
begin
if Msg.message = WM_SYSCOMMAND then
if Msg.WPARAM = WM_ALWAYSONTOP then
StayOnTop := not StayOnTop;
end;

procedure TForm1.SetStayOnTop(OnTop: Boolean);
begin
FStayOnTop := OnTop;

if FStayOnTop then begin
SetWindowPos(handle, HWND_TOPMOST, Left, Top, Width, Height, 0);
CheckMenuItem(GetSystemMenu(Handle, False), WM_ALWAYSONTOP, MF_CHECKED);
end
else begin
SetWindowPos(handle, HWND_NOTOPMOST, Left, Top, Width, Height, 0);
CheckMenuItem(GetSystemMenu(Handle, False), WM_ALWAYSONTOP,
MF_UNCHECKED);
end;
end;
end.

Tip 44

//I Need some assistance to figure out how to drop files from explorer onto my program.

If I remember well this can be done by some API functions.
You have to add unit ShellAPI ti your uses clause and the following
declaration to your form’s declaration:

procedure AppMessage(var Msg1 : TMsg; var Handled : Boolean);

…and these lines to your code…

procedure TForm1.FormCreate(Sender: TObject);
begin

DragAcceptFiles(Handle, True);
DragAcceptFiles(Application.Handle, True);
Application.OnMessage := AppMessage;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(Handle, False);
DragAcceptFiles(Application.Handle, False);
end;

procedure TForm1.AppMessage(var Msg1: TMsg; var Handled : Boolean);
var Buff : Array[0..MAX_PATH] of Char;
Count : Word;
begin
if (Msg1.message = WM_DropFiles) then begin
Handled := True;
for Count := 0 to DragQueryFile(Msg1.wParam, $FFFFFFFF, NIL, 0) – 1
do begin
DragQueryFile(Msg1.wParam,0,@Buff,SizeOf(Buff) – 1);
end;
DragFinish(Msg1.wParam);
end;
end;

//You also can use other handles than the one of your form, such as TListBoxes or something.

Tip 45
/*The following works for Win95 – should also work on 98. Most of the
knowledge is 3rd hand, so there may be some errors in the code, but it
does work.
Phil
Indeed it does – Tested & works fine – Toto – 6/5/99
*/

unit Usage;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Registry, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
PerfKey=’PerfStats’;
PerfStart=’StartStat’;
PerfRead=’StatData’;
PerfStop=’StopStat’;
PerfUsage=’KERNELCPUUsage’;

var r:TRegistry;

procedure TForm1.Timer1Timer(Sender: TObject);
type btype=record
case integer of
0:(bfr:array[0..3] of byte);
1:(bByte:byte;);
end;
var bufr:btype;
begin
// we have a key open – read the latest performance data
r.ReadBinaryData(PerfUsage,bufr,sizeof(bufr));
Label1.Caption:=IntToStr(bufr.bByte)+’ %CPU ‘;;
end;

var buf:array[0..3] of byte;
initialization
begin
// First create a registry item to access the performance data
r:=TRegistry.Create;
r.RootKey:=HKEY_DYN_DATA;
// before data is available, you must read the START key for the data you desire
r.OpenKeyReadOnly(PerfKey+PerfStart);
r.ReadBinaryData(PerfUsage,Buf,sizeof(buf));
// Now open the key for the data itself
r.CloseKey;
r.OpenKeyReadOnly(PerfKey+PerfRead);
end;

finalization
begin
// We’re done – open the key to close the data for updating
r.OpenKey(PerfKey+PerfStop,false);
r.ReadBinaryData(PerfUsage,Buf,sizeof(buf));
r.Free;
end;
end.

Tip 46

//A function to convert from Decimal to Hexadecimal

function DecToHex (Num : integer) : string;
begin
DecToHex := Format(‘%x’,[Num]);
end; { DecToHex }

Tip 47

Neil Cowburn wrote in message
> Does anyone have an ideas on how to open a text file into a RichEdit
> component and immediately apply some formatting to the text if, for
> example, exists between { and }?

var beginpos,endpos:integer;
begin
if ((POS(‘{‘,RICHEDIT1.TEXT)>0) and (Pos(‘}’,RICHEDIT1.TEXT)>0)) then
///are both braces present?
begin
beginpos:=pos(‘{‘,richedit1.text); /// start select
Endpos:=Pos(‘}’,richedit1.text); ////end select
Richedit1.selstart:=beginpos;
Richedit1.sellength:=(Endpos-beginpos); ////calculate selection length
Richedit1.SelAttributes.color:=clblue; /// apply selection attributes
Richedit1.selAttributes.Size:=18;
end;
end;