The Nine

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:=(b60)+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 :=(loop60)+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 HKEYCLASSESROOT. Say yourextension in “.ext”, then the first key you add is the extension itself: HKEYCLASSESROOT\ .ext\ and set the “default” string value of this key to an “internal name” for your file type – for example MyApp.Document: HKEYCLASSESROOT\ .ext\ Default = “MyApp.Document” You then create another key with this name: HKEYCLASSESROOT\ 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: HKEYCLASSESROOT\ MyApp.Document\ shell\ open\ command\ Default = “C:\myapp\myapp.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:\windows\notepad.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:\myapps\myapp.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:\windows\system’} 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,SWSHOWNORMAL); {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’, ‘https://www.yoursite.com’, nil, nil, SWNORMAL); 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(VKRETURN) then begin Perform(WMNEXTDLGCTL,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,GWWHINSTANCE) = 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, GWWHINSTANCE) = 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,SWRestore) 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 MINOERROR = 0; MIFAILSUBCLASS = 1; MIFAILCREATEMUTEX = 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, swrestore); 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, GWLWNDPROC, Longint(@NewWndProc))); { Set appropriate error flag if error condition occurred } if WProc = Nil then MIError := MIError or MIFAILSUBCLASS; end; procedure DoFirstInstance; begin SubClassApplication; MutHandle := CreateMutex(Nil, False, UniqueAppStr); if MutHandle = 0 then MIError := MIError or MIFAILCREATEMUTEX; 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 := BSMAPPLICATIONS; BroadCastSystemMessage(BSFIGNORECURRENTTASK or BSFPOSTMESSAGE, @BSMRecipients, MessageID, 0, 0); end; Function InitInstance : Boolean; begin MutHandle := OpenMutex(MUTEXALLACCESS, 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, SWShowNormal); 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, SWHide); Application.ShowMainForm:=FALSE; end; finalization begin if WProc <> Nil then { Restore old window procedure } SetWindowLong(Application.Handle, GWLWNDPROC, 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(EWRestartWindows, 0) then ShowMessage(‘An application refused to terminate’); end; Tip 15 procedure TMainForm.RebootSystemBtnClick(Sender: TObject); begin if not ExitWindows(EWRebootSystem, 0) then ShowMessage(‘An application refused to terminate’); end; Tip 16 Turn monitor off : SendMessage(Application.Handle, WMSYSCOMMAND, SCMONITORPOWER, 0); Turn monitor on : SendMessage(Application.Handle, WMSYSCOMMAND, SCMONITORPOWER, -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, SWHIDE); 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, SWNORMAL); 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, kvk@estpak.ee]} //////////////////////////////////////////////// // 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, oliver@zip.com.au] } 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, knowhow@compos.com.br] 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[VKNUMLOCK] = 0) then KeyState[VKNUMLOCK] := 1 else KeyState[VKNUMLOCK] := 0; SetKeyboardState(KeyState); end; for caps lock substitute VKCAPITAL for VKNUMLOCK. 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[VKNUMLOCK] = 1-Keystate[VKNUMLOCK]; 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(‘ShellTrayWnd’, nil); ShowWindow(hTaskBar, SWHIDE); 3.Finally, in your main form’s OnDestroy() event handler, code something like: ShowWindow(hTaskBar, SWSHOW); Method 2 PROCEDURE HideWin95TaskBar; VAR WindowHandle: hWnd; BEGIN {Hide the Windows 95 Taskbar} WindowHandle := FindWindow(‘ShellTrayWnd’, ”); IF WindowHandle <> 0 THEN ShowWindow(WindowHandle, SWHIDE) END {HideWin95TaskBar}; PROCEDURE ShowWin95TaskBar; VAR WindowHandle: hWnd; BEGIN {Allow the Windows 95 Taskbar to appear} WindowHandle := FindWindow(‘ShellTrayWnd’, ”); IF WindowHandle <> 0 THEN ShowWindow(WindowHandle, SWRESTORE) 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),swshow); end; Tip 27 {Conversion from ICO to BMP From: vincze@ti.com (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 WMEndSession message. These steps should be taken: Declare a message handling procedure in your Form’s Private section: } Procedure WMEndSession(var Msg : TWMEndSession); message WMENDSESSION; //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 WMQueryEndSession 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 WMQueryEndSession; // 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 WMSIZE; . . . procedure TForm1.WMSize (var msg: TWMSize); begin inherited; if (msg.SizeType = SIZEMAXIMIZED) or (msg.SizeType = SIZERESTORED) 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,SWHIDE); 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 = VKF2)) 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 := iNetntoa(PInAddr(p^.haddrlist^)^); StrPCopy(OutPut,’Hostname: ‘+Format(‘%s’, [p^.hName])+#10#13+ ‘IPaddress: ‘+Format(‘%s’,[p2]) ); WSACleanup; MessageBox(0,OutPut,’NetInfo’,mbok or mbiconinformation); 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 WMDEVICECHANGE message: procedure WMDeviceChange(var Msg: TMsg); message WMDEVICECHANGE; procedure TForm1.WMDeviceChange(var Msg: TMsg); begin if Msg.wParam = DBTDEVICEREMOVEPENDING then // user has started to eject CD // Tell Windows it’s OK. Msg.Result := True; end; (See also: DBTDEVICEARRIVAL DBTDEVICEREMOVECOMPLETE Where is DBTDEVICEREMOVEPENDING 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 DBTQUERYCHANGECONFIG = $0017; DBTCONFIGCHANGED = $0018; DBTCONFIGCHANGECANCELED = $0019; DBTDEVICEARRIVAL = $8000; DBTDEVICEQUERYREMOVE = $8001; DBTDEVICEQUERYREMOVEFAILED = $8002; DBTDEVICEREMOVEPENDING = $8003; DBTDEVICEREMOVECOMPLETE = $8004; DBTDEVICETYPESPECIFIC = $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 ]; <<<=== if Copy( d, 1, 1 ) = '>‘ 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 ) - use it just like WinExec.... ( ie. RunAProgram('c:\windows\notepad.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=’KERNEL\CPUUsage’; 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;