Quelltext /~heha/hs/tabpad.zip/TABPAD.PAS

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);
{bentigt 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;				{Rckpatch}
   lp:=lp2+1;
   while lp^ in [#13,#10] do Inc(lp);	{Nchste nicht-leere Zeile an Anfang}
  until false;
{  LocalUnlock(lh);}
  {Nun anhand der gefundenen Spalten ggf. neue Kpfe 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 fr Refresh auffinden}
    gtabs[i]:=tabs[i];
   end;
  end;
  if tabcount<=MaxCols then gtabs[tabcount]:=0;	{fr 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
   {Knpfe 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 untersttzt 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 fr 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 schlft 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.
Vorgefundene Kodierung: UTF-80