home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 17
/
CD_ASCQ_17_101194.iso
/
bonus
/
tpwform
/
plx.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-08-11
|
28KB
|
861 lines
{Program Listing Express - An ASCII Print Program}
{Begun 8/2/91} {Rel 1.7 6/6/92}
program PLXpress;
{$D Copyright 1991,1992 Doug Overmyer}
{$S-}{$R plx.RES}{$R-}{$X+}{$V-}
uses WinTypes,WinProcs,Strings,WObjects,TextStrm,WFPlus,
Buttons,SclpText,Printer,commdlg,Win31,Meter;
const
cm_FOpen = 101; {menuitem FileOpen }
cm_FPrint = 102; {menuitem FilePrint }
cm_FSetUp = 103; {menuitem FilePageSetup}
cm_FExit = 104; {menuitem FileExit }
cm_SetFont = 111; {menuitem TextFont }
id_But1 = 201; {User defined button 1 iconbar}
id_But2 = 202; { " 2 iconbar}
id_But3 = 203; { " 3 iconbar}
id_But4 = 204; { " 3 iconbar}
id_But5 = 205; { " 5 iconbar}
id_St1 = 401; {Static text 1 icon bar}
id_St2 = 402; {Static text 2 icon bar}
id_D2EC1 = 603; {Edit Control 1 in Dlg2 Margin.left}
id_D2EC2 = 605; { 2 Margin.right}
id_D2EC3 = 607; { 3 Margin.top}
id_D2EC4 = 609; { 4 Margin.bottom}
id_D2EC5 = 617; { 5 tabsize}
id_D2EC6 = 621; { 6 Header text}
id_D2EC7 = 622; { 7 Footer Text}
id_D2CB1 = 612; {Check box 1 in Dlg2 Format.ShowRuler}
id_D2CB2 = 613; {Check box 2 in Dlg2 Format.ShowFName}
id_D2CB3 = 614; {Check box 3 in Dlg2 Format.ShowDTStamp}
id_D2CB4 = 615; {Check box 4 in Dlg2 Format.ShowPageNum}
id_D2CB5 = 619; {Check box 5 in Dlg2 Format.ShowLineNum}
id_D2CB6 = 620; {Check box 6 in dlg2 format.UseCCB}
idm_About = 801; {menu id for PLX_About menu}
idm_RunCP = 802; {menu id for run control panel}
{************************ Types ************************}
type
TPLXApplication = object(TApplication)
procedure InitMainWindow;virtual;
function ProcessMDIAccels(var Message:TMsg):Boolean;virtual;
end;
FormatRec = record
MarginL,MarginR,MarginT,MarginB,TabSize:Array[0..4] of Char;
Header,Footer:Array[0..131] of Char;
ShowRuler,ShowFName,ShowDTStamp,ShowPageNum,ShowLineNum,UseCCB:Word;
end;
PTextObj = ^TTextObj;
TTextObj = object(TObject)
Text:PChar;
constructor Init(NewText:PChar);
destructor Done;virtual;
end;
PPLXAboutDlg = ^TPLXAboutDlg;
TPLXAboutDlg = object(TDialog)
CurBrush:HBrush;
Logo:HBitmap;
constructor Init(aParent:PWindowsObject;AName:PChar;Brush:HBrush);
procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
procedure SetupWindow;virtual;
function CanClose:Boolean;virtual;
end;
PPLXPrinter = ^TPLXPrinter;
TPlxPrinter = object(TLPrinter)
HeadLine1:Array[0..210] of Char;
Format:FormatRec;
procedure DoHeader;virtual;
procedure DoFooter;virtual;
function SetHeader1(NewHeadLine1:PChar):Boolean;virtual;
end;
{MainWindow of Application}
PPLXWindow = ^TPLXWindow;
TPLXWindow = object(TWindow)
DispWin:PEdit; {child window displaying sample lines from infile}
TheIcon:HIcon;
BN:Array[0..5] of PODButton; {icon bar buttons}
FileName:Array[0..79] of Char; {infile name}
CharsInFile:LongInt; {chars in infile}
St1,St2:PSText;
FontSize:Integer; {Current font size in tenths of a point}
Records:PCollection; {Collection of Infile records}
Format:FormatRec; {format fields}
LogFont:TLogFont;
IsProfileDirty:Boolean;
Br1:HBrush;
Buf3:PChar;
Helv:HFont;
constructor Init(AParent:PWindowsObject;ATitle:PChar);
destructor Done;virtual;
procedure SetupWindow;virtual;
procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
procedure SetStaticText;
procedure LoadDispWin;
procedure WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
procedure WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
procedure IDBut1(var Msg:TMessage);virtual id_First+id_But1; {Print}
procedure IDBut2(var Msg:TMessage);virtual id_First+id_But2; {FileOpen}
procedure IDBut3(var Msg:TMessage);virtual id_First+id_But3; {PageSetup}
procedure IDBut4(var Msg:TMessage);virtual id_First+id_But4; {SelectFont}
procedure IDBut5(var Msg:TMessage);virtual id_First+id_But5; {Exit}
procedure FilePrint;virtual ;
procedure WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
procedure CMFOpen(var Msg:TMessage);virtual cm_First+cm_FOpen;
procedure CMFPrint(var Msg:TMessage);virtual cm_First+cm_FPrint;
procedure CMFSetUp(var Msg:TMessage);virtual cm_First+cm_FSetUp;
procedure CMFExit(var Msg:TMessage);virtual cm_First+cm_FExit;
procedure CMSetFont(var Msg:TMessage);virtual cm_First+cm_SetFont;
procedure GetProfileValues;virtual;
procedure WriteProfileValues;virtual;
end;
{********************* Functions *******************************}
function StrTok(P:PChar;C:Char):PChar;
const
Next:Pchar = nil;
begin
if P = NIL then P := Next;
if P <> NIL then
begin
Next := StrScan(P,C);
If Next <> NIL then
begin
Next^ := #0;
Next := Next+1;
end;
end;
StrTok := P;
end;
procedure Take5;
var MsgP:TMsg;
begin
while PeekMessage(MsgP,0,0,0,PM_REMOVE) do
begin
if MsgP.Message = WM_QUIT then
begin
Application^.Done;
Halt;
end;
TranslateMessage(MsgP);
DispatchMessage(MsgP);
end
end;
{*********************** Methods *******************************}
procedure TPLXApplication.InitMainWindow;
begin
MainWindow := New(PPLXWindow,Init(nil,'PLX'));
end;
{This is a hack to avoid a mysterious error}
function TPLXApplication.ProcessMDIAccels(var Message:TMsg):Boolean;
begin
ProcessMDIAccels:= False;
end;
{********************** TPLXWindow *******************************}
constructor TPLXWindow.Init(AParent:PWindowsObject;ATitle:PChar);
var
TheBmp:HBitmap;
begin
TWindow.Init(AParent,ATitle);
Attr.Menu := LoadMenu(HInstance,'PLX_Menu');
Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 260;
Bn[2] := New(PODButton,Init(@Self,id_But2,'File Open',0,0,50,50,False,'PLX_Bn2',nil));
Bn[3] := New(PODButton,Init(@Self,id_But3,'Page Setup',50,0,100,50,False,'PLX_Bn3',nil));
Bn[4] := New(PODButton,Init(@Self,id_But4,'Font',150,0,50,50,False,'PLX_Bn4',nil));
Bn[1] := New(PODButton,Init(@Self,id_But1,'Print',200,0,50,50,False,'PLX_Bn1',nil));
Bn[5] := New(PODButton,Init(@Self,id_But5,'Exit',250,0,50,50,False,'PLX_Bn5',nil));
St1 := New(PSText,Init(@Self,id_St1,'',310,3,260,20,sr_Recessed,dt_Center or dt_VCenter));
St2 := New(PSText,Init(@Self,id_St2,'',310,26,260,20,sr_Recessed,dt_Center or dt_VCenter));
DispWin := New(PEdit,Init(@Self,200,nil,0,0,0,0,0,True));
with DispWin^.Attr do
Style := Style or es_readonly ;
Records := New(PCollection,Init(1000,500));
CharsInFile := 0;
StrCopy(FileName,'');
Format.ShowRuler := 1;Format.ShowFName := 1;
Format.ShowDTStamp := 1;Format.ShowPageNum := 1;
Format.ShowLineNum := 1;Format.UseCCB := 0;
StrCopy(Format.Header,'');StrCopy(Format.Footer,'');
Strcopy(Format.TabSize,'2');
GetProfileValues;
IsProfileDirty := False;
TheBmp :=LoadBitmap(HInstance,'PLX_Brush1');
Br1 :=CreatePatternBrush(TheBmp);
DeleteObject(TheBmp);
end;
procedure TPLXWindow.SetupWindow;
var
SysMenu:hMenu;
OEMFixFont:hFont;
Indx:Word;
LFont:TLogFont;
XStyle:LongInt;
begin
TWindow.SetupWindow;
SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'PLX_Icon'));
Sysmenu := GetSystemMenu(hWindow,false);
AppendMenu(SysMenu,MF_Separator,0,nil);
AppendMenu(SysMenu,0,idm_RunCP,'Run Control Panel');
AppendMenu(Sysmenu,0,idm_About,'About...');
OEMFixFont := GetStockObject(OEM_Fixed_Font);
SendMessage(DispWin^.hWindow,wm_SetFont,OEMFixFont,LongInt(1));
GetObject(GetStockObject(System_Font),sizeof(LogFont),@LFont);
StrCopy(LFont.lfFaceName,'Helv');
LFont.lfHeight := round(LFont.lfHeight * 2 / 3);
LFont.lfWidth := 0;
LFont.lfPitchAndFamily := 0;
Helv := CreateFontIndirect(LFont);
SetStaticText;
XStyle := GetWindowLong(DispWin^.HWindow,GWL_STYLE);
end;
procedure TPLXWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
ThePen:HPen;
TheBrush :HBrush;
OldBrush :HBrush;
OldPen:HPen;
begin
TheBrush := GetStockObject(LtGray_Brush);
ThePen := CreatePen(ps_Solid,1,$00000000);
OldPen := SelectObject(PaintDC,ThePen);
OldBrush := SelectObject(PaintDC,TheBrush);
Rectangle(PaintDC,0,0,1024,50);
SelectObject(PaintDC,OldBrush);
SelectObject(PaintDC,OldPen);
DeleteObject(ThePen);
end;
procedure TPLXWindow.WMDrawItem(var Msg:TMessage);
var
PDIS : ^TDrawItemStruct;
begin
PDIS := Pointer(Msg.lParam);
case PDIS^.CtlType of
odt_Button:
case PDIS^.CtlID of
id_But1..id_But5:BN[PDIS^.CtlID-200]^.DrawItem(Msg);
end;
end;
end;
destructor TPLXWindow.Done;
begin
if IsProfileDirty then
WriteProfileValues;
Dispose(Records,Done);
DeleteObject(Br1);
DeleteObject(Helv);
TWindow.Done;
end;
procedure TPLXWindow.WMSize(var Msg:TMessage);
begin
SetWindowPos(DispWin^.HWindow,0,-1,50,
(Msg.LParamLo )+1,(Msg.LParamHi-50),swp_NoZOrder);
end;
procedure TPLXWindow.IDBut1(var Msg:TMessage);
var
PD:TPrintDlg;
begin
with PD do
begin
lStructSize := sizeof(TPrintDlg);
hWndOwner := HWindow;
hDevMode := THandle(nil);
hDevNames := THandle(nil);
Flags := PD_NOPAGENUMS or PD_NOSELECTION or PD_ALLPAGES or PD_HIDEPRINTTOFILE;
hInstance := THandle(nil);
nCopies := 1;
end;
if (PrintDlg(PD)) then
FilePrint;
end;
procedure TPLXWindow.IDBut2(var Msg:TMessage);
const
szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
var
InFile :PTextStream;
InRecord:PChar;
PctMeter:PMeterWindow;
Division,Pctdone:Integer;
indx1,Indx2 : Integer;
hTab :Integer;
pBuf3:PChar;
Indx:Word;
OEMFixFont:HFont;
pBuf:PChar;
Dir,Name,Ext:Array[0..79] of Char;
szDirName:Array[0..256] of Char;
szFile,szFileTitle:Array[0..256] of Char;
OFN:TOpenFileName;
Ptr:PChar;
begin
DispWin^.CloseWindow;
DispWin := New(PEdit,Init(@Self,200,nil,0,0,0,0,0,True));
with DispWin^.Attr do
Style := Style OR ES_READONLY ;
Application^.MakeWindow(DispWin);
OEMFixFont := GetStockObject(OEM_Fixed_Font);
SendMessage(DispWin^.hWindow,wm_SetFont,OEMFixFont,LongInt(1));
Division := 10;
StrCopy(FileName,'*.*');
if Records^.Count > 0 then
begin
Dispose(Records,Done);
Records := New(PCollection,Init(1000,500));
end;
CharsInFile := 0;
Ptr := @szFilter;
StrCopy(szFile,'');
OFN.lStructSize := sizeof(TOpenFileName);
OFN.hWndOwner := HWindow;
OFN.lpStrFilter := Ptr;
OFN.lpStrCustomFilter := nil;
OFN.nMaxCustFilter := 0;
OFN.nFilterIndex := LongInt(1);
OFN.lpStrFile := szFile;
OFN.nMaxFile := sizeof(szFile);
OFN.lpstrfileTitle := szFileTitle;
OFN.nMaxFileTitle := sizeof(szFileTitle);
OFN.lpstrInitialDir := NIL;
OFN.lpStrTitle := 'Open File';
OFN.flags := OFN_Pathmustexist or OFN_Filemustexist;
OFN.nFileOffset := 0;
OFN.nFileExtension := 0;
OFN.lpstrDefext := nil;
If Not(GetOpenFileName(OFN)) then
begin
SetStaticText;
Exit;
end;
if StrIComp(szFile,'*.*') <> 0 then
begin
StrCopy(FileName,szFile);
InRecord :=MemAlloc(9999);
GetMem(Buf3,35000);
pBuf3 := Buf3;
StrCopy(Buf3,'');
PctMeter := New(PMeterWindow,Init(@Self,'Working...'));
Application^.MakeWindow(PctMeter);
PctMeter^.Draw(0);
InFile := New(PTextStream,Init(FileName,stOpen,1024));
CharsInFile := InFile^.CharsToRead;
While NOT InFile^.IsEOF do
begin
StrCopy(InRecord,InFile^.GetNext);
if InRecord = nil then {avoid storing null pointers }
StrCopy(InRecord,' ');
Records^.Insert(New(PTextObj,Init(InRecord)));
if (((InFile^.CharsRead)+(2*Records^.Count)) < 32768) then
pBuf3 := StrECopy(StrECopy(pBuf3,InRecord),#13#10#0);
if InFile^.GetPctDone > Division then
begin
PctMeter^.Draw(Division);
Inc(Division,5);
end;
Take5;
end;
PctMeter^.CloseWindow;
if ((InFile^.CharsRead)+(2*Records^.Count)) > 32768 then
StrECopy(pBuf3,'Rest of file not displayed...'#13#10#0);
FreeMem(InRecord,9999);
Dispose(InFile,Done);
LoadDispWin;
end;
SetStaticText;
end;
procedure TPLXWindow.LoadDispWin;
var
Indx,TabSize:Integer;
Cursor:hCursor;
CRLF :Array[0..2] of Char;
IntArray:Array[0..11] of Integer;
CR:TRect;
begin
SetCursor(LoadCursor(0,Idc_Wait));
SendMessage(DispWin^.HWindow,wm_SetText,word(0),LongInt(Buf3));
GetClientRect(HWindow,CR);
SetWindowPos(DispWin^.HWindow,0,-1,50,
(CR.Right-CR.Left )+1,(CR.Bottom-CR.Top-50),swp_NoZOrder);
FreeMem(Buf3,35000);
DispWin^.Scroll(0,-32000);
SetCursor(LoadCursor(0,Idc_Arrow));
Val(Format.TabSize,tabsize,Indx);
for Indx := 0 to 11 do
IntArray[Indx] := Indx*4*tabsize;
SendMessage(DispWin^.HWindow,em_SetTabStops,word(12),LongInt(@IntArray));
InvalidateRect(DispWin^.HWindow,nil,False);
end;
procedure TPLXWindow.IDBut3(var Msg:TMessage);
var
TotChars:Integer;
Dlg2:PDialog;
EC1,EC2,EC3,EC4,EC5,EC6,EC7:PEdit;
CB1,CB2,CB3,CB4,CB5,CB6:PCheckBox;
begin
Dlg2 := New(PDialog,Init(@Self,'PLX_Dlg2'));
New(EC1,InitResource(Dlg2,id_D2EC1,5));
New(EC2,InitResource(Dlg2,id_D2EC2,5));
New(EC3,InitResource(Dlg2,id_D2EC3,5));
New(EC4,InitResource(Dlg2,id_D2EC4,5));
New(EC5,InitResource(Dlg2,id_D2EC5,5));
New(EC6,InitResource(Dlg2,id_D2EC6,132));
New(EC7,InitResource(Dlg2,id_D2EC7,132));
New(CB1,InitResource(Dlg2,id_D2CB1));
New(CB2,InitResource(Dlg2,id_D2CB2));
New(CB3,InitResource(Dlg2,id_D2CB3));
New(CB4,InitResource(Dlg2,id_D2CB4));
New(CB5,InitResource(Dlg2,id_D2CB5));
New(CB6,InitResource(Dlg2,id_D2CB6));
Dlg2^.TransferBuffer := @Format;
if (Application^.ExecDialog(Dlg2) = 1) then
IsProfileDirty := True;
end;
procedure TPLXWindow.IDBut4(var Msg:TMessage);
var
CF:TChooseFont;
ThePrinter:PPLXPrinter;
IC:HDC;
begin
ThePrinter := New(PPLXPrinter,Init);
IC := ThePrinter^.GetIC;
with CF do
begin
lStructSize := sizeof(TChooseFont);
hDC := IC;
hWndOwner := HWindow;
lpLogfont:= @LogFont;
iPointSize := FontSize ; {in tenths of a point}
Flags := CF_ScreenFonts or CF_EFFECTS or CF_INITTOLOGFONTSTRUCT
or CF_PRINTERFONTS;
rgbColors:=RGB(255,0,0);
lCustData := 0;
@lpfnHook:= Pointer(0);
end;
if ChooseFont(CF) then
begin
FontSize := CF.iPointSize;
IsProfileDirty := True;
SetStaticText;
end;
ThePrinter^.DeleteIC;
Dispose(ThePrinter,Done);
end;
procedure TPLXWindow.IDBut5(var Msg:TMessage);
begin
CloseWindow;
end;
procedure TPLXWindow.FilePrint;
var
aPtr : pPLXPrinter;
indx: Integer;
OldFont,NewFont:hFont;
szSize:Array[0..7] of Char;
Buf1,pBuf:PChar;
szIndx:Array[0..5] of Char;
OutRecord:pTextObj;
ExpRec:PChar;
CCB:Char;
IC:HDC;
LPX,LPY:Integer;
rVal:Real;
Err,Hold,Tabsize:Integer;
begin
if Records^.Count = 0 then
begin
MessageBox(hWindow,'You need to open a file - click the disk icon',
'Alert',mb_OK or mb_IconExclamation);
exit;
end;
if StrLen(LogFont.lfFaceName) = 0 then
begin
MessageBox(hWindow,'You need to select a font - click the font button',
'Alert',mb_OK or mb_IconExclamation);
exit;
end;
aPtr := New(pPLXPrinter,Init);
indx := 0;
GetMem(Buf1,16000);
GetMem(ExpRec,16000);
if aPtr^.PrnStart('PLX') then
begin
Val(Format.MarginL,rVal,err);
aPtr^.SetMarginL(round(rVal * aPtr^.LogPixX)) ;{margin in device pixels}
Val(Format.MarginR,rVal,err);
aPtr^.SetMarginR(round(rVal * aPtr^.LogPixX)) ;{margin in device pixels}
Val(Format.MarginT,rVal,err);
aPtr^.SetMarginT(round(rVal * aPtr^.LogPixY)) ;{margin in device pixels}
Val(Format.MarginB,rVal,err);
aPtr^.SetMarginB(round(rVal * aPtr^.LogPixY)) ;{margin in device pixels}
Hold := LogFont.lfHeight;
LogFont.lfHeight := Round(FontSize * (aPtr^.LogPixY / 720));
NewFont := CreateFontIndirect(LogFont);
OldFont := aPtr^.SetFont(NewFont);
aPtr^.SetHeader1(FileName);
Move(Format,aPtr^.Format,sizeof(FormatRec));
aPtr^.SetupPage;
StrCopy(szIndx,'');
Val(Format.Tabsize,Tabsize,Err);
for indx := 0 to (Records^.Count-1) do
begin
OutRecord := Records^.AT(indx);
if OutRecord^.Text <> nil then {avoid null pointer}
StrCopy(Buf1,OutRecord^.Text)
else
StrCopy(Buf1,' ');
pBuf := Buf1;
if Format.ShowLineNum = 1 then {setup line numbers}
Str((indx+1):5,szIndx)
else
StrCopy(szIndx,'');
if (Format.UseCCB = 1) then {setup CCB for linespacing}
begin
CCB := Buf1[0];
pBuf:= Buf1+1;
end
else
CCB := ' ';
ExpandTabs(pBuf,ExpRec,Tabsize); {expand tabs}
StrCat(StrCat(StrCopy(Buf1,szIndx),' '),ExpRec);
case CCB of {do line spacing using CCB}
'1': aPtr^.NewPage;
'0': aPtr^.PrintLine(' ');
'-': begin
aPtr^.PrintLine(' ');
aPtr^.PrintLine(' ');
end;
end;
aPtr^.printLine(Buf1);
end;
APtr^.DoFooter;
OldFont := aPtr^.SetFont(OldFont); {restore the old font}
DeleteObject(NewFont);
aPtr^.PrnStop;
Dispose(aPtr,Done);
end; {end if}
FreeMem(Buf1,16000);
FreeMem(ExpRec,16000);
LogFont.lfHeight := Hold;
end;
procedure TPLXWindow.WMSysCommand(var Msg:TMessage);
begin
case Msg.Wparam of
idm_About:
Application^.ExecDialog(New(PPLXAboutDlg,Init(@Self,'PLX_About',Br1)));
idm_RunCP:
begin
WinExec('Control',1);
StrCopy(LogFont.lfFaceName,'');{Force a reselection of current font}
end;
else
DefWndProc(Msg);
end;
end;
procedure TPLXWindow.SetStaticText;
var
I,nBytes,LPY: Integer;
Buf:Array[0..80] of Char;
szLines:Array[0..5] of Char;
FontMetrics:TTextMetric;
szBytes:Array[0..7] of Char;
FormatRec : record
lines:Integer;
Bytes:LongInt;
FaceName:PChar;
end;
begin {build text display}
StrCopy(Buf,'File: ');
St1^.SetFont(Helv);
St1^.SetText(StrCat(Buf,FileName));
St2^.SetFont(Helv);
with FormatRec do
begin
lines := Records^.Count;
Bytes := CharsInFile;
Facename := LogFont.lfFaceName;
end;
wvsprintf(Buf,'lines:%i bytes:%li font:%s',FormatRec);
St2^.SetText(Buf);
end;
procedure TPLXWindow.CMFOpen(var Msg:TMessage);
begin
IDBut2(Msg);
end;
procedure TPLXWindow.CMFPrint(var Msg:TMessage);
begin
IDBut1(Msg);
end;
procedure TPLXWindow.CMFSetUp(var Msg:TMessage);
begin
IDBut3(Msg);
end;
procedure TPLXWindow.CMFExit(var Msg:TMessage);
begin
IDBut5(Msg);
end;
procedure TPLXWindow.CMSetFont(var Msg:TMessage);
begin
IDBut4(Msg);
end;
procedure TPLXWindow.GetProfileValues;
var
Buf1:Array[0..80] of Char;
Indx,Errcode:Integer;
Found:Boolean;
begin
Format.ShowRuler := GetPrivateProfileInt('PLX','ShowRuler',1,'PLX.INI');
Format.ShowFName := GetPrivateProfileInt('PLX','ShowFName',1,'PLX.INI');
Format.ShowDTStamp := GetPrivateProfileInt('PLX','ShowDTStamp',1,'PLX.INI');
Format.ShowPageNum := GetPrivateProfileInt('PLX','ShowPageNum',1,'PLX.INI');
Format.ShowLineNum := GetPrivateProfileInt('PLX','ShowLineNum',1,'PLX.INI');
Format.UseCCB := GetPrivateProfileInt('PLX','UseCCB',0,'PLX.INI');
GetPrivateProfileString('PLX','MarginL','0',Format.MarginL,sizeof(Format.MarginL),'PLX.INI');
GetPrivateProfileString('PLX','MarginR','0',Format.MarginR,sizeof(Format.MarginR),'PLX.INI');
GetPrivateProfileString('PLX','MarginT','0',Format.MarginT,sizeof(Format.MarginT),'PLX.INI');
GetPrivateProfileString('PLX','MarginB','0',Format.MarginB,sizeof(Format.MarginB),'PLX.INI');
GetPrivateProfileString('PLX','TabSize','0',Format.TabSize,sizeof(Format.TabSize),'PLX.INI');
GetPrivateProfileString('PLX','LogFont','',Buf1,SizeOf(Buf1),'PLX.INI');
FontSize:= GetPrivateProfileInt('PLX','FontSize',80,'PLX.INI');
with LogFont do
begin
GetPrivateProfileString('PLX','lfHeight','',Buf1,sizeof(Buf1),'PLX.INI');
Val(Buf1,lfHeight,errcode);
lfWidth := GetPrivateProfileInt('PLX','lfWidth',0,'PLX.INI');
lfEscapement := GetPrivateProfileInt('PLX','lfEscapement',0,'PLX.INI');
lfOrientation := GetPrivateProfileInt('PLX','lfOrientation',0,'PLX.INI');
lfWeight := GetPrivateProfileInt('PLX','lfWeight',0,'PLX.INI');
lfItalic := GetPrivateProfileInt('PLX','lfItalic',0,'PLX.INI');
lfUnderLine := GetPrivateProfileInt('PLX','lfUnderline',0,'PLX.INI');
lfStrikeout := GetPrivateProfileInt('PLX','lfStrikeout',0,'PLX.INI');
lfCharSet := GetPrivateProfileInt('PLX','lfCharSet',0,'PLX.INI');
lfOutPrecision := GetPrivateProfileInt('PLX','lfOutPrecision',0,'PLX.INI');
lfClipPrecision := GetPrivateProfileInt('PLX','lfClipPrecision',0,'PLX.INI');
lfQuality := GetPrivateProfileInt('PLX','lfQuality',0,'PLX.INI');
lfPitchAndFamily := GetPrivateProfileInt('PLX','lfPitchAndFamily',0,'PLX.INI');
GetPrivateProfileString('PLX','lfFaceName','',lfFaceName,sizeof(lfFaceName),'PLX.INI');
end;
end;
procedure TPLXWindow.WriteProfileValues;
var
Buf:Array[0..5] of Char;
Bufl:Array[0..65] of Char;
begin
Str(FontSize,Buf);
WritePrivateProfileString('PLX','FontSize',Buf,'PLX.INI');
Str(Format.ShowRuler,Buf);
WritePrivateProfileString('PLX','ShowRuler',Buf,'PLX.INI');
Str(Format.ShowFName,Buf);
WritePrivateProfileString('PLX','ShowFName',Buf,'PLX.INI');
Str(Format.ShowDTStamp,Buf);
WritePrivateProfileString('PLX','ShowDTStamp',Buf,'PLX.INI');
Str(Format.ShowPageNum,Buf);
WritePrivateProfileString('PLX','ShowPageNum',Buf,'PLX.INI');
Str(Format.ShowLineNum,Buf);
WritePrivateProfileString('PLX','ShowLineNum',Buf,'PLX.INI');
Str(Format.UseCCB,Buf);
WritePrivateProfileString('PLX','UseCCB',Buf,'PLX.INI');
WritePrivateProfileString('PLX','MarginL',Format.MarginL,'PLX.INI');
WritePrivateProfileString('PLX','MarginR',Format.MarginR,'PLX.INI');
WritePrivateProfileString('PLX','MarginT',Format.MarginT,'PLX.INI');
WritePrivateProfileString('PLX','MarginB',Format.MarginB,'PLX.INI');
WritePrivateProfileString('PLX','TabSize',Format.TabSize,'PLX.INI');
with LogFont do
begin
Str(lfHeight,Buf);
WritePrivateProfileString('PLX','lfHeight',Buf,'PLX.INI');
Str(lfWidth,Buf);
WritePrivateProfileString('PLX','lfWidth',Buf,'PLX.INI');
Str(lfEscapement,Buf);
WritePrivateProfileString('PLX','lfEscapement',Buf,'PLX.INI');
Str(lfOrientation,Buf);
WritePrivateProfileString('PLX','lfOrientation',Buf,'PLX.INI');
Str(lfWeight,Buf);
WritePrivateProfileString('PLX','lfWeight',Buf,'PLX.INI');
Str(lfItalic,Buf);
WritePrivateProfileString('PLX','lfItalic',Buf,'PLX.INI');
Str(lfUnderline,Buf);
WritePrivateProfileString('PLX','lfUnderline',Buf,'PLX.INI');
Str(lfStrikeout,Buf);
WritePrivateProfileString('PLX','lfStrikeout',Buf,'PLX.INI');
Str(lfCharSet,Buf);
WritePrivateProfileString('PLX','lfCharSet',Buf,'PLX.INI');
Str(lfOutPrecision,Buf);
WritePrivateProfileString('PLX','lfOutPrecision',Buf,'PLX.INI');
Str(lfClipPrecision,Buf);
WritePrivateProfileString('PLX','lfClipPrecision',Buf,'PLX.INI');
Str(lfQuality,Buf);
WritePrivateProfileString('PLX','lfQuality',Buf,'PLX.INI');
Str(lfPitchAndFamily,Buf);
WritePrivateProfileString('PLX','lfPitchAndFamily',Buf,'PLX.INI');
WritePrivateProfileString('PLX','lfFaceName',lfFaceName,'PLX.INI');
end;
end;
{************************ TPLXPrinter ******************************}
procedure TPLXPrinter.DoHeader;
var
Indx : Integer;
szSize:Array[0..7] of Char;
Buf1:Array[0..100] of Char;
szDateTime:Array[0..79] of Char;
szPageNumber:Array[0..5] of Char;
Ruler : Array[0..260] of Char;
begin
if Format.ShowLineNum = 1 then
StrCopy(Ruler,' ')
else
StrCopy(Ruler,'');
StrCat(Ruler,' |...+....1....+....2....+....3....+....4....+....5');
StrCat(Ruler,'....+....6....+....7....+....8....+....9....+....0');
StrCat(Ruler,'....+....1....+....2....+....3....+....4....+....5');
StrCat(Ruler,'....+....6....+....7....+....8....+....9....+....0');
StrCat(Ruler,'....+....1....+....2....+....3....+....4....+....5');
SetMarginL(Margin.left); {}
SetTOP;
if StrLen(Format.Header) <> 0 then
printLine(Format.Header);
StrCopy(Buf1,'');
GetDateTime(szDateTime);
if Format.ShowFName <> 0 then
StrCopy(Buf1,HeadLine1);
if Format.ShowDTStamp <> 0 then
StrCat(StrCat(Buf1,' '),szDateTime);
Str(PageNumber:3,szPageNumber);
if Format.ShowPageNum <> 0 then
StrCat(StrCat(Buf1,' page:'),szPageNumber);
if StrLen(Buf1) <> 0 then
printline(Buf1);
if Format.ShowRuler <> 0 then
PrintLine(Ruler);
FooterY := LineY;
end;
function TPLXPrinter.SetHeader1(NewHeadLine1:PChar):Boolean;
begin
StrCopy(HeadLine1,NewHeadLine1);
SetHeader1 := True;
end;
procedure TPLXPrinter.DoFooter;
begin
CurY := PageY - (Margin.Bottom + FooterY + LineY);
IsFooter := True;
if StrLen(Format.Footer) > 0 then
PrintLine(Format.Footer);
IsFooter := False;
end;
{******************** TPLXAbout **************************}
constructor TPLXAboutDlg.Init(aParent:PWindowsObject;aName:PChar;Brush:HBrush);
begin
TDialog.Init(AParent,aName);
CurBrush := Brush;
end;
procedure TPLXAboutDlg.WMCTLCOLOR(var Msg: TMessage);
const
as_AboutSt1 = 126; {about dlg static text }
as_AboutSt2 = 128; {about dlg static blank static to draw upon}
var
HSt1,HSt2:HWnd;
MemDC:hDC;
OldBitmap:HBitmap;
CR:TRect;
X,Y,W,H:Integer;
LogoMetrics:TBitmap;
begin
case Msg.LParamHi of
ctlColor_Static:
begin
HSt1 := GetItemHandle(as_AboutSt1);
HSt2 := GetItemHandle(as_AboutSt2);
If HSt1 = Msg.lParamLo then
SetTextColor(Msg.WParam, RGB(0,0,255))
else if HSt2 = Msg.lParamLO then
begin
MemDC := CreateCompatibleDC(Msg.WParam);
OldBitmap := SelectObject(MemDC,Logo);
GetClientRect(Msg.lParamLo,CR);
W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
GetObject(Logo,SizeOf(LogoMetrics),@LogoMetrics);
X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
SelectObject(MemDC,OldBitmap);
DeleteDC(MemDc);
end;
SetBkMode(Msg.WParam, transparent);
Msg.Result := GetStockObject(Null_Brush);
end;
ctlcolor_Dlg:
begin
SetBkMode(Msg.WParam, Transparent);
Msg.Result := CurBrush;
end;
else
DefWndProc(Msg);
end;
end;
procedure TPLXAboutDlg.SetupWindow;
begin
TDialog.SetupWindow;
Logo :=LoadBitmap(HInstance,'PLX_Logo');
end;
function TPLXAboutDlg.CanClose:Boolean;
begin
DeleteObject(Logo);
CanClose := True;
end;
{************************ TTextObj *****************************}
constructor TTextObj.Init(NewText:PChar);
begin
Text := StrNew(NewText);
end;
destructor TTextObj.Done;
begin
StrDispose(Text);
end;
{*********************** MainLine ********************************}
var
PLXApp : TPLXApplication;
begin
PLXApp.Init('PLX');
PLXApp.Run;
PLXApp.Done;
end.