oracle console

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, debuge, DB, ADODB, ExtCtrls, GridsEh, DBGridEh,
  DGRiOP, variants , dbctrls,  DBTables, types, Provider,comctrls, dblookupeh,
  DBClient,menus,ActiveX, actnlist,  inifiles,math, Mask,
  dbgridehimpexp,  DBCtrlsEh,comobj, ImgList, shellapi,popum,zbutton;


const
   TRMSG = WM_USER+5000;

   FL_LDIR = 'c:\tmpbk';
   FL_BK = 'c:\tmpbk\bk.log';
   FL_SYS = 'c:\tmpbk\sys.log';

type
  prgbarray=^trgbarray;
  trgbarray=array[0..1] of trgbtriple;

  trefr=class;
  tbkt=class;

   tvob=class(tobject)
   public
      filpath:string;
      isfil:integer;
   end;

   ftgre= record
      num:string;
      servnam:string;
      login:string;
      pass:string;
      coname:string;
   end;
   tftgarr=array of ftgre;

   tform2 = class;

   tdlo=class(tdblookupcomboboxeh)
   protected
      procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);override;
   end;

   tcofi = class
      private
         mast:tform2;
         qu:tadoquery;
         ds:tdatasource;
         co:tdlo;
         bu:tdebuge;
         //----------------------
         gri:tdbgridop;
         adc:tadoconnection;
         ncol:integer;
         isact:boolean;

      public
         procedure inico(incol:integer);
         procedure upfipo;
         constructor create(inadc:tadoconnection;ingri:tdbgridop;
         inbu:tdebuge; inmast:tform2);
         destructor destroy;
   end;

   thagro=class(tradiogroup)
   private
      procedure WMa(var msg:twmmouseactivate);message WM_MOUSEACTIVATE;
   public
      inmodo:procedure of object;
   published
      property caption;
      property onmousedown; //ftg
   end;

  thagrid=class(tdbgridop);

  //---------------------------------popup bk thread win
  {thlfo=class(tform)
  private
     procedure drawme;
     procedure WMPaint(var msg:TWMPaint); message WM_PAINT;
  public
     txtout:array of string;
  end;}

  TForm2 = class(TForm)
    DataSource1: TDataSource;
    Button2: TButton;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Panel2: TPanel;
    Panel3: TPanel;
    Splitter1: TSplitter;
    Panel4: TPanel;
    Splitter2: TSplitter;
    Panel1: TPanel;
    bu: tdebuge;
    RxDBGrid1: TDBGridOP;
    Panel5: TPanel;
    Memo1: TMemo;
    il: TImageList;
    ADOQuery2: TADOQuery;

    procedure RxDBGrid1HScro(rez_val: Integer);
    procedure RxDBGrid1ColWidthsChanged(Sender: TObject);
    procedure FormResize(Sender: TObject);

    //-----------------
    procedure WndProc(var msg:tmessage);override;

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ADOQuery1BeforeClose(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RxDBGrid1DblClick(Sender: TObject);

  private
    fkarr:array of integer;
    colresize:boolean;
    refrall:boolean;
    refr:trefr;
    bkt:tbkt;
    hbkt:cardinal;
    grih:hwnd;
    oldwpro:pointer;
    newwpro:pointer;
    lokpli:tlist;

    lock_upd:boolean;

    wmsgstr,statusstr{,dopstr}:string;
    ismaz:boolean;

    deltax,deltay:integer;

    refmode:boolean;

    function dtype(f:tfield):integer;

    procedure fkcolupd;
    procedure replgrwinpro;
    procedure newwndpro(var msg:tmessage);//ftg
    //procedure cloneme;
    procedure fpai(var msg:twmncpaint);message WM_NCPAINT;
    //procedure chi(var msg:twmmouseactivate{ftg});message WM_MOUSEACTIVATE;
    procedure chi(var msg:twmncrbuttondown);message WM_NCRBUTTONDOWN;
    //WM_NCHITTEST
  public
    is_upd:boolean;
    is_inter:boolean;
    tmp_owner:string;
    tmp_data:TADOQuery;
    cnt_a:integer;
    in_server:string;
    in_comms:string;
    tmpfname:string;
    //------------------------------
    tmp_baseq:string;
    tmp_filst:string;
    tmp_sortli:string;
    glocol:tcolumneh;
    //------------------------------
    gl_ragro:thagro;
    gl_lv:tlistview;
    ftgarr:tftgarr; //FTG

    pom,pom4,pom6:tpopupmenu;
    pom5,pom9,pom8:tpopum;
    zbu:tzbutton;
    //tpa:tpanel;
    liob:tlist;

    curzapfile:string;
    gtv:ttreeview;

    procedure defaulthandler(var message);override;
    function noad(instr:string):string;
    function adno(instr:string; goo:boolean):string;
    function noad9(instr:string):string;
    procedure mkradgro;
    procedure mkzapgri;
    procedure mkutree;
    procedure mkrg;
    procedure termrefr;

    procedure grchcli(sender:tobject);
    procedure grdrova(sender,source:tobject;x,y:integer;state:tdragstate;
    var accept:boolean);
    procedure grdrop(sender,source:tobject;x,y:integer);
    procedure tvdrop(sender,source:tobject;x,y:integer);
    procedure grmodon(sender:tobject; var dragobject:tdragobject);

    procedure spli(pare:twincontrol);
    function  pane(innam:string;ha:integer;ali:talign;pare:twincontrol):tpanel;
    function arrchecks:tlist;
    procedure redrtree;

    procedure execomm(incom:string);
    procedure shopo9;

  published
     procedure closup(Sender: TObject; Accept: Boolean);
     procedure cmbcle(sender: tobject);
     procedure cmbbdo(sender:tobject;topbutton:boolean;
     var autorepeat:boolean; var handled:boolean);

     //--------------------
     procedure dropdon(Sender: TObject);

     //---------------------------
     procedure refredata;
     procedure ftgrgproc(sender:tobject);
     procedure modo(isedit:boolean);
     procedure bktterm(sender:tobject);
     procedure updfilters;
     //----------------------------
     procedure chaque;
     procedure gricop4excel;
     procedure menucli(sender:tobject);
     function memofo(var inst:string):integer;

     procedure rgmmove(sender:tobject;shift:tshiftstate;x,y:integer);

     procedure menuou(sender:tobject;acol:integer;column:tcolumneh);
     procedure updstate(sender:tobject);
     procedure onlvcli(sender:tobject);
     procedure lvmodon(sender:tobject;button:tmousebutton;
     shift:tshiftstate;x,y:integer);
     procedure tvmodon(sender:tobject;button:tmousebutton;
     shift:tshiftstate;x,y:integer);

     procedure refmodcha(sender:tobject);
     //-----------------------------------------
     procedure tvonkli(sender:tobject);
  end;

  //----------------------------------
  trefr=class(tthread)
  private
     mymast:tform;
  protected
     sync_exec:tmethod;
     procedure Execute;override;
  public

     constructor create(createsuspended:boolean;mast:tform);
  end;

  //------------------------------------
  tbkt=class(tthread)
  private
     mymast:tform;
     {function processmsg(msg:tmsg):boolean;
     procedure processmsgs;  }

  protected
     bk_term:tmethod;
     procedure execute;override;
  public
     //hlo:thlfo;
     hlo,hlo9:twndclass;
     hloh,hl9:hwnd;
     z_counter:integer;
     constructor create(createsuspended:boolean;mast:tform);
  end;

  //------------------------------------------------------------
  //------------------------------------------------------------

var
  Form2: TForm2;
  txtout:array of string;
  debu:tmemorystream;
  crise:trtlcriticalsection;
  inb,inb9:graphics.tbitmap;
  grib:graphics.tbitmap;
  KICKM:integer;
  rndcol:tcolor;
  ibfkcode:boolean;

//---------------------------------------------------
implementation

uses asfo, Unit1;

//{$R menus.rc}
{$R *.DFM}


procedure tdlo.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
//
end;

//-------------------------------------------------------
constructor tcofi.create(inadc:tadoconnection;ingri:tdbgridop;
inbu:tdebuge;inmast:tform2);
begin
   inherited create;

   mast:=inmast;
   adc:=inadc;
   gri:=ingri;
   isact:=false;
   bu:=inbu;
   qu:=tadoquery.Create(nil);
   qu.Connection:=adc;
   ds:=tdatasource.Create(nil);
   ds.DataSet:=qu;

   co:=tdlo.Create(nil);
   co.Parent:=gri;
   co.Top:=1;
   co.Visible:=false;
   co.ListSource:=ds;
   co.DropDownbox.rows:=30;
   co.DropDownbox.Sizable:=true;
   co.DropDownBox.Width:=300;
   co.OnDropDown:=mast.dropdon;
   co.OnCloseUp:=mast.closup;
   co.OnClick:=mast.cmbcle;
   co.OnButtondown:=mast.cmbbdo;
   co.Tag:=5;

end;
destructor tcofi.destroy;
begin
   qu.Close;
   co.Free;
   ds.Free;
   qu.Free;

   inherited destroy;
end;
//----------------------------------------init filter
procedure tcofi.inico(incol:integer);
var
   s1:string;
begin
   if gri.Columns.Count-1<incol then
      exit;
   //endif
   s1:=gri.Columns[incol].FieldName;
   {qu.SQL.text:='select '+s1+' from ('+tmp_baseq+') '+
   ' group by '+s1+' order by 1';}
   if s1<>co.KeyField then
      qu.close;
   //endif

   co.ListField:=s1;
   co.KeyField:=s1;
   ncol:=incol;
   //qu.open;
   isact:=true;
   upfipo;

   co.Visible:=true;
end;
//-----------------------------update filter position
procedure tcofi.upfipo;
var
  di:tgriddrawinfoeh;
  lcol,i,lpos:integer;


begin
   //exit;
   if not(isact) then
      exit;
   //endif

   gri.OCalcDrawInfo(di);
   lcol:=di.Horz.FirstGridCell;
   {bu.wrln('-----------');
   bu.wrln(lcol);
   bu.wrln(ncol);
   bu.wrln(gri.Columns.count);  }

   if ((ncol+1)<lcol) then
      begin
         co.Visible:=false;
         exit;
      end
   else
      if gri.Columns.Count<(ncol+1) then
         begin
            co.Visible:=false;
            exit;
         end
      else
         if (gri.columns[ncol].width<20) then
            begin
               co.Visible:=false;
               exit;
            end
         else
            co.Visible:=true;
         //endif
      //endif
   //endif

   lpos:=15;
   for i:=lcol-1 to ncol-1 do
      lpos:=lpos+gri.Columns[i].Width+1;
   //endfor
   co.Left:=lpos+1;
   co.Width:=gri.Columns[ncol].Width-6;

end;



//-------------------------------------------------------
procedure thagro.WMa(var msg:twmmouseactivate);

function bitst(inva:integer):string;
function h(inv:integer):string;
begin
   if inv=0 then
      result:='+'
   else
      result:='I';
   //endif
end;
begin

   result:=h(inva and 128)+h(inva and 64)+h(inva and 32)+
   h(inva and 16)+h(inva and 8)+h(inva and 4)+h(inva and 2)+
   h(inva and 1);

   inva:=(inva shr 8);
   result:=h(inva and 128)+h(inva and 64)+h(inva and 32)+
   h(inva and 16)+h(inva and 8)+h(inva and 4)+h(inva and 2)+
   h(inva and 1)+result;
end;

begin
   caption:= bitst(msg.MouseMsg);
   if msg.MouseMsg=516 then
      begin
         if assigned(inmodo) then
            inmodo
         //enif
      end
   else
      if msg.MouseMsg=519 then
         begin
            {deletefile(extractfilepath(application.ExeName)+'\ftg.ini');
            form2.mkradgro;         }
         end;
      inherited;
   //endif


end;

//---------------------------------------------------
constructor trefr.create(createsuspended:boolean;mast:tform);
begin
   inherited create(true);
   mymast:=mast;
   with sync_exec do
      begin
         data:=mymast;
         code:=mymast.ClassType.MethodAddress('refredata');
      end;
   //endwith
   if not(createsuspended) then
      resume;
   //endif
end;

//---------------------------------------------------
procedure trefr.Execute;
begin
   while not(terminated) do
      begin
         synchronize(tthreadmethod(sync_exec));
         sleep(500);
      end;
   //wend
end;

//-------------------------------------------Win Proc
function windowproc(inhw:hwnd; msge, wparam:word;
lparam:longint): longint;stdcall;
//-----------------------------------
procedure drawme;
var
   i:integer;
   curect:trect;
   indc:hdc;
   //ps:tpaintstruct;

begin
   getwindowrect(inhw,curect);
   inb.Width:=curect.Right-curect.left;
   inb.Height:=curect.Bottom-curect.top;
   with inb.Canvas do
      begin
         font.Size:=8;
         font.Name:='lucida console';
         font.color:=clwhite;
         font.Style:=[fsbold];
         brush.Style:=bssolid;
         brush.Color:=rgb(0,0,40);
         fillrect(cliprect);

         brush.Style:=bsclear;
         for i:=0 to min(0,length(txtout)-1) do
            begin
               textout(10,6+15*i,txtout[i]);
            end;
         //endfor
      end;
   //endwith

   indc:=getwindowdc(inhw);
   bitblt(indc,0,0,inb.Width,inb.Height,inb.Canvas.Handle,0,0,srccopy);
   releasedc(inhw,indc);

end;

//-----------------------------------------
begin
   //windowproc:=0;
   case msge of
   //wm_erasebkgnd, wm_vscroll:
      //invagri;

   wm_hscroll:
      begin
         //invagri;
         invalidaterect(inhw,nil,true);
      end;

   wm_paint:
      begin
         //log_msg(' winproc got wm_paint');
         drawme;
      end;
   wm_rbuttondown:
      begin
         sendmessage(HWND_BROADCAST,KICKM,0,0);
      end;

   wm_destroy:
      begin
         //log_msg('_____________GOT WM_DESTROY');
      end;
   end;

   windowproc:=defwindowproc(inhw,msge,wparam,lparam);
end;

//-----------------------------------Win Proc for popup wins
function windowproc9(inhw:hwnd; msge, wparam:word;
lparam:longint): longint;stdcall;
//-----------------------------------
procedure drawme9;
var
   i:integer;
   curect:trect;
   indc9:hdc;
   //ps:tpaintstruct;

begin
   getwindowrect(inhw,curect);
   inb9.Width:=curect.Right-curect.left;
   inb9.Height:=curect.Bottom-curect.top;
   with inb9.Canvas do
      begin
         font.Size:=8;
         font.Name:='lucida console';
         font.color:=clwhite;
         font.Style:=[fsbold];
         brush.Style:=bssolid;
         brush.Color:=rndcol;
         fillrect(cliprect);

         brush.Style:=bsclear;
         for i:=0 to min(0,length(txtout)-1) do
            begin
               textout(10,6+15*i,txtout[i]);
            end;
         //endfor
      end;
   //endwith

   indc9:=getwindowdc(inhw);
   bitblt(indc9,0,0,inb9.Width,inb9.Height,inb9.Canvas.Handle,0,0,srccopy);
   releasedc(inhw,indc9);

end;

//-----------------------------------------
begin
   case msge of
   wm_hscroll:
      begin
         invalidaterect(inhw,nil,true);
      end;
   wm_paint:
      begin
         drawme9;
      end;
   end;
   windowproc9:=defwindowproc(inhw,msge,wparam,lparam);
end;

//---------------------------------------------------
constructor tbkt.create(createsuspended:boolean;mast:tform);

begin
   inherited create(true);
   z_counter:=0;
   mymast:=mast;
   with bk_term do
      begin
         data:=mymast;
         code:=mymast.classtype.MethodAddress('bktterm');
      end;
   //endwith
   onterminate:=TNotifyEvent(bk_term);

   with hlo do
      begin
         style:=cs_hredraw or cs_vredraw;
         lpfnwndproc:=@windowproc;
         cbclsextra:=0;
         cbwndextra:=0;
         hinstance:=0;
         hicon:=loadicon(0,IDI_APPLICATION);
         hcursor:=loadcursor(0,IDC_ARROW);
         lpszclassname:='AsInfo';
      end;
   //endwith
   with hlo9 do
      begin
         style:=cs_hredraw or cs_vredraw;
         lpfnwndproc:=@windowproc9;
         cbclsextra:=0;
         cbwndextra:=0;
         hinstance:=0;
         hicon:=loadicon(0,IDI_APPLICATION);
         hcursor:=loadcursor(0,IDC_ARROW);
         lpszclassname:='AsZInfo';
      end;
   //endwith

   windows.registerclass(hlo);
   windows.registerclass(hlo9);
   //hloh:=createwindowEX(WS_EX_TOPMOST,'AsInfo','AsInfo',
   //WS_POPUPWINDOW
   //,50,300,150,40,0{hwnd_desktop},0,hinstance,nil);

   {hloh:=createwindowEX(WS_EX_TOPMOST,'AsInfo','AsInfo',
   WS_POPUPWINDOW
   ,400,screen.Height-20,
   200,20,0{hwnd_desktop,0,hinstance,nil);  }

   hloh:=createwindowEX(0{WS_EX_TOPMOST},'AsInfo','AsInfo',
   WS_POPUPWINDOW
   ,0,0,
   200,20,mymast.handle{hwnd_desktop},0,hinstance,nil);

   {setwindowlong(hloh, GWL_EXSTYLE,
   getwindowlong(hloh,GWL_EXSTYLE) or WS_EX_LAYERED);
   setlayeredwindowattributes(hloh,0,200,LWA_ALPHA);   }

   showwindow(hloh,SW_SHOWNORMAL);
   updatewindow(hloh); // sends WM_PAINT

   if not(createsuspended) then
      resume;
   //endif

end;


//----------------------------------------------------
procedure tbkt.Execute;
var
  tp:tzbutton;
  r:trect;
  rp:prect;
  {drifo:tgriddrawinfoeh;
  inmsg:tagmsg;
  tmprow:longint;
  curect:trect;     }
  prevss:string;

//------------------------------------------------
procedure set_pars;
var
   excapp,wb,ws:variant;

begin
   with (mymast as tform2) do
      begin
         if length(txtout)<1 then
            begin
               setlength(txtout,3);
               txtout[0]:='';
               txtout[1]:='';
               txtout[2]:='';
            end;
         //endif
         txtout[0]:='tm:'+formatdatetime('hh:mm:ss.zzz',time);
         {if (txtout[1]<>statusstr) and (z_counter=0) then
            begin
               txtout[1]:=statusstr;
               z_counter:=100;
               randomize;
               rndcol:=rgb(random(200),random(200),random(200));  }
               {hl9:=createwindowEX(0,'AsZInfo','AszInfo',
               WS_POPUPWINDOW,random(500),random(500),400,50,0,0,hinstance,nil);}
               //hl9:=createwindow('AsZInfo','zinfo',WS_BORDER,
               //random(500),random(500),400,50,0,0,hinstance,nil);

               {setwindowlong(hl9, GWL_EXSTYLE,
               getwindowlong(hl9,GWL_EXSTYLE) or WS_EX_LAYERED);
               setlayeredwindowattributes(hl9,rndcol,128,LWA_ALPHA);   }
                //FTG
              { showwindow(hl9,SW_SHOWNORMAL);
               updatewindow(hl9); // sends WM_PAINT
            end;        }
         //enndif

         sendmessage(hloh,WM_PAINT,0,0);
         if z_counter>0 then
            sendmessage(hl9,WM_PAINT,0,0);
         //endif
         //updatewindow(hloh);
         //hlo.drawme;
         //getwindowrect(hloh,curect);
         //invalidaterect(hloh,@curect,true);

         if statusstr='excel plz wait' then
            begin
              excapp:=comobj.createoleobject('Excel.Application');
              excapp.visible:=false;
              wb:=excapp.workbooks.add;
              ws:=excapp.workbooks[1].worksheets[1];

              synchronize(gricop4excel);

              ws.paste;
              excapp.visible:=true;
              statusstr:='excel ok';
            end;
         //endif
         {if (statusstr<>prevss) and (statusstr<>'')  then
            begin
               prevss:=statusstr;
               pom9.cleara;
               pom9.appitem(statusstr,1,nil);
               pom9.popup(100,100);
            end;
         //endif     }
      end;
   //endwith
end;

//------------------------------------------------
begin
   prevss:='';
   //---------------------test wcy pro
   while (true) do
      begin
         set_pars;
         if terminated then
            exit;
         //endif
         tp:=(mymast as tform2).zbu;
         r:=rect(0,0,tp.Width-2,tp.Height-2);
         rp:=@r;
         (mymast as tform2).zbu.tick;
         invalidaterect(tp.Handle,rp,false);
         //sendmessage(tp.Handle,wm_paint,0,0);
         sleep(10);
      end;
   //wend
end;

//-----------------------------Terminate back thread
procedure tform2.bktterm(sender:tobject);
begin
   //log_msg('______________START SENDING WM_DESTROY',true);
   destroywindow(bkt.hloh);
   //sendmessage(bkt.hloh, WM_DESTROY,0,0);
   //postmessage(bkt.hloh, WM_DESTROY,0,0);

   //log_msg('______________FINISH SENDING WM_DESTROY',true);
   freeandnil(debu);

end;

//---------------------------------get data type
function tform2.dtype(f:tfield):integer;
begin
   if (f.datatype=ftstring) or
      (f.datatype=ftWideString) or
      (f.DataType=ftmemo) then
      dtype:=0
   else
   if (f.DataType=ftSmallint) or
      (f.DataType=ftLargeint) or
      (f.DataType=ftInteger) or
      (f.DataType=ftWord) or
      (f.DataType=ftCurrency) or
      (f.DataType=ftFloat) then
      dtype:=1
   else
   if (f.DataType=ftDate) or
      (f.DataType=ftDatetime) then
      dtype:=2
   else
      dtype:=3;
   //endif

end;

//-----------------------------------change refresh mode of grid
procedure tform2.refmodcha(sender:tobject);
begin
   refmode:=not refmode;
   if refmode then
      begin
        zbu.ButtonColor:=clred;
        execomm('refr');
      end
   else
      begin
         zbu.ButtonColor:=clblue;
         execomm('norefr');
      end;
   //endif


end;

//-------------------------------------refresh dataset
procedure tform2.refredata;
var
   curnu:integer;
   grinfo:tgriddrawinfoeh;
   tmprow, tmpcol,tmplcol:longint;

   allrows:integer;
   refrow:integer;
   //tmpstr:string;
   step1:integer;
   j:integer;

//-----------------------------------------
procedure movet(var step:integer);
var
   i:integer;

begin
   if step>=0 then
      for i:=1 to step do
         begin
            adoquery1.Next;
            if adoquery1.Eof then
               begin
                  step:=i;
                  break;
               end;
            //endif
         end
      //endfor
   else
      for i:=1 to -step do
         begin
            adoquery1.Prior;
            if adoquery1.Bof then
               begin
                  step:=i;
                  break;
               end;
            //endif
         end;
      //endfor
   //endif
end;
//-----------------------------------------
begin
   if lock_upd then
      exit;
   //endif
   is_upd:=true;
   //lockwindowupdate(rxdbgrid1.Handle);
   sendmessage(rxdbgrid1.Handle, WM_SETREDRAW,0,0);

   //-----------------------------
   rxdbgrid1.OCalcDrawInfo(grinfo);
   allrows:=grinfo.Vert.GridCellCount;
   refrow:=allrows div 2;
   tmprow:=rxdbgrid1.Row;
   tmpcol:=rxdbgrid1.Col;
   tmplcol:=rxdbgrid1.LeftCol;
   step1:=refrow-tmprow;
   movet(step1);

   curnu:=adoquery1.Fields[0].asinteger;
   try
      adoquery1.Close;
      adoquery1.Open;
   except
      on e:exception do
      begin
         statusstr:=e.Message;
         is_upd:=false;
         exit;
      end;

   end;


   fkcolupd;
   try
      adoquery1.Filter:='rownum='+inttostr(curnu);
      adoquery1.FindFirst;
   except
      //log_msg('invbk '+bkm,true);
   end;
     { end
   else
      begin
         log_msg('-------------error bkm');
      end;
   //endif   }

   step1:=-step1;
   movet(step1);
   rxdbgrid1.Col:=tmpcol;
   rxdbgrid1.LeftCol:=tmplcol;


   //lockwindowupdate(0);

   {redrawwindow(rxdbgrid1.Handle,nil,0,
   RDW_FRAME+RDW_INVALIDATE);}


   sendmessage(rxdbgrid1.Handle, WM_SETREDRAW,1,0);
   {redrawwindow(rxdbgrid1.Handle,nil,0,
   RDW_FRAME+RDW_INVALIDATE);}
   //sendmessage(rxdbgrid1.Handle, WM_PAINT,1,0);

   rxdbgrid1.invalidate;
   for j:=0 to rxdbgrid1.ControlCount-1 do
      begin
         rxdbgrid1.Controls[j].Invalidate;
      end;
   //endfor
   is_upd:=false;


end;

//--------------------------terminate refresh thread
procedure tform2.termrefr;
begin
   if assigned(refr) then
      begin
         with refr do
            begin
               terminate;
               waitfor;
            end;
         //endwith
         freeandnil(refr);
      end;
   //endif
end;



//-------------------------ckose if on title click
procedure tform2.chi(var msg:twmncrbuttondown);
begin
   {inherited;
   bu.wrr('caption mouse test',20);
   bu.wrln(inttostr(msg.HitTestCode));
   bu.wrln(inttostr(msg.MouseMsg));
   if (msg.HitTestCode=HTCAPTION) and (msg.MouseMsg=516) then
      close;
   //endif   }
   close;

end;


//-----------------------------------border draw
procedure tform2.fpai(var msg:twmncpaint);
var
   dc:hdc;
   pen:hpen;
   op:hpen;
   ob:hbrush;
   i:integer;

function sob(inob:hgdiobj):hgdiobj;
begin
   result:=selectobject(dc,inob);
end;

begin
   dc:=getwindowdc(handle);

   msg.Result:=1;
   pen:=createpen(ps_solid,1,rgb(255,0,0));
   op:=sob(pen);
   ob:=sob(getstockobject(null_brush));

   randomize;
   for i:=1 to 2 do
      rectangle(dc,0,i,width,i+5);
   //endfor


   sob(op);
   sob(ob);
   deleteobject(pen);
   releasedc(handle, canvas.Handle);

end;

//--------------------override wnd proc form2
procedure tform2.WndProc(var msg:tmessage);

function r(inw:integer):string;
begin
   result:=inttostr(inw)+'-';
end;
function u(inw1{ftg}:integer;inw2:integer):string;
begin
   result:=inttostr(inw1)+'/'+inttostr(inw2)+'-';
end;
function hh(inw:integer):string;
var
   i:integer;
   tms:string;
   tmw,yo:integer;
begin
   tmw:=inw;
   tms:='';
   //bu.wrln(tmw);
   for i:=8 downto 0 do
      begin
         yo:= tmw div round(power(16,i));
         //bu.wrln(yo);
         case yo of
            15:tms:=tms+'F';
            14:tms:=tms+'E';
            13:tms:=tms+'D';
            12:tms:=tms+'C';
            11:tms:=tms+'B';
            10:tms:=tms+'A';
            // 0:tms:=tms;
         else
            tms:=tms+inttostr(yo);
         end;
         tmw:=tmw-yo*round(power(16,i));
      end;
   //endfor
    result:=tms+'-';
end;

begin
    wmsgstr:=hh(msg.Msg)+u(msg.WParamhi,msg.wparamlo)+
       u(msg.LParamhi,msg.lparamlo)+u(msg.Resulthi,msg.resultlo);
    {if assigned(bu) then
       bu.wrln(wmsgstr);
    //endif      }
    //bu.wrln(msg.)
    if msg.Msg=$112 then
       if ismaz=false then
          begin
             //inherited;
             ismaz:=true;
             //windowstate:=wsmaximized;
             if windowstate=wsmaximized then
                begin
                   sendmessage(handle,wm_syscommand,sc_restore,0);
                   windowstate:=wsnormal;
                end
             else
                begin
                   sendmessage(handle,wm_syscommand,sc_maximize,0);
                   windowstate:=wsmaximized;
                end;
             //endif
             {width:=screen.Width;
             height:=screen.Height;
             left:=0;
             top:=0;  }
             //invalidate;
             //refresh;
             //sendmessage(handle,WM_NCPAINT,0,0);
             //msg.Result:=1;
             exit;
          end;
       {else
          begin
             ismaz:=false;
             sendmessage(handle,wm_syscommand,sc_restore,0);
             exit;
          end;  }
       //endif
    //endi
    inherited;
end;

//------------------------------grid window proc
procedure tform2.newwndpro(var msg:tmessage);
{var
   curect:trect; }

procedure drawme;
var
   dc:hdc;
   bm:tbitmap;
   w,h,i,j:integer;
   s:prgbarray;

begin
   dc:=getwindowdc(rxdbgrid1.handle);
   bm:=tbitmap.Create;
   bm.Width:=rxdbgrid1.Width;
   bm.Height:=rxdbgrid1.Height;
   w:=bm.Width-1;
   h:=bm.Height-1;
   bitblt(bm.Canvas.Handle,0,0,w,h,dc,0,0,srccopy);
   for i:=0 to h-1 do
      begin
         s:=bm.ScanLine[i];
         for j:=0 to w-1 do
            begin
               s[j].rgbtBlue:=max(s[j].rgbtBlue * j div w,0);
            end;
         //endfor
      end;
   //endfor
   bitblt(dc,0,0,w,h,bm.Canvas.Handle,0,0,srccopy);
   releasedc(rxdbgrid1.Handle,dc);

end;

begin
   {if lock_upd then
      is_upd:=false;
   //endif      }

   if ((msg.Msg=WM_PAINT) or (msg.Msg=WM_ERASEBKGND)
      or (msg.Msg=WM_NCPAINT) {or (msg.Msg=WM_WINDOWPOSCHANGING) }
      {or (msg.Msg=WM_NCCALCSIZE)} {or (msg.Msg=WM_GETMINMAXINFO)}) and (is_upd) then
      exit;
   //endif


   if (msg.Msg=WM_ERASEBKGND) then
      begin
         {getwindowrect(grih,curect);
         grib.Width:=curect.Right-curect.Left;
         grib.Height:=curect.Bottom-curect.Top;
         callwindowproc(oldwpro,grib.handle,msg,wparam,lparam);}

         exit;
      end;
   //endif

   with msg do
      result:=callwindowproc(oldwpro,grih, msg,wparam,lparam);
   //endwith
   //sleep(1000);

    //--------------------------buff output
   {if msg.Msg=WM_PAINT then
      drawme;
   //endif       }

end;

//---------------------replace grid winproc
procedure tform2.replgrwinpro;
begin
   grih:=rxdbgrid1.Handle;
   newwpro:=classes.MakeObjectInstance(newwndpro);
   oldwpro:=pointer(getwindowlong(grih,GWL_WNDPROC));
   setwindowlong(grih,GWL_WNDPROC,longint(newwpro));

end;

//---------------------------------------------------
procedure TForm2.FormShow(Sender: TObject);
var
   //tmp_str:string;
   //tmuser,tmpass:string;
   //act:tcloseaction;
   //h:integer;
   rx:tdbgridop;

begin
   mkrg;
   {h:=rxdbgrid1.Canvas.TextHeight('test');
   thagrid(rxdbgrid1).RowCount:=2; }
   //thagrid(rxdbgrid1).RowHeights[0]:=70;
   rx:=rxdbgrid1;
   rx.TitleHeight:=70;
   rx.UseMultiTitle:=true;
   //rx.VTitleMargin:=4;
   //rx.optionseh

   bkt:=tbkt.create(true,self);
   with bkt do
      begin
         hbkt:=handle;
         resume;
      end;
   //endwith
   if not(directoryexists(FL_LDIR)) then
      mkdir(FL_LDIR);
   //endif
   if fileexists(FL_BK) then
      deletefile(FL_BK);
   //endif
   if fileexists(FL_SYS) then
      deletefile(FL_SYS);
   //endif
   {with tasyfo.Create(nil) do
      begin
         windows.ShowWindow(handle, SW_SHOWNORMAL);
         windows.SetWindowPos(handle,HWND_TOP,
         250,400,50,50, SWP_NOACTIVATE);
      end;
   //endwith   }
end;



procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
{var
  //al:boolean;
  exco:cardinal; }

begin
   AdoConnection1.close;
   if assigned(bkt) then
      begin
         bkt.Terminate;
         bkt.WaitFor;
      end;
   //endif
   if assigned(refr) then
      begin
         refr.Terminate;
         refr.WaitFor;
      end;
   //endif
   if assigned(debu) then  //tmemorystream
      begin
         debu.clear;
         debu.Free;
      end;
   //endif
   //terminatethread(hbkt,exco);
   //waitforsingleobject(hbkt,INFINITE);


   {al:=true;
   while al=true do
      if getexitcodethread(bkt.Handle,exco) then
         if exco<>STILL_ACTIVE then
            al:=false;
         //endif
      //endif
   //wend  }


end;

//-----------------------------open connection
procedure tform2.ftgrgproc(sender:tobject);
var
   rg:tradiogroup;
   aco:tadoconnection;
begin
   rg:=(sender as tradiogroup);
   aco:=adoconnection1;

   termrefr;
   aco.Close;        //FTG-FTG
   ibfkcode:=false;
   if pos('freecs',ansilowercase(ftgarr[rg.itemindex].coname))<>0 then
      begin
         aco.ConnectionString:=ftgarr[rg.Itemindex].servnam;
         ibfkcode:=true;
      end
   else
      if pos('mssql',ansilowercase(ftgarr[rg.itemindex].coname))<>0 then
         aco.connectionstring:=
         'Provider=SQLNCLI.1;Password='+ftgarr[rg.itemindex].pass+';'+
         'Persist Security Info=True;User ID='+ftgarr[rg.itemindex].login+';'+
         {'Initial catalog=Expenses;}'Data Source='+ftgarr[rg.Itemindex].servnam
      else
         if pos('as sysdba', ansilowercase(ftgarr[rg.itemindex].pass))<>0 then
            aco.ConnectionString:=
            'Provider=MSDASQL.1;Password='+ftgarr[rg.itemindex].pass
            +';Persist Security Info=true;'+'User ID='+ftgarr[rg.itemindex].login+
            ';Extended Properties="DRIVER=Oracle in OraDb10g_home1;'+
            'UID='+ftgarr[rg.itemindex].login+';PWD='+ftgarr[rg.itemindex].pass+
            ';DBQ='+ftgarr[rg.itemindex].servnam+'"'
         else
            aco.connectionstring:=
            'Provider=OraOLEDB.Oracle.1;Password='+ftgarr[rg.itemindex].pass+
            ';Persist Security Info=True;'+
            'User ID='+ftgarr[rg.itemindex].login+
            ';Data Source='+ftgarr[rg.itemindex].servnam;
         //endif
      //endif
   //endif
   aco.LoginPrompt:=false;
   try
      aco.OPEN; //ftg
      statusstr:=ftgarr[rg.itemindex].servnam+' success';
   except
      statusstr:=ftgarr[rg.itemindex].servnam+' failed'
   end;

   chaque;



end;

//---------------------------set active query
procedure tform2.chaque;
var
  tms:string;
  aq:tadoquery;
  n_rows:integer;

begin
   if (copy(ansiuppercase(trimleft(tmp_baseq)),1,6)<>'SELECT') and
      (copy(ansiuppercase(trimleft(tmp_baseq)),1,4)<>'WITH') then
      begin
         if messagebox(handle,pansichar('confirm: '+tmp_baseq),
         'sys', MB_YESNO+MB_ICONWARNING)=IDYES then
            begin
               try
                  aq:=adoquery2;
                  aq.SQL.Text:=tmp_baseq;
                  n_rows:=aq.ExecSQL;
                  statusstr:='rows affected '+inttostr(n_rows);
                  shopo9;
               except
                  on E: Exception do
                     begin
                        statusstr:=E.Message;
                        shopo9;
                     end;
                  //---
               end;
            end;
         //endif
         exit;
      end;
   //endif

   is_upd:=true;
   if refmode=true then
      tms:='refr;'
   else
      tms:='norefr;noresize;';
   //endif

   //if pos
   if ibfkcode then
      memo1.Text:=tmp_baseq+' '+tmp_filst+tmp_sortli+';'+tms
   else
      if pos('SQLNCLI',adoconnection1.ConnectionString)<>0 then
         memo1.Text:=
         'select  a.* from ('+
         tmp_baseq+') a '+tmp_filst+tmp_sortli+';'+tms
      else
         memo1.Text:=
         'select rownum, a.* from ('+
         tmp_baseq+') a '+tmp_filst+tmp_sortli+';'+tms;
      //endif
   //endif

   button1click(nil);
   is_upd:=false;
end;

//--------------------------------------new connection
procedure tform2.modo(isedit:boolean);
var
   fo:tform;
   i:integer;
   ini:tinifile;
   g:thagro;


function getcomp(instr:string):tedit;
{var
   j:integer; }

begin
   {bu.wrr('find components',40);

   for j:=0 to fo.ComponentCount-1 do
      begin
         bu.wrln(fo.Components[j].Name);
      end;
   //endfor      }
   result:=fo.FindComponent(instr) as tedit;
end;

begin
   {if button<>mbright then
      exit;
   //endif  }

   g:=gl_ragro;
   //----------------------
      fo:=tform.CreateNew(nil);   //ftg
      fo.Width:=350;
      fo.Height:=150;
      for i:=1 to 4 do
         begin
            with tlabel.create(fo) do
               begin
                  parent:=fo;
                  left:=10;
                  top:=20*i-15;
                  case i of
                     1:caption:='NAME';
                     2:caption:='SERVER';
                     3:caption:='LOGIN';
                     4:caption:='PASS';
                  end;
               end;
            //endwith
            with tedit.Create(fo) do
               begin
                  parent:=fo;
                  top:=20*i-15;
                  left:=60;
                  width:=280;
                  height:=19;
                  name:='edit'+inttostr(i);
                  if isedit then
                     begin
                     case i of
                        1:text:=ftgarr[g.itemindex].coname;
                        2:text:=ftgarr[g.itemindex].servnam;
                        3:text:=ftgarr[g.itemindex].login;
                        4:text:=ftgarr[g.itemindex].pass;
                     end;
                     end
                  else
                     text:='';
                  //endif
                  showhint:=true;
                  case i of
                     1:hint:='NAME';
                     2:hint:='SERVER';
                     3:hint:='LOGIN';
                     4:hint:='PASS';
                  end;
               end;
            //endwith
         end;
      //endfor
   //------------------------
   with tbutton.Create(nil) do
      begin
         parent:=fo;
         caption:='ok';
         top:=90;
         width:=50;
         left:=10;
         modalresult:=mrok;
      end;
   //end with
   with tbutton.Create(nil) do
      begin
         parent:=fo;
         caption:='cancel';
         top:=90;
         width:=50;
         left:=70;
         modalresult:=mrcancel;
      end;
   //end with
   if fo.showmodal=mrok then
      begin
         randomize;
         if isedit then
            i:=strtoint(ftgarr[g.itemindex].num)
         else
            i:=random(10000);
         //endif
         ini:=tinifile.Create(extractfilepath(application.ExeName)+'\ftg.ini');
         ini.WriteString('CONAME','name'+inttostr(i),getcomp('edit1').text);
         ini.WriteString('SERVERS','serv'+inttostr(i),getcomp('edit2').text);
         ini.WriteString('LOGINS','login'+inttostr(i),getcomp('edit3').text);//FTG
         ini.writestring('PASSES','pass'+inttostr(i), getcomp('edit4').text);//FTG
         ini.UpdateFile;
         ini.Free;
         mkradgro;
      end;
   //endif
   fo.Free;

end;

//-------------------------------------------------------
procedure tform2.mkradgro;
var
   ini:tinifile;
   FTGS,ftgs3,ftgs5,ftgs6:tstringlist;
   i:integer;
   pa:tpanel;
   rg:thagro;

procedure apserv(servnam, lognam,pasnam, coname:string;nu:integer);
begin
   ini.WriteString('SERVERS','serv'+inttostr(nu),servnam);
   ini.WriteString('LOGINS','login'+inttostr(nu),lognam);//FTG
   ini.writestring('PASSES','pass'+inttostr(nu), pasnam);//FTG
   ini.WriteString('CONAME','name'+inttostr(nu),coname);
end;


function ftgpa:string;
begin
   result:=extractfilepath(application.exename)
   //FTG ! getdir(0,spath);
end;

begin

   panel1.FindChildControl('ubl').Free;
   pa:=tpanel.Create(panel1);
   with pa do
      begin
         parent:=panel1;
         name:='ubl';
         height:=150;
         align:=albottom;
         popupmenu:=pom4;
      end;
   //endwith
   rg:=thagro.Create(pa);
   rg.ShowHint:=true;
   rg.Parent:=pa;
   rg.Align:=alclient;
   rg.OnClick:=ftgrgproc;
   //rg.inmodo:=modo;
   gl_ragro:=rg;

   FTGS:=tstringlist.Create;
   ftgs3:=tstringlist.Create;
   ftgs5:=tstringlist.Create;
   ftgs6:=tstringlist.Create;
   ini:=tinifile.Create(ftgpa+'ftg.ini');


   ini.ReadSection('SERVERS',FTGS);
   if ftgs.count=0 then
      begin
         apserv('emg-oracle1.europaplus.ru/MONIT','MONIT','MONIT','Cert/MONIT',1);
         ini.ReadSection('SERVERS',FTGS);
      end;
   //endif
   ini.ReadSection('LOGINS',ftgs3);
   ini.ReadSection('PASSES',ftgs5);
   ini.ReadSection('CONAME',ftgs6);

   setlength(ftgarr,ftgs.Count);

   for i:=0 to ftgs.Count-1 do
      begin                              //FTG
         ftgarr[i].num:=copy(ftgs[i],5,length(ftgs[i])-4);
         ftgarr[i].servnam:=ini.ReadString('SERVERS',ftgs[i],'');
         ftgarr[i].login:=ini.readstring('LOGINS',ftgs3[i],'');
         ftgarr[i].pass:=ini.ReadString('PASSES',ftgs5[i],'');
         ftgarr[i].coname:=ini.ReadString('CONAME',ftgs6[i],'');
         rg.Items.Add(ftgarr[i].coname);
      end;
   //endfor
   pa.Height:=ftgs.Count*25+10;

   {if not(fileexists(ftgpa+'\ftg.ini')) then
      begin   }
   FTGS.free;
   ftgs3.free;
   ftgs5.Free;
   ini.Free;

   rg.OnMouseMove:=rgmmove;
   for i:=0 to rg.ControlCount-1 do
      (rg.Controls[i] as tradiobutton).onmousemove:=rgmmove;
   //endfor

   rg.ItemIndex:=0;
end;

//------------------------------set hint of rgroup
procedure tform2.rgmmove(sender:tobject;shift:tshiftstate;x,y:integer);
{var
   rg:thagro;
   i:integer;  }

begin
   {if sender is thagro then
      rg:=sender as thagro
   else
      rg:=(sender as tcontrol).parent as thagro;
   //endif
   i:=floor((mouse.CursorPos.y-rg.parent.Top-self.top-30)/25);
   if (i>=0) and (i<rg.Items.count) then
      begin
         statusstr:=rg.Items[i];
         //dopstr:=ftgarr[i].login;
      end;
   //endif    }

end;


//------------------------------------------------------------
//            make list of querys
//------------------------------------------------------------
procedure tform2.mkzapgri;
var
   pa:tpanel;
   lv:tlistview;
   fs:tfilestream;
   sl:tstringlist;
   tms:string;
   i:integer;
   li:tlistitem;

begin

   tms:=curzapfile;//extractfilepath(application.ExeName)+'\zaps.txt';
   sl:=tstringlist.Create;

   if not(fileexists(tms)) then
      begin
         sl.Add(tmp_baseq);
         fs:=tfilestream.Create(tms,fmcreate);
         sl.SaveToStream(fs);
         fs.Free;
      end;
   //endif

   sl.clear;
   sl.LoadFromFile(tms);

   if not assigned(gl_lv) then
      begin
         spli(panel2);
         pa:=pane('zap',50,alclient,panel2);
         lv:=tlistview.Create(self);
         lv.Parent:=pa;
         lv.Align:=alclient;
         lv.Columns.Insert(0);
         lv.Columns[0].Width:=700;
         //lv.Checkboxes:=true;
         lv.ViewStyle:=vsreport;
         lv.SmallImages:=il;
         lv.MultiSelect:=true;
         lv.OnDblClick:=onlvcli;
         lv.OnMouseDown:=lvmodon;
         //lv.PopupMenu:=pom;
         lv.DragMode:=dmautomatic;
      end
   else
      begin
         lv:=gl_lv;
         lv.Clear;
      end;
   //endif

   randomize;
   for i:=sl.Count-1 downto 0 do
      begin
         li:=lv.Items.Add;
         li.Caption:=sl.Strings[i];
         li.ImageIndex:=random(4);
      end;
   //endfor
   sl.Free;

   gl_lv:=lv;
end;

//--------------------------on listview click
procedure tform2.onlvcli(sender:tobject);
var
   lv:tlistview;

begin
   lv:=sender as tlistview;
   if lv.SelCount>0 then
      begin
         tmp_baseq:=adno(lv.Selected.Caption,true);
         tmp_filst:='';
         tmp_sortli:='';
         colresize:=true;
         chaque;
      end;
   //endif
end;

//------------------------sql listview right button click
procedure tform2.lvmodon(sender:tobject;button:tmousebutton;
shift:tshiftstate;x,y:integer);
{var
   lv:tlistview;  }

begin
   //lv:=sender as tlistview;
   if (button=mbright) {and (lv.selcount>0)} then
      pom5.Popup(mouse.CursorPos.X, mouse.cursorpos.Y,0);
   //endif

   {f:=tform.createnew;
   f.     }

end;

//----------------------------show menu of query files
procedure tform2.tvmodon(sender:tobject;button:tmousebutton;
shift:tshiftstate;x,y:integer);
begin
   if (button=mbright) then
      pom8.popup(mouse.CursorPos.X,mouse.CursorPos.Y,0);
   //endif
end;

//------------------------------group check onclick
procedure tform2.grchcli(sender:tobject);
begin
end;
//-----------------------group modo
procedure tform2.grmodon(sender:tobject;var dragobject:tdragobject);
begin
   deltax:=mouse.CursorPos.X;
   deltay:=mouse.CursorPos.Y;
   {deltax:=round(dragobject.MouseDeltaX);
   deltay:=round(dragobject.MouseDeltaY); }
   {bu.wrln('-*---');
   bu.wrln(mouse.CursorPos.x);
   bu.wrln(mouse.CursorPos.y);    }
   {bu.wrln((sender as tcontrol).left);
   bu.wrln((sender as tcontrol).Top);  }
end;

//------------------group box drover & drop
procedure tform2.grdrova(sender,source:tobject;x,y:integer;
state:tdragstate; var accept:boolean);
begin
//
end;
procedure tform2.grdrop(sender,source:tobject;x,y:integer);
var
   pa8:tpanel;
   mo:tpoint;

begin
   pa8:=(source as tpanel);
   mo:=mouse.cursorpos;//ftg
   pa8.left:=pa8.left+mo.x-deltax;
   pa8.top:=pa8.Top+mo.y-deltay;
   if mo.Y<deltay then
      pa8.Top:=pa8.Top-25;
   //endif
   {bu.wrln('-------');
   bu.wrln(x-deltax);
   bu.wrln(y-deltay);
   bu.wrln(deltax);
   bu.wrln(deltay); }
   //arrchecks;
   redrtree;
end;

//---------------------------compare func for sort
function compaf(item1,item2:pointer):integer;
begin
   if (tcontrol(item1).top)<(tcontrol(item2).Top) then
      result:=-1
   else
      if (tcontrol(item1).top)>(tcontrol(item2).Top) then
         result:=1
      else
         result:=0;
   //endif
end;
//-----------------------arrange checks
function tform2.arrchecks:tlist;
var
   i:integer;
   pa:tpanel;
   li:tlist;
   //sorted:boolean;
   //co:tcontrol;


begin
   li:=tlist.Create;
   pa:=panel1.findcomponent('abl') as tpanel;
   for i:=0 to pa.ComponentCount-1 do
      li.Add(pa.Components[i]);
   //endif
   li.sort(compaf);

   for i:=0 to li.Count-1 do
      begin
         tcontrol(li[i]).top:=3+25*i;
         tcontrol(li[i]).Left:=1+10*i;
      end;
   //endfor
   result:=li;

end;


//--------------------------
procedure tform2.spli(pare:twincontrol);
begin
   with tsplitter.Create(pare) do
      begin
         parent:=pare;
         align:=altop;
         //height:=1;
         minsize:=15;
         autosnap:=false;
         beveled:=true;
         //minsize:=panel1.FindChildControl('ubl').height;
         resizestyle:=rsupdate;
      end;
   //endwith
end;
//-----------------------
function tform2.pane(innam:string;ha:integer;ali:talign;pare:twincontrol):tpanel;
var
   inpa:tpanel;
begin
   inpa:=tpanel.Create(pare);
   with inpa do
      begin
         parent:=pare;
         name:=innam;
         height:=ha;
         align:=ali;
         caption:='';
         fullrepaint:=false;
         parentbackground:=false;
         parentcolor:=true;
      end;
   //endwith

   result:=inpa;
end;


//---------------------------make aggregate tree & control
procedure tform2.mkutree;
type
   ans = (smon,sday,suser,smach);
   tans = set of ans;

var
   pa,pa3:tpanel;

//----------------------
procedure chbo(cap:string;taga:integer);
var
   hy:integer;
   pa9:tpanel;
begin
   hy:=pa.ComponentCount*25;
   pa9:=tpanel.Create(pa);
   with pa9 do
      begin
         parent:=pa;
         top:=hy+3;
         //bu.wrln(top);
         height:=24;
         //align:=alnone;
         tag:=taga;
         dragmode:=dmautomatic;
         onstartdrag:=grmodon;
         ondragover:=grdrova;
         ondragdrop:=grdrop;
         width:=pa.Width-41;
         left:=1+pa.ComponentCount*10; //ftg
      end;
   //endwith

   with tcheckbox.Create(pa9) do
      begin
         parent:=pa9;
         //align:=alclient;
         left:=20;
         top:=1;
         width:=50;//parent.Width-24;
         height:=parent.Height-3;
         //top:=hy+3;
         //height:=24;
         caption:=cap;
         checked:=false;
         tag:=taga;
         onclick:=grchcli;
         ondragover:=grdrova;
         ondragdrop:=grdrop;
      end;
   //endwith
end;
//------------------------------
procedure chbos(instr:tans);
var
   tms:ans;
   j:integer;
   tmst:string;
begin
   j:=1;
   for tms in instr do
      begin
         case tms of
            smon:tmst:='month';
            sday:tmst:='day';
            suser:tmst:='user';
            smach:tmst:='machine';
         else
            tmst:='';
         end;
         chbo(tmst,j);
         j:=j+1
      end;
   //endfor
end;

//------------------------
begin


   spli(panel1);
   pa:=pane('abl',15,altop,panel1);
   pa.OnDragOver:=grdrova;
   pa.OnDragDrop:=grdrop;

   {pa3:=}pane('trb',100,alclient,panel1);
   //pa.Caption:='groups';
   chbos([smon,sday,suser,smach]);
   redrtree;
end;
//----------------------------make tree
procedure tform2.redrtree;
var
   pa3:tpanel;//ftg
   //tv:ttreeview;
   i:integer;
   vob:tvob;
   //i:integer;
   //sq:array[1..4] of string;

procedure recufi(indir:string;parno:ttreenode);
var
   sr:tsearchrec;
   finde:integer;
   tno:ttreenode;

procedure maction;
begin
   vob:=tvob.Create;
   vob.filpath:=indir+'\'+sr.Name;
   liob.Add(vob);
   if (sr.Attr and fadirectory)<>0 then
      begin
         vob.isfil:=0;
         tno:=gtv.Items.Addobject(nil,sr.Name,vob);
         tno.ImageIndex:=random(4);
         recufi(indir+'\'+sr.name,tno);
      end
   else
      if parno=nil then
         begin
            vob.isfil:=1;
            tno:=gtv.Items.AddObject(nil,sr.Name, vob);
         end
      else
         begin
            vob.isfil:=1;
            tno:=gtv.Items.AddChildObject(parno,sr.Name,vob);
         end;
      //endif
end;

begin
   finde:=findfirst(indir+'\*.zpu',faanyfile,sr);
   while finde=0 do
      begin
         maction;
         finde:=findnext(sr);
      end;
   //wend
end;

begin
   //sq[1]:='select to_char(extract(year from sess_table))||'+
   //chr(39)+'-'+chr(39)+'||to_char(;
   pa3:=panel1.FindChildControl('trb') as tpanel;
   pa3.DestroyComponents;
   liob.Clear;
   gtv:=ttreeview.Create(pa3);
   gtv.Parent:=pa3;
   gtv.Align:=alclient;
   gtv.Images:=il;
   gtv.OnClick:=tvonkli;
   gtv.OnMouseDown:=tvmodon;
   gtv.DragMode:=dmautomatic;//ftg
   gtv.OnDragOver:=grdrova;//ftg
   gtv.OnDragDrop:=tvdrop;
   recufi(extractfilepath(application.exename),nil);
   {for i:=0 to ili.Count-1 do
      begin
         if ((ili[i] as tcontrol).components[0] as tcheckbox).checked=true then  }
end;


//-------------------------------------------------------tree view drop
procedure tform2.tvdrop(sender,source:tobject;x,y:integer);
var
   //li:tlistitem;
   tn:ttreenode;
   sl:tstringlist;
   fnam:string;
   tmi:integer;

begin
   tn:=gtv.GetNodeAt(x,y);

   if (gtv.SelectionCount>0) and (tvob(tn.data).isfil=1) then
      begin
         fnam:=tvob(tn.data).filpath;
         sl:=tstringlist.Create;
         sl.loadfromfile(fnam);
         sl.insert(0,gl_lv.Selected.caption);
         sl.SaveToFile(fnam);

         sl.clear;
         tmi:=gl_lv.selected.Index;
         sl.LoadFromFile(curzapfile);
         sl.Delete(sl.Count-1-tmi);
         sl.SaveToFile(curzapfile);

         sl.Free;
         mkzapgri;
      end;
   //endif
end;


//----------------------------------select query list
procedure tform2.tvonkli(sender:tobject);
var
   //tv:ttreeview;
   //pa9:tpanel;
   vo:tvob;

begin
   //pa9:=panel1.findchildcontrol('trb') as tpanel;
   //tv:=pa9.components[0] as ttreeview;
   vo:=tvob(gtv.Selected.data);
   if vo.isfil=1 then
      begin
         curzapfile:=vo.filpath;
         mkzapgri;
      end;
   //endif
end;


//-----------------------------
procedure tform2.mkrg;
var
   p:array[0..4] of tpoint;
   rg1, rg2:hrgn;

begin
   p[0].x:=1;p[0].Y:=1;p[1].X:=width;p[1].Y:=1;
   p[2].X:=width;p[2].Y:=height;
   p[3].X:=1;p[3].Y:=height;p[4].X:=1;p[4].Y:=1;

   rg1:=createpolygonrgn(p,5,alternate);
   rg2:=createellipticrgn(width-120,-100,width+50,28);
   combinergn(rg1,rg1,rg2,RGN_XOR);

   setwindowrgn(handle,rg1,true);
   //bu.wrr('check set wreg',20);
   //bu.wrln(inttostr(clientwidth)+'-'+inttostr(clientheight));

end;
//----------------------------------------------------------------
//                 form creation
//----------------------------------------------------------------
procedure TForm2.FormCreate(Sender: TObject);
var
   i:integer;
   //w:dword;
   im:tmenuitem;
   al:tlist;
   ac:taction;
//----------------------------
begin
   curzapfile:='';
   {w:=getwindowlong(handle,GWL_STYLE);
   w:=w and not WS_MINIMIZEBOX;
   w:=w and not WS_MAXIMIZEBOX;
   w:=setwindowlong(handle,GWL_STYLE,1);     }
   lokpli:=tlist.Create;
   liob:=tlist.Create;
   ismaz:=false;
   bu.ini;
   initializecriticalsection(crise);
   inb:=tbitmap.create;
   inb9:=tbitmap.Create;
   grib:=tbitmap.Create;
   colresize:=true;
   refrall:=false;
   is_upd:=false;
   lock_upd:=false;
   refmode:=false;
   //mkrg;
   rxdbgrid1.Parent:=panel3;
   rxdbgrid1.Align:=alclient;
   rxdbgrid1.OptionsEh:=rxdbgrid1.optionseh+[dghmultisortmarking];
   {tpa:=tpanel.Create(self);
   tpa.Parent:=rxdbgrid1;
   tpa.Left:=0;
   tpa.Top:=30;
   tpa.Width:=17;
   tpa.Height:=30;}

   zbu:=tzbutton.Create(self);
   zbu.Parent:=rxdbgrid1;
   zbu.Width:=8;
   zbu.Height:=16;
   zbu.Left:=1;
   zbu.Top:=26;
   zbu.ButtonColor:=clblue;
   //zbu.start;
   zbu.OnClick:=refmodcha;

   //-----------------------------------
   al:=tlist.Create;
   pom:=tpopupmenu.Create(self);
   pom4:=tpopupmenu.Create(self);
   pom5:=tpopum.Create(self);
   pom9:=tpopum.create(self);
   pom6:=tpopupmenu.Create(self);
   pom8:=tpopum.create(self);
   pom8.forecheck:=false;
   //pom8.Color:=rgb(200,0,0);

   for i:=1 to 13 do
      begin
         ac:=taction.Create(self);
         ac.Tag:=i;
         ac.OnExecute:=menucli;
         al.Add(ac);
         im:=tmenuitem.Create(self);
         im.Action:=al.items[i-1];
         case i of
         1: im.caption:='sort ascending';
         2: im.Caption:='sort descending';
         3: im.Caption:='x clear sort';
         4: im.Caption:='export to excel';
         //----------------------------------
         5: im.Caption:='new connection';
         6: im.Caption:='edit connection';
         7: im.Caption:='delete connection';
         //----------------------------------
         8: im.Caption:='new query';
         9: im.Caption:='edit query';
         10:im.Caption:='delete query';
         11:im.Caption:='tkprof';
         12:im.Caption:='new file';
         13:im.Caption:='new folder';

         end;
         if i<5 then
            pom.Items.Add(im)
         else
            if i<8 then
               pom4.Items.Add(im)
            else
               if i<11 then
                  pom5.appitem(im.caption,i,menucli,0)
               else
                  if i<12 then
                     pom6.Items.Add(im)
                  else
                     pom8.appitem(im.Caption,i,menucli,0);
                  //endif
               //endif
            //endif
         //endif
      end;
   //endfor

   rxdbgrid1.PopupMenu:=pom6;
   rxdbgrid1.ontitlebtnclick:=menuou;
   //memo1.PopupMenu:=pom4;

   //-----------------------------------
   tmp_baseq:='select * from sess_table where program_name<>'+
   chr(39)+'perl.exe'+chr(39);//FTG
   tmp_filst:='';
   tmp_sortli:='';

   replgrwinpro;
   //spli;
   //mkzapgri;
   mkradgro;
   mkutree;
end;

//----------------------out menu
procedure tform2.menuou(sender:tobject;acol:integer;column:tcolumneh);
begin
   glocol:=column;
   pom.Popup(mouse.cursorpos.x,mouse.cursorpos.y);
end;


//-------------------------------------memo dialog form
function tform2.memofo(var inst:string):integer;
var
   f:tform;
   m:tmemo;
   b:tbutton;
begin
   f:=tform.createnew(nil);
   f.Width:=400;
   f.Height:=300;
   m:=tmemo.create(f);
   m.ScrollBars:=ssvertical;
   m.WordWrap:=true;
   m.Text:=adno(inst,false);
   m.parent:=f;
   m.left:=1;
   m.Top:=1;
   m.Width:=f.Width-2;
   m.Height:=f.Height-30;
   m.Anchors:=[akleft,akright,aktop,akbottom];
   b:=tbutton.Create(f);
   b.Parent:=f;
   b.Caption:='ok';
   b.ModalResult:=mrok;
   b.Left:=10;
   b.Top:=f.Height-25;
   b.Anchors:=[akleft,akbottom];
   b:=tbutton.Create(f);
   b.Parent:=f;
   b.Caption:='cancel';
   b.ModalResult:=mrcancel;
   b.Left:=90;
   b.Top:=f.Height-25;
   b.Anchors:=[akleft,akbottom];

   result:=f.showmodal;
   inst:=noad(m.Text);

   f.Free;
end;

//----------------------------------popup menu action
procedure tform2.menucli(sender:tobject);
var
   ac:tcomponent;
   ini:tinifile;
   tmi:integer;
   tms:string;
   sl:tstringlist;
   fs:tfilestream;
   //---------------------
   sti:tstartupinfo;
   pinf:tprocessinformation;
   rist:longbool;
   err:integer;

procedure bazs;
begin
   if tmp_sortli='' then
      tmp_sortli:=' order by ';
   //endif
   if tmp_sortli<>' order by ' then
      tmp_sortli:=tmp_sortli+',';
   //endif
end;

begin
   ac:=sender as tcomponent;
   //messagebox(handle,pansichar(inttostr(ac.tag)),'sys',0);
   case ac.Tag of
   1: begin
         bazs;
         tmp_sortli:=tmp_sortli+'"'+glocol.FieldName+'"';
         //glocol.title.sortmarker:=smupeh;
         chaque;
      end;
   2: begin
         bazs;
         tmp_sortli:=tmp_sortli+'"'+glocol.FieldName+'" desc';
         chaque;
         //glocol.Title.SortMarker:=smdowneh;
      end;
   3:begin
        tmp_sortli:='';
        {for i:=0 to rxdbgrid1.Columns.Count-1 do
           rxdbgrid1.Columns[i].Title.SortMarker:=smnoneeh;
        //endfor }
        chaque;
      end;
   4:statusstr:='excel plz wait';
   5:modo(false);
   6:modo(true);
   7:begin
        tms:=ftgarr[gl_ragro.itemindex].num;
        ini:=tinifile.Create(extractfilepath(application.ExeName)+'\ftg.ini');
        ini.DeleteKey('SERVERS','serv'+tms);
        ini.DeleteKey('LOGINS','login'+tms);
        ini.DeleteKey('PASSES','pass'+tms);
        ini.deletekey('CONAME','name'+tms);
        mkradgro;
     end;
   8,9,10:begin
        if (gl_lv.SelCount=0) and (ac.Tag<>8) then
           exit
        else
           if (gl_lv.SelCount>0) then
              tmi:=gl_lv.Selected.Index;
           //endif
        //endif

        fs:=tfilestream.Create(curzapfile
        {extractfilepath(application.exename)+'\zaps.txt'},
        fmopenread);
        fs.Seek(0,sofrombeginning);
        {sz:=fs.Size;
        getmem(buf,sz);
        fs.ReadBuffer(buf[0],sz);}
        sl:=tstringlist.create;
        sl.LoadFromStream(fs);
        //freemem(buf,sz);
        //setlength(buf,0);
        fs.Free;
        if ac.Tag=8 then
           begin
              tmi:=sl.add('');
              tms:='';
           end
        else
           tms:=sl.Strings[sl.count-1-tmi];
        //endif

        if (ac.Tag=10) or ((ac.Tag<>10) and (memofo(tms)=mrok)) then  //ftg
           begin
              if ac.Tag=10 then
                 sl.Delete(sl.Count-1-tmi)     //tstringlist
              else
                 if ac.Tag=8 then
                    sl.strings[tmi]:=tms
                 else
                    sl.strings[sl.Count-1-tmi]:=tms;
                 //endif
              //endif
              fs:=tfilestream.create(curzapfile
              {extractfilepath(application.exename)
              +'\zaps.txt'},fmcreate);
              //fs.Seek(0,sofrombeginning);
              {for i:=0 to sl.Count-1 do
                 begin
                    tms:=sl.Strings[i]{+chr(13)+chr(10);
                    if (i<sl.Count-1) or (ac.Tag<>10) then
                       fs.writebuffer(pchar(tms)^,length(tms));
                    //endif
                 end;
              //endfor    }
              sl.SaveToStream(fs);
              fs.Free;
              mkzapgri;
           end;
        //endif
        sl.Free;
     end;
   11:begin
         tms:=adoquery1.Fields.FieldByName('TRAS_FILE').asstring;

         fillchar(sti,sizeof(sti),0);
         sti.cb:=sizeof(sti);
         sti.dwFlags:=0;
         sti.wshowwindow:=SW_HIDE;

         rist:=createprocess(nil,
         pansichar('tkprof.exe "'+tms+'" "'+tms+'.txt"'),nil,nil,false,
         NORMAL_PRIORITY_CLASS,nil,nil,sti,pinf);

         if rist then
            begin
               waitforsingleobject(pinf.hprocess,INFINITE);
               closehandle(pinf.hProcess);
               closehandle(pinf.hThread);
            end
         else
            raise exception.create(inttostr(getlasterror));
         //endif


         {shellexecute(handle,'open','cmd.exe',
         pansichar('/c tkprof "'+tms+'" "'+tms+'.txt"'),'',sw_hide);
         //winexec(pansichar('cmd /c tkprof.exe '+tms+' '+tms+'.txt'),0);  }
         shellexecute(handle,'open',pansichar(tms+'.txt'),'','',sw_shownormal);
      end;
   //------------------------------------
   12,13:begin
         tms:='';
         if memofo(tms)=mrok then
            begin
               if (gtv.SelectionCount>0) and
                  (tvob(gtv.Selected.Data).isfil=0) then
                  begin//FTG
                     if ac.Tag=12 then
                        begin
                           fs:=tfilestream.Create(
                           tvob(gtv.Selected.Data).filpath+
                           '\'+noad9(tms)+'.zpu',fmcreate);
                           fs.Free;
                        end
                     else
                        mkdir(tvob(gtv.Selected.Data).filpath+
                        '\'+noad9(tms)+'.zpu');//FTG
                     //endif
                  end
               else
                  begin
                     if ac.Tag=12 then
                        begin
                           fs:=tfilestream.Create(
                           extractfilepath(application.exename)+
                           '\'+noad9(tms)+'.zpu',fmcreate);
                           fs.Free;
                        end
                     else
                        mkdir(extractfilepath(application.ExeName)+
                        '\'+noad9(tms)+'.zpu');
                     //endif
                  end;
               //endif
               redrtree;
            end;
         //endif
      end;
   end;


end;


procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   {if button=mbright then
      close;
   //endif  }
end;

procedure TForm2.FormResize(Sender: TObject);
begin
   mkrg;
end;

//-------------------------------update column sizes
procedure tform2.fkcolupd;
var
   i:integer;
   g:tdbgridop;

procedure marks(ii:integer);
begin
   if pos(g.Columns[ii].FieldName+' desc', tmp_sortli)<>0 then
      g.Columns[ii].Title.SortMarker:=smdowneh
   else
      if pos(g.Columns[ii].FieldName,tmp_sortli)<>0 then
         g.Columns[ii].Title.SortMarker:=smupeh;
      //endif
   //endif
end;

begin
   g:=rxdbgrid1;
   if colresize then

      for i:=0 to g.columns.count-1 do
         begin
            if i=0 then
               g.Columns[i].Width:=1
            else
               g.columns[i].width:=50;
            //endif
            g.Columns[i].Title.Caption:=
            '.|'+rxdbgrid1.Columns[i].Title.Caption;
            g.Columns[i].Title.TitleButton:=true;
            marks(i);
         end
      //endfor

   else
      begin
         i:=0;
         while (i<length(fkarr)) and (i<g.Columns.Count) do
            begin
               g.Columns[i].Width:=fkarr[i];
               g.Columns[i].Title.Caption:=
              '.|'+g.Columns[i].Title.Caption;
               g.Columns[i].Title.TitleButton:=true;
               marks(i);
               i:=i+1;
            end;
         //wend
      end;
   //endif
end;



procedure TForm2.ADOQuery1BeforeClose(DataSet: TDataSet);
var
   i:integer;
begin
   //lokpli.Clear;
   if rxdbgrid1.Columns.Count<2 then
      exit;
   //endif

   setlength(fkarr,0);
   for i:=0 to rxdbgrid1.columns.Count-1 do
      begin
         setlength(fkarr, length(fkarr)+1);
         fkarr[length(fkarr)-1]:=rxdbgrid1.Columns[i].Width;
      end;
   //endfor
end;


//----------------------------------------------------------------
//        clone active form
//----------------------------------------------------------------
{procedure tform2.cloneme;
var
   clf:tform2;
   ms:tmemorystream;

begin
   ms:=tmemorystream.Create;
   try
      ms.WriteComponent(self);
      clf:=tform2.CreateNew(application);
      ms.position:=0;
      ms.ReadComponent(clf);
      clf.Show;
   finally
      ms.Free;
   end;
end;}

//----------------------------------------------------chr(13)chr(10)
function tform2.noad(instr:string):string;
var
   adpo:integer;

begin
   adpo:=pos(chr(13),instr);
   while adpo<>0 do
      begin
         instr:=copy(instr,1,adpo-1)+'#%13%#'+copy(instr,adpo+1,length(instr)-adpo);
         adpo:=pos(chr(13),instr);
      end;
   //wend
   adpo:=pos(chr(10),instr);
   while adpo<>0 do
      begin
         instr:=copy(instr,1,adpo-1)+'#%10%#'+copy(instr,adpo+1,length(instr)-adpo);
         adpo:=pos(chr(10),instr);
      end;
   //wend
   result:=instr;
end;
//----------------------------------------------------chr(13)chr(10)
function tform2.adno(instr:string; goo:boolean):string;
var
   adpo:integer;

begin
   adpo:=pos('#%13%#',instr);
   while adpo<>0 do
      begin
         if goo then
            instr:=copy(instr,1,adpo-1)+' '+copy(instr,adpo+6,length(instr)-adpo-5)
         else
            instr:=copy(instr,1,adpo-1)+chr(13)+copy(instr,adpo+6,length(instr)-adpo-5);
         //endif
         adpo:=pos('#%13%#',instr);
      end;
   //wend
   adpo:=pos('#%10%#',instr);
   while adpo<>0 do
      begin
         if goo then
            instr:=copy(instr,1,adpo-1)+' '+copy(instr,adpo+6,length(instr)-adpo-5)
         else
            instr:=copy(instr,1,adpo-1)+chr(10)+copy(instr,adpo+6,length(instr)-adpo-5);
         //endif
         adpo:=pos('#%10%#',instr);
      end;
   //wend
   result:=instr;
end;
//--------------------------------------------chr(13)chr(10)space
function tform2.noad9(instr:string):string;
var
   adpo:integer;

begin
   adpo:=pos(chr(13),instr);
   while adpo<>0 do
      begin
         instr:=copy(instr,1,adpo-1)+''+copy(instr,adpo+1,length(instr)-adpo);
         adpo:=pos(chr(13),instr);
      end;
   //wend
   adpo:=pos(chr(10),instr);
   while adpo<>0 do
      begin
         instr:=copy(instr,1,adpo-1)+''+copy(instr,adpo+1,length(instr)-adpo);
         adpo:=pos(chr(10),instr);
      end;
   //wend
   adpo:=pos(chr(32),instr);
   while adpo<>0 do
      begin
         instr:=copy(instr,1,adpo-1)+''+copy(instr,adpo+1,length(instr)-adpo);
         adpo:=pos(chr(32),instr);
      end;
   //wend
   result:=instr;
end;



//----------------------------------------execute command
procedure tform2.execomm(incom:string);
var
   i:integer;
   coll,lcoll:integer;
   //fkmass:array of integer;

begin
   //----------------inside commands
   if (incom='noresize') then
      begin
         colresize:=false;
         exit;
      end;
   //endif
   if (incom='resize') then
      begin
         colresize:=true;
         exit;
      end;
   //endif
   if (incom='refr') then
      begin
         if assigned(refr) then
            exit;
         //endif
         colresize:=false;
         refr:=trefr.create(false,self);
         exit;
      end;
   //endif
   if (incom='norefr') then
      begin
         colresize:=true;
         if not assigned(refr) then
            exit;
         //endif
         with refr do
            begin
               Terminate;
               waitfor;
            end;
         //endwith
         freeandnil(refr);
         exit;
      end;
   //endif

   termrefr;
   adoquery1beforeclose(nil); //clear list combo
   //lokpli.Clear;
   for i:=0 to lokpli.Count-1 do
      begin
         tcofi(lokpli.Items[i]).isact:=false;
         tcofi(lokpli.Items[i]).co.Visible:=false;
      end;
   //endfor

   coll:=rxdbgrid1.Col;
   lcoll:=rxdbgrid1.leftcol;

   //sendmessage(memo1.Handle,WM_SETREDRAW,0,0);
   is_upd:=true;

   rxdbgrid1.columns.clear;
   rxdbgrid1.DataSource:=nil;

   //bu.wrln('checkpoint 3');
   adoquery1.Close;

   try
      adoquery1.sql.text:=incom;
      adoquery1.open;
      //statusstr:=q
      if length(txtout)>0 then
         txtout[0]:='refr ok';
      //endif
   except
      on e: exception do
      begin
         statusstr:=e.Message;
         shopo9;
         //memofo(statusstr);
         //messagebox(handle,pansichar(e.message),'sys',0);
         //tmps:=e.Message;
         is_upd:=false;
         //exit;
         {messagebox(handle,pansichar(tmps+chr(13)+'--------------'+chr(13)+
         noad(adoquery1.SQL.text)),'sys',MB_ICONINFORMATION or MB_OK);}
         raise exception.Create('exec terminated');
      end;
   end;

   rxdbgrid1.DataSource:=datasource1;



   rxdbgrid1.Col:=coll;
   rxdbgrid1.LeftCol:=lcoll;

                     //ftg .
   //bu.wrln('checkpoint 1');
   fkcolupd;

   //updfilters;
   for i:=0 to rxdbgrid1.Columns.Count-1 do
      begin
         if lokpli.Count<(i+1) then
            lokpli.Add(tcofi.create(adoconnection1,rxdbgrid1,bu,self));
         //endif
         tcofi(lokpli.Items[i]).inico(i);
      end;
   //endfor
   {rxdbgrid1.invalidate;
   for i:=0 to rxdbgrid1.ControlCount-1 do
      begin
         rxdbgrid1.Controls[j].Invalidate;
      end;
   //endfor }


   is_upd:=false;

   //sendmessage(memo1.Handle,WM_SETREDRAW,1,0);

   //memo2.clear;
   for i:=0 to rxdbgrid1.columns.count-1 do
      begin
         //memo2.lines.add(rxdbgrid1.columns[i].title.caption);
      end;
   //endfor
end;
//----------------------------------------------show error message
procedure tform2.shopo9;
begin
   pom9.cleara;
   pom9.appitem(statusstr,1,nil,1);
   pom9.popup(100,100,550);
end;


//----------------------------------------------------------------
//           ADO QUERY
//----------------------------------------------------------------
procedure TForm2.Button1Click(Sender: TObject);
var
   i,j:integer;
   //tmpo:integer;
   comms:tstringlist;
   tmpstr:string;

begin
   comms:=tstringlist.Create;
   tmpstr:=noad(memo1.Text);
   i:=pos(';',tmpstr);
   while i<>0 do
      begin
         comms.Add(copy(tmpstr,1,i-1));
         tmpstr:=copy(tmpstr,i+1,length(tmpstr)-i);
         i:=pos(';',tmpstr);
      end;
   //wend
   try
   for i:=0 to comms.Count-1 do
      begin
         if comms[i]='clone' then
            begin
               tmpstr:=application.exename+' "'+in_server+';';
               for j:=i+1 to comms.Count-1 do
                  tmpstr:=tmpstr+comms[j]+';';
               //endfor
               tmpstr:=tmpstr+'"';
               winexec(pansichar(tmpstr),0);
               break;
            end
         else
            execomm(comms[i]);
         //endif
      end;
   //endfor
   except end;
   comms.Free;
end;

//--------------------------------------------------------
//          updating filters state
//--------------------------------------------------------
procedure tform2.updstate(sender:tobject);
var
   i:integer;
   f:tcofi;
   s,a:string;
   dtp:integer;

begin
   s:='';
   //bu.wrr('updstate',40);
   for i:=0 to lokpli.Count-1 do
      begin
         f:=tcofi(lokpli[i]);
         if not(f.qu.active) then
            continue;
         //endif
         if f.co.Value<>null then
            begin
               if s='' then
                  s:=' where '
               else
                  s:=s+' and ';
               //endif
               dtp:=dtype(f.qu.FieldByName(f.co.keyfield));
               if (dtp=0) or (dtp=3) then
                  try
                     a:=chr(39)+f.co.value+chr(39)
                  except
                     a:=chr(39)+inttostr(f.co.value)+chr(39);
                  end
               else
                  if dtp=1 then
                     a:=inttostr(f.co.Value)
                  else
                     if dtp=2 then
                        a:='to_date('+chr(39)+datetimetostr(f.co.value)+chr(39)+','+
                        chr(39)+'dd.mm.yyyy HH24:MI:ss'+chr(39)+')';
                     //endif
                  //endif
               //endif
               s:=s+'"'+f.co.KeyField+'"='+a;
            end;
         //endif
      end;
   //endfor
   tmp_filst:=s;
   chaque;


end;


//--------------------------------------------------------
//     combo boxes dropdown and closeup
//--------------------------------------------------------
procedure tform2.closup(Sender: TObject; Accept: Boolean);
begin
   updstate(sender);
   lock_upd:=false;
end;
//-----------------------------------
procedure tform2.cmbcle(sender: tobject);
var
  co:tdlo;
begin
   co:=(sender as tdlo);
   co.Value:=null;
   //co.Tag:=5;
   updstate(sender);
end;
//-----------------------------------
procedure tform2.cmbbdo(sender:tobject;topbutton:boolean;
     var autorepeat:boolean; var handled:boolean);
var
   co:tdlo;
   qu:tadoquery;
   tms,tmp_filst3:string;
   po,po3,po4:integer;
   tmf:string;


begin
   if sender is tdlo then
      co:=sender as tdlo
   else
      co:=(sender as tcontrol).parent as tdlo;
   //endif

   qu:=(co.listsource.dataset as tadoquery);
   {if co.Tag=5 then
      begin    }
         qu.DisableControls;
         qu.Close;
         tms:=co.ListField;
         po:=pos('where',tmp_filst);
         //---------------------
         if po<>0 then
            tmp_filst3:=' and'+copy(tmp_filst,po+5,length(tmp_filst)-po-4)
         else
            tmp_filst3:=tmp_filst;
         //endif

         po3:=0;
         po4:=0;
         tmf:=tmp_filst3;
         po:=pos(tms,tmp_filst3);
         if po<>0 then
            begin
               po3:=pos('and',copy(tmp_filst3,1,po-1));
               po4:=pos('and',copy(tmp_filst3,po+length(tms),
               length(tmp_filst3)-po-length(tms)+1));
            end;
         //endif
         if po3<>0 then
            begin
               if po4=0 then
                  tmf:=copy(tmp_filst3,1,po3-1)
               else
                  begin
                     po4:=po4+po+length(tms)-1;
                     tmf:=copy(tmp_filst3,1,po3-1)+' '+
                     copy(tmp_filst,po4,length(tmp_filst3)-po4+1);
                  end;
               //endif
            end;
         //endif

         if pos('SQLNCLI',qu.connection.ConnectionString)<>0 then
            qu.SQL.text:='select '+tms+' from ('+tmp_baseq+') as a '+
            'where 6=6 '+tmf+' group by '+tms+' order by 1'
         else
            qu.SQL.text:='select '+tms+' from ('+tmp_baseq+') '+
            'where 6=6 '+tmf+' group by '+tms+' order by 1';
         //endif
         //bu.wrln(qu.SQL.text);
         qu.Open;
         qu.EnableControls;
         handled:=false;
     { end
   else
      handled:=false;  }
   //endif
end;

procedure tform2.dropdon(Sender: TObject);
begin
   lock_upd:=true;
end;




//----------------------------------------------------------------
//           DETAIL
//----------------------------------------------------------------
procedure TForm2.Button2Click(Sender: TObject);
var
   i:integer;
   j:integer;
   tmp_str:string;
   tmpquery:TDataSet;
   fou:tfilestream;



//-------------------------------create process
procedure createpro;
var
   stainf:tstartupinfo;
   rist:longbool;
   proinf:tprocessinformation;
   err:integer;

begin
   fillchar(stainf, sizeof(stainf),0);
   with stainf do
      begin
         cb:=sizeof(stainf);
         dwflags:=STARTF_USESHOWWINDOW or
         STARTF_FORCEONFEEDBACK;
         wShowWindow:=SW_SHOWNORMAL;
      end;
   //endwith
   Rist:=createprocess(nil,
   'notepad c:\temp\ftg.txt', //commandline
   nil,//securityattributes
   nil,//threadattributes
   false,//have inherited handles
   NORMAL_PRIORITY_CLASS,//creation flags
   nil,//lpenvironment
   nil,//lpcurrentdirectory
   stainf, proinf);

   if Rist then
      with proinf do
         begin
            Waitforinputidle(hProcess,INFINITE);
            closeHandle(hThread);
            closeHandle(hProcess);
         end
      //endwith
   else
      Err:=GetLastError;
   //endif
   //bu.wrln(err);


end;

begin
   if not(directoryexists('c:\temp')) then
      mkdir('c:\temp');
   //endif
   fou:=tfilestream.Create('c:\temp\ftg.txt', fmcreate);

   tmpquery:=(adoquery1 as TADOQuery);
   for i:=0 to tmpquery.FieldCount-1 do
      begin
         try
         tmp_str:=tmpquery.fields[i].fieldname;
         for j:=1 to 30-length(tmp_str) do
            tmp_str:=tmp_str+' ';
         //endfor
         tmp_str:=tmp_str+tmpquery.fields[i].asstring+chr(13)+chr(10);

         fou.WriteBuffer(pchar(tmp_str)^,length(tmp_str))

         //ftgform3.memo1.lines.add(tmp_str);
         except end;
      end;
   //endfor
   fou.Free;
   //winexec('notepad c:\temp\ftg.txt',SW_SHOWNORMAL);
   createpro;
end;




procedure TForm2.RxDBGrid1ColWidthsChanged(Sender: TObject);

begin
   //bu.wrln('colwid');
   updfilters;
end;

procedure TForm2.RxDBGrid1DblClick(Sender: TObject);
begin
   button2click(nil);
end;



//-------------------------------------------------------------
//         recalc filter positions
//-------------------------------------------------------------
procedure tform2.updfilters;
var
   i:integer;
begin
   if is_upd then
      exit;
   //endif
   //bu.wrln('---->');
   //lockwindowupdate(rxdbgrid1.Handle);
   if assigned(lokpli) then
      for i:=0 to lokpli.Count-1 do
         tcofi(lokpli[i]).upfipo;
      //endfor
   //endif
   //lockwindowupdate(0);
end;

procedure TForm2.RxDBGrid1HScro(rez_val: Integer);
begin
   //bu.wrln('hscro');
   updfilters;
end;

//----------------------------------------------------------------
//   copy grid to export to excel
//----------------------------------------------------------------
procedure TForm2.gricop4excel;
begin
   rxdbgrid1.SelectedRows.SelectAll;
   dbgrideh_docopyaction(rxdbgrid1,false);
end;


//----------------------------------------------override default handler
procedure tform2.DefaultHandler(var message);
begin
   with tmessage(message) do
      begin
         if msg=KICKM then
            close
         else
            inherited defaulthandler(message);
         //endif
      end;
   //endwith
end;

initialization
   KICKM:=registerwindowmessage('kickmnutproj');

end.