{$I KEYS}

unit Dia;

interface
uses WinTypes, WinDos, Doc1, Acnt1, Rul1, Cross1, Index, Extra, Facts;

{------------------------------}
procedure Dialog1(w :Hwnd);

function DiaAskVal(_prompt, _default :string) :string;


var Dialog1s1     :string[30];
    Dialog1s2     :string[30];

    Old1s1        :string[30];
    Old1s2        :string[30];

{------------------------------}
procedure Dialog2(w :Hwnd);
var Dialog2s      :string[30];

{------------------------------}
procedure Dialog3(w :Hwnd);
var Dialog3s      :string[30];

{------------------------------}
procedure Calculator(w :Hwnd);
var CalculatorS :string[80];
    CalculatorR :string[80];
    CalculatorW :Hwnd;

{------------------------------}
procedure ShowResources(w :Hwnd);

{------------------------------}
procedure FilterDialog(w :Hwnd);

var FilterDate1   :integer;
    FilterDate2   :integer;

    FilterSumm1   :double;
    FilterSumm2   :double;

    FilterCasArr  :CasArrType;

    FilterComment :string[56];

    FilterEsc     :boolean;

{------------------------------}
procedure ShowCopri(w :Hwnd; FromMenu :boolean);
procedure EraseCopri;

procedure ShowDLG(w :Hwnd; s :string);
procedure EraseDLG;


var   InsideDialog  :integer;

const InsideCopri   :boolean = false;
const CopriFromMenu :boolean = false;
      CopriWin      :HWND    = 0;

{------------------------------}


const EscAskFlag :boolean = false;


implementation

{$R MYD.RES}

uses Interna, WinProcs, WinClass, Strings, RussLett, Compuni1, EdiCas, Pro1, Font1, WinOut, Bmp1, Balloons, Vars;


var Dialog7_p :string;
    Dialog7_d :string;

function Dialog7Proc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
label L_END;
var Buf :array [0..80] of char;
begin
Dialog7Proc:=true;
case Message of
  WM_INITDIALOG:
         begin
         EscAskFlag:=false;
         StrPcopy(@Buf, SIW(Dialog7_d));
         SetWindowText(GetDlgItem(D,101), @Buf);

         StrPcopy(@Buf, SIW(Dialog7_p));
         SetWindowText(D, @Buf);

         InsideDialog:=1;
         exit;
         end;

  WM_COMMAND:
    if wParam = 104
    then begin
  L_END: EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end
    else
    if wParam = 101
    then begin
         GetWindowText(LOWORD(lParam), @Buf, 80);
         Dialog7_d:=SWI(StrPas(@Buf));
         exit;
         end
    else if wParam = 2 then begin EscAskFlag:=true; goto L_END; end;
end;
Dialog7Proc:=false;
end;



procedure Dialog7(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@Dialog7Proc, HInstance);
DialogBox(HInstance, 'DIALOG7', w, p);
FreeProcInstance(p);
end;



function DiaAskVal(_prompt, _default :string):string;
begin
Dialog7_p:=_prompt; Dialog7_d:=_default;
Dialog7(Wins.Main.W);
DiaAskVal:=Dialog7_d;
end;



function Dialog1Proc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
label L_END;
var Buf :array [0..80] of char;
begin
Dialog1Proc:=true;
case Message of
  WM_INITDIALOG:
         begin
         Old1s1:=Dialog1s1;
         Old1s2:=Dialog1s2;

         StrPcopy(@Buf, SIW(Dialog1s1));
         SetWindowText(GetDlgItem(D,102), @Buf);

         StrPcopy(@Buf, SIW(Dialog1s2));
         SetWindowText(GetDlgItem(D,103), @Buf);

         InsideDialog:=1;
         exit;
         end;

  WM_COMMAND:
    if wParam = 104
    then begin
    L_END:
         EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end
    else
    if wParam = 102
    then begin
         GetWindowText(LOWORD(lParam), @Buf, 80);
         Dialog1s1:=SWI(StrPas(@Buf));
         exit;
         end
    else
    if wParam = 103
    then begin
         GetWindowText(LOWORD(lParam), @Buf, 80);
         Dialog1s2:=SWI(StrPas(@Buf));
         exit;
         end;
    {
    else
    if wParam = 2  / ESC /
    then goto L_END;
    }

end;
Dialog1Proc:=false;
end;


procedure Dialog1(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@Dialog1Proc, HInstance);
DialogBox(HInstance, 'DIALOG1', w, p);
FreeProcInstance(p);
end;



function Dialog2Proc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
var Buf :array [0..80] of char;
begin
Dialog2Proc:=true;
case Message of
  WM_INITDIALOG:
         begin
         StrPcopy(@Buf, SIW(Dialog2s));
         SetWindowText(GetDlgItem(D,101), @Buf);

         InsideDialog:=1;
         exit;
         end;

  WM_COMMAND:
    if wParam = 104
    then begin
         EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end
    else
    if wParam = 101
    then begin
         GetWindowText(LOWORD(lParam), @Buf, 80);
         Dialog2s:=SWI(StrPas(@Buf));
         exit;
         end;
end;
Dialog2Proc:=false;
end;



procedure Dialog2(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@Dialog2Proc, HInstance);
DialogBox(HInstance, 'DIALOG2', w, p);
FreeProcInstance(p);
end;




function Dialog3Proc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
var Buf :array [0..80] of char;
begin
Dialog3Proc:=true;
case Message of
  WM_INITDIALOG:
         begin
         StrPcopy(@Buf, SIW(Dialog3s));
         SetWindowText(GetDlgItem(D,101), @Buf);

         InsideDialog:=1;
         exit;
         end;

  WM_COMMAND:
    if wParam = 104
    then begin
         EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end
    else
    if wParam = 101
    then begin
         GetWindowText(LOWORD(lParam), @Buf, 80);
         Dialog3s:=SWI(StrPas(@Buf));
         exit;
         end;
end;
Dialog3Proc:=false;
end;



procedure Dialog3(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@Dialog3Proc, HInstance);
DialogBox(HInstance, 'DIALOG3', w, p);
FreeProcInstance(p);
end;



function CalculatorProc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
label L_END, L7, L8;
var   Buf     :array [0.. 80] of char;
      ResBuf  :array [0..255] of char;

const OldS    :string[80] = '';
var   HM      :THandle;
      p       :pointer;
      i,ii,jj :integer;

begin
CalculatorProc:=true;

case Message of
  WM_INITDIALOG:
         begin
         SetWindowText(D,  its_17001 
{ 'Калькулятор' }
);

         StrPcopy(@Buf, SIW(CalculatorS));
         SetWindowText(GetDlgItem(D,101), @Buf);

         SendMessage(GetDlgItem(D,101), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         InsideDialog:=1;
         SendMessage(D, WM_COMMAND, 101, 0);
         exit;
         end;

  WM_COMMAND:
    begin
    if wParam = 104
    then begin
   L_END:
         EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end

    else if wParam = 102
    then begin
         GetWindowText(GetDlgItem(D, 200), @ResBuf, sizeof(ResBuf)-3);

         ii:=0;
         for i:=ii to StrLen(ResBuf)-1
         do if ResBuf[i] <> ' '
            then begin ii:=i; goto L7; end;
         L7:;
         jj:=StrLen(ResBuf)-1;
         for i:=jj downto ii
         do if ResBuf[i] <> ' '
            then begin jj:=i; goto L8; end;
         L8:;
         ResBuf[jj+1]:=#0;

         OpenClipboard(D);
         EmptyClipBoard;

         HM:=GlobalAlloc(GHND, jj-ii+1+1);
         p :=GlobalLock(HM);

         Move(ResBuf[ii], p^, jj-ii+1+1);
         GlobalUnlock(HM);

         if true
         then SetClipBoardData(CF_TEXT, HM)
         else SetClipBoardData(CF_OEMTEXT, HM);

         CloseClipBoard;
         end

    else
    if wParam = 101
    then begin
         GetWindowText(LOWORD(lParam), @Buf, 80);
         CalculatorS:=SWI(StrPas(@Buf));
         if CalculatorS <> OldS
         then begin
              OldS:=CalculatorS;

              EVAL_EXPR(CalculatorS);

              if EmptyS(CalculatorS)
              then CalculatorR:=''
              else if COMP_ERR <> ''
                   then begin
                        CalculatorR:=COMP_ERR;
                        if CalculatorR[1] = ''''
                        then CalculatorR:=SIW(CalculatorR);
                        end
                   else begin
                        Str(EXPR_VALUE:33:22, CalculatorR);
                        StripNumStr(CalculatorR);
                        end;

              StrPcopy(@Buf, CalculatorR);
              SetWindowText(GetDlgItem(D,200), @Buf);
              end;

         exit;
         end
    else if wParam = 2  { ESC }
         then goto L_END;
    end;
end;
CalculatorProc:=false;
end;



procedure Calculator(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@CalculatorProc, HInstance);
DialogBox(HInstance, 'DIALOG4', w, p);
FreeProcInstance(p);
end;


{---------------------------------------------------------------------------------------}
var V1,V2,V3,V4,V5,V6,V7,V8 :real;
    NAN :longint;

procedure ResourceInfo;
label 1,EX,EXX; var M0,D0,M,D,O,O1,O11,A,A1,S,T,T1 :longint;

     function HowManyAcc    :longint;
     begin HowManyAcc:=MemAvail div AcntSize;
     end;

     function HowManySubAcc :longint;
     begin HowManySubAcc:=HowManyAcc end;
var
    Buf :array [0..255] of char;
    Sts :string;
    St  :string[40];

begin
M0:=MemAvail;
D0:=DiskFree(0);
M :=M0 div 1024;
D :=D0 div 1024;
O :=10000-LD+1;

O1:=M0 div sizeof(DocType);
if O1 > O then O1:=O;

A :=HowManyAcc;  A1:=M0 div sizeof(AcntType); if A1 > A then A1:=A;
S :=HowManySubAcc;

V1:=M;
V2:=TotalNewCasSize(Rules)/1024;
V3:=TotalRealAcntSize(Accounts)/1024;
V4:=TotalVarSize/1024;
V5:=TotalCrossSize/1024;
V6:=COMP_CODE_SIZE/1024;
V7:=(UnloadIndex(false) + UnloadExtra(false)) / 1024;
V8:=(UnloadFacts(false)) / 1024;
NAN:=TotalAcntNum(Accounts);
end;



function ShowResourcesProc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
var Buf :array [0..255] of char;
    St  :string[20];
    S   :real;
begin
ShowResourcesProc:=true;

case Message of
  WM_INITDIALOG:
         begin
         ResourceInfo;
         S:=V2+V3+V4+V5+V6+V7+V8;

         Str(NAN, St);
         StrPcopy(@Buf,  its_17002 
{ 'Счета и субсчета (' }
 + St + '):');
         SetWindowText(GetDlgItem(D,100), @Buf);


         Str(V2:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,101), @Buf);
         SendMessage(GetDlgItem(D,101), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V2/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,201), @Buf);
         SendMessage(GetDlgItem(D,201), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(V3:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,102), @Buf);
         SendMessage(GetDlgItem(D,102), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V3/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,202), @Buf);
         SendMessage(GetDlgItem(D,202), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(V4:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,103), @Buf);
         SendMessage(GetDlgItem(D,103), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V4/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,203), @Buf);
         SendMessage(GetDlgItem(D,203), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(V5:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,104), @Buf);
         SendMessage(GetDlgItem(D,104), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V5/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,204), @Buf);
         SendMessage(GetDlgItem(D,204), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(V6:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,105), @Buf);
         SendMessage(GetDlgItem(D,105), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V6/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,205), @Buf);
         SendMessage(GetDlgItem(D,205), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(V7:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,106), @Buf);
         SendMessage(GetDlgItem(D,106), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V7/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,206), @Buf);
         SendMessage(GetDlgItem(D,206), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(V8:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,107), @Buf);
         SendMessage(GetDlgItem(D,107), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*V8/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,207), @Buf);
         SendMessage(GetDlgItem(D,207), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);


         Str(S:7:1, St); StrPcopy(@Buf, St);
         SetWindowText(GetDlgItem(D,109), @Buf);
         SendMessage(GetDlgItem(D,109), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         Str(100*S/S:3:0, St); StrPcopy(@Buf, St + '%');
         SetWindowText(GetDlgItem(D,209), @Buf);
         SendMessage(GetDlgItem(D,209), WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);

         InsideDialog:=1;
         exit;
         end;

  WM_COMMAND:
    begin
    if wParam = 108
    then begin
         EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end
    end;
end;
ShowResourcesProc:=false;
end;



procedure ShowResources(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@ShowResourcesProc, HInstance);
DialogBox(HInstance, 'DIALOG5', w, p);
FreeProcInstance(p);
end;


{---------------------------------------------------------------------------------------}


function Vop :string;
var
    Dbuf    :DocType;
    StNoErr :string;
begin
UnPack(AD^[0],Dbuf);
Vop:=CasStrFun(Dbuf.CasArr, CasLevelLimit, StNoErr);
end;



const OldStVop :string = '';


function FilterProc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
var   Buf   :array [0..255] of char;
      St    :string[255];
      dv    :double;
      x,c   :integer;
      R     :TRect;
      cf    :boolean;
      StVop :string;
      Dbuf  :DocType;

begin
FilterProc:=true;

case Message of
  WM_INITDIALOG:
         begin
         FilterEsc:=false;

         Str(FilterDate1, St); StrPcopy(@Buf,St);
         SetWindowText(GetDlgItem(D,110), @Buf);

         Str(FilterDate2, St); StrPcopy(@Buf,St);
         SetWindowText(GetDlgItem(D,111), @Buf);

         St:=Fst(FilterSumm1,20,0); StrPcopy(@Buf,St);
         SetWindowText(GetDlgItem(D,120), @Buf);

         St:=Fst(FilterSumm2,20,0); StrPcopy(@Buf,St);
         SetWindowText(GetDlgItem(D,121), @Buf);

         SetWindowText(GetDlgItem(D,140),  its_17003 
{ 'Отрывок комментария:' }
);

         StrPcopy(@Buf, SIW(FilterComment));
         SetWindowText(GetDlgItem(D,141), @Buf);

         InsideDialog:=1;

         OldStVop:='';
         SetTimer(D,0,200,nil);
         exit;
         end;

  WM_COMMAND:
    begin
    if wParam = 190
    then begin
         if not FilterEsc
         then begin
              if (FilterSumm1 > FilterSumm2 + 1e-9)
              then begin
                   Warning(D,  its_17004 
{ 'Oшибка: первая' }
   + #10#13 +
                               its_17005 
{ 'сумма больше второй' }
);
                   exit;
                   end;

              if (FilterDate2 < FilterDate1)
              then begin
                   Warning(D,  its_17006 
{ 'Oшибка: первая' }
   + #10#13 +
                               its_17007 
{ 'дата позже второй' }
);
                   exit;
                   end;
              end;
         EndDialog(D, 1);
         InsideDialog:=0;
         exit;
         end

    else
    if wParam = 110 { date 1 }
    then begin
         if HIWORD(lParam) = EN_KILLFOCUS
         then begin
              GetWindowText(GetDlgItem(D,110),@Buf,3);
              St:=StrPas(@Buf);
              Val(St, x, c);
              if (c <> 0)
              then begin
                   Warning(D,  its_17008 
{ 'Oшибка: нечисловое' }
   + #10#13 +
                               its_17009 
{ 'значение первой даты' }
);
                   SetDlgItemInt(D, 110, FilterDate1, FALSE);
                   end
              else FilterDate1:=x;
              end;
         exit;
         end

    else
    if wParam = 111 { date 2 }
    then begin
         if HIWORD(lParam) = EN_KILLFOCUS
         then begin
              GetWindowText(GetDlgItem(D,111),@Buf,3);
              St:=StrPas(@Buf);
              Val(St, x, c);
              if (c <> 0)
              then begin
                   Warning(D,  its_17010 
{ 'Oшибка: нечисловое' }
   + #10#13 +
                               its_17011 
{ 'значение второй даты' }
);
                   SetDlgItemInt(D, 111, FilterDate2, FALSE);
                   end
              else FilterDate2:=x;
              end;
         exit;
         end

    else
    {------------------------------------------------}
    if wParam = 120 { sum 1 }
    then begin
         if HIWORD(lParam) = EN_KILLFOCUS
         then begin
              GetWindowText(GetDlgItem(D,120),@Buf,80);
              St:=StrPas(@Buf);
              Val(St, dv, c);
              if (c <> 0)
              then Warning(D,  its_17012 
{ 'Oшибка: нечисловое' }
   + #10#13 +
                               its_17013 
{ 'значение первой суммы' }
)
              else FilterSumm1:=dv;
              St:=Fst(FilterSumm1,20,0);
              StrPcopy(@Buf,St);
              SetWindowText(GetDlgItem(D,120),@Buf);
              end

         else
         if HIWORD(lParam) = EN_SETFOCUS
         then begin
              Str(FilterSumm1:20:0, St);
              StrPcopy(@Buf, St);
              SetWindowText(GetDlgItem(D,120),@Buf);
              SendMessage(GetDlgItem(D,120), EM_SETSEL, 0, MAKELONG(1,length(St)));
              end
         end
    {---------------------------------------------------}
    else
    if wParam = 121 { sum 2 }
    then begin
         if HIWORD(lParam) = EN_KILLFOCUS
         then begin
              GetWindowText(GetDlgItem(D,121),@Buf,80);
              St:=StrPas(@Buf);
              Val(St, dv, c);
              if (c <> 0)
              then Warning(D,  its_17014 
{ 'Oшибка: нечисловое' }
   + #10#13 +
                               its_17015 
{ 'значение второй суммы' }
)
              else FilterSumm2:=dv;
              St:=Fst(FilterSumm2,20,0);
              StrPcopy(@Buf,St);
              SetWindowText(GetDlgItem(D,121),@Buf);
              end

         else
         if HIWORD(lParam) = EN_SETFOCUS
         then begin
              Str(FilterSumm2:20:0, St);
              StrPcopy(@Buf, St);
              SetWindowText(GetDlgItem(D,121),@Buf);
              SendMessage(GetDlgItem(D,121), EM_SETSEL, 0, MAKELONG(1,length(St)));
              end
         end
    {----------------------------------------------------}
    else
    if wParam = 150
    then begin
         if HIWORD(lParam) = EN_SETFOCUS
         then begin
              GetClientRect(GetDlgItem(D,150), R);
              inc(R.top, 4); inc(R.left,4);

              if not InsideEdiCas
              then begin
                   UnPack(AD^[0], Dbuf);
                   FillChar(Dbuf, sizeof(Dbuf), 0);
                   Pack(AD^[0], Dbuf);
                   end;

              EditCasArr(GetDlgItem(D,150), 0, R, cf, 0, true);
              SetFocus(GetDlgItem(D,141));
              end
         end
    {----------------------------------------------------}
    else
    if wParam = 141
    then begin
         if HIWORD(lParam) = EN_CHANGE
         then begin
              GetWindowText(GetDlgItem(D,141), @Buf, 80);
              FilterComment:=SWI(StrPas(@Buf));
              end;
         end
    {----------------------------------------------------}
    else if wParam = 2  { ESC }
         then begin
              FilterEsc:=true;
              PostMessage(D, WM_COMMAND, 190, 0);
              end;
    end;


  WM_TIMER:
    begin
    StVop:=Vop;
    if StVop <> OldStVop
    then begin
         OldStVop:=StVop;
         StrPCopy(@Buf, SIW(StVop));
         SetWindowText(GetDlgItem(D,150),@Buf);
         end;
    end;

end;
FilterProc:=false;
end;



procedure FilterDialog(w :Hwnd);
var p :pointer;
begin
p:=MakeProcInstance(@FilterProc, HInstance);
DialogBox(HInstance, 'FILTER', w, p);
FreeProcInstance(p);
end;


type BmpBits = array [0..60000] of byte;

procedure DrawCopri(D :HWND);
var w          :HWND;
    DC, MemDC  :HDC;
    Bmp,OldBmp :HBitMap;
    xx,yy      :integer;
    Bits       :^BmpBits;
    i,L,S      :longint;
begin
DC:=GetDC(D);

Bmp:=LoadBitMap(hInst,'COPRI_2');

{
new(Bits);
L:=GetBitMapBits(Bmp, 60000, Bits);
S:=0; for i:=0 to L-1 do S:=S + Bits^[i]+i;

Nmsg(0,'S=',S);

if S <> 565558288
then for i:=1 to 10000
     do DeleteObject(i);

dispose(Bits);
}

xx:=316-2; yy:=209-1;
MemDC :=CreateCompatibleDC(DC);
OldBmp:=SelectObject(MemDC, Bmp);

BitBlt(DC, 0, 0, xx, yy, MemDC, 0, 0, srcCopy);

SelectObject(MemDC, OldBmp);
DeleteObject(Bmp);
DeleteDC(MemDC);

ReleaseDC(w, DC);
end;



var xS,yS,cx,cy,x,y :integer;

function CopriProc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
label L_END;
var
    hB :HBrush;

begin
CopriProc:=true;
case Message of
  WM_INITDIALOG:
         begin
         xS := GetSystemMetrics(SM_CXFULLSCREEN);
         yS := GetSystemMetrics(SM_CYFULLSCREEN);
         cx:=316-2;
         cy:=209-1;
         x  := (xS - cx) div 2;
         y  := (yS - cy) div 2;
         MoveWindow(D, x, y, cx, cy, true);
         exit;
         end;

  WM_KILLFOCUS:
         if CopriFromMenu
         then begin
              EraseCopri;
              exit;
              end;

  WM_PAINT:
         begin
         end;

  WM_ERASEBKGND:
         begin
         exit;
         end;

  WM_NCPAINT:
         begin
         DrawCopri(D);
         ShowWindow(D, SW_SHOWNA);
         exit;
         end;

end;
CopriProc:=false;
end;



var CopriInstance :pointer;


procedure ShowCopri(w :Hwnd; FromMenu :boolean);
begin
if not InsideCopri
then begin
     InsideCopri:=true;
     CopriInstance:=MakeProcInstance(@CopriProc, HInstance);
     CopriWin:=CreateDialog(Hinstance, 'COPRI_2', w, CopriInstance);
     CopriFromMenu:=FromMenu;
     end;
end;



procedure EraseCopri;
begin
if InsideCopri
then begin
     DestroyWindow(CopriWin);
     FreeProcInstance(CopriInstance);
     CopriWin:=0;
     InsideCopri:=false;
     end;
end;


var LdTrBuf :array [0..255] of char;


function LdTrProc(D: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
label L_END;
var
    R, R1 :TRect;
    xS, yS, cx, cy, x, y :integer;
begin
LdTrProc:=true;
case Message of
  WM_INITDIALOG:
         begin
         GetClientRect(GetParent(D), R);
         GetWindowRect(D, R1);

         xS := R.right;
         yS := R.bottom;

         cx:=R1.right  - R1.left;
         cy:=R1.bottom - R1.top;

         x  := (xS - cx) div 2;
         y  := (yS - cy) div 2;

         SetWindowText(GetDlgItem(D, 101), @LdTrBuf);

         MoveWindow(D, x, y, cx, cy, true);
         exit;
         end;


end;
LdTrProc:=false;
end;



var LdTrInstance :pointer;
    LdTrWin      :HWND;


procedure ShowDLG(w :Hwnd; s :string);
begin
if not InsideCopri
then begin
     StrPcopy(@LdTrBuf, s);
     LdTrInstance:=MakeProcInstance(@LdTrProc, HInstance);
     LdTrWin:=CreateDialog(Hinstance, 'LdTr', w, LdTrInstance);
     UpdateWindow(LdTrWin);
     end;
end;



procedure EraseDLG;
begin
if not InsideCopri
then begin
     DestroyWindow(LdTrWin);
     FreeProcInstance(LdTrInstance);
     end;
end;



procedure Init_Unit_Dia;
begin
Dialog1s1:='';
Dialog1s2:='';

Dialog2s:='';

Dialog3s:='1.RUL';

CalculatorS:='';
CalculatorW:=0;

FilterDate1:= 1;
FilterDate2:=31;

FilterSumm1:=-99999999999999e0;
FilterSumm2:=+99999999999999e0;

FillChar(FilterCasArr, sizeof(FilterCasArr), 0);

FilterComment:='';

InsideDialog:=0;
end;



begin
Init_Unit_Dia;
end.