{$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.