Better in Time – Leona Lewis

February 17, 2009


Sending an image to the printer

February 12, 2009
Question:

How can I reliably print an image to the printer?

Answer:

Sending a bitmap based on the screen to the printer is an invalid operation that will usually fail, unless the print driver has been designed to detect this error condition and compensate for the error. This means you should use the VCL canvas methods Draw, StretchDraw,CopyRect, BrushCopy, and the like to transfer a bitmap to the printer, since the underlying bitmap is based on the screen, and is device dependent. The only way to reliably print an image is to use DIBs (Device Independent Bitmaps). Getting a valid DIB can be difficult, as there are many Windows API functions that must be used correctly. Further, many video drivers incorrectly fill in the DIB structure in regards to the color table in the DIB.

The following example demonstrates an attempt to overcome some of these problems and limitations. The example should compile successfully under all versions of Delphi/C++ Builder.

The core function in the example, BltTBitmapAsDib(), accepts a handle to a device to image to, the x and y coordinates you wish the bitmap to be imaged at, the width and height you wish the image to be (stretching and shrinking is acceptable), and the TBitmap you wish to image.

Example:

uses Printers;

type

PPalEntriesArray = ^TPalEntriesArray; {for palette re-construction}

TPalEntriesArray = array[0..0] of TPaletteEntry;

procedure BltTBitmapAsDib(DestDc : hdc; {Handle of where to blt}

x : word; {Bit at x}

y : word; {Blt at y}

Width : word; {Width to stretch}

Height : word; {Height to stretch}

bm : TBitmap); {the TBitmap to Blt}

var

OriginalWidth :LongInt; {width of BM}

dc : hdc; {screen dc}

IsPaletteDevice : bool; {if the device uses palettes}

IsDestPaletteDevice : bool; {if the device uses palettes}

BitmapInfoSize : integer; {sizeof the bitmapinfoheader}

lpBitmapInfo : PBitmapInfo; {the bitmap info header}

hBm : hBitmap; {handle to the bitmap}

hPal : hPalette; {handle to the palette}

OldPal : hPalette; {temp palette}

hBits : THandle; {handle to the DIB bits}

pBits : pointer; {pointer to the DIB bits}

lPPalEntriesArray : PPalEntriesArray; {palette entry array}

NumPalEntries : integer; {number of palette entries}

i : integer; {looping variable}

begin

{If range checking is on – lets turn it off for now}

{we will remember if range checking was on by defining}

{a define called CKRANGE if range checking is on.}

{We do this to access array members past the arrays}

{defined index range without causing a range check}

{error at runtime. To satisfy the compiler, we must}

{also access the indexes with a variable. ie: if we}

{have an array defined as a: array[0..0] of byte,}

{and an integer i, we can now access a[3] by setting}

{i := 3; and then accessing a[i] without error}

{$IFOPT R+}

{$DEFINE CKRANGE}

{$R-}

{$ENDIF}

{Save the original width of the bitmap}

OriginalWidth := bm.Width;

{Get the screen’s dc to use since memory dc’s are not reliable}

dc := GetDc(0);

{Are we a palette device?}

IsPaletteDevice :=

GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;

{Give back the screen dc}

dc := ReleaseDc(0, dc);

{Allocate the BitmapInfo structure}

if IsPaletteDevice then

BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255)

else

BitmapInfoSize := sizeof(TBitmapInfo);

GetMem(lpBitmapInfo, BitmapInfoSize);

{Zero out the BitmapInfo structure}

FillChar(lpBitmapInfo^, BitmapInfoSize, #0);

{Fill in the BitmapInfo structure}

lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);

lpBitmapInfo^.bmiHeader.biWidth := OriginalWidth;

lpBitmapInfo^.bmiHeader.biHeight := bm.Height;

lpBitmapInfo^.bmiHeader.biPlanes := 1;

if IsPaletteDevice then

lpBitmapInfo^.bmiHeader.biBitCount := 8

else

lpBitmapInfo^.bmiHeader.biBitCount := 24;

lpBitmapInfo^.bmiHeader.biCompression := BI_RGB;

lpBitmapInfo^.bmiHeader.biSizeImage :=

((lpBitmapInfo^.bmiHeader.biWidth *

longint(lpBitmapInfo^.bmiHeader.biBitCount)) div 8) *

lpBitmapInfo^.bmiHeader.biHeight;

lpBitmapInfo^.bmiHeader.biXPelsPerMeter := 0;

lpBitmapInfo^.bmiHeader.biYPelsPerMeter := 0;

if IsPaletteDevice then begin

lpBitmapInfo^.bmiHeader.biClrUsed := 256;

lpBitmapInfo^.bmiHeader.biClrImportant := 256;

end else begin

lpBitmapInfo^.bmiHeader.biClrUsed := 0;

lpBitmapInfo^.bmiHeader.biClrImportant := 0;

end;

{Take ownership of the bitmap handle and palette}

hBm := bm.ReleaseHandle;

hPal := bm.ReleasePalette;

{Get the screen’s dc to use since memory dc’s are not reliable}

dc := GetDc(0);

if IsPaletteDevice then begin

{If we are using a palette, it must be}

{selected into the dc during the conversion}

OldPal := SelectPalette(dc, hPal, TRUE);

{Realize the palette}

RealizePalette(dc);

end;

{Tell GetDiBits to fill in the rest of the bitmap info structure}

GetDiBits(dc,

hBm,

0,

lpBitmapInfo^.bmiHeader.biHeight,

nil,

TBitmapInfo(lpBitmapInfo^),

DIB_RGB_COLORS);

{Allocate memory for the Bits}

hBits := GlobalAlloc(GMEM_MOVEABLE,

lpBitmapInfo^.bmiHeader.biSizeImage);

pBits := GlobalLock(hBits);

{Get the bits}

GetDiBits(dc,

hBm,

0,

lpBitmapInfo^.bmiHeader.biHeight,

pBits,

TBitmapInfo(lpBitmapInfo^),

DIB_RGB_COLORS);

if IsPaletteDevice then begin

{Lets fix up the color table for buggy video drivers}

GetMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);

{$IFDEF VER100}

NumPalEntries := GetPaletteEntries(hPal,

0,

256,

lPPalEntriesArray^);

{$ELSE}

NumPalEntries := GetSystemPaletteEntries(dc,

0,

256,

lPPalEntriesArray^);

{$ENDIF}

for i := 0 to (NumPalEntries – 1) do begin

lpBitmapInfo^.bmiColors[i].rgbRed :=

lPPalEntriesArray^[i].peRed;

lpBitmapInfo^.bmiColors[i].rgbGreen :=

lPPalEntriesArray^[i].peGreen;

lpBitmapInfo^.bmiColors[i].rgbBlue :=

lPPalEntriesArray^[i].peBlue;

end;

FreeMem(lPPalEntriesArray, sizeof(TPaletteEntry) * 256);

end;

if IsPaletteDevice then begin

{Select the old palette back in}

SelectPalette(dc, OldPal, TRUE);

{Realize the old palette}

RealizePalette(dc);

end;

{Give back the screen dc}

dc := ReleaseDc(0, dc);

{Is the Dest dc a palette device?}

IsDestPaletteDevice :=

GetDeviceCaps(DestDc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;

if IsPaletteDevice then begin

{If we are using a palette, it must be}

{selected into the dc during the conversion}

OldPal := SelectPalette(DestDc, hPal, TRUE);

{Realize the palette}

RealizePalette(DestDc);

end;

{Do the blt}

StretchDiBits(DestDc,

x,

y,

Width,

Height,

0,

0,

OriginalWidth,

lpBitmapInfo^.bmiHeader.biHeight,

pBits,

lpBitmapInfo^,

DIB_RGB_COLORS,

SrcCopy);

if IsDestPaletteDevice then begin

{Select the old palette back in}

SelectPalette(DestDc, OldPal, TRUE);

{Realize the old palette}

RealizePalette(DestDc);

end;

{De-Allocate the Dib Bits}

GlobalUnLock(hBits);

GlobalFree(hBits);

{De-Allocate the BitmapInfo}

FreeMem(lpBitmapInfo, BitmapInfoSize);

{Set the ownership of the bimap handles back to the bitmap}

bm.Handle := hBm;

bm.Palette := hPal;

{Turn range checking back on if it was on when we started}

{$IFDEF CKRANGE}

{$UNDEF CKRANGE}

{$R+}

{$ENDIF}

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if PrintDialog1.Execute then begin

Printer.BeginDoc;

BltTBitmapAsDib(Printer.Canvas.Handle,

0,

0,

Image1.Picture.Bitmap.Width,

Image1.Picture.Bitmap.Height,

Image1.Picture.Bitmap);

Printer.EndDoc;

end;

end;


Control Panel Applets

February 12, 2009
Question:

How do I create a Control Panel Applet?

Answer:

Creating a Control Panel Applet is a straight forward process. Simply create a Dynamic Link Library with the extension of .cpl (Control Panel Library) and place it in the Windows system directory. Each cpl file can support multiple control panel applets. The cpl will have a single function entry point called CPlApplet() that must be exported by name. All the following control panel messages will come through this single entry point:

Message:

CPL_INIT – Sent to indicate CPlApplet() was found. Return TRUE to continue the loading process.

CPL_GETCOUNT – Return the number of applets supported by the cpl.

CPL_INQUIRE – Sent for information about each applet supported by the cpl.lParam1 contains the zero based applet number for the inquiry. lParam2 points to a TCplInfo structure. The idIcon field of the TClpInfo structure should be initialized with the resource id for an icon to display, and the idName and idInfo fields should be initialized with the resource string id for the name and description string id.lData can contain applet defined data for use by the applet.

CPL_SELECT – Sent when the applet’s icon has been selected by the user. lParam1 contains the applet number that was selected. lParam2 contains the applet’s user defined lData value.

CPL_DBLCLK – Sent when the applet’s icon has been double-clicked. lParam1 contains the applet number. lParam2 contains the applet’s user defined lData value. This message initiates the display of the applet’s dialog box.

CPL_STOP – Sent for each applet when the control panel is exiting. lParam1 contains the applet number. lParam2 contains the applet’s user defined lData value. Any applet specific cleaning up should be performed during this call.

CPL_EXIT – Sent prior to the control panel call to FreeLibrary. Non-applet specific cleaning up should be performed during this call.

CPL_NEWINQUIRE – Same as CPL_INQUIRE except lParam2 is a pointer to a NEWCPLINFO structure.

Your control panel library will need some additional resources to function. You will need to create a resource file containing a string table containing both the name and description of your applet(s) and icons for each applet in your cpl. You can create a res file from a .rc (resource script file) using the BRCC.EXE or BRCC32.EXE command line resource compiler, or a WYSIWYG resource editor like Borland’s Resource Workshop.

Example .rc file containing a string table with two strings and a pointer to a icon file resource:

STRINGTABLE

{

1, “TestApplet”

2, “My Test Applet”

}

2 ICON C:SOMEPATHCHIP.ICO

To compile the .rc file to a .res file that can be linked with your application, simply type on the dos command line the full path to the resource compiler, and the full path to the name of the .rc file to compile. Here is an example:

c:DelphiBinbrcc32.exe c:DelphiMyRes.rc

When the compiler is finished, you should have a new file with the same name as the .rc file you’ve compiled, only with an extension of “.res”.

If you are developing for multiple platforms, you should create both a 16 and 32 bit res file for linkage with your application.

The following is an example of a control panel applet that executes a secondary executable in response to the CPL_DBLCLK message. You can adapt the code to show a form or dialog box as well. The example is coded to compile for Win16 and Win32 environments.

To build the project, you will need to compile the above .rc file to a res file named either: TCPL32.RES or TCPL16.RES.

Example:

library TestCpl;

{$IFDEF WIN32}

uses

SysUtils,

Windows,

Messages;

{$ELSE}

uses

SysUtils,

WinTypes,

WinProcs,

Messages;

{$ENDIF}

{$IFDEF WIN32}

{$R TCPL32.RES}

{$ELSE}

{$R TCPL16.RES}

{$ENDIF}

const NUM_APPLETS = 1;

{$IFDEF WIN32}

const CPL_DYNAMIC_RES = 0;

{$ENDIF}

const CPL_INIT = 1;

const CPL_GETCOUNT = 2;

const CPL_INQUIRE = 3;

const CPL_SELECT = 4;

const CPL_DBLCLK = 5;

const CPL_STOP = 6;

const CPL_EXIT = 7;

const CPL_NEWINQUIRE = 8;

{$IFDEF WIN32}

const CPL_STARTWPARMS = 9;

{$ENDIF}

const CPL_SETUP = 200;

{$IFNDEF WIN32}

type DWORD = LongInt;

{$ENDIF}

type TCplInfo = record

idIcon : integer;

idName : integer;

idInfo : integer;

lData : LongInt;

end;

PCplInfo = ^TCplInfo;

type TNewCplInfoA = record

dwSize : DWORD;

dwFlags : DWORD;

dwHelpContext : DWORD;

lData : LongInt;

IconH : HIcon;

szName : array [0..31] of char;

szInfo : array [0..63] of char;

szHelpFile : array [0..127] of char;

end;

PNewCplInfoA = ^TNewCplInfoA;

{$IFDEF WIN32}

type TNewCplInfoW = record

dwSize : DWORD;

dwFlags : DWORD;

dwHelpContext : DWORD;

lData : LongInt;

IconH : HIcon;

szName : array [0..31] of WChar;

szInfo : array [0..63] of WChar;

szHelpFile : array [0..127] of WChar;

end;

PNewCplInfoW = ^TNewCplInfoW;

{$ENDIF}

type TNewCplInfo = TNewCplInfoA;

type PNewCplInfo = ^TNewCplInfoA;

function CPlApplet(hWndCPL : hWnd;

iMEssage : integer;

lParam1 : longint;

lParam2 : longint) : LongInt

{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}

begin

case iMessage of

CPL_INIT : begin

Result := 1;

exit;

end;

CPL_GetCount : begin

Result := NUM_APPLETS;

exit;

end;

CPL_Inquire : begin

PCplInfo(lParam2)^.idIcon := 2;

PCplInfo(lParam2)^.idName := 1;

PCplInfo(lParam2)^.idInfo := 2;

PCplInfo(lParam2)^.lData := 0;

Result := 1;

exit;

end;

CPL_NewInquire : begin

PNewCplInfo(lParam2)^.dwSize := sizeof(TNewCplInfo);

PNewCplInfo(lParam2)^.dwHelpContext := 0;

PNewCplInfo(lParam2)^.lData := 0;

PNewCplInfo(lParam2)^.IconH := LoadIcon(hInstance,

MakeIntResource(2));

lStrCpy(@PNewCplInfo(lParam2)^.szName, ‘TestCPL’);

lStrCpy(PNewCplInfo(lParam2)^.szInfo, ‘My Test CPL’);

PNewCplInfo(lParam2)^.szHelpFile[0] := #0;

Result := 1;

exit;

end;

CPL_SELECT : begin

Result := 0;

exit;

end;

CPL_DBLCLK : begin

WinExec(‘Notepad.exe’, SW_SHOWNORMAL);

Result := 1;

exit;

end;

CPL_STOP : begin

Result := 0;

exit;

end;

CPL_EXIT : begin

Result := 0;

exit;

end else begin

Result := 0;

exit;

end;

end;

end;

exports CPlApplet name ‘CPlApplet’;

begin

end.


Allow your Delphi Forms to Accept Dropped Files from Window Explorer

February 11, 2009

Drag and drop operations are commonly used operations in Windows applications. When working with Window Explorer you can copy, move and even delete files by using drag and drop.

Moving an object with the mouse button pressed is usually called dragging, and what happens when we end dragging by releasing the mouse button is called dropping.

While drag and drop is implemented in the VCL, to accept files from dragged from the Windows Explorer you need to handle a few shell api messages.

I can accept files!

For an object (window), like a Delphi form, to be able to accept files from the Windows shell a call to DragAcceptFiles is required. Next, a handler for the WM_DROPFILES message needs to be provided.

Here’s an example:

  1. Have a Delphi form named “dropForm”.
  2. Have a Memo control on it, named “memo1″.
      The code registers a form as a window that accepts dropped files in the form’s OnCreate event. The WMDROPFILES procedure handles files being dropped by listing their names in the memo control.

      unit dropFormUnit;

      interface

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

      type
      TDropForm = class(TForm)
      Memo1: TMemo;
      procedure FormCreate(Sender: TObject) ;
      private
      procedure WMDROPFILES(var msg : TWMDropFiles) ; message WM_DROPFILES;
      public
      { Public declarations }
      end;

      var
      DropForm: TDropForm;

      implementation
      {$R *.dfm}

      uses ShellApi;

      //form’s OnCreate event handler
      procedure TDropForm.FormCreate(Sender: TObject) ;
      begin
      //form is ready to accept files
      DragAcceptFiles( Handle, True ) ;
      end;

      (* handle files being dropped on a form *)
      procedure TDropForm.WMDROPFILES(var msg: TWMDropFiles) ;
      const
      MAXFILENAME = 255;
      var
      cnt, fileCount : integer;
      fileName : array [0..MAXFILENAME] of char;
      begin
      // how many files dropped?
      fileCount := DragQueryFile(msg.Drop, $FFFFFFFF, fileName, MAXFILENAME) ;

      // query for file names
      for cnt := 0 to -1 + fileCount do
      begin
      DragQueryFile(msg.Drop, cnt, fileName, MAXFILENAME) ;

      //do something with the file(s)
      memo1.Lines.Insert(0, fileName) ;
      end;

      //release memory
      DragFinish(msg.Drop) ;
      end;

      end.


How to Retrieve the Users Current IP address using Delphi code

February 10, 2009

In this tutorial you will learn how to retrieve the users current IP address using Delp
hi code. You can use this method in a variety of network applications or internet utilities.

If you would like to learn how to retrieve the user IP address follow the steps below.

Make sure to add this code to the beginning of your project:

uses

Winsock;

Step One – IP Finding Function

To make it easier to find and read the users current IP address create a function called getIPS using the code provided below. It is recommended that you copy and paste so you don’t miss anything. However be encouraged to read through the code to learn from it and how it works.

function getIPs: Tstrings;

type

TaPInAddr = array[0..10] of PInAddr;

PaPInAddr = ^TaPInAddr;

var

phe: PHostEnt;

pptr: PaPInAddr;

Buffer: array[0..63] of Char;

I: Integer;

GInitData: TWSAData;

begin

WSAStartup($101, GInitData);

Result := TstringList.Create;

Result.Clear;

GetHostName(Buffer, SizeOf(Buffer));

phe := GetHostByName(buffer);

if phe = nil then Exit;

pPtr := PaPInAddr(phe^.h_addr_list);

I := 0;

while pPtr^[i] nil do

begin

Result.Add(inet_ntoa(pptr^[i]^));

Inc(I);

end;

WSACleanup;

end;

Conclusion

Here is an example usage of the above function:

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Lines := GetIps;

end;

You now know a very simple yet affective function on how to get and read the users current IP address using Delphi code.


Printing With Richedit

February 10, 2009
James V. Bacus <bacuslab@mcs.net>

I have written a program that collects information that a user selects, by
a number of checkboxes and buttons, to a non visible RichEdit box.  The
program was written under Windows 95 and works fine.  But under NT 4.0 the
line ...

RichEdit1.Print(''); 

returns a Divide by Zero Error.  The only way I have found round this is to
save the file and use Word to print the final file.

Does anyone have or know of any workrounds?

Yes, I have a solution and a fix...
To fix this problem requires a minor change to the VCL unit ComCtrls.pas.

I've tested this on many different systems running NT 4.0 and Win95, and all seems to work well now. It's actually a very simple fix, and here it is...

--------------------------------------------------------------------------------

{
A compatibility problem exists with the original RichEdit.Print method
code and the release of NT 4.0.  A EDivByZero exception is caused because
accessing the Printer.Handle property outside of a BeginDoc/EndDoc block
returns an Information Context (IC) handle under NT 4.0 instead of a
Device Context (DC) handle.  The EM_FORMATRANGE attempts to use this IC
instead of a real printer DC, which causes the exception.  If the Handle
property is accessed AFTER the BeginDoc, a true Device Context handle is
returned, and I have modified the code to handle this correctly.  I have
left the original position of BeginDoc in the code but remarked it out to
indicate the difference.    J.V.Bacus 11/12/96
}
procedure TCustomRichEdit.Print(const Caption: string);
var
  Range: TFormatRange;
  LastChar, MaxLen, LogX, LogY: Integer;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Printer, Range do
  begin
    LogX := GetDeviceCaps(Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(Handle, LOGPIXELSY);
    // The repositioned BeginDoc to now be compatible with
    // both NT 4.0 and Win95
    BeginDoc;
    hdc := Handle;
    hdcTarget := hdc;
    if IsRectEmpty(PageRect) then
    begin
      rc.right := PageWidth * 1440 div LogX;
      rc.bottom := PageHeight * 1440 div LogY;
    end
    else begin
      rc.left := PageRect.Left * 1440 div LogX;
      rc.top := PageRect.Top * 1440 div LogY;
      rc.right := PageRect.Right * 1440 div LogX;
      rc.bottom := PageRect.Bottom * 1440 div LogY;
    end;
    rcPage := rc;
    Title := Caption;
    // The original position of BeginDoc
    { BeginDoc; }
    LastChar := 0;
    MaxLen := GetTextLen;
    chrg.cpMax := -1;
    repeat
      chrg.cpMin := LastChar;
      LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
      if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
    until (LastChar >= MaxLen) or (LastChar = -1);
    EndDoc;
  end;
  SendMessage(Handle, EM_FORMATRANGE, 0, 0);
end;

Direct Write to Network Printer

February 10, 2009
unit Rawprint;

interface
uses printers,windows;

type TRawprinter =class(TPrinter)
                  public
                    dc2 : HDC;
                    aborted : boolean;
                    printing : boolean;
                    lasttime : integer;
                    procedure abort;
                    function startraw : boolean;
                    function endraw: boolean;
                    function write(s : string): boolean;
                    function writeln: boolean;
                    destructor destroy; override;
                    procedure settimer;
                    function printerror : boolean;
                  end;
implementation
uses sysutils,forms,dialogs,controls;

procedure TRawPrinter.settimer;
begin
  lasttime:=gettickcount;
end;

function TRawPrinter.printerror : boolean;
var r : integer;
begin
  result:=false;
  if (gettickcount>lasttime+15000) or (gettickcount<lasttime) then
  begin
    r:=messagedlg('Error '+inttostr(getlasterror)+' Printing on '+printers[printerindex],mterror,[mbretry,mbabort,mbignore],0);
    if r=mrretry then
      result:=false
    else
    begin
      result:=true;
      if r=mrabort then
        abort;
    end;
    settimer;
  end;
end;

procedure TRawPrinter.abort;
begin
  abortdoc(dc2);
  endraw;
end;

function AbortProc(Prn: HDC; Error: Integer): Bool; stdcall;
begin
  Application.ProcessMessages;
  Result := not TRawprinter(Printer).Aborted;
end;

type
  TPrinterDevice = class
    Driver, Device, Port: String;
    constructor Create(ADriver, ADevice, APort: PChar);
    function IsEqual(ADriver, ADevice, APort: PChar): Boolean;
  end;

constructor TPrinterDevice.Create(ADriver, ADevice, APort: PChar);
begin
  inherited Create;
  Driver := ADriver;
  Device := ADevice;
  Port := APort;
end;

function TPrinterDevice.IsEqual(ADriver, ADevice, APort: PChar): Boolean;
begin
  Result := (Device = ADevice) and (Port = APort);
end;

destructor TRawprinter.destroy;
begin
  if dc2<>0 then
    deletedc(dc2);
end;

function TRawprinter.startraw:boolean;
var
  CTitle: array[0..31] of Char;
  CMode : Array[0..4] of char;
  DocInfo: TDocInfo;
  r : integer;
begin
  result:=false;
  StrPLCopy(CTitle, Title, SizeOf(CTitle) - 1);
  StrPCopy(CMode, 'RAW');
  FillChar(DocInfo, SizeOf(DocInfo), 0);
  with DocInfo do
  begin
    cbSize := SizeOf(DocInfo);
    lpszDocName := CTitle;
    lpszOutput := nil;
    lpszDatatype :=CMode;
  end;
  with TPrinterDevice(Printers.Objects[PrinterIndex]) do
  begin
    if dc2=0 then
    begin
      DC2 := CreateDC(PChar(Driver), PChar(Device), PChar(Port), nil);
      if dc2=0 then
      begin
        result:=false;
        exit;
      end;
     SetAbortProc(dc2, AbortProc);
   end;
  end;
  settimer;
  aborted:=false;
  repeat
    application.processmessages;
  until (StartDoc(dc2, DocInfo)>0) or printerror;
  if not aborted then
    printing:=true;
  result:=printing;
end;

function TRawprinter.endraw : boolean;
begin
  settimer;
  if not aborted and printing then
  repeat
    application.processmessages;
  until (windows.enddoc(dc2)>0) or printerror;
  printing:=false;
  result:=not aborted;
end;

type passrec = packed record
                 l : word;
                 s : Array[0..255] of char;
               end;
var pass : Passrec;
function TRawprinter.write(s : string):boolean;
var tmp : string;
begin
result:=false;
  if not aborted and printing then
  while s<>'' do
  begin
    result:=false;
    tmp:=copy(s,1,255);
    delete(s,1,255);
    pass.l:=length(tmp);
    strpcopy(pass.s,tmp);
    settimer;
    repeat
      application.processmessages
    until (escape(dc2,PASSTHROUGH,0,@pass,nil)>=0) or printerror;
    if aborted then
      break;
    result:=true;
  end;
end;

function TRawprinter.writeln : boolean;
begin
  pass.l:=2;
  strpcopy(pass.s,#13#10);
  settimer;
  repeat
    application.processmessages
  until (escape(dc2,PASSTHROUGH,0,@pass,nil)>=0) or printerror;
  result:=not aborted;
end;

end.

Kelly Clarkson — Cryin (original by Aerosmith)

January 28, 2009

Lirik :

There was a time
When I was so brokenhearted
Love wasn't much of a friend of mine
The tables have turned, yeah
'Cause me and them ways have parted
That kind of love was the killin' kind, listen
All I want is someone I can't resist
I know all I need to know by the way that you kissed me 

I was cryin' when I met you
Now I'm tryin to forget you
your Love is sweet misery
I was cryin' just to get you
Now I'm dyin' 'cause I let you
Do what you do down on me 

Now there's not even breathin' room
No, no, no
Between pleasure and pain
Yeah you cry when we're makin’ love
Must be one and the same 

'Cause what you got inside
Ain't where your love should stay
Yeah, our love, sweet love, ain't love
'Till you give your heart away
Yeeeaaahhh
I was cryin' when I met you
Now I'm tryin to forget you
Your Love is sweet misery
I was cryin' just to get you
Now I'm dyin' ‘cos to let you
Do what you down on, down on, baby, baby, baby 

Baby, yeah

Apa yang menjadi no.1 dalam kehidupan Anda?

January 22, 2009

Apa yang menjadi no.1 dalam kehidupan Anda?

Pernahkah Anda bertanya apa tujuan yang ingin Anda capai
dalam hidup ini?
1. Kesuksesan
2. Kekayaan
3. Kebahagiaan
4. Kedamaian
5. Keberhasilan
6. …
Jika ambisi Anda belum ada didaftar, silahkan Anda racik sendiri.

Dalam beberapa hari ini atau beberapa bulan ini
atau beberapa tahun ini atau bahkan beberapa puluh tahun
belakangan ini, telah berapa lama waktu dan usaha yang telah
Anda keluarkan untuk meraih impian Anda?
Dalam hal ini saya yakin Anda tidak sendiri..

Apapun ambisi Anda sekarang,
ada satu kata pembuka yang TIDAK boleh terlupakan.
KESEHATAN..

Jangan lupakan kesehatan Anda sendiri.
Kesehatan mungkin bukan yang PERTAMA dalam daftar Anda, tapi
kesehatan itu yang UTAMA dalam kehidupan ini.
Jangan menyia-nyiakan diri Anda sendiri.
Mulailah bergaya hidup sehat diawali dengan hal2 kecil dalam kegiatan
Anda.
1. Perhatikanlah asupan yang menjadi input dalam diri Anda.
Baik itu makanan, udara, beban pikiran, dsb.
2. Awasi dengan hati2 output tubuh Anda karena itu adalah
hasil proses metabolisme tubuh Anda.
3. Mulailah berkeringat, lakukan olah raga saat ada kesempatan.
- Get the stairs to go up, then your blood pressure will go down.
- Berjalan kaki untuk memompa peredaran darah Anda ke jantung.
- Perhatikan posisi tubuh Anda saat Anda berdiri atau duduk.
PS : Ingat sehat itu murah..
Jadi masih banyak cara lain untuk menjadi sehat.

Jangan lupa kesehatan itu berharga..
**
Health is something that you can’t buy, it is a wellness..,
if only you know how to take control of it
**


Cara Kerja Otak Manusia – Penelitian

January 22, 2009

Ini  sagnat menraik

========================
Menuurt sbeauh penilitean di
Cmabrigde Uinervtisy,
tdaik mejnadi maslaah
bgaimanaa urtaun hufur-hufur di dlaam
sebauh kaat, ynag  palngi pnteing
adlaah leatk hruuf partema dan
terkhair itu bnaer.
Siasnya dpaat brantaaken saam skelai
dan kmau maish dpaat  mebmacanya
tnpaa msaalah. Hal ini kerana oatk masunia tdaik
mambeca seitap  huurf
msaing-msaing, tatepi kaat kesuleruhan.

Manejkubakn naggk?