Direct Printing With Delphi

Biar tidak terjadi kesalahpahaman, direct printing yang saya maksud adalah, suatu proses cetak/print secara langsung(direct) ke LPT (Port Printer), khususnya Teks yang di print menggunakan Printer Dotmatrix

Tujuannya adalah untuk kecepatan proses print, yang seringnya diimplementasikan untuk cetak struk/nota, maupun laporan(Text Base Reporting).

Lebih jelasnya, lihat gambar berikut:

'

Diatas merupakan contoh direct printing melalui Command Prompt Windows System.

Bagaimana jika dilakukan melalui pemrograman Delphi?

Ya, Command diatas disimpan dalam batch file ( .cmd / .bat ),
terus batch file tersebut dijalankan di Delphi perintah ShellExecute(), bisa kan.

Dengan cara itu bisa dilakukan, tapi disini kita akan coba implementasikan secara internal(tidak melalui perantara batch-file)

Perhatikan prosedure kode ini:

procedure TextPrint(lst:TStringList);
var
  F: TextFile;
begin
  AssignFile(F,'LPT1');
  Rewrite(F);
  Write(F,lst.Gettext);
  CloseFile(F);
end;

dan pemanggilannya dengan cara:

procedure TForm1.btn3Click(Sender: TObject);
var
  infoNota : TStringlist;
begin
  infoNota := TStringList.Create;
  try
    infoNota.Add('isinya teks, asumsi nota');
    infoNota.Add('isinya baris kedua');
    infoNota.Add('isinya baris ketiga, dst...');

    TextPrint(infoNota);
  finally
    infoNota.Free;
  end;
end;

Contoh diatas diatas akan mencetak semua teks(string) yang ada di dalam variabel infoNota(TStringlist).

Read more »

Generate Random String (Bikin Password Acak)

Saat itu lagi ada keperluan untuk bikin fungsi untuk generate random string, yang rencananya mau digunakan untuk random password.

Seperti biasa mencoba searching dulu di internet, siapa tahu udah ada yang bikin.
Akhirnya saya tertarik dengan salah satu trik berikut

Berikut Kode fungsi:

function GeneratePWDSecutityString: string;
const
  Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
var
  i, x: integer;
  s1, s2: string;
begin
  s1 := Codes64;
  s2 := '';
  for i := 0 to 15 do
  begin
    x  := Random(Length(s1));
    x  := Length(s1) - x;
    s2 := s2 + s1[x];
    s1 := Copy(s1, 1,x - 1) + Copy(s1, x + 1,Length(s1));
  end;
  Result := s2;
end;

Contoh pemanggilannya:

procedure TForm1.btn2Click(Sender: TObject);
begin
  Edit1.Text := GeneratePWDSecutityString();
end;

Fungsi diatas akan generate random string dengan panjang 15 karakter,

Silahkan dimodifikasi sesuai kebutuhan.

Read more »

manage, control NT-Services

unit ServiceManager; interface uses SysUtils, Windows, WinSvc; type TServiceManager = class private { Private declarations } ServiceControlManager: SC_Handle; ServiceHandle: SC_Handle; protected function DoStartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; public { Public declarations } function Connect(MachineName: PChar = nil; DatabaseName: PChar = nil; Access: DWORD = SC_MANAGER_ALL_ACCESS): Boolean; // Access may be SC_MANAGER_ALL_ACCESS function OpenServiceConnection(ServiceName: PChar): Boolean; function StartService: Boolean; overload; // Simple start function StartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; overload; // More complex start function StopService: Boolean; procedure PauseService; procedure ContinueService; procedure ShutdownService; procedure DisableService; function GetStatus: DWORD; function ServiceRunning: Boolean; function ServiceStopped: Boolean; end; implementation { TServiceManager } function TServiceManager.Connect(MachineName, DatabaseName: PChar; Access: DWORD): Boolean; begin Result := False; { open a connection to the windows service manager } ServiceControlManager := OpenSCManager(MachineName, DatabaseName, Access); Result := (ServiceControlManager <> 0); end; function TServiceManager.OpenServiceConnection(ServiceName: PChar): Boolean; begin Result := False; { open a connetcion to a specific service } ServiceHandle := OpenService(ServiceControlManager, ServiceName, SERVICE_ALL_ACCESS); Result := (ServiceHandle <> 0); end; procedure TServiceManager.PauseService; var ServiceStatus: TServiceStatus; begin { Pause the service: attention not supported by all services } ControlService(ServiceHandle, SERVICE_CONTROL_PAUSE, ServiceStatus); end; function TServiceManager.StopService: Boolean; var ServiceStatus: TServiceStatus; begin { Stop the service } Result := ControlService(ServiceHandle, SERVICE_CONTROL_STOP, ServiceStatus); end; procedure TServiceManager.ContinueService; var ServiceStatus: TServiceStatus; begin { Continue the service after a pause: attention not supported by all services } ControlService(ServiceHandle, SERVICE_CONTROL_CONTINUE, ServiceStatus); end; procedure TServiceManager.ShutdownService; var ServiceStatus: TServiceStatus; begin { Shut service down: attention not supported by all services } ControlService(ServiceHandle, SERVICE_CONTROL_SHUTDOWN, ServiceStatus); end; function TServiceManager.StartService: Boolean; begin Result := DoStartService(0, ''); end; function TServiceManager.StartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; begin Result := DoStartService(NumberOfArgument, ServiceArgVectors); end; function TServiceManager.GetStatus: DWORD; var ServiceStatus: TServiceStatus; begin { Returns the status of the service. Maybe you want to check this more than once, so just call this function again. Results may be: SERVICE_STOPPED SERVICE_START_PENDING SERVICE_STOP_PENDING SERVICE_RUNNING SERVICE_CONTINUE_PENDING SERVICE_PAUSE_PENDING SERVICE_PAUSED } Result := 0; QueryServiceStatus(ServiceHandle, ServiceStatus); Result := ServiceStatus.dwCurrentState; end; procedure TServiceManager.DisableService; begin { Implementation is following... } end; function TServiceManager.ServiceRunning: Boolean; begin Result := (GetStatus = SERVICE_RUNNING); end; function TServiceManager.ServiceStopped: Boolean; begin Result := (GetStatus = SERVICE_STOPPED); end; function TServiceManager.DoStartService(NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean; var err: integer; begin Result := WinSvc.StartService(ServiceHandle, NumberOfArgument, ServiceArgVectors); end; end.

Read more »

Shuffle strings...

So you don't like ordered / sorted string lists? Well, whatever the reason you have behind shuffling a string list, the following ShuffleStrings() function will do it for you.
All you have to do is pass the string list (type of TStrings) you want to shuffle and the intensity. "Intensity" is just a number between 1 and the number of strings in your string list. ShuffleStrings() function will use this value to find out how many times it should shuffle. If you're not sure about this number, simply pass 0, and ShuffleStrings() will use the count of strings in your string list.

procedure ShuffleStrings( sl : TStrings; nIntensity : integer ); var n1, n2, n3 : integer; s1 : string; begin if(0 = nIntensity)then begin nIntensity := sl.Count; end else if(nIntensity > sl.Count)then begin nIntensity := sl.Count; end; Randomize; for n1 := 1 to nIntensity do begin n2 := Random( nIntensity ); n3 := Random( nIntensity ); s1 := sl.Strings[n3]; sl.Strings[n3] := sl.Strings[n2]; sl.Strings[n2] := s1; end; end;

Example call:

(assuming that you want to shuffle items in your ListBox named listbox1)

ShuffleStrings( ListBox1.Items, 0 );

Read more »

Setting Windows wallpaper revisited (with new tricks!)

We demonstrated how to set Windows' wallpaper from your application using our previously featured SetWallpaper() function. Since then we've improved it to support setting the exact position of the wallpaper and the ability to resize the wallpaper to fit the screen.

uses Registry, WinProcs, SysUtils; const // WallPaperStyles WPS_Tile = 0; WPS_Center = 1; WPS_SizeToFit = 2; WPS_XY = 3; // // sWallpaperBMPPath // - path to a BMP file // // nStyle // - any of the above WallPaperStyles // // nX, nY // - if the nStyle is set to WPS_XY, // nX and nY can be used to set the // exact position of the wall paper // procedure SetWallpaperExt( sWallpaperBMPPath : string; nStyle, nX, nY : integer ); var reg : TRegIniFile; s1 : string; X, Y : integer; begin // // change registry // // HKEY_CURRENT_USER\ // Control Panel\Desktop // TileWallpaper (REG_SZ) // Wallpaper (REG_SZ) // WallpaperStyle (REG_SZ) // WallpaperOriginX (REG_SZ) // WallpaperOriginY (REG_SZ) // reg := TRegIniFile.Create( 'Control Panel\Desktop' ); with reg do begin s1 := '0'; X := 0; Y := 0; case nStyle of WPS_Tile : s1 := '1'; WPS_Center: nStyle := WPS_Tile; WPS_XY : begin nStyle := WPS_Tile; X := nX; Y := nY; end; end; WriteString( '', 'Wallpaper', sWallpaperBMPPath ); WriteString( '', 'TileWallpaper', s1 ); WriteString( '', 'WallpaperStyle', IntToStr( nStyle ) ); WriteString( '', 'WallpaperOriginX', IntToStr( X ) ); WriteString( '', 'WallpaperOriginY', IntToStr( Y ) ); end; reg.Free; // // let everyone know that we // changed a system parameter // SystemParametersInfo( SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE ); end;

Here are two examples on how to call the above SetWallpaperExt() function.

// set wallpaper to winnt.bmp and
  // stretch it to fit the screen
  SetWallpaperExt(
    'c:\winnt\winnt.bmp',
    WPS_SizeToFit, 0, 0 );

  // set the wallpaper origin
  // to (10, 200)
  SetWallpaperExt(
    'c:\winnt\winnt.bmp',
    WPS_XY, 10, 200 );

Read more »

Moving to the next tab stop

You can make your application focus the next control (in the tab order) on your form by using the SelectNext() method.
To move to the next control:

SelectNext( ActiveControl as TWinControl, True, True );

To move to the previous control:

SelectNext( 
  ActiveControl as TWinControl, 
  False, 
  True );

Read more »

Convert font attributes to a string and vise versa

Sometimes it's necessary to represent attributes of certain objects as strings. For example, if your program allows the user to change fonts and you want to save these customized font attributes in the registry, you might want to save these attributes as strings.
Following two functions will let you convert a font object's attributes into a string and then convert formatted string back into font attributes:

const
  csfsBold      = '|Bold';
  csfsItalic    = '|Italic';
  csfsUnderline = '|Underline';
  csfsStrikeout = '|Strikeout';

//
// Expected format:
//   "Arial", 9, [Bold], [clRed]
//
procedure StringToFont(
  sFont : string; Font : TFont );
var
  p      : integer;
  sStyle : string;
begin
  with Font do
  begin
    // get font name
    p    := Pos( ',', sFont );
    Name :=
      Copy( sFont, 2, p-3 );
    Delete( sFont, 1, p );

    // get font size
    p    := Pos( ',', sFont );
    Size :=
      StrToInt( Copy( sFont, 2, p-2 ) );
    Delete( sFont, 1, p );

    // get font style
    p      := Pos( ',', sFont );
    sStyle :=
      '|' + Copy( sFont, 3, p-4 );
    Delete( sFont, 1, p );

    // get font color
    Color :=
      StringToColor(
        Copy( sFont, 3,
          Length( sFont ) - 3 ) );

    // convert str font style to
    // font style
    Style := [];

    if( Pos( csfsBold,
          sStyle ) > 0 )then
      Style := Style + [ fsBold ];

    if( Pos( csfsItalic,
          sStyle ) > 0 )then
      Style := Style + [ fsItalic ];

    if( Pos( csfsUnderline,
          sStyle ) > 0 )then
      Style := Style + [ fsUnderline ];

    if( Pos( csfsStrikeout,
          sStyle ) > 0 )then
      Style := Style + [ fsStrikeout ];
  end;
end;

//
// Output format:
//   "Aril", 9, [Bold|Italic], [clAqua]
//
function FontToString(
  Font : TFont ) : string;
var
  sStyle : string;
begin
  with Font do
  begin
    // convert font style to string
    sStyle := '';

    if( fsBold in Style )then
      sStyle := sStyle + csfsBold;

    if( fsItalic in Style )then
      sStyle := sStyle + csfsItalic;

    if( fsUnderline in Style )then
      sStyle := sStyle + csfsUnderline;

    if( fsStrikeout in Style )then
      sStyle := sStyle + csfsStrikeout;

    if( ( Length( sStyle ) > 0 ) and
        ( '|' = sStyle[ 1 ] ) )then
    begin
      sStyle :=
        Copy( sStyle, 2,
          Length( sStyle ) - 1 );
    end;

    Result := Format(
      '"%s", %d, [%s], [%s]',
      [ Name,
        Size,
        sStyle,
        ColorToString( Color ) ] );
  end;
end;

Read more »

How to put a delay

Looking for a way to delay the execution of your program? Well, delay() function is gone, but Sleep() and SleepEx() Windows functions are here to stay:
For example, if you want to delay your program execution for 10 seconds, call Windows API function Sleep() with 10*1000 (convert seconds to milliseconds):

Sleep( 10000 );

Read more »

Find out if the CAPS LOCK is on

Here's a function you can use to find out if the CAPS LOCK is on:

function IsCapsLockOn : boolean;
begin
  Result := 0 <>
    (GetKeyState(VK_CAPITAL) and $01);
end;

Read more »

Control AutoPlay (dynamically) from your program

You know how to stop Windows' [CD-ROM] AutoPlay from occurring by holding SHIFT or by changing Windows settings. Here's how to detect whether an AutoPlay is about to occur from your application and then either allowing or stopping it.
We're going to ask Windows to send us a message when the AutoPlay is about to occur. In order to catch this message, first of all we have to override our default Windows message handler -- "WndProc()." You can do this by inserting the following code in your form's (named "Form1" for example) public declarations section:

MsgID_QueryCancelAutoPlay : Word; procedure WndProc( var Msg : TMessage ); override;

Now, type in the following code in the "implementation" section (again, assuming that your form is named "Form1") to actually handle the Windows messages. As you can see, we're only interested in catching "QueryCancelAutoPlay" messages, so we'll let the default (or the inherited) "WndProc()" handle all other messages.

procedure TForm1. WndProc( var Msg : TMessage ); begin if( MsgID_QueryCancelAutoPlay = Msg.Msg )then begin // set Msg.Result // to 1 to stop AutoPlay or // to 0 to continue with AutoPlay Msg.Result := 1; end else inherited WndProc( Msg ); end;

Finally, we have to ask Windows to actually send a "QueryCancelAutoPlay" message to our message handler by inserting the following code in the "FormCreate()" event (click on your form, go to the "events" tab in the "Object Inspector" and double click on "Create"):

MsgID_QueryCancelAutoPlay
  := RegisterWindowMessage(
       'QueryCancelAutoPlay' );

Read more »

Search for help...

Looking for a way to open your application's help file to it's search window? All you have to do is pass the name (and the path) of your help file and the string you want to search for to the following HelpSearch() function:

procedure HelpSearch( sHelpFName, sSearchKey : string ); var pc : PChar; begin Application.HelpFile := sHelpFName; pc := StrAlloc( Length( sSearchKey ) + 1 ); StrPCopy( pc, sSearchKey ); Application.HelpCommand( HELP_PARTIALKEY, LongInt( pc ) ); StrDispose( pc ); end;

For example:

HelpSearch( 'DELPHI.HLP', 'colors' );

If you just want to open the "search" window without specifying a search string:

HelpSearch( 'DELPHI.HLP', '' );

Read more »

Detecting CD-ROM disc and other disk change using serial numbers

A simple way to find out if a disc (or disk) was changed is to check its volume serial number. For example, you can use the following function to get the volume serial number of a disc. If your CD-ROM drive name is E:, "GetDiskVolSerialID( 'E' )" will return the serial number we're looking for. You can then store this number in your program and compare it to the serial number returned by the next call to "GetDiskVolSerialID()" function. If they are different, you can safely assume that the disc was changed.

function GetDiskVolSerialID(
  cDriveName : char ) : DWord;
var
  dwTemp1,
  dwTemp2 : DWord;
begin
  GetVolumeInformation(
    PChar( cDriveName + ':' ),
    Nil,
    0,
    @Result,
    dwTemp2,
    dwTemp2,
    Nil,
    0
    );
end;

Listing #1 : Delphi code. Download diskvol (0.29 KB).

If need to display the serial number as it's displayed by most original DOS and Windows programs, simply convert the number returned by "GetDiskVolSerialID()" to a hex string:

MessageDlg(
  'Serial number: ' +
  Format( '%X', [ GetDiskVolSerialID( 'E' ) ] ),
  mtInformation, [mbOk], 0 );

Listing #2 : Delphi code. Download diskvol2 (0.24 KB).

Read more »

Do you have Hot Keys?

Defining and handling hot keys is very easy:

• Set your form's "KeyPreview" property to "True."
  
  

  KeyPreview := True;

  
  
• Define your form's "KeyDown" event. For example, following code will catch any CTRL+F1 [hot] key presses:
  
  

  procedure TForm1.FormKeyDown( Sender: TObject; var Key: Word; Shift: TShiftState ); begin if( (ssCtrl in Shift) and (Key = VK_F1) )then begin // do your thing here... MessageBox( Handle, 'F1 pressed!', 'Hot Key', MB_OK ); end; end;

Read more »

GlobalMemoryStatus() to the rescue

"GetFreeSystemResources()" Win16 API function is no longer supported in Win32 API, but you can use "GlobalMemoryStatus()" to get even more memory related information:

var
  ms : TMemoryStatus;
begin
  ms.dwLength := SizeOf( ms );
  GlobalMemoryStatus( ms );
  with ms do
  begin
    //
    // now you can use any of
    // the following parameters
    //

    // percent of memory in use
    {dwMemoryLoad}

    // bytes of physical memory
    {dwTotalPhys}

    // free physical memory bytes
    {dwAvailPhys}

    // bytes of paging file
    {dwTotalPageFile}

    // free bytes of paging file
    {dwAvailPageFile}

    // user bytes of address space
    {dwTotalVirtual}

    // free user bytes
    {dwAvailVirtual}
  end;
end;

Listing #1 : Delphi code. Download memstat (0.38 KB).

For example:

function GetMemoryTotalPhys : DWord;
var
  ms : TMemoryStatus;
begin
  ms.dwLength := SizeOf( ms );
  GlobalMemoryStatus( ms );
  Result := ms.dwTotalPhys;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MessageDlg(
    'total physical memory: ' +
    IntToStr( GetMemoryTotalPhys )
    , mtInformation, [mbOk], 0 );
end;

Listing #2 : Delphi code. Download memtotal (0.36 KB).

Read more »

Splash windows for all your special occations

Splash windows can be used to dress up many parts of your application. You could use them at the initialization of your application to display copyright and other information, or you could use them to display "please wait messages" while your application is in the middle of long operations. You could also use variations of "splash windows" to display floating tool bars and other properties. Well, you get the picture. Here's how to create a simple splash window dynamically:

var WaitForm : TForm; WaitLabel : TLabel; function WaitStart( TheParent : TComponent; sMsg : string ) : boolean; begin Result := False; // create our message form // only if it's not already // created if( Nil = WaitForm )then begin WaitForm := TForm.Create( TheParent ); with WaitForm do begin Position := poScreenCenter; Width := 500; Height := 25; // create the message label WaitLabel := TLabel.Create( WaitForm ); with WaitLabel do begin Align := alClient; Alignment := taCenter; Font.Height := -30; ParentFont := False; Caption := sMsg; Parent := WaitForm; end; // hide the title bar SetWindowLong( Handle, GWL_STYLE, GetWindowLong( Handle, GWL_STYLE ) and not WS_CAPTION ); ClientHeight := Height; Show; Update; end; Result := True; end; end; procedure WaitSetMsg( sMsg : string ); begin WaitLabel.Caption := sMsg; WaitForm.Refresh; end; function WaitEnd : boolean; begin Result := False; if( Nil <> WaitForm )then begin WaitForm.Hide; WaitForm.Free; WaitForm := Nil; Result := True; end; end;

Here's a sample on how to use above splash windows functions:

// start the splash window
  WaitStart( Self {or Nil},
    'Please wait...' );

  // start the long operation...
  WaitSetMsg( 'Almost done!...' );

  // continue the operation...
  WaitSetMsg( 'One more second...' );

  // complete the operation
  WaitSetMsg( 'Done.' );

  // wait a bit here if you want users
  // to see the "done." message

  // close the splash window
  WaitEnd;

Read more »

Count your words

Looking for a simple function that would return the number of words, anything separated by spaces, in a specified string? Following function will do just that using pointers to strings. If you're new to string handling/parsing you might want to pay close attention to how the following function sets up a pointer to the original string and then travel through it, rather than using s[ 1 ], s[ 2 ], s[ 3 ], etc.

 

function WordsCount( s : string )
  : integer;
var
  ps       : PChar;
  nSpaces,
  n        : integer;
begin
  n  := 0;
  s  := s + #0;
  ps := @s[ 1 ];
  while( #0 <> ps^ ) do
  begin
    while((' ' = ps^)and(#0 <> ps^)) do
    begin
      inc( ps );
    end;

    nSpaces := 0;
    while((' ' <> ps^)and(#0 <> ps^))do
    begin
      inc( nSpaces );
      inc( ps );
    end;
    if ( nSpaces > 0 ) then
    begin
      inc( n );
    end;
  end;
  Result := n;
end;

Listing #1 : Delphi code. Download wrdcount (0.35 KB).

Read more »

Calling CreateProcess() the easy way

If you look up the CreateProcess() function in Win32 help, you'll notice that there are more than three dozen parameters that you can optionally setup before calling it. The good news is that you have to setup only a small number of those parameters to make a simple CreateProcess() call as demonstrated in the following function:

function CreateProcessSimple( sExecutableFilePath : string ) : string; var pi: TProcessInformation; si: TStartupInfo; begin FillMemory( @si, sizeof( si ), 0 ); si.cb := sizeof( si ); CreateProcess( Nil, // path to the executable file: PChar( sExecutableFilePath ), Nil, Nil, False, NORMAL_PRIORITY_CLASS, Nil, Nil, si, pi ); // "after calling code" such as // the code to wait until the // process is done should go here CloseHandle( pi.hProcess ); CloseHandle( pi.hThread ); end;

Now, all you have to do is call CreateProcessSimple(), let's say to run Windows' Notepad:

CreateProcessSimple( 'notepad' );

Read more »

Better way to display [error] messages

If you display more than a few [error] messages in your application, using a simple method such as the following may not be the best approach:

Application.MessageBox( 'File not found', 'Error', mb_OK );

Above method of displaying errors will make it harder to modify actual messages since they are distributed all over your application source code. It may be better to have a "centralized" function that can display error messages, or better yet, a centralized function that can display replaceable error messages. Consider the following example:

type cnMessageIDs = ( nMsgID_NoError, nMsgID_FileNotFound, nMsgID_OutOfMemory, nMsgID_ExitProgram // list your other error // IDs here... ); const csMessages_ShortVersion : array [ Low( cnMessageIDs ).. High( cnMessageIDs ) ] of PChar = ( 'No error', 'File not found', 'Out of memory', 'Exit program?' // other error messages... ); csMessages_DetailedVersion : array [ Low( cnMessageIDs ).. High( cnMessageIDs ) ] of PChar = ( 'No error; please ignore!', 'File c:\config.sys not found.'+ 'Contact your sys. admin.', 'Out of memory. You need '+ 'at least 4M for this function', 'Exit program? '+ 'Save your data first!' // other error messages... ); procedure MsgDisplay( cnMessageID : cnMessageIDs ); begin // set this to False to display // short version of the messages if( True )then Application.MessageBox( csMessages_DetailedVersion[ cnMessageID ], 'Error', mb_OK ) else Application.MessageBox( csMessages_ShortVersion[ cnMessageID ], 'Error', mb_OK ); end;

Now, whenever you want to display an error message, you can call the MsgDisplay() function with the message ID rather than typing the message itself:

MsgDisplay( nMsgID_FileNotFound );

MsgDisplay() function will not only let you keep all your error messages in one place -- inside one unit for example, but it will also let you keep different sets of error messages -- novice/expert, debug/release, and even different sets for different languages.

Read more »