{$I KEYS}


unit RPTW;

interface
uses WinTypes;

function RptProc(w :HWND) :HWND;

procedure BuildRptMenu(ReBuildFlag :boolean);

const     MenuRptBodyReady :boolean = false;
          RptWin     :HWnd = 0;
          RptListWin :Hwnd = 0;

implementation
uses  Interna, WinProcs, Pro1, Edi1, Font1, Win31, WinClass, WinOut, WinDos, Size,
      Rul1, Compuni1, RussLett, strings, Opt1, Bmp1, BalW, Prn1, AsgnUnit, OemView, Lib1;


var   Head0, HeadFile, HeadName :HWND;


const BodyLimit =    500;
      ActiveFnLimit = 12;

type  ActiveFnType = array [1..ActiveFnLimit]
                     of record
                        Re       :real;
                        Fn       :string[10];
                        Line1    :string[80];
                        x1,x2,y1 :integer;
                        W        :HWND;
                        end;


var   LastActiveFn :integer;
var   ActiveFn :^ActiveFnType;


type  BodyElemType = record
                       a     :boolean;
                       Re    :real;
                       Fn    :string[10];
                       Line1 :string[80];
                     end;

type  BodyType = array [0..BodyLimit] of BodyElemType;

var   Body      :^BodyType;
      BodySize  :integer;


const First  :string[8]='FIRST';
      Proto  :string[8]='PROTO';
      NoName :string[8]='NONAME';
      Histr  :string[8]='H-';


function LT(i,j :integer) :boolean;
label EX;
begin
LT:=true;
if Body^[i].Re < Body^[j].Re then goto EX;
if Body^[i].Re = Body^[j].Re
then if Body^[i].Fn <= Body^[j].Fn
     then goto EX;
LT:=false;
EX:
end;


procedure SortBody;
var i :integer;
    b :boolean;
    t :BodyElemType;
begin
repeat
  b:=true;
  for i:=1 to BodySize-1
  do if LT(i,i+1)
     then (* *)
     else begin
          t:=Body^[i];
          Body^[i]:=Body^[i+1];
          Body^[i+1]:=t;
          b:=false;
          end;
until b;
end;



function FindBodyElem(s :string) :integer;
label EX; var i,f :integer;
begin
f:=0;
for i:=1 to BodySize
do if EqStr(s, Body^[i].Fn)
   then begin f:=i; goto EX end;
EX: FindBodyElem:=f;
end;



function FindNonStrickly(s :string) :integer;
label EX; var i,f :integer; t :string;
begin
f:=0;
for i:=1 to BodySize
do begin
   t:=copy(Body^[i].Fn,1,length(s));
   if EqStr(s,t)
   then begin f:=i; goto EX end;
   end;
EX: FindNonStrickly:=f;
end;



procedure LoadActiveFn;
var i :integer; f :text;
begin
for i:=1 to ActiveFnLimit
do begin
   ActiveFn^[i].Fn:='';
   ActiveFn^[i].W := 0;
   end;
assign(f, WorkDir('FIN.AFM')); reset(f);
if ioresult <> 0 then (* *)
else begin
     i:=1;
     while not eof(f) and (i <= ActiveFnLimit)
     do begin
        readln(f,ActiveFn^[i].Fn);
        inc(i);
        end;
     close(f); i:=ioresult;
     end;
end;


procedure SaveActiveFn;
var i :integer; f :text;
begin
assign(f, WorkDir('FIN.AFM')); rewrite(f);
if ioresult <> 0 then MessageBeep(word(-1))
else begin
     for i:=1 to ActiveFnLimit
     do if ActiveFn^[i].Fn <> ''
        then writeln(f,ActiveFn^[i].Fn);
     if ioresult <> 0 then MessageBeep(word(-1));
     close(f);
     if ioresult <> 0 then MessageBeep(word(-1));
     end;
end;



function InActiveFn(var s :string) :boolean;
label 1;
var i :integer;
begin
InActiveFn:=false;
if EmptyS(s) then goto 1;
for i:=1 to ActiveFnLimit
do if s = ActiveFn^[i].Fn
   then begin
        InActiveFn:=true;
        goto 1;
        end;
1:
end;


function WithOutStar(s :string) :string;
var i :integer;
begin
i:=1;
while (i < length(s))
and ((s[i]=' ') or (s[i]='*')) do inc(i);
s:=copy(s,i,255); if EmptyS(s) then s:='  ?  ';
WithOutStar:=s;
end;



procedure RebuildActiveFn;
label 1;
var i,j,k,L,LMax :integer;
    x,y   :integer;
    Buf   :array [0..128] of char;
    R,R1  :TRect;
    DC    :HDC;

    ny,dy :integer;

begin
for i:=1 to ActiveFnLimit
do begin
   ActiveFn^[i].Fn:='';
   if IsWindow(ActiveFn^[i].W)
   then DestroyWindow(ActiveFn^[i].W);
   end;
LastActiveFn:=0;
for i:=1 to ActiveFnLimit do ActiveFn^[i].W:=0;

i:=1;
for j:=1 to BodyLimit
do if Body^[j].a
   then begin
        ActiveFn^[i].Re   :=Body^[j].Re;
        ActiveFn^[i].Fn   :=Body^[j].Fn;
        ActiveFn^[i].Line1:=WithOutStar(Body^[j].Line1);
        LastActiveFn:=i;
        if i < ActiveFnLimit then inc(i) else goto 1;
        end;
1:

if LastActiveFn <= 6 then ny:=LastActiveFn else ny:=6;
if ny = 0 then dy:=-1 else dy:=9;

GetClientRect(RptWin, R1);
MoveWindow(RptListWin, 0, MetricsH+1,
           R1.right,
           R1.bottom - MetricsH -1 - (MetricsH + 10)*ny - dy,
           true);

LMax:=0;
GetClientRect(RptWin, R);
for i:=1 to LastActiveFn
do begin
   DC:=GetDC(RptWin);
   StrPcopy(@Buf, ActiveFn^[i].Line1);
   IBMtoWIN(@Buf, @Buf);
   L:=LOWORD(GetTextExtent(DC, @Buf, StrLen(@Buf))) + 20;
   if i <= 6 then if L > LMax then LMax:=L;
   ReleaseDC(RptWin,DC);

   k:=i;  if i > 6 then k:=k-6;
   x:=10; if i > 6 then x:=x + Lmax + 15;
   y:=R.bottom - (MetricsH+10)*ny + (k-1)*(MetricsH+10) + 4-5;

   ActiveFn^[i].W:=CreateWindow
                   ('BUTTON', @Buf,
                     WS_CHILD or WS_VISIBLE,
                     x, y, L, 20,
                     RptWin, 300+i, hInst, nil);
   end;
end;



procedure BodyTreeSelection(p :pCas);
label EX;
var TempS :string[20];
    i,k,j :integer;
begin
if p^.Group
then begin
     TempS:=ExtractFileName(p^);
     TempS:=RptExt(TempS);

     if ExistFile_(TempS)
     then begin
          delete(TempS,pos('.RPT',TempS),4);

          k:=FindBodyElem(TempS);

          if k <> 0
          then begin
               if (   (pos(RussCreateWord,p^.G.oName) <> 0)
                   or (pos(EnglCreateWord,p^.G.oName) <> 0)
                  )
               and(   (pos(RussDocWord,p^.G.oName) <> 0)
                   or (pos(EnglDocWord,p^.G.oName) <> 0)
                  )
               then Body^[k].Re:=5  (* документ *)
               else Body^[k].Re:=3; (* файл-коэфф *)
               end;
          end;
     goto EX;
     end;
for i:=1 to ListLimit
do if p^.List[i] <> nil
   then BodyTreeSelection(p^.List[i]);
EX:
end;



procedure AddBodyComment;
var i :integer;
begin
for i:=1 to BodySize
do if Body^[i].Fn = ' '
   then if (i=BodySize) or (Body^[i+1].Fn = '')
        then Body^[i].Line1:=Body^[i].Line1 + SWI( its_59001 
{ ' отсутствуют' }
)
        else Body^[i].Line1:=Body^[i].Line1 + ':';
end;



procedure BuildRptMenu(ReBuildFlag :boolean);
label L, EX;
var i,io  :integer;
    S     :TSearchRec; F :text;
    st    :string[20];
    st2   :string[3];

begin
if MenuRptBodyReady
then if not RebuildFlag
     then goto EX;

BmenuN( its_59002 
{ ' Постpоение списка фоpм...' }
);

for i:=0 to BodyLimit
do begin
   Body^[i].Fn:='';
   Body^[i].Re:=9;
   Body^[i].a :=false;
   end;

Body^[1].Fn   :=' ';
Body^[1].Line1:=SWI( its_59003 
{ 'Отчетные фоpмы' }
);
Body^[1].Re   :=0;

Body^[2].Fn   :='';
Body^[2].Line1:='';
Body^[2].Re   :=2;

Body^[3].Fn   :=' ';
Body^[3].Line1:=SWI( its_59004 
{ 'Файлы-коэффициенты' }
);
Body^[3].Re   :=2;

Body^[4].Fn   :='';
Body^[4].Line1:='';
Body^[4].Re   :=4;

Body^[5].Fn   :=' ';
Body^[5].Line1:=SWI( its_59005 
{ 'Фоpмы пеpвичных документов' }
);
Body^[5].Re   :=4;

Body^[6].Fn   :='';
Body^[6].Line1:='';
Body^[6].Re   :=6;

Body^[7].Fn   :=' ';
Body^[7].Line1:=SWI( its_59006 
{ 'Истоpии' }
);
Body^[7].Re   :=6;

Body^[8].Fn   :='';
Body^[8].Line1:='';
Body^[8].Re   :=8;

Body^[9].Fn   :=' ';
Body^[9].Line1:=SWI( its_59007 
{ 'Общие опpеделения' }
);
Body^[9].Re   :=8;

BodySize:=9;

FindFirst('.\*.rpt', faAnyFile, S); i:=0;
while DosError=0
do begin
   if BodySize = BodyLimit then goto L;
   inc(BodySize);

   st:=StrPas(@S.Name);

   st2:=copy(st,1,2);

   delete(st,pos('.RPT',st),4);
   Body^[BodySize].Fn:=st;

   Body^[BodySize].a :=InActiveFn(st);

   if EqStr(First,st) or EqStr(Proto,st)
   then Body^[BodySize].Re:=9
   else if EqStr(NoName,st)
        then Body^[BodySize].Re:=-1
        else if EqStr(Histr,st2)
             then Body^[BodySize].Re:=7
             else Body^[BodySize].Re:=1;

   assign(F, WorkDir(S.Name)); reset(F);
   if ioresult = 0
   then begin
        readln(F,Body^[BodySize].Line1); close(F); io:=IoResult;
        end;
   FindNext(S);
   end;
L:
BodyTreeSelection(Rules);
SortBody;
AddBodyComment;

BmenuN('');

EX:
ReBuildActiveFn;

MenuRptBodyReady:=true;
end;



const
    AppName = 'RPTGEN';

var
    hInst     :THandle;
    hBrush    :THandle;

    mcw,
    xHead0, xFile, xName, xLast  :integer;

    RFile,  RName,  Rit,
   _RFile, _RName, _Rit :TRect;


const
    OldNi :integer = 0;


procedure FillList; forward;


procedure FillList;
var i,n :integer;
begin
SendMessage(RptListWin, LB_RESETCONTENT, 0, 0);
for i:=1 to BodySize do SendMessage(RptListWin, LB_ADDSTRING, 0, 0);
n:=G.RptMenuPos-1;
if n > BodySize-1 then n:=0;
SendMessage(RptListWin, LB_SETCURSEL, n, 0);
end;



procedure DrawItem(CDC :HDC; R :TRect; Ni :integer; Si :boolean; ForPrn :boolean);
var
    Co  :TcolorRef;
    hOF :HFont;

begin
Co:=GetTextColor(CDC);

if not Si
then begin
     if ForPrn
     then hBrush:=CreateSolidBrush(RGB(255,255,255))
     else hBrush:=CreateSolidBrush(GetSysColor(COLOR_WINDOW));
     SetTcolor(CDC, GetSysColor(COLOR_WINDOWTEXT), ForPrn);
     end
else begin
     hBrush:=CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT));
     SetTcolor(CDC, GetSysColor(COLOR_HIGHLIGHTTEXT), ForPrn);
     end;

FillRect(CDC, R, hBrush);

DeleteObject(hBrush);

hOF:=SelectObject(CDC, WorkFont);
SetBkMode(CDC,TRANSPARENT);

if Si
then begin
     SetTcolor(CDC, GetSysColor(COLOR_HIGHLIGHTTEXT), ForPrn);
     SetBkColor  (CDC, GetSysColor(COLOR_HIGHLIGHT));
     end
else begin
     SetTcolor(CDC, GetSysColor(COLOR_WINDOWTEXT), ForPrn);
     SetBkColor  (CDC, GetSysColor(COLOR_WINDOW));
     end;

if InActiveFn(Body^[Ni+1].Fn)
then DrawCheck(CDC, R.left, R.top);

RFile.top   :=R.top;
RFile.left  :=xFile;
RFile.bottom:=RFile.top  + MetricsH;
RFile.right :=xName - 1;

if not Si
then SetTcolor(CDC, GetSysColor(COLOR_HIGHLIGHT), ForPrn)
else SetTcolor(CDC, GetSysColor(COLOR_HIGHLIGHTTEXT), ForPrn);

DrawPstring(CDC, Body^[Ni+1].Fn, RFile, DT_LEFT);

RName.left :=RFile.right + 1; RName.top   :=R.top;
RName.right:=R.right   - 1; RName.bottom:=R.bottom;

if Si
then SetTcolor(CDC,GetSysColor(COLOR_HIGHLIGHTTEXT), ForPrn)
else if EmptyS(Body^[Ni+1].Fn)
     then SetTcolor(CDC, GetSysColor(COLOR_HIGHLIGHT), ForPrn)
     else SetTcolor(CDC, GetSysColor(COLOR_WINDOWTEXT), ForPrn);

DrawPstring(CDC, Body^[Ni+1].Line1, RName, DT_LEFT);

if Si
then begin
     SetTcolor(CDC, GetSysColor(COLOR_HIGHLIGHTTEXT), ForPrn);
     SetBkColor  (CDC, GetSysColor(COLOR_HIGHLIGHT));
     end
else begin
     SetTcolor(CDC, GetSysColor(COLOR_WINDOWTEXT), ForPrn);
     SetBkColor  (CDC, GetSysColor(COLOR_WINDOW));
     end;

SetTextColor(CDC, Co);
SelectObject(CDC, hOF);
end;



procedure PrintRptList;
label EX1, EX2;
var R       :TRect;
    DC,PCDC :HDC;
    hB,
    hOB     :THandle;
    i,h,n   :integer;
    HeaderForPrint :string[100];
    Buf     :BufType;

    Page    :integer;

begin
if BeginPrint <> 0
then begin
     if StartDoc(PDC, DocInfoData) <= 0 then goto EX1;

     SetMapMode(PDC, MM_ANISOTROPIC);
     SetWindowExt(PDC, 1, 1); SetViewPortExt(PDC, PrinterXCoeff, PrinterYCoeff);

     GetWindowText(Wins.Rpt.W, @Buf, 100);
     HeaderForPrint:=StrPas(@Buf);

     GetClientRect(RptListWin, R);
     R.bottom:=MetricsH;
     R.right :=PaperWidth;

     DC  :=GetDC(GetDeskTopWindow);
     PCDC:=CreateCompatibleDC(DC);

     if Options.PrintColorMode
     then hB:=CreateCompatibleBitmap(  DC, R.right, R.bottom)
     else hB:=CreateCompatibleBitmap(PCDC, R.right, R.bottom);

     hOB:=SelectObject(PCDC, hB);
     ReleaseDC(GetDeskTopWindow, DC);

     if StartPage(PDC) <= 0 then goto EX2;

     Page:=0; inc(Page);

     DrawPageHeader0(PCDC, R, SWI(HeaderForPrint), Page);
     BitBlt(PDC, PrinterLeftField, 0, R.right, R.bottom, PCDC, 0, 0, SRCCOPY);

     i:=0; n:=0;

     if BodySize > 1
     then
     repeat
        h:=n*MetricsH + R.bottom;

        if h * PrinterYCoeff <= PrinterYres - (2*MetricsH) * PrinterYCoeff
        then begin
             DrawItem(PCDC, R, i, false, true);
             BitBlt(PDC, PrinterLeftField, h, R.right, R.bottom, PCDC, 0, 0, SRCCOPY);
             inc(i);
             inc(n);
             end
        else begin
             EndPage(PDC);

             SetMapMode(PDC, MM_ANISOTROPIC);
             SetWindowExt(PDC, 1, 1); SetViewPortExt(PDC, PrinterXCoeff, PrinterYCoeff);

             if StartPage(PDC) <= 0 then goto EX2;

             inc(Page);
             DrawPageHeader0(PCDC, R, SWI(HeaderForPrint), Page);
             BitBlt(PDC, PrinterLeftField, 0, R.right, R.bottom, PCDC, 0, 0, SRCCOPY);

             n:=0;
             end;

     until i >= BodySize;

     EndPage(PDC);
 EX2:
     EndDoc(PDC);

     SelectObject(PCDC, hOB);
     DeleteObject(hB);
     DeleteDC(PCDC);
 EX1:
     EndPrint;
     end;
end;



procedure EvalMetrics;
var i :integer;
    RA :TRect;
begin
MetricsH:=Metrics.tmHeight + Metrics.tmExternalLeading;
mcw :=Metrics.tmAveCharWidth;
xHead0:=0;
xFile :=xHead0 + MetricsH;
xName :=xFile  + mcw*10;
xLast :=xName  + mcw*160;
end;



const LITER :string[8] = '';



function RptWinProc(Win: HWND; Message, wParam: word; lParam: longint): longint;
export;
label 1,2,3,4,5,6, LF2, LF4, LF5, LF6, LF7, LF8, ENDLF8, LLL;
var R1   :TRect;
    pTMIS   :^TMEASUREITEMSTRUCT;
    pTDIS   :^TDRAWITEMSTRUCT;

    PS      :TPaintStruct;
    DC      :HDC;

    Buf     :array [0..255] of char;
    i,Ni    :integer;
    Si      :boolean;

    St, ts  :string[20];
    Pnt     :TPoint;
    cff     :boolean;

    ParentWin  :HWND;
    F       :text;
    FRe     :integer;


begin
RptWinProc := 0;

case Message of
  WM_CREATE:  begin
              Head0   :=CreateWindow('STATIC', '',
                                     WS_CHILD or WS_VISIBLE or SS_LEFT,
                                     0,0,0,0, Win, 0, hInst, nil);

              HeadFile:=CreateWindow('STATIC',  its_59008 
{ 'Файл' }
,
                                     WS_CHILD or WS_VISIBLE or SS_LEFT,
                                     0,0,0,0, Win, 0, hInst, nil);

              HeadName:=CreateWindow('STATIC',  its_59009 
{ 'Наименование' }
,
                                     WS_CHILD or WS_VISIBLE or SS_LEFT,
                                     0,0,0,0, Win, 0, hInst, nil);
              end;

  WM_SETFOCUS:
              begin
              SetFocus(RptListWin);
              end;

  WM_SIZE:    begin
              BuildRptMenu(false);

              EvalMetrics;

              SetWindowTextStr(HeadFile, XOEM( its_59010 
{ 'Файл' }
));
              SetWindowTextStr(HeadName, XOEM( its_59011 
{ 'Наименование' }
));

              Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
              GetClientRect(Win, R1);

              SendMessage(HeadFile,  WM_SETFONT, WorkFont, longint(true));
              SendMessage(HeadName,  WM_SETFONT, WorkFont, longint(true));

              MoveWindow(Head0,    xHead0, 0, xFile - xHead0, MetricsH, true);
              MoveWindow(HeadFile, xFile,  0, xName - xFile,  MetricsH, true);
              MoveWindow(HeadName, xName,  0, xLast - xName,  MetricsH, true);


              if RptListWin <> 0 then DestroyWindow(RptListWin);
              RptListWin:=CreateWindow('LISTBOX', 'the list',
                                       LBS_OWNERDRAWVARIABLE
                                    or LBS_WANTKEYBOARDINPUT
                                    or LBS_NOINTEGRALHEIGHT
                                    or LBS_NOTIFY
                                    or WS_CHILD
                                    or WS_BORDER
                                    or WS_VSCROLL,
                                    0,0,0,0,
                                    Win,
                                    0,
                                    hInst,
                                    nil);

              SendMessage(RptListWin, WM_SETFONT, WorkFont, MAKELONG(1,0));
              FillList;

              RebuildActiveFn;

              ShowWindow(RptListWin, SW_SHOWNA);
              SetFocus(RptListWin);
              end;

  WM_PAINT:   begin
              end;


  WM_MEASUREITEM:
              begin
              EvalMetrics;

              pTMIS:=pointer(lParam);

              pTMIS^.ItemWidth  :=    xLast;
              pTMIS^.ItemHeight := MetricsH;
              pTMIS^.ItemData   :=        0;

              RptWinProc:=longint(true);
              exit;
              end;


  WM_DRAWITEM:begin
              pTDIS:=pointer(LParam);
              DC:=pTDIS^.hDC;
              Ni:=integer(pTDIS^.ItemId);
              Si:=(pTDIS^.itemState and ODS_SELECTED) <> 0;

              Rit :=pTDIS^.rcItem;

              Rit.right :=Rit.right  - Rit.left; Rit.left:=0;
              Rit.bottom:=Rit.bottom - Rit.top;  Rit.top :=0;

              DrawItem(CDC, Rit, Ni, Si, false);

              Rit:=pTDIS^.rcItem;
              BitBlt(DC, Rit.left, Rit.top,
                         Rit.right - Rit.left, Rit.bottom - Rit.top,
                         CDC,
                         0, 0,
                         SRCCOPY);

              CorRect(RFile, Rit);
              CorRect(RName, Rit);

              if Si
              then begin
                   _Rit  :=Rit;
                   _RFile:=RFile;
                   _RName:=RName;
                   end;
              exit;
              end;

  WM_CHARTOITEM:
              begin
              if wParam = 13
              then begin
                   Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
                   goto 1;
                   end
              else begin
                   if UpCase(chr(wParam)) in ['A'..'Z','$','0'..'1', '-', chr(VK_BACK)]
                   then begin
                        if UpCase(chr(wParam)) = chr(VK_BACK)
                        then Delete(LITER, length(LITER), 1)
                        else LITER:=LITER + UpCase(chr(wParam));
                        if LITER = ''
                        then i:=1 else i:=FindNonStrickly(LITER);
                        if i > 0
                        then begin
                             if i <> G.RptMenuPos
                             then begin
                                  G.RptMenuPos:=i;
                                  SendMessage(RptListWin, LB_SETCURSEL, i-1, 0);
                                  end;
                             end
                        else LITER:='';
                        end
                   else LITER:='';
                   end;
              end;

  WM_VKEYTOITEM:
              begin
              if wParam = VK_SPACE
              then begin
                   Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0) + 1;
                   G.RptMenuPos:=Ni;
                   FRe:=round(Body^[G.RptMenuPos].Re);
                   if FRe in [0,2,4,6,8]
                   then MessageBeep(word(-1))
                   else if (FRe = 3) and not Body^[G.RptMenuPos].a
                        then begin
                             Warning(RptListWin,  its_59012 
{ 'Файл-коэффициент нельзя' }
 +
                                           #10#13 + its_59013
{ 'отметить закладкой' }
);
                             end
                   else begin
                        Body^[G.RptMenuPos].a:=
                             not Body^[G.RptMenuPos].a;
                        RebuildActiveFn;
                        SaveActiveFn;
                        InvalidateRect(RptListWin, @_Rit, false);
                        end;
                   end

              else
              if wParam = VK_F4
              then begin
              LF4: Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
                   ts:=Body^[Ni+1].Fn;
                   if EmptyS(ts)
                   then MessageBeep(word(-1))
                   else begin
                        ts:=ts + '.RPT';
                        StrPcopy(@Buf, ts);
                        RunMDI_(Wins.Efo, 'EFOWIN', @Buf, true, false);
                        LoadFileToEdit(ts,
                                       false,
                                      (round(Body^[Ni+1].Re) = 3)
                                    or(round(Body^[Ni+1].Re) = 9),
                                       false);
                        end;
                   end

              else
              if wParam = VK_F5
              then begin
              LF5: EvalMetrics;
                   PrintRptList;
                   end

              else
              if wParam = VK_F6
              then begin
              LF6: Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
                   G.RptMenuPos:=Ni + 1;
                   ts:= Body^[G.RptMenuPos].Fn;
                   if EmptyS(ts)
                   then MessageBeep(word(-1))
                   else begin
                        EditString_(RptListWin, ts, sizeof(ts)-1,
                                   _RFile, cff, 0, false, false);

                        ts:=UpCaseStr(ts);

                        if EqStr(ts, Body^[G.RptMenuPos].Fn)
                        then {}
                        else begin
                             assign(F, WorkDir(RptExt(Body^[G.RptMenuPos].Fn)));
                             rename(F, WorkDir(RptExt(ts)));
                             if ioresult <> 0
                             then Warning(0, its_59014 
{ 'Такое имя файла уже имеется' }
)
                             else begin
                                  FRe:=round(Body^[G.RptMenuPos].Re);

                                  BuildRptMenu(true);
                                  G.RptMenuPos:=FindBodyElem(ts);
                                  InvalidateRect(RptListWin, nil, false);
                                  SendMessage(RptListWin, LB_SETCURSEL, G.RptMenuPos-1, 0);

                                  RedrawTree;
                                  if (FRe = 3) or (round(Body^[G.RptMenuPos].Re) = 3)
                                  or (FRe = 9) or (round(Body^[G.RptMenuPos].Re) = 9)
                                  then begin
                                       SET_BKGND_OFF_FOR_EDIT; { для файлов-коэфф }
                                       end;
                                  end;
                             end;
                        end;
                   end

              else
              if wParam = VK_F7
              then begin
              LF7: if ExistFile_(NoName+'.RPT')
                   then Warning(0, its_59015 
{ 'Не могу создать новый файл пока есть NONAME' }
)
                   else begin
                        assign(F, WorkDir(NoName+'.RPT'));
                        rewrite(F);
                        writeln(F, SWI( its_59016 
{ 'Новая фоpма, pедактиpуйте ее' }
));
                        close(F);
                        if ioresult <> 0
                        then Warning(0, its_59017 
{ 'Не могу создать ' }
+NoName+'.RPT')
                        else begin
                             BuildRptMenu(true);
                             SendMessage(RptListWin, LB_INSERTSTRING, 0, 0);
                             G.RptMenuPos:=1;
                             SendMessage(RptListWin, LB_SETCURSEL, G.RptMenuPos-1, 0);
                             goto LF6;
                             end;
                        end;
                   end

              else
              if wParam = VK_F8
              then begin
              LF8: Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
                   G.RptMenuPos:=Ni + 1;
                   ts:=RptExt(Body^[G.RptMenuPos].Fn);

                   if EmptyS(ts)
                   then MessageBeep(word(-1))
                   else if AreYouSure(RptListWin,  its_59018 
{ 'Удаление файла ' }
 + ts + #13#10 + its_59019
{ 'Вы уверены?' }
)
                        then begin
                             assign(F, WorkDir(RptExt(ts)));
                             erase(F);
                             if ioresult <> 0
                             then Warning(0, its_59020 
{ 'Не могу удалить файл ' }
+ts)
                             else begin
                                  Fre:=round(Body^[G.RptMenuPos].Re);

                                  BuildRptMenu(true);
                                  if G.RptMenuPos = 1 then inc(G.RptmenuPos);
                                  SendMessage(RptListWin, LB_DELETESTRING, G.RptMenuPos-1, 0);
                                  SendMessage(RptListWin, LB_SETCURSEL, G.RptMenuPos-1, 0);

                                  RedrawTree;
                                  if (FRe = 3)
                                  or (FRe = 9)  { для файлов-коэфф }
                                  then begin
                                       SET_BKGND_OFF_FOR_EDIT;
                                       end;
                                  end;
                             end;
              ENDLF8:
                   end;
              end;

  WM_COMMAND:
              begin
              if (wParam >= 300) and (wParam <= 300 + ActiveFnLimit)
              then begin
                   SetFocus(RptListWin);

                   G.RptFileStr_:=ActiveFn^[wParam-300].Fn + '.RPT';
                   RptNameStr:=SIW(ActiveFn^[wParam-300].Line1);

                   goto 6;
                   end

              else if wParam = 6
                   then begin
                        SetFocus(RptListWin);
                        goto LF5
                        end

              else if wParam = 7
                   then begin
                        SetFocus(RptListWin);
                        goto LF6
                        end


              else if wParam = 8
                   then begin
                        SetFocus(RptListWin);
                        goto LF7
                        end

              else if wParam = 9
                   then begin
                        SetFocus(RptListWin);
                        goto LF8
                        end

              else if wParam =10
                   then begin
                        SetFocus(RptListWin);
                        goto LF4;
                        end

              else
              case HIWORD(lParam) of

                LBN_SELCHANGE: begin
                               LITER:='';
                               OldNi:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
                               G.RptMenuPos:=OldNi + 1;
                               end;

                LBN_DBLCLK:    begin
                               Ni:=SendMessage(RptListWin, LB_GETCURSEL, 0, 0);
                               G.RptMenuPos:=Ni + 1;

                               if OldNi = Ni
                               then begin
                                   1:
                                    if round(Body^[Ni+1].Re) = 3  { файл-коэфф }
                                    then begin
                                         Warning(RptListWin,  its_59021 
{ 'Файл-коэффициент нельзя' }
 +
                                                       #10#13 + its_59022
{ 'выполнить как форму' }
);
                                         exit;
                                         end;

                                    ts:=Body^[Ni+1].Fn;

                                    if not EmptyS(ts)
                                    then begin
                                         G.RptFileStr_:=ts + '.RPT';
                                         RptNameStr:=WithOutStar(SIW(Body^[Ni+1].Line1));
                                   6:
                                         ErrorText:='';
                                         COMP_ERR:= '';

                                         if FixedErrStruct.Regim = BalError
                                         then begin
                                              ErrMsg(ErrorText, 0, nil, 0, '');
                                              FixError(false);
                                              end;

                                         OemHorPos:=0;

                                         RPT_RECOMPILE_FLAG:=true;

                                         RunRptFile_(G.RptFileStr_, true);
                                         end;
                                    end;
                               end;

              end;
              end;

  WM_DESTROY: RptListWin:=0;
end;

LLL:
RptWinProc := DefWindowProc(Win, Message, WParam, LParam);
end;



procedure InitRptW;
const WinClass: TWndClass = (
      style: 0;
      lpfnWndProc: @RptWinProc;
      cbClsExtra: 0;
      cbWndExtra: 0;
      hInstance: 0;
      hIcon: 0;
      hCursor: 0;
      hbrBackground: 0;
      lpszMenuName: AppName;
      lpszClassName: AppName);
begin
if HPrevInst = 0
then begin
     hInst:=Hinstance;
     WinClass.hInstance     :=hInst;
     WinClass.hIcon         :=LoadIcon(0, IDI_APPLICATION);
     WinClass.hCursor       :=LoadCursor(0, IDC_ARROW);
     WinClass.hbrBackground :=GetStockObject(LTGRAY_BRUSH);
     if not RegisterClass(WinClass) then Halt(255);
     end;

RptListWin:=0;
end;


function RptProc(w :HWND) :HWND;
var R :TRect;
begin
GetClientRect(w, R);
RptWin := CreateWindow(AppName,
                        '',
                        WS_CHILD or WS_VISIBLE,
                        R.left,
                        R.top,
                        R.right,
                        R.bottom,
                        w,
                        0,
                        HInstance,
                        nil);
SendMessage(RptWin, WM_SIZE, 0, 31415926);
RptProc:=RptWin;
end;



begin
RptWin:=0;
new(Body);
new(ActiveFn);
LoadActiveFn;

InitRptW;
end.