home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcmagazi
/
1992
/
19
/
cddemo.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-30
|
24KB
|
824 lines
{************************************************}
{ }
{ Turbo Pascal for Windows }
{ Demo program }
{ Copyright (c) 1992 by Pat Ritchey }
{ }
{************************************************}
{$B-,I-,V-,R+}
program CDDemo;
{$R CDDEMO}
uses WinProcs, WinTypes, Strings, WinDOS,
{$IFDEF VER10} { If we're compiling with TPW 1.0, some special }
{ branching is needed: }
{$IFDEF BWCC}
WObjectB, { TPW 1.0 - Use units shipped with Resource Workshop }
BWCC,
{$ELSE}
WObjects, { TPW 1.0 - Don't use BWCC dialogs at all }
{$ENDIF}
Xtra31, { TPW 1.0 - Some Win 3.1 functions this demo needs }
{$ELSE} { If we're compiling with TPW 1.5 or later, no }
{ special branching is required. }
WObjects,
BWCC, { TPW 1.5 - Activates TPW 1.5's Wobjects' BWCC support }
Win31, { TPW 1.5 - New Win 3.1 functions defined here. }
{$ENDIF}
COMMDLG, { CommDlg functions - same as TPW 1.5's Commdlg.pas }
CDOWL; { OWL object layer for CommDlg dialogs, the feature of }
{ this demo program. }
{$I cddemo.inc }
const
AppName = 'CDDEMO';
MaxLines = 16000; { The maximum number of text lines that can be loaded.
Due to the implementation of a TCollection, the
absolute maximum is 16384 }
var
UserAbort : boolean;
type
PBrowseWindow = ^TBrowseWindow;
TBrowseWindow = object(TWindow)
CurColor : longint;
CurFont : hFont;
CurBkGndColor : longint;
CurBkgnd : hBrush;
LF : TLogFont;
CCA : CustColorArray;
TextCol : PStrCollection;
LastFound : integer;
FRDlg : PFindReplaceDlg;
DevNames : PDevNames;
DevMode : PDevMode;
PrintDC : hDC;
FileIsDirty : boolean;
CurrentFile : array[0..fsPathName] of char;
constructor Init;
Destructor Done; virtual;
Procedure GetWindowClass(var WndClass : TWndClass); virtual;
Procedure SetupWindow; virtual;
Function CanClose : boolean; virtual;
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
Procedure WMKeyDown(var Msg : TMessage); virtual wm_first+wm_KeyDown;
procedure CMChangeFont(var Msg: TMessage);
virtual cm_First + cm_ChangeFont;
procedure CMChangeEffects(var Msg : TMessage);
virtual cm_first + cm_ChangeEffects;
Procedure CMChangeColor(var Msg : TMessage);
virtual cm_first + cm_ChangeColor;
procedure CMAbout(var Msg: TMessage);
virtual cm_First + cm_About;
Procedure CMFileOpen(var Msg : TMessage);
virtual cm_First + cm_FileOpen;
Procedure CMFileSaveAs(var Msg : TMessage);
virtual cm_First + cm_FileSaveAs;
Procedure CMFindText(var Msg : TMessage);
virtual cm_First + cm_EditFind;
Procedure CMReplaceText(var Msg : TMessage);
virtual cm_First + cm_EditReplace;
Procedure CMPrint(var Msg : Tmessage);
virtual cm_first+cm_Print;
Procedure CMPrintSetup(var Msg : TMessage);
virtual cm_first+cm_PrintSetup;
Procedure DefWndProc(var Msg : TMessage); virtual;
private
FileLines : word;
Procedure LoadFile(FileName : pchar);
Procedure SetScrollUnits;
Procedure FindReplaceMessage(var Msg : TMessage);
Function SaveFile(Ask : boolean) : boolean;
Procedure PrintTheText(FromI,ToI : integer);
end;
PMyFileDlg = ^TMyFileDlg;
TMyFileDlg = object(TFileDlg)
Function GetFileFilter : Pchar; virtual;
end;
PMyPrintDlg = ^TMyPrintDlg;
TMyPrintDlg = object(TPrintInitDlg)
Procedure SetupWindow; virtual;
end;
PAbortDialog = ^TAbortDialog;
TAbortDialog = object(TDialog)
Procedure Cancel(var Msg : TMessage); virtual id_first+id_Cancel;
Procedure UpdateStatus(Total,Printed : integer);
end;
{ Application object }
TBrowseApp = object(TApplication)
procedure InitMainWindow; virtual;
end;
Function Min(i1,i2 : integer) : integer;
begin
if i1 < i2 then Min := i1 else Min := i2;
end;
Function Max(i1,i2 : integer) : integer;
begin
if i1 > i2 then Max := i1 else Max := i2;
end;
Function StrIPos(TargetStr,SubStr : Pchar) : Pchar;
var
i,SLen,TLen : integer;
begin
SLen := StrLen(SubStr);
TLen := StrLen(TargetStr);
for i := 0 to TLen-SLen do
if StrLIComp(SubStr,@TargetStr[i],SLen) = 0 then
begin
StrIPos := @TargetStr[i];
exit;
end;
StrIPos := nil;
end;
{ TMyFileDlg is a descendant of TFileDlg. A descendant is created and used
by this app so that a GetFileFilter method (specific to this app) can be
created. }
Function TMyFileDlg.GetFileFilter : pchar;
begin
GetFileFilter :=
'Pascal Files'#0'*.pas;*.inc'#0+
'C Files'#0'*.c;*.h;*.cpp;*.hpp'#0+
'Resources'#0'*.rc;*.dlg'#0+
'All Files'#0'*.*'#0;
end;
{ TMyPrintDlg is a descendant of TPrintInitDlg. This object overrides the
SetupWindow method so that the checkbox that normally is displayed as
"[ ] Pages" can be changed to "[ ] Lines". This is done because this
application prints on a line by line basis rather than a page by page basis.
}
Procedure TMyPrintDlg.SetupWindow;
begin
TPrintInitDlg.SetupWindow;
SendDlgItemMsg(1058,WM_SETTEXT,0,longint(pchar('&Lines')));
end;
Procedure TAbortDialog.UpdateStatus(Total,Printed : integer);
var
TextStr : array[0..30] of char;
begin
if (Printed mod 10) = 0 then
begin
wvsprintf(TextStr,'Printed %d of %d lines',Printed);
SendDlgItemMsg(101,WM_SETTEXT,0,longint(@TextStr));
end;
end;
Procedure TAbortDialog.Cancel;
begin
UserAbort := true;
SendDlgItemMsg(101,WM_SETTEXT,0,longint(pchar('Printing Aborted')));
end;
{ Constructor for main window object. }
constructor TBrowseWindow.Init;
var
i : integer;
begin
TWindow.Init(nil, 'File Browser');
Attr.Menu := LoadMenu(HInstance, 'MAIN');
Attr.Style := Attr.Style or WS_HSCROLL or WS_VSCROLL;
{ Initialize the font and colors to some default values }
CurFont := GetStockObject(System_Fixed_FONT);
GetObject(CurFont,Sizeof(LF),@LF);
CurFont := CreateFontIndirect(LF);
CurColor := 0;
CurBkgndColor := GetSysColor(COLOR_Window);
CurBkgnd := CreateSolidBrush(CurBkgndColor);
for i := 0 to 15 do CCA[i] := $FFFFFF;
{ initialize the file and printer fields of the window. The DevNames and
DevMode fields will actually be initialized in this window's SetupWindow
method (when the hWindow field is valid). }
LastFound := -1;
PrintDC := 0;
FileIsDirty := false;
CurrentFile[0] := #0;
DevNames := nil;
DevMode := nil;
New(TextCol,Init(100,100));
Scroller := New(PScroller,Init(@Self,0,0,0,0));
Scroller^.AutoOrg := false;
end;
Destructor TBrowseWindow.Done;
begin
if CurFont <> 0 then DeleteObject(CurFont);
Dispose(TextCol,Done);
if PrintDC <> 0 then DeleteDC(PrintDC);
TWindow.Done;
end;
Procedure TBrowseWindow.GetWindowClass;
begin
TWindow.GetWindowClass(WndClass);
WndClass.hIcon := LoadIcon(hInstance,'MAIN');
WndClass.hbrBackGround := CurBkgnd;
end;
Procedure TBrowseWindow.SetupWindow;
begin
TWindow.SetupWindow;
{executing a TPrintInitDlg dialog with the PD_ReturnDefault flag cause the
"PrintDC", "DevNames" and "DevMode" structures to be initialized without
actually displaying a dialog. }
Application^.ExecDialog(NEw(PPrintInitDlg,Init(@Self,PD_PRINTSETUP or PD_ReturnDefault,
PrintDC,DevNames,DevMode)));
SetScrollUnits;
end;
Function TBrowseWindow.CanClose;
begin
If FileIsDirty then
CanClose := SaveFile(True)
else
CanClose := true;
end;
Procedure TBrowseWindow.SetScrollUnits;
var
DC : hDC;
OldFont : hFont;
TM : TTextMetric;
begin
DC := GetDC(0);
OldFont := SelectObject(DC,CurFont);
GetTextMetrics(DC,TM);
SelectObject(DC,OldFont);
ReleaseDC(0,DC);
Scroller^.SetUnits(TM.tmAveCharWidth,TM.tmHeight);
end;
Procedure TBrowseWindow.LoadFile(FileName : pchar);
{ Loads a text file into a collection. This demo program will handle text
files with up to 16,000 lines. }
const
TextBufSize = 32768;
var
f : text;
FText : array[0..255] of char;
TextBuf : pointer;
Procedure CloseFile;
begin
Close(f);
if IOResult = 0 then;
FreeMem(TextBuf,TextBufSize);
end;
begin
GetMem(TextBuf,TextBufSize);
Assign(f,FileName);
SetTextBuf(f,TextBuf^,TextBufSize); { optimize the text buffer for fast loading }
Reset(f);
if IOResult <> 0 then
begin
FreeMem(TextBuf,TextBufSize);
MessageBox(hWindow,'Unable to open the file',AppName,MB_OK or MB_ICONSTOP);
exit;
end;
TextCol^.FreeAll; { get rid of any text lines that may be present from a
previously loaded file }
FileLines := 0;
FileIsDirty := true;
LastFound := -1;
While (FileLines < MaxLines) and (not Eof(f)) do
begin
Readln(f,FText);
if IOResult <> 0 then
begin
CloseFile;
MessageBox(hWindow,'Error reading the file',AppName,MB_OK or MB_ICONSTOP);
exit;
end;
if FText[0] = #0 then
begin
{ StrNew won't create a zero length string. Modify the string so that
it's a string with a length of one. }
FText[0] := ' ';
FText[1] := #0;
end;
With TextCol^ do AtInsert(Count,StrNew(FText));
Inc(FileLines);
end;
If not EOF(f) then
MessageBox(hWindow,'File too large, trucation has occured',AppName,MB_OK or MB_ICONINFORMATION)
else
FileIsDirty := false;
CloseFile;
StrCopy(CurrentFile,FileName);
StrCopy(FText,'File Browser - ');
StrCat(FText,StrLower(FileName));
SetWindowText(hWindow,FText);
Scroller^.SetRange(120,FileLines);
InvalidateRect(hWindow,nil,true);
Scroller^.ScrollTo(0,0);
end;
Function TBrowseWindow.SaveFile(Ask : boolean) : boolean;
var
FileName : array[0..fsPathName] of char;
begin
SaveFile := false;
If Ask then
if MessageBox(hWindow,'File has been modified, Save it?',AppName,
MB_OKCANCEL or MB_ICONQUESTION) = id_Cancel then exit;
StrCopy(FileName,CurrentFile);
if Application^.ExecDialog(New(PMyFileDlg,
Init(@Self,OFN_HIDEREADONLY,Save,FileName,fsPathName))) = id_Cancel then exit;
{ Code to write text to disk would go here. This demo program does not
support file writing.}
MessageBox(hWindow,'This function is not implemented','File Save',MB_OK or
MB_ICONSTOP);
SaveFile := true;
end;
Procedure TBrowseWindow.CMFileOpen(var Msg : TMessage);
var
FileName : array[0..fsPathName] of char;
begin
If FileIsDirty then
If not SaveFile(true) then exit;
StrCopy(FileName,'');
if Application^.ExecDialog(New(PMyFileDlg,
Init(@Self,OFN_FILEMUSTEXIST,
Open,FileName,fsPathName))) = id_ok then
LoadFile(FileName);
end;
Procedure TBrowseWindow.CMFileSaveAs(var Msg : TMessage);
begin
SaveFile(false);
end;
procedure TBrowseWindow.CMChangeFont(var Msg: TMessage);
var
P : PChooseFontDlg;
FontFlags : word;
begin
FontFlags := CF_SCREENFONTS or CF_SHOWHELP;
{ check if this is a "Change Effects" menu selection or a simple
"Change Font" message. }
if Msg.wParam = cm_ChangeEffects then
FontFlags := FontFlags or CF_EFFECTS;
P := New(PChooseFontDlg,Init(@Self,FontFlags,@LF,CurColor));
P^.SetPrinterDC(PrintDC);
if Application^.ExecDialog(P) = id_OK then
begin
If CurFont <> 0 then
DeleteObject(CurFont); { get rid of the "old" font }
CurFont := CreateFontIndirect(lf); { create the new font }
SetScrollUnits; { adjust the scroller for the new font }
InvalidateRect(hWindow,nil,true); { cause a repaint using the new font }
end;
end;
procedure TBrowseWindow.CMChangeEffects;
begin
{ direct the message to CMChangeFont. Code in that method will determine
the actual source of the message. }
CMChangeFont(Msg);
end;
procedure TBrowseWindow.CMChangeColor(var Msg: TMessage);
begin
if Application^.ExecDialog(New(PChooseColorDlg,
Init(@Self,CC_SHOWHELP,CCA,CurBkgndColor))) = id_OK then
begin
CurBkgnd := CreateSolidBrush(CurBkgndColor);
DeleteObject(SetClassWord(hWindow,GCW_hbrBackground,CurBkgnd));
InvalidateRect(hWindow,nil,true);
end;
end;
procedure TBrowseWindow.CMAbout(var Msg: TMessage);
var
AboutResID : PChar;
begin
{$IFDEF VER10}
{$IFDEF BWCC}
AboutResId := 'ABOUT';
{$ELSE}
AboutResID := 'ABOUT_PLAIN';
{$ENDIF}
{$ELSE}
if BWCCClassNames then AboutResId := 'ABOUT' else AboutResID := 'ABOUT_PLAIN';
{$ENDIF}
Application^.ExecDialog(New(PDialog, Init(@Self, AboutResID)));
end;
Procedure TBrowseWindow.CMFindText(var Msg : TMessage);
begin
LastFound := -1;
FRDlg := New(PFindReplaceDlg,Init(@Self,0,nil,nil));
if Application^.MakeWindow(FRDlg) <> nil then;
end;
Procedure TBrowseWindow.CMReplaceText(var Msg : TMessage);
begin
LastFound := -1;
FRDlg := New(PFindReplaceDlg,Init(@Self,FR_REPLACE,nil,nil));
Application^.MakeWindow(FRDlg);
end;
{ Abort procedure used for printing }
function AbortProc(Prn: HDC; Code: Integer): Boolean; export;
var
Msg: TMsg;
begin
while not UserAbort and PeekMessage(Msg, 0, 0, 0, pm_Remove) do
if not Application^.ProcessAppMsg(Msg) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
AbortProc := not UserAbort;
end;
Procedure TBrowseWindow.PrintTheText(FromI,ToI : integer);
var
i : integer;
di : TDocInfo;
LinesPrinted,
LineHeight,
LinesPerPage : integer;
TM : TTextMetric;
OldFont : hFont;
Item : Pchar;
PrevMode : word;
vExt,wExt : longint;
PrintLF : TLogFont;
PrintFont : hFont;
DisplayDC : hDC;
AbortDlg : PAbortDialog;
AbortProcInst : function (DC: HDC; Error: Integer): Boolean;
Error : integer;
begin
LinesPrinted := 0;
{ Create a font scaled to the printer }
PrintLF := LF;
DisplayDC := GetDC(0);
PrintLF.lfHeight := -MulDiv(Abs(LF.lfHeight),
GetDeviceCaps(PrintDC,LOGPIXELSY),
GetDeviceCaps(DisplayDC,LOGPIXELSY));
ReleaseDC(0,DisplayDC);
PrintFont := CreateFontIndirect(PrintLF);
OldFont := SelectObject(PrintDC,PrintFont);
GetTextMetrics(PrintDC,TM);
LineHeight := TM.tmHeight+TM.tmExternalLeading;
LinesPerPage := GetDeviceCaps(PrintDC,VERTRES) div LineHeight;
with di do
begin
cbSize := sizeof(DI);
lpszDocName := AppName;
lpszOutput := nil;
end;
UserAbort := false;
AbortDlg := New(PAbortDialog,Init(@Self,'ABORTDLG'));
Application^.MakeWindow(AbortDlg);
@AbortProcInst := MakeProcInstance(@AbortProc,hInstance);
SetAbortProc(PrintDC,AbortProcInst);
UpdateWindow(hWindow);
EnableWindow(hWindow,false);
AbortDlg^.UpdateStatus(Succ(ToI-FromI),0);
Error := StartDoc(PrintDC,DI);
If error >= 0 then StartPage(PrintDC);
i := Pred(FromI);
While (Error >= 0) and (i < ToI) do
begin
if LinesPrinted >= LinesPerPage then
begin
EndPage(PrintDC);
StartPage(PrintDC);
LinesPrinted := 0;
end;
Item := TextCol^.At(i);
TabbedTextOut(PrintDC,0,LinesPrinted*LineHeight,Item,StrLen(Item),
0,mem[0:0],0);
AbortDlg^.UpdateStatus(Succ(ToI-FromI),(Succ(Succ(i)-FromI)));
Inc(LinesPrinted);
Inc(i);
if UserAbort then Error := -1;
end;
if Error >= 0 then
begin
EndPage(PrintDC);
EndDoc(PrintDC);
end
else
AbortDoc(PrintDC);
FreeProcInstance(@AbortProcInst);
EnableWindow(hWindow,true);
Dispose(AbortDlg,Done);
SelectObject(PrintDC,OldFont);
DeleteObject(PrintFont);
UserAbort := false;
end;
Procedure TBrowseWindow.CMPrint;
var
P : PPrintInitDlg;
PD : TPrintDlg;
OldPrintDC : hDC;
begin
OldPrintDC := PrintDC;
P := New(PMyPrintDlg,Init(@Self,PD_NOSELECTION,
PrintDC,DevNames,DevMode));
P^.SetMinMaxPage(1,TextCol^.Count);
P^.SetCDTransferBuffer(@PD);
if Application^.ExecDialog(P) = id_ok then
begin
if OldPrintDC <> 0 then DeleteDC(OldPrintDC);
With PD do begin
if (Flags and PD_PAGENUMS) = 0 then
begin
nFromPage := 1;
nToPage := TextCol^.Count;
end;
PrintTheText(nFromPage,nToPage);
end; end;
end;
Procedure TBrowseWindow.CMPrintSetup;
var
OldPrintDC : hDC;
begin
OldPrintDC := PrintDC;
if Application^.ExecDialog(NEw(PPrintInitDlg,Init(@Self,PD_PRINTSETUP,
PrintDC,DevNames,DevMode))) = id_ok then
if OldPrintDC <> 0 then DeleteDC(OldPrintDC);
end;
Procedure TBrowseWindow.WMKeyDown;
{ a simple keyboard handler that causes the window to respond to
keystrokes in a manner similar to the TPW IDE. }
var
CtrlPress : boolean;
begin
CtrlPress := GetKeyState(VK_CONTROL) < 0;
if Scroller <> nil then
With Scroller^ do
case Msg.wParam of
VK_Up : ScrollBy(0,-1);
VK_Down : ScrollBy(0,1);
VK_Left : If CtrlPress then ScrollBy(-10,0) else ScrollBy(-1,0);
VK_Right : If CtrlPress then ScrollBy(10,0) else ScrollBy(1,0);
VK_Home : ScrollTo(0,Ypos);
VK_End : ScrollTo(XRange,YPos);
VK_Prior : If not CtrlPress then ScrollBy(0,-YPage) else ScrollTo(0,0);
VK_Next : If not CtrlPress then ScrollBy(0,YPage) else ScrollTo(0,YRange);
end;
end;
Procedure TBrowseWindow.FindReplaceMessage(var Msg : TMessage);
{ Process a message sent from a Find/Replace modeless dialog to the
parent Window }
var
SearchString : pchar;
WholeWord,
MatchCase : boolean;
SearchLen : integer;
{$IFOPT R+} {$DEFINE RestoreR} {$ENDIF}
{$IFOPT B+} {$DEFINE RestoreB} {$ENDIF}
{$R-,B-}
Function ISWholeWord(SubStr,TargetStr : Pchar; Len : integer) : boolean;
{- This function determines if the preceding or following character
of the substring is alphanumeric. For the function to work properly
it is required that the $B- and $R- options are set.}
var
i : integer;
begin
i := -1;
IsWholeWord :=
((SubStr = TargetStr) or (not IscharAlphaNumeric(SubStr[i]))) and
(not (IsCharAlphaNumeric(SubStr[Len])));
end;
{$IFDEF RestoreR} {$R+} {$UNDEF RestoreR} {$ENDIF}
{$IFDEF RestoreB} {$B+} {$UNDEF RestoreB} {$ENDIF}
Function GetSubString(i : integer; SrchOfs : integer) : Pchar;
var
SubString,
TargetStr : Pchar;
begin
TargetStr := TextCol^.At(i);
Inc(TargetStr,SrchOfs);
if MatchCase then
SubString := StrPos(TargetStr,SearchString)
else
SubString := StrIPos(TargetStr,SearchString);
if SubString <> nil then
if WholeWord then
if not IsWholeWord(SubString,TextCol^.At(i),SearchLen) then
SubString := nil;
GetSubString := SubString;
end;
Function FindNextOccurance : boolean;
var
i,
Dir : integer;
begin
FindNextOccurance := true;
if FRDlg^.FindOptionSet(FR_Down) then Dir := 1 else Dir := -1;
if LastFound = -1 then
i := Scroller^.YPos
else
i := LastFound+Dir;
while (i < TextCol^.Count) and (i >= 0) do
begin
if GetSubString(i,0) <> nil then
begin
LastFound := i;
exit;
end;
Inc(i,Dir);
end;
FindNextOccurance := false;
end;
Procedure ReplaceText(FirstLine,LastLine : integer);
Var
SubStr,
TargetStr,
NewStr,
ReplaceStr : Pchar;
NextOfs,
ReplaceLen,
NewLen,
i : integer;
begin
ReplaceStr := FRDlg^.ReplaceWith;
ReplaceLen := StrLen(ReplaceStr);
for i := FirstLine to LastLine do
begin
SubStr := GetSubString(i,0);
while Substr <> nil do
begin
TargetStr := TextCol^.At(i);
NewLen := StrLen(TargetStr)-SearchLen+ReplaceLen;
GetMem(NewStr,NewLen+1);
StrLCopy(NewStr,TargetStr,(SubStr-TargetStr));
Inc(TargetStr,StrLen(NewStr)+SearchLen);
StrCat(NewStr,ReplaceStr);
NextOfs := StrLen(NewStr);
StrCat(NewStr,TargetStr);
StrDispose(TextCol^.At(i));
TextCol^.Items^[i] := NewStr;
FileIsDirty := true;
LastFound := i;
SubStr := GetSubString(i,NextOfs);
end;
end;
InvalidateRect(hWindow,nil,true);
With Scroller^ do
ScrollTo(0,Max(LastFound-(YPage div 2),0));
end;
begin { FindReplaceMessage }
with FRDlg^ do begin
MatchCase := FindOptionSet(FR_MATCHCASE);
WholeWord := FindOptionSet(FR_WHOLEWORD);
SearchString := FindWhat;
SearchLen := StrLen(SearchString);
end;
If FRDlg^.FindOptionSet(FR_FINDNEXT) then
begin
If not FindNextOccurance then
begin
{ the hWindow field in the MessageBox call is the dialogs
window handle. This is the desired window handle. }
MessageBox(FRDlg^.hWindow,'No further occurances',AppName,
MB_ICONINFORMATION or MB_OK);
LastFound := -1;
InvalidateRect(hWindow,nil,true);
end
else
With Scroller^ do
begin
InvalidateRect(hWindow,nil,true);
ScrollTo(0,Max(LastFound-(YPage div 2),0));
end;
end
else
If FRDlg^.FindOptionSet(FR_Replace) then
begin
if LastFound = -1 then
begin
MessageBox(FRDlg^.hWindow,'No Item is selected',AppName,MB_OK);
exit;
end;
ReplaceText(LastFound,LastFound);
end
else
IF FRDlg^.FindOptionSet(FR_ReplaceAll) then
begin
if LastFound = -1 then
begin
MessageBox(FRDlg^.hWindow,'No Item is selected',AppName,MB_OK);
exit;
end;
ReplaceText(LastFound,Pred(TextCol^.Count));
end;
end;
Procedure TBrowseWindow.DefWndProc(Var Msg : TMessage);
{- Messages sent to the parent window by COMMDLG have message IDs
which are registered dynamically (via RegisterWindowMessage). This
prevents the abiltity to create of dynamic methods, so they must be
handled here. }
begin
if Msg.Message = IDC_FindReplace then
FindReplaceMessage(Msg)
else
TWindow.DefWndProc(Msg);
end;
procedure TBrowseWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var
OldFont : hFont;
OldBrush : hBrush;
x,y,
FirstLine,LastLine,idx : integer;
Item : Pchar;
R : TRect;
begin
OldFont := SelectObject(PaintDC,CurFont);
OldBrush := SelectObject(PaintDC,CurBkgnd);
SetBKMode(PaintDC,Transparent);
SetTextColor(PaintDC,CurColor);
With Scroller^,PaintInfo.RCPaint do begin
FirstLine := (Top div YUnit);
y := FirstLine*YUnit;
x := -(Xpos*XUnit)+XUnit;
FirstLine := FirstLine+YPos;
LastLine := FirstLine+(Bottom div YUnit);
end;
For idx := FirstLine to LastLine do
begin
if (idx >= 0) and (idx < TextCol^.Count) then
begin
Item := TextCol^.At(idx);
TabbedTextOut(PaintDC,x,y,Item,StrLen(Item),0,mem[0:0],x);
{ "mem[0:0]" is a technique that can be used to pass a "NULL pointer"
to a Windows function when the TPW prototype is a VAR parameter. }
if LastFound = idx then
begin
R.top := y; R.Bottom := y+Scroller^.YUnit;
R.Left := 0; R.Right := MaxLines;
InvertRect(PaintDC,R);
end;
end;
Inc(y,Scroller^.YUnit);
end;
SelectObject(PaintDC,OldFont);
SelectObject(PaintDC,OldBrush);
end;
{ Create the application's main window. }
procedure TBrowseApp.InitMainWindow;
begin
MainWindow := New(PBrowseWindow, Init);
end;
var
BrowseApp: TBrowseApp;
begin
BrowseApp.Init(AppName);
BrowseApp.Run;
BrowseApp.Done;
end.