program tabpad;
{$G+,A+,W-,K+}
{$R-,S-,I-,Q-}
{$M $3000,$1000}
{$D TabPad - NotePad 3.1 mit automatischen Tabulatoren (05/04)}
uses WinProcs,WinTypes,Win31,ToolHelp,CommDlg, WUtils;
{$R TabPad}
{Unter Anzapfung und Modifikation von NotePad}
const
MaxCols=10;
IgnoreTails: Boolean=true;
var
hInstEdit:THandle;
var
hMain: HWnd;
hEdit: HWnd;
MMenu: HMenu;
gOem: Boolean;
{ hButs: array[0..MaxCols] of HWnd; {Buttons oben}
gtabs: array[0..MaxCols] of Integer; {Tab-Weiten, von links gerechnet}
skopf: array[0..MaxCols] of TS31;
gLeft: Integer; {Scroll-Position}
gMenuSpace: Integer;
gEditRect: TRect;
{
gHScroll: Integer;
EditProc: TFarProc;
function EditSubProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt; export;
var
i:Integer;
begin
EditSubProc:=CallWindowProc(EditProc,Wnd,Msg,wParam,lParam);
i:=GetScrollPos(Wnd,SB_Horz);
if i<>gHScroll then begin
SendMessage(GetParent(Wnd),GetDlgCtrlID(Wnd),i,MakeLong(Wnd,EN_HScroll));
gHScroll:=i;
end;
end;
}
function strdup(s:PChar):PChar; assembler;
asm mov di,PtrRec[s].ofs
mov si,PtrRec[s].sel
push si
push di
call lstrlen
inc ax
push LMEM_Fixed
push ax
call LocalAlloc
push ax
push ds
push ax
push si
push di
call lstrcpy
pop ax
mov dx,ds
end;
procedure HandleTextChange(lp:PChar);
{benötigt alle obigen globalen Variablen}
var
dc: HDC;
{ posinfo: THandle;}
{hEditFont: HFont;}
DialogX,SpaceX,xfirst: Integer;
lp2,lp3: PChar;
i,{j,}tabfirst,tabcount,width: Integer;
R: TRect;
x1,x2: Integer; {Scroll}
tabs: array[0..MaxCols] of Integer;
s: TS31;
{ f:Text;}
ofont: HFont;
begin
{hEditFont:=SendMessage(hEdit,WM_GetFont,0,0);}
dc:=GetDC(hEdit);
ofont:=SelectObject(dc,SendMessage(hEdit,WM_GetFont,0,0));
DialogX:=Word(GetDialogBaseUnits);
SpaceX:=GetTextExtent(dc,' ',1);
lp[SendMessage(hEdit,WM_GetTextLength,0,0)]:=#0; {selber terminieren!!}
tabcount:=0;
FillChar(tabs,sizeof(tabs),0);
{Spaltenbreiten und deren Anzahl ermitteln}
repeat
lp2:=lstrchr(lp,#13); {Zeilenende suchen}
if lp2<>nil then lp2^:=#0; {terminieren}
for i:=0 to MaxCols do begin
lp3:=lstrchr(lp,#9); {Tab vorhanden?}
if lp3<>nil
then width:=lp3-lp {Anzahl Zeichen zum Tab}
else if IgnoreTails then break
else width:=lstrlen(lp); {oder Zeichen zum Ende}
width:=GetTextExtent(dc,lp,width); {in Pixel}
width:=MulDiv(width+SpaceX,4,DialogX)+1; {in Dialogeinheiten}
tabs[i]:=max(tabs[i],width); {Tab-Weite ausdehnen}
if lp3=nil then break;
tabcount:=max(tabcount,i+1); {Tab-Anzahl ausweiten}
lp:=lp3+1; {weiter hinter dem Tab}
end{for};
if lp2=nil then break;
lp2^:=#13; {Rückpatch}
lp:=lp2+1;
while lp^ in [#13,#10] do Inc(lp); {Nächste nicht-leere Zeile an Anfang}
until false;
{ LocalUnlock(lh);}
{Nun anhand der gefundenen Spalten ggf. neue Köpfe erzeugen}
SelectObject(dc,ofont);
for i:=tabcount-1 downto 0 do begin
wvsprintf(skopf[i],'#%d',i);
width:=max(GetTextExtent(dc,skopf[i],lstrlen(skopf[i])),gMenuSpace);
tabs[i]:=max(tabs[i],MulDiv(width+SpaceX,4,DialogX)+1);
end;
ReleaseDC(hEdit,dc);
{Spaltenbreiten in Tabstop-Positionen akkumulieren (ab tabcount=2)}
for i:=1 to tabcount-1 do begin
Inc(tabs[i],tabs[i-1]); {als absolute Positionen}
end;
{Feststellen, ob, und wenn ja, ab welcher Spalte sich etwas änderte}
tabfirst:=tabcount; {kann auch 11 sein!}
for i:=tabcount-1 downto 0 do begin
if gtabs[i]<>tabs[i] then begin
tabfirst:=i;
xfirst:=min(gtabs[i],tabs[i]);
{Kleinere der linken Seiten für Refresh auffinden}
gtabs[i]:=tabs[i];
end;
end;
if tabcount<=MaxCols then gtabs[tabcount]:=0; {für Expansion}
xfirst:=MulDiv(xfirst,DialogX,4); {in Pixel}
{Wenn sich etwas änderte, aktiv werden}
if tabfirst<>tabcount then begin
{Neue Positionen setzen und rechts der Änderung Anzeige aktualisieren}
SendMessageP(hEdit,EM_SetTabstops,tabcount,@tabs);
{ MessageBeep($FFFF);}
GetClientRect(hEdit,R);
R.left:=xfirst-gLeft;
InvalidateRect(hEdit,@R,false); {EDIT zeichnet Hintergrund selbst}
for i:=tabfirst to MAXCOLS do begin
{ if gtabs[i]=0 then break;}
DeleteMenu(MMenu,$FF00+i,0);
end;
for i:=tabfirst to tabcount-1 do begin
wvsprintf(skopf[i],'%d',i); {oder aus 1. Textzeile}
AppendMenu(MMenu,
IfThenElse(Bool(i),MF_OwnerDraw,MF_MenuBarBreak or MF_OwnerDraw),
$FF00+i,skopf[i]);
end;
DrawMenuBar(hMain);
end;
i:=GetScrollPos(hEdit,SB_Horz);
GetScrollRange(hEdit,SB_Horz,x1,x2); {x1 sollte 0, x2 = 100 sein}
GetClientRect(hEdit,R);
x1:=MulDiv(tabs[tabcount-1],DialogX,4);
i:=MulDiv(i,x1+R.right div 4,x2);
if gLeft<>i then begin
tabfirst:=0;
gLeft:=i;
end;
(*
if tabfirst<>tabcount then begin
{Knöpfe verschieben: in einem Rutsch mit XxDeferWindowPos}
posinfo:=BeginDeferWindowPos(tabcount-tabfirst);
if posinfo<>0 then begin
x1:=-gLeft;
if tabfirst<>0 then x1:=MulDiv(tabs[tabfirst-1],DialogX,4)-gLeft;
for i:=tabfirst to tabcount-1 do begin
x2:=MulDiv(tabs[i],DialogX,4)-gLeft;
DeferWindowPos(posinfo,hButs[i],0,x1,0,x2-x1,20,SWP_NoZOrder);
x1:=x2;
end;
EndDeferWindowPos(posinfo);
end;
end;
*)
end;
(*
function WndProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt; export;
var
lPar: LongRec absolute lParam;
CallOld: Boolean;
fs: Word;
lp: PChar;
begin
WndProc:=0;
CallOld:=false;
case Msg of
WM_Create: begin
hMain:=Wnd;
hEdit:=CreateWindow('EDIT',nil,
WS_Visible or WS_Child or WS_HScroll or WS_VScroll
or ES_AutoHScroll or ES_AutoVScroll or ES_MultiLine,
0,20,0,0,
Wnd,100,Seg(HInstance),nil);
{Horizontales Rollen kann leider nicht unterstützt werden, es sei denn:
* man zeichnet das ganze Fenster nach, nicht nur den rechten Teil, und
* man verzichtet auf die Buttons
Ursache: Es scheint keinen Weg zu geben, an die horizontale Scroll-
Position heranzukommen}
(* fh:=_lopen(FileName,0);
if fh>=0 then begin
fs:=_llseek(fh,0,2);
_llseek(fh,0,0);
lh:=LocalAlloc(LMEM_MoveAble,fs+1);
if lh<>0 then begin
lp:=LocalLock(lh);
lp[_lread(fh,lp,fs)]:=#0;
LocalUnlock(lh);
LocalFree(Word(SendMessage(hEdit,EM_GetHandle,0,0)));
SendMessage(hEdit,EM_SetHandle,lh,0);
end;
_lclose(fh);
end;* )
end;
WM_Activate: if wParam<>0 then SetFocus(hEdit);
WM_Size: begin
SetWindowPos(hEdit,0,0,20,lPar.lo,lPar.hi-20,SWP_NoMove or SWP_NoZOrder);
HandleTextChange;
end;
WM_Destroy: PostQuitMessage(0);
WM_Close: begin
(* fh:=_lcreat(FileName,0);
if fh>=0 then begin
_lwrite(fh,LocalLock(lh),SendMessage(hEdit,WM_GetTextLength,0,0));
LocalUnlock(lh);
_lclose(fh);
end;* )
CallOld:=true;
end;
WM_Command: case wParam of
100: if (lPar.hi=EN_Update) or (lPar.hi=EN_HScroll) then begin
HandleTextChange;
end;
end;
else CallOld:=true;
end;
if CallOld then WndProc:=DefWindowProc(Wnd,Msg,wParam,lParam);
end;
*)
procedure OnTextChange;
var
lh: THandle;
p: PChar;
begin
lh:=SendMessage(hEdit,EM_GetHandle,0,0);
asm push ds
mov ds,[hInstEdit]
push [lh]
call _LocalLock {unter fremder Flagge!}
mov PtrRec[p].ofs,ax
mov PtrRec[p].sel,ds
pop ds
end;
HandleTextChange(p);
{ MBox2(0,17,MB_OK or MB_IconQuestion,
PChar(MakeLong(lh,PtrRec(p).ofs)),p);}
asm push ds
mov ds,[hInstEdit]
push [lh]
call LocalUnlock
pop ds
end;
end;
procedure OnSize;
begin
GetWindowRect(hEdit,gEditRect);
MapWindowPoints(0,hMain,gEditRect,2); {ScreenToClient}
end;
var
HookMain,HookEdit: TFarProc;
{$S-}{
function GetMsgHook(code:Integer; wParam:Word; lParam:LongInt):LongInt; far;
var
Msg: PMsg absolute lParam;
begin
export_enter;
if code>=0 then begin
if (Msg^.hwnd=hMain)
and (Msg^.message=WM_Command)
and (LongRec(Msg^.lParam).lo=hEdit)
and (LongRec(Msg^.lParam).hi=EN_Update)
then OnTextChange;
end;
GetMsgHook:=CallNextHookEx(Hook2,code,wParam,lParam);
export_leave;
end;}
var
GetMsgHook:HHook;
GetMsgProcInst:TFarProc;
MsgFR: Word;
WndFR: HWnd;
function GetMsgProc(code:Integer; wParam:Word; lParam:LongInt):LongInt;
far;
{Diese taskspezifische Hook-Funktion ist nur bei aktiviertem FindReplace-
Dialog aktiv}
var Msg:PMsg absolute lParam;
begin
export_enter;
GetMsgProc:=CallNextHookEx(GetMsgHook,code,wParam,lParam);
if IsDialogMessage(WndFR,Msg^) then Msg^.message:=WM_Null;
export_leave;
end;
function FindReplaceHook(Wnd:HWnd; Msg,wParam: Word; lParam:Longint): Word;
far;
begin
export_enter;
FindReplaceHook:=0;
case Msg of
WM_InitDialog: FindReplaceHook:=1;
WM_Activate: if wParam<>0 then begin
GetMsgProcInst:=MakeProcInstance(@GetMsgProc,Seg(HInstance));
GetMsgHook:=SetWindowsHookEx(WH_GetMessage,THookProc(GetMsgProcInst),
GetModuleHandle(PChar(Seg(HInstance))),GetCurrentTask);
end else begin
UnhookWindowsHookEx(GetMsgHook);
FreeProcInstance(GetMsgProcInst);
end;
end;
export_leave;
end;
var
ThisTask: THandle;
FindWhat, ReplaceWith: TS255;
const
fr: TFindReplace=(
lStructSize:sizeof(TFindReplace);
hwndOwner: 0; {wird ersetzt}
hInstance: 0;
Flags: FR_EnableHook; {Hook für IsDlgMessage}
lpstrFindWhat: FindWhat;
lpstrReplaceWith: ReplaceWith;
wFindWhatLen: sizeof(FindWhat);
wReplaceWithLen: sizeof(ReplaceWith));
function MainHook(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt; far;
var
lPar: LongRec absolute lParam;
mis: PMeasureItemStruct absolute lParam;
dis: PDrawItemStruct absolute lParam;
CallOld: Boolean;
p: PChar;
id: Integer;
fo: HFont;
cf: TChooseFont;
lf: TLogFont;
begin
export_enter;
CallOld:=true;
case Msg of
WM_SetText: begin
p:=lstrstr('Editor',PChar(lParam),lstrcmpi);
if p<>nil then Move(StdMBoxTitle^,p^,6);
end;
WM_MeasureItem: with mis^ do begin
if itemid<>0 then begin
id:=itemid and $FF;
itemwidth:=min(MulDiv(gtabs[id],Integer(GetDialogBaseUnits),4),
gEditRect.right-gEditRect.left)
-MulDiv(IfThenElse(Bool(id),gtabs[id-1],0),
Integer(GetDialogBaseUnits),4);
Dec(itemwidth,gMenuSpace);
if id=0 then inc(itemwidth,gEditRect.left);
end else begin
itemwidth:=0;
end;
itemheight:=GetSystemMetrics(SM_cyMenu);
end;
WM_DrawItem: with dis^ do begin
if itemid=0 then gMenuSpace:=rcitem.right-rcitem.left
else begin
id:=itemid and $FF;
if itemstate and ODS_Selected <>0 then begin
SetTextColor(hdc,GetSysColor(COLOR_HighlightText));
SetBkColor(hdc,GetSysColor(COLOR_Highlight));
end;
if id=0 then Inc(rcitem.left,gEditRect.left);
ExtTextOut(hdc,0,0,ETO_Opaque,@rcitem,nil,0,nil);
DrawText(hdc,PChar(itemdata),-1,rcitem,DT_Center or DT_NoPrefix);
if id=0 then begin
MoveTo(hdc,rcitem.left,rcitem.bottom-1);
LineTo(hdc,rcitem.left,rcitem.top);
Dec(rcitem.left,gEditRect.left);
end else MoveTo(hdc,rcitem.left,rcitem.top);
LineTo(hdc,rcitem.right-1,rcitem.top);
LineTo(hdc,rcitem.right-1,rcitem.bottom);
{ Rectangle(hdc,rcitem.left,rcitem.top,rcitem.right,rcitem.bottom);}
end;
end;
end;
if CallOld then MainHook:=CallWindowProc(HookMain,Wnd,Msg,wParam,lParam);
case Msg of
WM_Command: begin
if lPar.hi=EN_Change then OnTextChange;
case wParam of
$FFF0: begin {Schriftart (wie bei Win98)}
fo:=SendMessage(hEdit,WM_GetFont,0,0);
GetObject(fo,sizeof(lf),@lf);
InitStruct(cf,sizeof(cf));
cf.hwndowner:=Wnd;
cf.lplogfont:=@lf;
cf.flags:=CF_ForceFontExist or CF_InitToLogFontStruct or CF_ScreenFonts;
if ChooseFont(cf) then begin
gOem:=lf.lfcharset=OEM_Charset;
SendMessage(hEdit,WM_SetFont,CreateFontIndirect(lf),0);
DeleteObject(fo);
OnTextChange;
end;
end;
$FFF1: begin {Ersetzen (wie bei WinNT)}
if WndFR<>0 then SetActiveWindow(WndFR) else begin
fr.hwndOwner:=Wnd;
WndFR:=ReplaceText(fr);
{ShowWindow(WndFR,SW_Show);}
end;
end;
end;
end;
else if (Msg=MsgFR) and (Pointer(lParam)=@fr) then begin
if fr.flags and FR_DialogTerm <>0 then begin
WndFR:=0;
end;
if fr.flags and FR_Replace <>0 then begin
MessageBeep($FFFF);
end;
end;
end;
export_leave;
end;
function EditHook(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):LongInt; far;
var
p: PChar;
begin
export_enter;
case Msg of
WM_Char: if gOem then AnsiToOemBuff(PChar(@wParam),PChar(@wParam),1);
end;
EditHook:=CallWindowProc(HookEdit,Wnd,Msg,wParam,lParam);
if (Wnd=hEdit)
and (Msg=EM_SetHandle) {Datei wird geladen}
then OnTextChange;
export_leave;
end;
function EnumWindowsProc(Wnd:HWnd; lParam:LongInt):Boolean; export;
begin
EnumWindowsProc:=true;
if GetWindowWord(Wnd,GWW_HInstance)=hInstEdit then begin
hMain:=Wnd;
EnumWindowsProc:=false;
end;
end;
function NotifyCallback(ID:Word; Data:LongInt):Bool; far; assembler;
{Achtung! Smart Callback funktioniert hier NICHT! AX=DS dieser Instanz}
asm push ds
mov ds,ax
cmp [ID],NFY_ExitTask
jne @@e
mov ax,ss {SS ist praktisch immer =HInstance!}
xor ax,[hInstEdit]
and ax,0FFFCh {RPL-Bits nicht beachten}
jne @@e
push [ThisTask]
push WM_Quit
push LongRec[Data].lo {= Returncode durchreichen}
push ax {=0}
push ax
call PostAppMessage
@@e: pop ds
xor ax,ax
end;
label exi,exi2;
var
Msg: TMsg;
buf: TS127;
hTaskEdit: THandle; {nur zum "Killen"}
NotifyInst: TFarProc;
InstMain,InstEdit: TFarProc;
R: TRect;
{ hBmp: HBitmap;
{ Hook2Inst: TFarProc;}
procedure error(code:Integer);
begin
MBox0(0,code,MB_OK or MB_IconStop or MB_Sound);
if hTaskEdit<>0 then TerminateApp(hTaskEdit,No_Uae_Box);
if code<12 then halt($FFFF);
end;
begin
StdMBoxTitle:='TabPad';
Msg.wParam:=$FFFF;
if GetWinFlags and WF_WinNT <>0
then error(10); {Will/kann nicht mit WinNT}
ThisTask:=GetCurrentTask;
MsgFR:=RegisterWindowMessage(FindMsgString);
@fr.lpfnHook:=MakeProcInstance(@FindReplaceHook,Seg(HInstance));
NotifyInst:=MakeProcInstance(@NotifyCallback,Seg(HInstance));
if not NotifyRegister(0,TNotifyCallback(NotifyInst),NF_Normal)
then error(11); {Fehler mit Toolhelp}
wvsprintf(buf,'NOTEPAD %s',CmdLine);
hInstEdit:=WinExec(buf,CmdShow);
if hInstEdit<=32 then begin
error(12); {Kann NOTEPAD.EXE nicht finden/starten}
goto exi;
end;
EnumWindows(@EnumWindowsProc,0);
if hMain=0 then begin
error(13); {Kann Hauptfenster nicht auffinden}
goto exi;
end;
hTaskEdit:=GetWindowTask(hMain);
MMenu:=GetMenu(hMain);
hEdit:=GetWindow(hMain,GW_Child);
GetClassName(hEdit,buf,sizeof(buf));
if lstrcmpi(buf,'EDIT')<>0 then begin
error(14); {Ist wohl keine original NOTEPAD.EXE?}
goto exi;
end;
OnSize;
SendMessage(hEdit,WM_SetFont,GetStockObject(System_Font),0);
{ CreateWindow('BUTTON','Test',WS_Child or WS_Visible or BS_PushButton
or WS_Disabled,
0,-20,100,30,
hMain,
$FFFF,
hInstEdit,
nil);}
InstMain:=MakeProcInstance(@MainHook,Seg(HInstance));
LongInt(HookMain):=SetWindowLong(hMain,GWL_WndProc,LongInt(InstMain));
InstEdit:=MakeProcInstance(@EditHook,Seg(HInstance));
LongInt(HookEdit):=SetWindowLong(hEdit,GWL_WndProc,LongInt(InstEdit));
{ Hook2Inst:=MakeProcInstance(@GetMsgHook,Seg(HInstance));
Hook2:=SetWindowsHookEx(WH_GetMessage,THookProc(Hook2Inst),hInstEdit,
hTaskEdit);}
{
hBmp:=LoadBitmap(Seg(HInstance),MakeIntResource(100));}
AppendMenu(GetSubMenu(MMenu,1),MF_String,$FFF0,'Schriftart...');
AppendMenu(GetSubMenu(MMenu,2),MF_String,$FFF1,'Ersetzen...');
AppendMenu(MMenu,MF_OwnerDraw,0,nil);
{ AppendMenu(GetMenu(hMain),MF_Bitmap,$FF02,PChar(hBmp));
AppendMenu(GetMenu(hMain),MF_OwnerDraw,$FF03,'3');
AppendMenu(GetMenu(hMain),MF_String,$FF04,'#4');}
DrawMenuBar(hMain);
DeleteMenu(MMenu,0,0);
if lstrlen(CmdLine)<>0 then OnTextChange;
while GetMessage(Msg,0,0,0) {Prozess schläft praktisch}
do case Msg.message of
WM_User: OnTextChange;
WM_Size: OnSize;
end;
exi2:
FreeProcInstance(@fr.lpfnHook);
FreeProcInstance(InstMain);
FreeProcInstance(InstEdit);
{ DeleteObject(hBmp);}
exi:
{ MessageBeep(0);}
NotifyUnregister(0);
FreeProcInstance(NotifyInst);
halt(Msg.wParam);
end.
| Detected encoding: OEM (CP437) | 1
|
|
|