Site hosted by Angelfire.com: Build your free website today!

Home
DelphiZeus
TestText Text Editor like Notepad

Home



This is a text editing program modled after Notepad in a file called TestText.dpr. It will show some API printing procedures in the PrintMe Function. This uses menus and you can drag and drop files from explorer. There are reading and writing Registry functions here. This program uses a Resource Template windows dialog, it's in the Resourse file {$R PNTDLG.RES}. Here is the code lines for the .RC file named PntDlg.rc
PrintDlg DIALOG  20, 20, 120, 42
     STYLE WS_POPUP | WS_DLGFRAME | WS_CAPTION | WS_SYSMENU | WS_VISIBLE
     CAPTION " Stop Printing"
     FONT 10, "MS Sans Serif"
     {
     CTEXT "Stop Printing and Cancel Printing process"     -1, 4, 6, 112, 9
     DEFPUSHBUTTON "Cancel"   IDCANCEL, 44, 22,  32, 14, WS_GROUP
     }
Complie this PntDlg.rc file with brcc32.exe

This Dialog is included here because it is in several "How To Code" windows 95 instuction books (in the C language). . And was meant for "Older" types of printers and printer drivers, where one page was sent to the printer and printed before the next page was sent (or the amount of text the printer's Memory would hold). But Newer printers and newer Window's versions, use a different method of printing and Memory usage. They send the entire print job (all pages) to the printer driver, (or as many pages as the driver will accept at once). So you may never see this Dialog box, even with muti-page printing, unless you still use an old Dot-Matrix printer.

Under Construction
There are not many comments in this to help you understand it.
The whole printing thing is rather much to try and do, but the code here should give you something to start with.

program TestText;

uses
  Windows, Messages, Commdlg, WinSpool, ShellApi, smallutils;

{$R *.RES}
{$R PNTDLG.RES}

const
mID_New = 101;
mID_Open = 102;
mID_Save = 103;
mID_SaveAs = 104;
mID_Print = 105;
mID_PageSetup = 106;
mID_Exit = 107;

mID_Undo = 201;
mID_Copy = 202;
mID_Cut = 203;
mID_Paste = 204;
mID_Del = 205;
mID_SelAll = 206;
mID_Date = 207;
mID_Wrap = 208;
mID_Font = 209;

mID_Find = 301;
mID_FindNext = 302;

var
wClass: TWndClass;
hForm1, hMemo1, Font1, Font2, hStatus, hLineNum,
menuFile, menuEdit, menuMain, menuSearch,
hFindWnd, hDlgCancel: Integer;
mainMsg: TMSG;
CurrentFile: String;
PntDrvName: PChar;
Rect1, SetupRect, MinMarRect: TRect;
Wrap, StopPrint, GotSetup, ShowMax: Boolean;
FontLog: TLogFont;
MenuInfo: TMENUITEMINFO;
PMemo1Proc, PExitSave: Pointer;
DataType, Left, Top, sWidth, sHeight, RegTemp: Integer;
TT88Key: HKey;
WndProcPtrAtom: TAtom = 0;
FindMess: Integer;

FindRelp: TFindReplace;
FindTextA: array[0..255] of Char;
{FindTextA is the Array the Pointer lpstrReplaceWith
in FindRelp is set to}

FaceNmA: array[0..31] of Char;
Arry4Byte: Array[0..3] of Byte;


// / / / / / / /

function Write2Reg(Key: HKEY ;const Name: PChar; Buffer: Pointer;
  BufSize: Integer; DataType: Integer): Boolean;
begin
Result := False;
if RegSetValueEx(Key, Name, 0, DataType, Buffer, BufSize) = ERROR_SUCCESS then
  Result := True;
end;

function OpenRegKey: HKey;
var
TempKey, SoftKey: HKey;
RegOpen: Boolean;
Dispos: Integer;
begin
RegOpen := True;
if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software\TestText88', 0,
      KEY_WRITE, TempKey) <> ERROR_SUCCESS then
  begin
  RegOpen := False;
  if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software', 0,
      KEY_WRITE, SoftKey) = ERROR_SUCCESS then
    begin
    if RegCreateKeyEx(SoftKey,'TestText88',0,nil,
        REG_OPTION_NON_VOLATILE,KEY_WRITE,nil,TempKey,@Dispos) = ERROR_SUCCESS then
      RegOpen := True;
    RegCloseKey(SoftKey);
    end;
  end;
if RegOpen then
Result := TempKey
else Result := 0;
end;

procedure ShutDown;
var
WinPlace: TWindowPlacement;
RegKey: HKey;
Name: PChar;
RegValue, Neg: Cardinal;

begin
WinPlace.length := SizeOf(TWindowPlacement);
GetWindowPlacement(hForm1,@WinPlace);
RegKey := OpenRegKey;
if RegKey <> 0 then
  begin
  if WinPlace.rcNormalPosition.Top < 0 then
  Neg := 0 else
  Neg := WinPlace.rcNormalPosition.Top;
  if WinPlace.rcNormalPosition.Left < 0 then
    WinPlace.rcNormalPosition.Left := 0;
  RegValue := abs(Neg shl 16)+WinPlace.rcNormalPosition.Left;
  Name := 'Position';
  Write2Reg(RegKey, Name, @RegValue, SizeOf(Cardinal), REG_DWORD);

  Name := 'WindowSize';
  Neg := WinPlace.rcNormalPosition.Right - WinPlace.rcNormalPosition.Left;
  RegValue := abs(Neg shl 16) +
              abs(WinPlace.rcNormalPosition.Bottom-WinPlace.rcNormalPosition.Top);
  Write2Reg(RegKey, Name, @RegValue, SizeOf(Cardinal),REG_DWORD );
  Name := 'IsMax';
  RegValue := WinPlace.showCmd;
  Write2Reg(RegKey, Name, @RegValue, SizeOf(Cardinal),REG_DWORD );
  RegCloseKey(RegKey);
  end;

DeleteObject(Font1);
DeleteObject(Font2);
PostQuitMessage(0);
end;

function DlgOpenSave(Open: Boolean): String;
var
OFName : TOpenFileName;
FileName: Array[0..2047] of Char;
begin
ZeroMemory(@FileName, SizeOf(FileName));
ZeroMemory(@OFName, SizeOf(OFName));

with OFName do
  begin
  lStructSize := sizeof(ofName);
  hwndowner := hForm1;
  nMaxFile := SizeOf(FileName);
  lpstrFile := @FileName;
  nFilterIndex := 1;
  lpstrFilter := 'Text file (*.txt)'#0'*.txt'#0'All files (*.*)'#0'*.*'#0#0;

  if Open then
    begin
    Flags := OFN_EXPLORER or OFN_PATHMUSTEXIST or
                 OFN_FILEMUSTEXIST or OFN_HIDEREADONLY;
    lpstrTitle:='Open a Text file';
    end else
    begin
    FileName := 'New1.txt';
    Flags := OFN_EXPLORER or OFN_PATHMUSTEXIST or
                OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY;
    lpstrTitle:='Save this Text File';
    end;
    lpstrDefExt := 'txt';
    if CurrentFile = '?' then
      lpstrInitialDir := 'C:\'
      else
      begin
      if not Open then
        StrCopy(FileName, PChar(CurrentFile));
      if UpperCase(GetFileExt(CurrentFile)) <> '.TXT' then
        begin
        lpstrFilter := 'All files (*.*)'#0'*.*'#0#0;
        lpstrDefExt := '';
        end;
      lpstrInitialDir := PChar(GetFilePath(CurrentFile));
      end;
  end;

Result := '';
if Open then
  begin
  if GetOpenFileName(OFName) then
    Result := FileName;
  end else
  if GetSaveFileName(OFName) then
    Result := FileName;

end;


function CancelProc(hWnd,Msg,wParam,lParam:Longint):Integr; stdcall;
begin
Result := 0;
if Msg = WM_COMMAND then
  begin
  StopPrint := True;
  EnableWindow(hForm1,True);
  DestroyWindow(hWnd);
  hDlgCancel := 0;
  Result := 1;
  end;
end;

function AbortProc(PrintDC: HDC; Error1: Integer): Boolean;
var
Msg1: TMsg;
begin
while (not StopPrint) and PeekMessage(Msg1,0,0,0, PM_REMOVE) do
  begin
  if (hDlgCancel <> 0) or (not IsDialogMessage(hDlgCancel, Msg1)) then
    begin
    TranslateMessage(Msg1);
    DispatchMessage(Msg1);
    end;
  end;
Result :=  not StopPrint;
end;

function GetDefaultPrinter: PChar;
var
  ByteCnt, StructCnt: DWORD;
  DefaultPrinter: array[0..79] of Char;
  Cur: PChar;
  PrinterInfo: PPrinterInfo5;

  function FetchStr(var pStr: PChar): PChar;
  var
  P: PChar;
  begin
  Result := pStr;
  if pStr = nil then Exit;
  P := pStr;
  while P^ = ' ' do Inc(P);
  Result := P;
  while (P^ <> #0) and (P^ <> ',') do Inc(P);
  if P^ = ',' then
    begin
    P^ := #0;
    Inc(P);
    end;
  pStr := P;
  end;
  
begin
Result := '';
ByteCnt := 0;
StructCnt := 0;
if not EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, nil, 0, ByteCnt,
  StructCnt) and (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
  begin
    // With no printers installed, Win95/98 fails above with "Invalid filename".
    // NT succeeds and returns a StructCnt of zero.
  MessageBox(hForm1, PChar('No Default Printer availible'+#13+
              SysErrorMessage(GetLastError)),
    'No Default Printer', MB_OK or MB_ICONERROR);
  Exit;
  end;
PrinterInfo := AllocMem(ByteCnt);
  try
  EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 5, PrinterInfo, ByteCnt, ByteCnt,
                StructCnt);
  if StructCnt > 0 then
    begin
    Result := PrinterInfo.pPrinterName;
    end else
    begin
    GetProfileString('windows', 'device', '', DefaultPrinter, SizeOf(DefaultPrinter) - 1);
    Cur := DefaultPrinter;
    Result := FetchStr(Cur);
    end;
  finally
  FreeMem(PrinterInfo);
  end;
end;

function PageSetup(Def: Boolean): PChar;
var
PgSetupRec: TPageSetupDlg;
DevNames: PDevNames;
DeviceName: PChar;
PaperSize: TPoint;

begin
Result := '';
FillChar(PgSetupRec, SizeOf(PgSetupRec), 0);
{the PgSetupRec must be filled with "0" or the random data in that
memory block will confuse the OS when it tries to read it and will fail}
PgSetupRec.lStructSize := SizeOf(PgSetupRec);
PgSetupRec.hwndOwner := hForm1;
PgSetupRec.hInstance := wClass.hInstance;
if Def then
  PgSetupRec.Flags := PSD_INTHOUSANDTHSOFINCHES or PSD_RETURNDEFAULT
  else
  PgSetupRec.Flags := PSD_INTHOUSANDTHSOFINCHES or PSD_DISABLEORIENTATION or PSD_DISABLEPAPER;
{WARNING , , I have included the PSD_DISABLEORIENTATION and PSD_DISABLEPAPER flags because
 the Page Setup Dialog DOES NOT set the Printer driver to use these changes. The selections
 are recorded in the TPageSetupDlg Record, but the printer driver is NOT changed. If Landscape
 is set in Page Setup it DOES NOT set the printer driver to Landscape. If a paper size is set
 it does not change the printer driver to that size}
if PageSetupDlg(PgSetupRec) then
  begin
  if not Def then
    GotSetup := True;
  DevNames := PDevNames(GlobalLock(PgSetupRec.hDevNames));
  DeviceName := PChar(DevNames) + DevNames.wDeviceOffset;
  GlobalUnlock(PgSetupRec.hDevNames);
  SetupRect := PgSetupRec.rtMargin;
  MinMarRect := PgSetupRec.rtMinMargin;
  PaperSize := PgSetupRec.ptPaperSize;
  Result := DeviceName;
  end;
end;

procedure SetUpPage;
begin
PntDrvName := PageSetup(False);
if PntDrvName = '' then
GotSetup := False;
end;

function PrintMe: Boolean;
var
MemoStr: String;
DocInfo: TDocInfo;
PrintDC: HDC;
TextM: TTextMetric;
PntName: PChar;
PntRect: TRect;
PntDlg1: TPrintDlg;
DrawTxRec: TDRAWTEXTPARAMS;
PageHeight, PageWidth, PixInch, RemainText: Integer;

begin
Result := False;
StopPrint := False;
with DocInfo do
  begin
  cbSize := SizeOF(DocInfo);
  if CurrentFile = '?' then
    lpszDocName := 'New1.txt'
    else lpszDocName := PChar(GetFileName(CurrentFile));
  lpszOutput := nil;
  lpszDatatype := nil;
  fwType := 0;
  end;
MemoStr := GetWindowStr(hMemo1);
if GotSetup then
  PntName := PntDrvName else
  PntName := PageSetup(True);

if PntName = '' then
  begin
  with PntDlg1 do
    begin
    lStructSize := sizeof(PntDlg1);
    hDevMode := 0;
    hDevNames := 0;
    Flags := PD_RETURNDC;
    hwndOwner := hForm1;
    hDC := 0;
    nFromPage := 1;
    nToPage := 1;
    nMinPage := 0;
    nMaxPage := 0;
    nCopies := 1;
    hInstance := 0;
    lCustData := 0;
    lpfnPrintHook := nil;
    lpfnSetupHook := nil;
    lpPrintTemplateName := nil;
    lpSetupTemplateName := nil;
    hPrintTemplate := 0;
    hSetupTemplate := 0;
    end;

  SetRect(MinMarRect,250,250,250,500);
  if PrintDlg(PntDlg1) then
    PrintDC := PntDlg1.HDC else
    Exit;
  end else
  PrintDC := CreateDC(nil,PntName, nil,nil);

if PrintDC = 0 then
  begin
  MessageBox(hForm1, 'No Printer is available, can not print this page',
    'No Printer', MB_OK or MB_ICONERROR);
  Exit;
  end;
SelectObject(PrintDC,Font1);
GetTextMetrics(PrintDC, TextM);
PixInch := GetDeviceCaps(PrintDC,LOGPIXELSX);
PageHeight := GetDeviceCaps(PrintDC,VERTRES);
PageWidth := GetDeviceCaps(PrintDC,HORZRES);
if GotSetup then
  SetRect(PntRect,((SetupRect.Left-MinMarRect.Left) * PixInch) div 1000,
        ((SetupRect.Top-MinMarRect.Top) * PixInch) div 1000,
        PageWidth-(((SetupRect.Right-MinMarRect.Right) * PixInch) div 1000),
        PageHeight- (((SetupRect.Bottom-MinMarRect.Bottom) * PixInch) div 1000))
  else
  SetRect(PntRect,abs((PixInch div 2)- ((MinMarRect.Left* PixInch) div 10000)),
        abs((PixInch div 2)- ((MinMarRect.Top* PixInch) div 1000)),
        PageWidth- abs((PixInch div 2)- ((MinMarRect.Right* PixInch) div 10000)),
        PageHeight- abs((PixInch div 2)- ((MinMarRect.Bottom* PixInch) div 1000)));

DrawTxRec.cbSize := SizeOf(DrawTxRec);
DrawTxRec.iTabLength := 6;
DrawTxRec.iLeftMargin := 0;
DrawTxRec.iRightMargin := 0;
StopPrint := False;
hDlgCancel := CreateDialog(hInstance, 'PrintDlg', hForm1, @CancelProc);
SetAbortProc(PrintDC, @AbortProc);
if StartDoc(PrintDC, DocInfo) < 1 then
  begin
  DeleteDC(PrintDC);
  EnableWindow(hForm1, True);
  DestroyWindow(hDlgCancel);
  hDlgCancel := 0;
  MessageBox(hForm1, 'Printer is not available, I can not print this page',
             'No Printer', MB_OK or MB_ICONERROR);
  Exit;
  end;
RemainText := Length(MemoStr);
while RemainText > 0 do
  begin
  if StartPage(PrintDC) < 1 then Break;
  DrawTextEx(PrintDC,PChar(MemoStr),Length(MemoStr),PntRect,
         DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_EDITCONTROL,@DrawTxRec);
  if DrawTxRec.uiLengthDrawn <1 then Break;
  Delete(MemoStr,1,DrawTxRec.uiLengthDrawn);
  RemainText := Length(MemoStr);
  If StopPrint then Break;
  EndPage(PrintDC);
  end;
EndDoc(PrintDC);
Result := True;
DeleteDC(PrintDC);

EnableWindow(hForm1, True);
DestroyWindow(hDlgCancel);
hDlgCancel := 0;
end;

procedure SaveIt(NewName: Boolean);
var
Sfile1: HWND;
TextBuf, FileName: String;
WriteAmount: Cardinal;
Sizes: TdriveSize;
begin
if NewName then
  begin
  FileName := DlgOpenSave(False);
  if FileName = '' then
    Exit;
  end else
  FileName := CurrentFile;
while PeekMessage(MainMsg, 0, 0, 0, PM_REMOVE) do
  begin
  TranslateMessage(MainMsg);
  DispatchMessage(MainMsg);
  end;
Sizes := DiskSpace(FileName);
while PeekMessage(MainMsg, 0, 0, 0, PM_REMOVE) do
  begin
  TranslateMessage(MainMsg);
  DispatchMessage(MainMsg);
  end;
while Sizes.FreeS < 0 do 
  begin
  if MessageBox(hForm1, PChar('Could not write to text file - '#10+
        FileName+#10'Is there a Disk in this drive ? To try again, '+
        'place a disk in the drive and click "Retry"'),
        'Disk in Drive ?', MB_RETRYCANCEL or MB_ICONERROR) = IDCANCEL then
  Exit else
  Sizes := DiskSpace(FileName);
  while PeekMessage(MainMsg, 0, 0, 0, PM_REMOVE) do
    begin
    TranslateMessage(MainMsg);
    DispatchMessage(MainMsg);
    end;
  end;
TextBuf := GetWindowStr(hMemo1);
if Sizes.FreeS < Length(TextBuf) then
  begin
  MessageBox(hForm1, PChar('Not enough Free disk space to save file - '#10+
            FileName+#10'Delete files to increase free space or save to another disk'),
           'Disk in Drive ?', MB_OK or MB_ICONERROR);
  Exit;
  end;
Sfile1 := CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,
                     FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,0);
if Sfile1 = INVALID_HANDLE_VALUE then
  begin
  MessageBox(hForm1, PChar('System Error, Could not create text file - - - '+
    SysErrorMessage(GetLastError)),
    'System could not write to file', MB_OK or MB_ICONERROR);
  SetWindowText(hStatus, 'ERROR,  system file write error');
  Exit;
  end;
if Length(TextBuf) > 0 then
if not WriteFile(Sfile1,TextBuf[1],Length(TextBuf),WriteAmount,nil) then
  begin
  MessageBox(hForm1, PChar('System Error, Could not write to text file - - - '+
    SysErrorMessage(GetLastError)),
    'System could not write to file', MB_OK or MB_ICONERROR);
  CloseHandle(Sfile1);
  SetWindowText(hStatus, 'ERROR,  system file write error');
  Exit;
  end;
CloseHandle(Sfile1);
SendMessage(hMemo1,EM_SETMODIFY,0,0);
SetWindowText(hStatus, PChar(' '+FileName));
SetWindowText(hForm1, PChar(' '+GetFileName(FileName)+' -Test Text'));
end;

procedure File2Memo(FileName: String);
var
ChBuf: Array of Char;
hFile1: Integer;
Amount, BytesRead: Cardinal;
TempStr: String;

begin
Amount := FileSize(FileName);
if Amount = 0 then
  begin
  SendMessage(hMemo1, EM_SETSEL, 0, -1);
  SendMessage(hMemo1, WM_CLEAR, 0, 0);
  SetWindowText(hLineNum, '1: 1');
  SetWindowText(hStatus, PChar(' '+FileName));
  SetWindowText(hForm1, PChar(' '+GetFileName(FileName)+' -Test Text'));
  CurrentFile := FileName;
  Exit;
  end;
if Amount > 32765 then
  begin
  MessageBox(hForm1, PChar(FileName+#10+
     '    file is more than 32 Kb, and CAN NOT be opened by this program'),
     'ERROR, File is TOO LARGE', MB_OK or MB_ICONERROR);
  SetWindowText(hStatus, 'ERROR,  file is more than 32 Kb');
  Exit;
  end;
SetLength(ChBuf,Amount+1);
hFile1 := CreateFile(PChar(FileName),GENERIC_READ,FILE_SHARE_READ,nil,
            OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,0);

if not ReadFile(hFile1,ChBuf[0],Amount,BytesRead,nil) then
  begin
  CloseHandle(hFile1);
  MessageBox(hForm1, PChar('System Error, Could not read text file - - - '+
             SysErrorMessage(GetLastError)),
    'System could not read file', MB_OK or MB_ICONERROR);
  SetWindowText(hStatus, 'ERROR,  system file read error');
  Exit;
  end;
CloseHandle(hFile1);
if BytesRead<=0 then
  begin
  MessageBox(hForm1, 'file Read Error, Could not read text file',
     ' could not read file', MB_OK or MB_ICONERROR);
  SetWindowText(hStatus, 'ERROR,  system file read error');
  Exit;
  end;

ChBuf[BytesRead] := #0;
TempStr := String(ChBuf);
TempStr := AdjustLineBreaks(TempStr);
SetWindowText(hMemo1,@TempStr[1]);
SetWindowText(hLineNum, '1: 1');
SetWindowText(hStatus, PChar(' '+FileName));
SetWindowText(hForm1, PChar(' '+GetFileName(FileName)+' -Test Text'));
CurrentFile := FileName;
SendMessage(hMemo1,EM_SETMODIFY,0,0);
TempStr := '';
end;

procedure OpenTextFile;
var
FileName: String;

begin
FileName := DlgOpenSave(True);
if Filename = '' then Exit;
File2Memo(FileName);
end;

procedure DropedOn(const hDropS:Cardinal);
var
BufferSize : Integer;
File1: String;
begin
BufferSize := 256;
BufferSize := DragQueryFile(hDropS,0,NIL,BufferSize);
SetLength(File1,BufferSize);
DragQueryFile(hDropS,0,@File1[1],BufferSize+1);
DragFinish(hDropS);
if not DirectoryExists(File1) then
  File2Memo(File1);
File1 := '';
end;

procedure SetLineNum;
var
MesRe, ChPos, Line: Integer;
begin
MesRe := SendMessage(hMemo1,EM_GETSEL, 0, 0);
ChPos := HIWORD(MesRe);
Line := SendMessage(hMemo1,EM_LINEFROMCHAR, ChPos, 0);
MesRe := SendMessage(hMemo1,EM_LINEINDEX, Line, 0);
if MesRe < 0 then
  begin
  SetWindowText(hLineNum, 'X: Y');
  Exit
  end;
SetWindowText(hLineNum, PChar(Int2Str(Line+1)+': '+Int2Str(1+ChPos - MesRe)));
end;


procedure SearchFor(This: String; Down, MatchCase, Whole: Boolean);
var
i, ThisLgn, CurPos: Integer;
MemoStr: String;
begin
MemoStr := GetWindowStr(hMemo1);
if Length(MemoStr) < 16 then Exit;
i := SendMessage(hMemo1,EM_GETSEL, 0, 0);
CurPos := HIWORD(i);
if CurPos > 1 then
Delete(MemoStr, 1, CurPos);
if Whole then
This := ' '+This+' ';
ThisLgn := Length(This);
if ThisLgn < 1 then Exit;

if MatchCase then
  i := Pos(This,MemoStr)
  else i := Pos(UpperCase(This),UpperCase(MemoStr));

if i = 0 then
  begin
  MessageBox(hForm1, 'Searched from the Cursor to the end of document and Could NOT find text',
     'NOT There', MB_OK or MB_ICONINFORMATION);
  Exit;
  end;
SendMessage(hMemo1, EM_SETSEL, CurPos+i-1, CurPos+ i+ThisLgn-1);
SendMessage(hMemo1, EM_SCROLLCARET, 0, 0);
SetFocus(hMemo1);
SetLineNum;
end;

procedure FindIt(New: Boolean);
var
CurPos: Integer;
MemoStr: String;
begin
{sets up the FindReplace record for the
FindText function}
MemoStr := GetWindowStr(hMemo1);
if Length(MemoStr) < 16 then Exit;
if New then
  begin
  CurPos := SendMessage(hMemo1,EM_GETSEL, 0, 0);
  if  Loword(CurPos) <> HIWORD(CurPos) then
    begin
    MemoStr := Copy(MemoStr,Loword(CurPos)+1,HIWORD(CurPos)-Loword(CurPos));
    StrLCopy(FindTextA, PChar(MemoStr), SizeOf(FindTextA)-1);
    end else FindTextA := ' '#0;
{At this program's "begin" the
FindRel.lpstrFindWhat :=  FindTextA;
was set. Making the Charater values of lpstrFindWhat those of FindTextA.
Now any changes to FindTextA will be in FindRelp.lpstrFindWhat}
  FindRelp.lStructSize := SizeOf(FindRelp);
  FindRelp.hWndOwner := hForm1;
  FindRelp.hInstance := 0;
  FindRelp.Flags := FR_DOWN{ or FR_NOMATCHCASE};

  {FindRel.lpstrReplaceWith := RelCh;}
  {FindRel.lpfnHook := FindReplaceDialogHook;}
  {FindRel.wReplaceWithLen := 1;}

  hFindWnd := FindText(FindRelp);
  end else
  SearchFor(FindTextA,(FindRelp.Flags and (not FR_DOWN)) <> FindRelp.Flags,
            FindRelp.Flags and (not FR_MATCHCASE) <> FindRelp.Flags,
            FindRelp.Flags and (not FR_WHOLEWORD) <> FindRelp.Flags);
{you can use FindRelp.lpstrFindWhat or FindTextA in SearchFor( ) 
 since they are the same Block of memory}

MemoStr := '';
end;

procedure InsertDate;
var
TimeRec: TSystemTime;
Time, DoStr, DoStr2: String;
begin
GetLocalTime(TimeRec);
if (TimeRec.wHour = 24) then
  begin
  Time := Int2Str(TimeRec.wHour-12);
  DoStr := ' AM ';
  end else
  if (TimeRec.wHour > 11)  then
  begin
  if TimeRec.wHour = 12 then
  Time := Int2Str(TimeRec.wHour) else
  Time := Int2Str(TimeRec.wHour-12);
  DoStr := ' PM ';
  end else
  begin
  Time := Int2Str(TimeRec.wHour);
  DoStr := ' AM ';
  end;
if TimeRec.wMinute <10 then
DoStr := Time+':'+ '0'+Int2Str(TimeRec.wMinute)+DoStr
else
DoStr := Time+':'+ Int2Str(TimeRec.wMinute)+DoStr;
Time := Int2Str(TimeRec.wYear);
Delete(Time,1,2);
Time := DoStr+Int2Str(TimeRec.wMonth)+'/'+Int2Str(TimeRec.wDay)+ '/'+Time;
SendMessage(hMemo1,EM_REPLACESEL, 1, Integer(@Time[1]));
Time := '';
DoStr := '';
DoStr2 := '';
end;

function Memo1Proc(hWnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
case Msg of
  WM_LBUTTONUP: SetLineNum;
  WM_DROPFILES: begin
                CallWindowProc(PMemo1Proc, hWnd, Msg, wParam, lParam);
                DropedOn(WParam);
                Result := 0;
                Exit;
                end;
  WM_KEYDOWN: if wParam = VK_F3 then
                begin
                if Length(FindRelp.lpstrFindWhat) = 0 then
                FindIt(True) else FindIt(False);
                end else
                if wParam = VK_F5 then InsertDate;
end;
Result := CallWindowProc(PMemo1Proc, hWnd, Msg, wParam, lParam);
end;


procedure FontReg(LogFont: TLogFont);
var
RegKey: HKey;
Name, FaceName: PChar;
RegValue: Integer;

begin
RegKey := OpenRegKey;

  if RegKey <> 0 then
    begin
    FaceName := LogFont.lfFaceName;
    Name := 'FontFace';
    Write2Reg(RegKey, Name, FaceName, StrLen(FaceName)+1, REG_SZ);
    Name := 'FontSize';
    RegValue := LogFont.lfHeight;
    Write2Reg(RegKey, Name, @RegValue, SizeOf(Integer),REG_DWORD );
    Name := 'FontWeight';
    RegValue := LogFont.lfWeight;
    Write2Reg(RegKey, Name, @RegValue, SizeOf(Integer),REG_DWORD );
    Name := 'FontVar';
    Arry4Byte[0] := FontLog.lfPitchAndFamily;
    Arry4Byte[1] := FontLog.lfCharSet;
    Arry4Byte[2] := FontLog.lfClipPrecision;
    Arry4Byte[3] := FontLog.lfItalic;
    RegValue := Integer(Arry4Byte);
    Write2Reg(RegKey, Name, @RegValue, SizeOf(Integer),REG_DWORD );

    RegCloseKey(RegKey);
    end;
end;

procedure GetFont;
var
ChooseFont1: TChooseFont;
TempFont: Cardinal;

begin
with ChooseFont1 do
  begin
  lStructSize := SizeOf(ChooseFont1);
  hWndOwner := hForm1;
  hDC := 0;
  lpLogFont := @FontLog;
  iPointSize := 0;
  nSizeMax := 24;
  nSizeMin := 6;
  Flags := CF_INITTOLOGFONTSTRUCT or CF_FORCEFONTEXIST or CF_LIMITSIZE or CF_SCREENFONTS;
  lpfnHook := nil;
  end;
if ChooseFont(ChooseFont1) then
  begin
  FontLog.lfOutPrecision := OUT_TT_PRECIS;
  FontLog.lfQuality := ANTIALIASED_QUALITY;
  FontLog.lfUnderline := 0;
  FontLog.lfStrikeOut := 0;
  TempFont := CreateFontIndirect(FontLog);
  SendMessage(hMemo1,WM_SETFONT,TempFont,0);
  SendMessage(hMemo1, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MAKELONG(4, 4));
  DeleteObject(Font1);
  Font1 := TempFont;
  FontReg(FontLog);
  InvalidateRect(hMemo1,nil,True);
  end;
end;

procedure WordWrap;
var
MemoText: String;
SelPos: Cardinal;
Modi: Boolean;

begin
MemoText := GetWindowStr(hMemo1);
if SendMessage(hMemo1,EM_GETMODIFY,0,0) = 1 then
  Modi := True else Modi := False;
SetWindowLong(hMemo1, GWL_WNDPROC, Longint(PMemo1Proc));
SelPos := SendMessage(hMemo1,EM_GETSEL, 0, 0);
GetClientRect(hForm1,Rect1);
DestroyWindow(hMemo1);
if Wrap then
  begin
  hMemo1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', nil,
            WS_VISIBLE or WS_CHILD or WS_VSCROLL or ES_LEFT or ES_MULTILINE or
            ES_AUTOVSCROLL or ES_AUTOHSCROLL or WS_HSCROLL,
            0,0,Rect1.Right,Rect1.Bottom-22,hForm1,0,hInstance,nil);
  CheckMenuItem(menuEdit,mID_Wrap, MF_UNCHECKED);
  Wrap := False;
  end else
  begin
  hMemo1:=CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', nil, WS_VISIBLE or WS_CHILD or
           WS_VSCROLL or ES_LEFT or ES_MULTILINE or ES_AUTOVSCROLL,
           0,0,Rect1.Right,Rect1.Bottom-22,hForm1,0,hInstance,nil);
  CheckMenuItem(menuEdit,mID_Wrap, MF_CHECKED);
  Wrap := True;
  end;
PMemo1Proc := Pointer(SetWindowLong(hMemo1, GWL_WNDPROC, Longint(@Memo1Proc)));
SendMessage(hMemo1,WM_SETFONT,Font1,0);
SendMessage(hMemo1, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MAKELONG(4, 4));
SetWindowText(hMemo1, @MemoText[1]);
SendMessage(hMemo1,EM_SETSEL, LOWORD(SelPos), HIWORD(SelPos));
if Modi then
SendMessage(hMemo1,EM_SETMODIFY,1,0);
UpdateWindow(hMemo1);
SetFocus(hMemo1);
end;

procedure SetMenu;
{WM_INITMENUPOPUP message is sent before any menu popups are displayed.
This gets Info about Memo1 and Enables and disables
menu items}
var
More: Integer;
begin
if SendMessage(hMemo1,EM_CANUNDO, 0, 0) = 1 then
{EM_CANUNDO will see if Undo Info is there}
  EnableMenuItem(menuEdit, mID_Undo, MF_ENABLED)
  else EnableMenuItem(menuEdit, mID_Undo, MF_GRAYED);

if IsClipboardFormatAvailable(CF_TEXT) then
  More := MF_ENABLED else More := MF_GRAYED;
  EnableMenuItem(menuEdit, mID_Paste, More);

More := SendMessage(hMemo1,EM_GETSEL, 0, 0);
{Result of EM_GETSEL has the Start Select in the Loword
and End Select in the Hiword}
if  Loword(More) = HIWORD(More) then
  More := MF_GRAYED
  else More := MF_ENABLED;
EnableMenuItem(menuEdit, mID_Copy, More);
EnableMenuItem(menuEdit, mID_Cut, More);
EnableMenuItem(menuEdit, mID_Del, More);

if GetWindowTextLength(hMemo1) = 0 then
  More := MF_GRAYED
  else More := MF_ENABLED;
EnableMenuItem(menuEdit, mID_SelAll, More);
EnableMenuItem(menuFile, mID_PageSetup, More);
end;

function Ask2Save: Boolean;
var
Re: Integer;
begin
Result := False;
if SendMessage(hMemo1,EM_GETMODIFY,0,0) = 1 then
  begin
  Re := MessageBox(hForm1,'The text in this document has been changed,'#10+
                   'Do you want to save this document to file? ?',
                   'Save this document ? ?', MB_YESNOCANCEL or MB_ICONQUESTION);
  if Re = IDCANCEL then
  Result := True
  else
  if Re = IDYES then
                 if CurrentFile = '?' then
                   SaveIt(True) else
                   SaveIt(False);
  end;
end;

function MessageProc(hWnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
Result := 0;
if Msg = FindMess then
  begin
  if (FindRelp.Flags and (not FR_DIALOGTERM)) <> FindRelp.Flags then
  hFindWnd := 0;
  if (FindRelp.Flags and (not FR_FINDNEXT)) <> FindRelp.Flags then
  SearchFor(FindRelp.lpstrFindWhat,(FindRelp.Flags and (not FR_DOWN)) <> FindRelp.Flags,
           FindRelp.Flags and (not FR_MATCHCASE) <> FindRelp.Flags,
           FindRelp.Flags and (not FR_WHOLEWORD) <> FindRelp.Flags);
  end;
  
case Msg of
  WM_DESTROY: ShutDown;
  WM_COMMAND: if lParam = 0 then
    begin
    case LOWORD(wParam) of
        {the menu ID number is in the LOWORD position of wParam}
      mID_New: begin
        if Ask2Save then Exit;
        CurrentFile := '?';
        SetWindowText(hMemo1,'');
        SetWindowText(hForm1,'New1 -Test Text');
        end;
      mID_Open: begin
        if Ask2Save then Exit;
        OpenTextFile;
        end;
      mID_Save: begin
        if CurrentFile = '?' then
        SaveIt(True) else
        SaveIt(False);
        end;
      mID_SaveAs: SaveIt(True);
      mID_Print: PrintMe;
      mID_PageSetup: SetUpPage;
      mID_Exit: PostMessage(hForm1,WM_CLOSE,0,0);
      mID_Undo: SendMessage(hMemo1, EM_UNDO, 0, 0);
      mID_Copy: SendMessage(hMemo1, WM_COPY, 0, 0);
      mID_Cut: SendMessage(hMemo1, WM_CUT, 0, 0);
      mID_Paste: SendMessage(hMemo1, WM_PASTE, 0, 0);
      mID_Del: SendMessage(hMemo1, WM_CLEAR, 0, 0);
      mID_SelAll: SendMessage(hMemo1, EM_SETSEL, 0, -1);
      mID_Date: InsertDate;
      mID_Wrap: WordWrap;
      mID_Font: GetFont;
      mID_Find: FindIt(True);
      mID_FindNext: FindIt(False);
      end;
    end else
    if (lParam = hMemo1) and (HIWORD(wParam) = EN_CHANGE) then SetLineNum;

  WM_CLOSE: if Ask2Save then Exit;
  WM_DROPFILES:
    begin
    DropedOn(wParam);
    Exit;
    end;
  WM_INITMENUPOPUP: SetMenu;
  WM_SETFOCUS:
    begin
    SetFocus(hMemo1);
    Exit;
    end;
  WM_SIZE:
    begin
    MoveWindow(hMemo1,0,0,LOWORD(lParam),HIWORD(lParam)-22,True);
    MoveWindow(hLineNum,1,HIWORD(lParam)-20,66,20,True);
    MoveWindow(hStatus,68,HIWORD(lParam)-20,LOWORD(lParam)-68,20,True);
    end;

  end; // case
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

procedure MyExit;
begin
ExitProc := PExitSave;  // restore old proc first
CurrentFile := '';
DestroyWindow(hMemo1);
DestroyWindow(hLineNum);
DestroyWindow(hStatus);
DestroyWindow(hForm1);
end;

function GetRegVSize(const CKey: HKey; const Name: PChar; Check: Integer): Integer;
begin
if (RegQueryValueEx(CKey, Name, nil, @DataType, nil,
    @Result) <> ERROR_SUCCESS) or (Check <> DataType) then
Result := 0;
end;

function ReadReg(CKey: HKey; const Name: PChar; Buffer: Pointer;
  BufSize: Integer; Check: Integer): Boolean;
begin
Result := False;
if (RegQueryValueEx(CKey, Name, nil, @DataType, PByte(Buffer),
      @BufSize) = ERROR_SUCCESS)  and (Check = DataType) then
  Result := True;
end;

begin //  *  *  *  *  *  *  * Main Program begin
Wrap := False;
GotSetup := False;
ShowMax := False;
FindRelp.lpstrFindWhat := FindTextA;
{the FindRelp.lpstrFindWhat will be shown as a PChar variable,
but there is no Memory assigned to lpstrFindWhat in that variable,
it's just a Pointer. So you have to have an array of Char and set
lpstrFindWhat := ArrayOfChar
this sets the Pointer to ArrayOfChar - - Unlike A
PChar1 := PChar2
where the Charaters in PChar1 are set to the Charaters in PChar2
Now FindRelp.lpstrFindWhat and FindTextA use the same block of memory}
FindRelp.wFindWhatLen := SizeOf(FindTextA);
FindTextA[0] := #0;

CurrentFile := '?';
PntDrvName := '?';

SetRect(MinMarRect,250,250,250,500);
Top := (GetSystemMetrics(SM_CYSCREEN) div 2)-220;
Left := (GetSystemMetrics(SM_CXSCREEN) div 2)-310;
sHeight := 420;
sWidth := 620;
PExitSave := ExitProc;
ExitProc := @MyExit;

FontLog.lfHeight := -14;
FontLog.lfWidth := 0;
FontLog.lfWeight := FW_NORMAL;
FontLog.lfCharSet := ANSI_CHARSET;
FontLog.lfOutPrecision := OUT_TT_PRECIS;
FontLog.lfClipPrecision := CLIP_DEFAULT_PRECIS;
FontLog.lfQuality := ANTIALIASED_QUALITY;
FontLog.lfPitchAndFamily := FIXED_PITCH or FF_ROMAN;
FontLog.lfUnderline := 0;
FontLog.lfStrikeOut := 0;
FontLog.lfFaceName := 'Courier New';
PntDrvName := 'Mrial';
if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software\TestText88', 0,
      KEY_READ, TT88Key) = ERROR_SUCCESS then
  begin
  RegTemp := 8;
     if ReadReg(TT88Key, 'Position', @RegTemp, SizeOf(Integer), REG_DWORD) then
       begin
       Left := LOWORD(RegTemp);
       Top := HIWORD(RegTemp);
       end;
     if ReadReg(TT88Key, 'WindowSize', @RegTemp, SizeOf(Integer), REG_DWORD) then
       begin
       sHeight := LOWORD(RegTemp);
       sWidth := HIWORD(RegTemp);
       end;
     if ReadReg(TT88Key, 'IsMax', @RegTemp, SizeOf(Integer), REG_DWORD) then
       if RegTemp or SW_SHOWMAXIMIZED = RegTemp then ShowMax := True;
     RegTemp := GetRegVSize(TT88Key, 'FontFace', REG_SZ);
     if RegTemp >0 then
       begin
       if ReadReg(TT88Key, 'FontFace', @FaceNmA, RegTemp, REG_SZ) then
       StrCopy(FontLog.lfFaceName,FaceNmA);
       end;
      if ReadReg(TT88Key, 'FontSize', @RegTemp, SizeOf(Integer), REG_DWORD) then
      FontLog.lfHeight := RegTemp;
      if ReadReg(TT88Key, 'FontWeight', @RegTemp, SizeOf(Integer), REG_DWORD) then
      FontLog.lfWeight := RegTemp;
      if ReadReg(TT88Key, 'FontVar', @RegTemp, SizeOf(Integer), REG_DWORD) then
        begin
        Integer(Arry4Byte) := RegTemp;
        FontLog.lfPitchAndFamily := Arry4Byte[0];
        FontLog.lfCharSet := Arry4Byte[1];
        FontLog.lfClipPrecision := Arry4Byte[2];
        FontLog.lfItalic := Arry4Byte[3];
        {another way to Read separate Bytes is with LOBYTE and HYBYTE
        FontLog.lfPitchAndFamily := LOBYTE(LOWORD(RegTemp));
        FontLog.lfCharSet := HIBYTE(LOWORD(RegTemp));
        FontLog.lfClipPrecision := LOBYTE(HIWORD(RegTemp));
        FontLog.lfItalic := HIBYTE(HIWORD(RegTemp));}
        end;

  RegCloseKey(TT88Key);
  end; {else Top := 444;}

Font1 := CreateFontIndirect(FontLog);
Font2 := CreateFont(-12,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET,OUT_DEFAULT_PRECIS,
   CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,VARIABLE_PITCH or FF_SWISS,'MS Sans Serif');


with wClass do
  begin
  hInstance := SysInit.hInstance;
  hIcon:= LoadIcon(hInstance,'MAINICON');
  lpfnWndProc:=   @MessageProc;
  hbrBackground:= COLOR_BTNFACE+1;
  lpszClassName:= 'Text Class';
  hCursor:=       LoadCursor(0,IDC_ARROW);
  end;

RegisterClass(wClass);

menuFile := CreateMenu();
InsertMenu(menuFile,0,MF_BYPOSITION or MF_STRING,mID_New,'&New');
InsertMenu(menuFile,1,MF_BYPOSITION or MF_STRING,mID_Open,'&Open');
InsertMenu(menuFile,2,MF_BYPOSITION or MF_STRING,mID_Save,'&Save');
InsertMenu(menuFile,3,MF_BYPOSITION or MF_STRING,mID_SaveAs,'Save &As');
InsertMenu(menuFile,4,MF_BYPOSITION or MF_SEPARATOR,1,nil);
InsertMenu(menuFile,6,MF_BYPOSITION or MF_STRING,mID_Print,'&Print');
InsertMenu(menuFile,5,MF_BYPOSITION or MF_STRING,mID_PageSetup,'Page Se&tup');
InsertMenu(menuFile,7,MF_BYPOSITION or MF_SEPARATOR,1,nil);
InsertMenu(menuFile,8,MF_BYPOSITION or MF_STRING,mID_Exit,'E&xit');

menuEdit := CreateMenu();
InsertMenu(menuEdit,0,MF_BYPOSITION or MF_STRING,mID_Undo,'&Undo          Ctrl+Z');
InsertMenu(menuEdit,1,MF_BYPOSITION or MF_SEPARATOR,1,nil);
InsertMenu(menuEdit,2,MF_BYPOSITION or MF_STRING,mID_Copy,'&Copy          Ctrl+C');
InsertMenu(menuEdit,3,MF_BYPOSITION or MF_STRING,mID_Cut,'Cu&t             Ctrl+X');
InsertMenu(menuEdit,4,MF_BYPOSITION or MF_STRING,mID_Paste,'&Paste         Ctrl+V');
InsertMenu(menuEdit,5,MF_BYPOSITION or MF_STRING,mID_Del,'Delete        Del');
InsertMenu(menuEdit,6,MF_BYPOSITION or MF_SEPARATOR,1,nil);
InsertMenu(menuEdit,7,MF_BYPOSITION or MF_STRING,mID_SelAll,'Select &All');
InsertMenu(menuEdit,8,MF_BYPOSITION or MF_STRING,mID_Date,'Time/&Date    F5');
InsertMenu(menuEdit,9,MF_BYPOSITION or MF_SEPARATOR,1,nil);
InsertMenu(menuEdit,10,MF_BYPOSITION or MF_STRING,mID_Wrap,'&Word Wrap');
InsertMenu(menuEdit,11,MF_BYPOSITION or MF_STRING,mID_Font,'Set &Font');

menuSearch := CreateMenu();
InsertMenu(menuSearch,0,MF_BYPOSITION or MF_STRING,mID_Find,'&Find');
InsertMenu(menuSearch,1,MF_BYPOSITION or MF_STRING,mID_FindNext,'Find &Next   F3');

MenuInfo.cbSize := SizeOf(MenuInfo);
MenuInfo.fMask := MIIM_ID or MIIM_SUBMENU or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.fState := 0;
MenuInfo.dwTypeData := '&File';
MenuInfo.cch := 5;
MenuInfo.hSubMenu := menuFile;
MenuInfo.wID := 10;
MenuInfo.hbmpChecked := 0;
MenuInfo.hbmpUnchecked := 0;


menuMain := CreateMenu();
InsertMenuItem(menuMain,0,True,MenuInfo);

MenuInfo.dwTypeData := '&Edit';
MenuInfo.hSubMenu := menuEdit;
MenuInfo.wID := 11;
InsertMenuItem(menuMain,1,True,MenuInfo);

MenuInfo.dwTypeData := '&Search';
MenuInfo.hSubMenu := menuSearch;
MenuInfo.cch := 7;
MenuInfo.wID := 12;
InsertMenuItem(menuMain,2,True,MenuInfo);

hForm1 := CreateWindow(wClass.lpszClassName,'New1 -Test Text',WS_OVERLAPPEDWINDOW,
    Left, Top,sWidth,sHeight,0,menuMain,hInstance,nil);

if hForm1 = 0 then
begin
Exit;
end;

GetClientRect(hForm1,Rect1);
hMemo1:=CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', nil,
  WS_VISIBLE or WS_CHILD or WS_VSCROLL or ES_LEFT or ES_MULTILINE
  or ES_AUTOVSCROLL or ES_AUTOHSCROLL or WS_HSCROLL {or ES_WANTRETURN},
    0,0,Rect1.Right,Rect1.Bottom-40,hForm1,0,hInstance,nil);

SendMessage(hMemo1,WM_SETFONT,Font1,0);
SendMessage(hMemo1, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MAKELONG(4, 4));

hLineNum := CreateWindowEx(WS_EX_CLIENTEDGE, 'Static', ' 1: 1',
    WS_VISIBLE or WS_CHILD or SS_NOPREFIX or SS_CENTER,
    0, Rect1.Bottom-20, 49,20, hForm1, 0, hInstance,nil);
SendMessage(hLineNum,WM_SETFONT,Font2,0);

hStatus := CreateWindowEx(WS_EX_CLIENTEDGE, 'Static', ' New1',
    WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or SS_NOPREFIX,
    51, Rect1.Bottom-20, Rect1.Right,20, hForm1, 0, hInstance,nil);
SendMessage(hStatus,WM_SETFONT,Font2,0);

PMemo1Proc := Pointer(SetWindowLong(hMemo1, GWL_WNDPROC, Longint(@Memo1Proc)));

DragAcceptFiles(hForm1,True);
DragAcceptFiles(hMemo1,True);
FindMess := RegisterWindowMessage(FINDMSGSTRING);

hFindWnd := 0;

if ParamStr(1)<> '' then
if FileExists(ParamStr(1)) then
File2Memo(ParamStr(1));
{ParamStr(1) tests for command line file name and loads the
file if it exists}

if ShowMax then
ShowWindow(hForm1, SW_SHOWMAXIMIZED)
else ShowWindow(hForm1, SW_SHOWDEFAULT);

while GetMessage(mainMsg,0,0,0) do
  begin
  TranslateMessage(mainMsg);
  DispatchMessage(mainMsg);
  end;

end.

Next
The next program uses a listbox and textdraw functions with the WM_PAINT message for a Post some Notes program.
  PostNote


       






H O M E