home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d45 / IBSB1.ZIP / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-06-20  |  45.0 KB  |  1,590 lines
  1. // ******************************************************************************** //
  2. //  SQL Builder For Interbase 5.6                                                   //
  3. //  Author: ▄mit BAKAR                                                              //
  4. //  eMail:ubakar@karnet.com.tr                                                      //
  5. //  www.karnet.com.tr                                                               //
  6. //  ! FREEWARE !                                                                    //
  7. // ******************************************************************************** //
  8. //  Contents:                                                                       //
  9. //   1.Graphic Query design sample (similar Access)                                 //
  10. //   2.LineDDA using sample                                                         //
  11. //   3.Drawing something (lines, images etc.) over the MDI form's ClientHandle      //
  12. //   4.Convert the query results to CSV (comma delimited) format                    //
  13. //   5.Convert the query results to XLS   format                                    //
  14. //   6.Convert the query results to RTF   format                                    //
  15. //   7.Drag and Drop sample  between TCheckListBoxes (Tables)                       //
  16. // ******************************************************************************** //
  17. // Notes:
  18. //     This program is FREEWARE and open source.  You can develop as you want or we //
  19. //     can develop together if you have different opinions for this subject.
  20. //     I am waiting your suggestions, opinions, critiques.
  21. //     Kind Regards.
  22. // ******************************************************************************** //
  23.  
  24. unit Unit1;
  25.  
  26. interface
  27.  
  28. uses
  29.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,checklst,
  30.   StdCtrls,IB, ActnList, ImgList, Menus, IBDatabase, Db,
  31.    ComCtrls, ToolWin,  IBCustomDataSet, IBQuery,IBSQL,  ExtCtrls,
  32.   Grids, DBGrids, StdActns, DBCtrls, OleServer, Excel97;
  33.  
  34.  
  35.  
  36. type
  37.   PDATableOfJoins = ^DATableOfJoins;
  38.   DATableOfJoins = record //Records of Join
  39.      RN: string;         //Join Name
  40.      ST : string;        //Source Table
  41.      Tt : string;        //Target table
  42.      SI: integer;        //source item index
  43.      TI: integer;        //target item index
  44.      SIX : integer;      //Source item X position
  45.      SIY : integer;      //Source item Y position
  46.      TIX : integer;      //Target item X position
  47.      TIY : integer;      //Target item Y position
  48.      Del    : char;      //Record Delete flag
  49.      JT  : string;       //Join type (Inner,full,left,Right)
  50. end;
  51. type
  52.   TForm1 = class(TForm)
  53.     IBD: TIBDatabase;
  54.     IBT: TIBTransaction;
  55.     MainMenu1: TMainMenu;
  56.     Database1: TMenuItem;
  57.     Open1: TMenuItem;
  58.     k1: TMenuItem;
  59.     N1: TMenuItem;
  60.     StatusBar1: TStatusBar;
  61.     ToolBar1: TToolBar;
  62.     popJoin: TPopupMenu;
  63.     Sil1: TMenuItem;
  64.     Inner: TMenuItem;
  65.     btndbConnect: TToolButton;
  66.     btnCikis: TToolButton;
  67.     ToolButton1: TToolButton;
  68.     btnsqlrun: TToolButton;
  69.     btnTables: TToolButton;
  70.     Panel1: TPanel;
  71.     MemoSQLstr: TMemo;
  72.     Splitter1: TSplitter;
  73.     popdbconnect: TPopupMenu;
  74.     ToolButton2: TToolButton;
  75.     btnDisconnect: TToolButton;
  76.     Disconnect1: TMenuItem;
  77.     btngetsqltext: TToolButton;
  78.     ToolButton4: TToolButton;
  79.     btnsqltextsave: TToolButton;
  80.     popSQL: TPopupMenu;
  81.     btnSQLOutBrowse: TToolButton;
  82.     btnsqlouttext: TToolButton;
  83.     ToolButton3: TToolButton;
  84.     btnsqloutCSV: TToolButton;
  85.     SQLBuild1: TMenuItem;
  86.     ResultView1: TMenuItem;
  87.     OpenSQLTextFile1: TMenuItem;
  88.     SaveSQLText1: TMenuItem;
  89.     RunSQL1: TMenuItem;
  90.     Tables1: TMenuItem;
  91.     N2: TMenuItem;
  92.     Browse1: TMenuItem;
  93.     Report1: TMenuItem;
  94.     AsciTextCSV1: TMenuItem;
  95.     actions: TActionList;
  96.     actExit: TAction;
  97.     actdbConnect: TAction;
  98.     actDBDisconnect: TAction;
  99.     actOpenSQLtext: TAction;
  100.     actRunSql: TAction;
  101.     actTables: TAction;
  102.     Left: TMenuItem;
  103.     Right: TMenuItem;
  104.     Full: TMenuItem;
  105.     N3: TMenuItem;
  106.     actWindow: TActionList;
  107.     WindowCascade1: TWindowCascade;
  108.     WindowArrange1: TWindowArrange;
  109.     WindowClose1: TWindowClose;
  110.     WindowTileHorizontal1: TWindowTileHorizontal;
  111.     WindowTileVertical1: TWindowTileVertical;
  112.     Window1: TMenuItem;
  113.     ArrangeAll1: TMenuItem;
  114.     Cascade1: TMenuItem;
  115.     Tile1: TMenuItem;
  116.     TileVertically1: TMenuItem;
  117.     Close1: TMenuItem;
  118.     N4: TMenuItem;
  119.     SaveResult1: TMenuItem;
  120.     btnExcel: TToolButton;
  121.     SendtoExcel1: TMenuItem;
  122.     procedure CloseAllChildForm;
  123.     procedure MouseClick(Sender: TObject);
  124.     procedure CLBDragOver(Sender, Source: TObject; X,
  125.       Y: Integer; State: TDragState; var Accept: Boolean);
  126.     procedure CLBDragDrop(Sender, Source: TObject; X,
  127.       Y: Integer);
  128.     procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  129.       Y: Integer);
  130.  
  131.     procedure ConnectDB(Sender: TObject);
  132.     procedure Line_ReDraw;
  133.     procedure lbTableDblClick(Sender: TObject);
  134.     procedure SQLStringReCreate(Sender: TObject);
  135.     procedure ChildFormClose(Sender: TObject; var Action: TCloseAction);
  136.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  137.     procedure FormCreate(Sender: TObject);
  138.     procedure SQLrun(Sender: TObject);
  139.  
  140.     procedure ChildMove(Sender: TObject);
  141.     procedure k1Click(Sender: TObject);
  142.     procedure Sil1Click(Sender: TObject);
  143.     procedure btnTablesClick(Sender: TObject);
  144.     procedure tempFormClose(Sender: TObject; var Action: TCloseAction);
  145.     procedure btndbConnectClick(Sender: TObject);
  146.     procedure ODiaDBCanClose(Sender: TObject; var CanClose: Boolean);
  147.     procedure DisConnectDB(Sender: TObject);
  148.     procedure popItemAdd(vdbname:string);
  149.     procedure btngetsqltextClick(Sender: TObject);
  150.     procedure btnsqltextsaveClick(Sender: TObject);
  151.     procedure SaveSqltext(Sender: TObject);
  152.     procedure popsqlitemekle(vsqlname:string);
  153.     procedure SQLActive(Sender: TObject);
  154.     procedure AnimateRun(v_animname:string;v_parent:TWinControl);
  155.     procedure AnimateFree(v_animname:string;v_parent:TWinControl);
  156.     procedure RichEditFormat(vrie:TrichEdit;vdataset:Tdataset);
  157.     procedure RieOutRenk(vrie:TrichEdit;v_color:Tcolor);
  158.     procedure Browse1Click(Sender: TObject);
  159.     procedure Report1Click(Sender: TObject);
  160.     procedure AsciTextCSV1Click(Sender: TObject);
  161.     procedure actExitExecute(Sender: TObject);
  162.     procedure MemoSQLstrChange(Sender: TObject);
  163.     procedure PopJoinTypeClick(Sender: TObject);
  164.     procedure CheckListBoxDblClick(Sender: TObject);
  165.     procedure CheckListBoxKeyEnter(Sender: TObject;var Key: Char);
  166.     procedure SaveResult1Click(Sender: TObject);
  167.     procedure DBGridColEnter(Sender: TObject);
  168.     procedure SendtoExcel1Click(Sender: TObject);
  169.     procedure SendToExcel(v_Dset:Tdataset);
  170.  
  171.  
  172.  
  173.  
  174.   private
  175.      OWproc,NWproc:Pointer;
  176.      Procedure NewWinP(var msg:Tmessage);
  177.  
  178.     { Private declarations }
  179.   public
  180.     { Public declarations }
  181.   end;
  182.  
  183. var
  184.   Form1: TForm1;
  185.   Oc:Tcanvas;
  186.   vmPoint:Tpoint;
  187.   vmousemove:boolean;
  188.   vselecteditem:integer;
  189.   MainImage:TImage; // mainimage is a temp image that to draw the join lines
  190.                     // between tables on the MDI form's ClientHandle
  191.   vcurdir:string;
  192.   v_DDAok:Boolean;
  193.   vRlist:Tlist;
  194.   DARR: PDATableOfJoins; // Pointer of Join records (vRlist)
  195. implementation
  196. uses frmCh; //Child form
  197. {$R *.DFM}
  198. {$R IBSBIMAGES.RES}
  199.  
  200. //................................................................................//
  201. // This function is returns X,Y coordinates for a Join line's highlighted points 
  202. //................................................................................//
  203. procedure JoinLineDDAFunction(X,Y: Integer; TheCanvas: TCanvas); stdcall;
  204. begin
  205. if (vmpoint.X = X) and (vmpoint.Y = Y) then
  206.    v_DDAok:=True;
  207. end;
  208.  
  209.  
  210. procedure TForm1.FormCreate(Sender: TObject);
  211. var vpopdblist:TstringList;
  212.     vi:integer;
  213.     ImageList1:TimageList;
  214. begin
  215.  
  216.   vRList:=Tlist.Create; //Join Records
  217.  
  218.   // Load images from IBSBIMAGES.RES
  219.   ImageList1:=Timagelist.Create(Self);
  220.   with ImageList1 do
  221.   begin
  222.      Height:=32;
  223.      width:=32;
  224.      ResourceLoad(rtBitmap,'IMAGES', clbtnFace);
  225.      geticon(11,application.icon);
  226.   end;
  227.   Toolbar1.Images:=imagelist1;
  228.  
  229.   mainImage:= TImage.create(self);
  230.   with mainImage do
  231.   begin
  232.        parent:=form1;
  233.        Align:=alClient;
  234.        transparent:=true;
  235.        onMouseMove:=ImageMouseMove;
  236.        onClick:=MouseClick;
  237.   end;
  238.  
  239.  
  240.   NWproc:=MakeObjectInstance(NewWinP);
  241.   OWproc:=Pointer(setWindowLong(Clienthandle,gwl_wndproc,cardinal(NWproc)));
  242.   OC:=Tcanvas.Create;
  243.   //get current directory
  244.   vcurdir:=trim(getcurrentdir);
  245.  
  246.   //Load Previous Database Connections
  247.   if Fileexists(vcurdir+'\PopDbIt.dat')  then
  248.   begin
  249.      vpopdblist:=tstringlist.Create;
  250.      vpopdblist.LoadFromFile(vcurdir+'\popDbIt.dat');
  251.      for vi:=0 to vpopdblist.Count-1 do
  252.      begin
  253.        if Fileexists(vpopdblist.Strings[vi])  then
  254.           popdbconnect.Items.Add(NewItem(vpopdblist.Strings[vi],TextToShortCut('') ,False, True, connectdb, 0, 'mi_db'+inttostr(popdbconnect.Items.Count))  );
  255.      end;
  256.      vpopdblist.Free;
  257.   end;
  258.  
  259.   //Load previous SQL Commands Which has been executed and saved.
  260.   if Fileexists(vcurdir+'\PopSQL.dat')  then
  261.   begin
  262.      vpopdblist:=tstringlist.Create;
  263.      vpopdblist.LoadFromFile(vcurdir+'\popSQL.dat');
  264.      for vi:=0 to vpopdblist.Count-1 do
  265.      begin
  266.        if Fileexists(vpopdblist.Strings[vi])  then
  267.           popSQL.Items.Add(NewItem(vpopdblist.Strings[vi],TextToShortCut('') ,False, True, btngetsqltextclick, 0, 'mi_sql'+inttostr(popsql.Items.Count))  );
  268.      end;
  269.      vpopdblist.Free;
  270.   end;
  271.  
  272. end;
  273.  
  274. // .............................................................................. //
  275. //  New WinProc For drawing ClientHandle
  276. // .............................................................................. //
  277. procedure TForm1.NewwinP(var msg:Tmessage);
  278. begin
  279.   msg.Result:=CallWindowProc(OWproc,clientHandle,msg.msg,msg.Wparam,msg.lParam);
  280.   if msg.msg=wm_EraseBkgnd then
  281.   begin
  282.     OC.handle:=msg.WParam;
  283.     oc.CopyMode:= cmsrcand;
  284.     oc.CopyRect(mainimage.ClientRect,mainimage.Canvas,mainimage.ClientRect);
  285.   end;
  286. end;
  287.  
  288.  
  289. procedure TForm1.lbTableDblClick(Sender: TObject);
  290. var vform:TfrmChild;
  291.     vclb:TcheckListBox;
  292.     vitemname:string;
  293.     vleft,vtop:integer;
  294.     Qrelf:TibSQL;
  295. begin
  296.   if (sender is TcheckListbox)  then
  297.   begin
  298.       vitemname:=(sender as tchecklistbox).items[(sender as tchecklistbox).itemindex];
  299.       if not (sender as tchecklistbox).checked[(sender as tchecklistbox).itemindex]
  300.          then
  301.       begin
  302.       if (application.findcomponent(vitemname) is TfrmChild) then
  303.          (application.findcomponent(vitemname) as TfrmChild).Close;
  304.          exit;
  305.       end;
  306.   end
  307.   else
  308.   if (sender is Tlistbox)  then
  309.      vitemname:=(sender as tlistbox).items[(sender as tlistbox).itemindex]
  310.   else
  311.       exit;
  312.  
  313.   if findComponent('Clb_'+vitemname)<>nil then
  314.   begin
  315.      showmessage('Table Already Exist')  ;
  316.      exit;
  317.   end;
  318.  
  319.  
  320.  
  321.   if mdiChildCount>1 then
  322.   begin
  323.      vleft:= mdiChildren[1].BoundsRect.Right ;
  324.      vtop:=  mdiChildren[1].BoundsRect.top;
  325.   end
  326.   else
  327.   begin
  328.      vleft:= mdiChildren[0].BoundsRect.Right;
  329.      vtop:=  mdiChildren[0].BoundsRect.top;
  330.   end;
  331.  
  332.  
  333.   vform:=TfrmChild.Create(application);
  334.   with vform do
  335.   begin
  336.      width:=80;
  337.      height:=120;
  338.      formstyle:=fsMDIChild;
  339.      name:=vitemname;
  340.      caption:=vitemname;
  341.      DragMode:=dmAutomatic;
  342.      left:=vleft;
  343.      top:=vtop;
  344.      OnClose:=ChildFormClose;
  345.      OnPaint:=ChildMove;
  346.      visible:=true;
  347.   end;
  348.  
  349.  
  350.   vclb:=TcheckListBox.Create(self);
  351.   with vclb do
  352.   begin
  353.      Parent:=ActiveMDIChild;
  354.      name:='Clb_'+vitemname;
  355.      Visible:=True;
  356.      align:=alClient;
  357.      Dragmode:=dmAutomatic;
  358.      OnDragDrop:=CLBDragDrop;
  359.      OnDragOver:= CLBDragOver;
  360.      OnClickCheck:=SQLStringReCreate;
  361.      onDblClick:=CheckListBoxDblClick;
  362.      onkeyPress:= CheckListBoxKeyEnter;
  363.  
  364.   end;
  365.   //? Read  Columns of the table
  366.   Qrelf:=TibSQL.Create(self);
  367.   with qrelf do
  368.   begin
  369.       database:=ibd;
  370.       transaction:=ibt;
  371.       SQL.Clear;
  372.       SQL.add('Select rdb$field_name as fname from rdb$relation_fields where rdb$relation_name="'+vitemname+'" ');
  373.       ExecQuery;
  374.   end;
  375.   while not Qrelf.Eof do
  376.   begin
  377.      vclb.Items.add(trim(Qrelf.Fields[0].asstring));
  378.      Qrelf.next;
  379.   end;
  380.  
  381.   (application.findcomponent('Tables') as tform).show; //tables mdiChildForm setfocus
  382.  
  383.   qrelf.Free;
  384. end;
  385.  
  386.  
  387. procedure TForm1.ChildMove(Sender: TObject);
  388. begin
  389. Line_ReDraw; //? Join lines Redraw, because Child Form moved etc.
  390. end;
  391.  
  392. procedure TForm1.ChildFormClose(Sender: TObject; var Action: TCloseAction);
  393. var vs:Integer;
  394.   vtablescheckfalse:TchecklistBox;
  395. begin
  396. action:=caFree;
  397. for vs:=0 to vRlist.count-1 do
  398. begin
  399.     DARR:=vRlist.Items[vs];
  400.     if (DARR^.ST='Clb_'+(sender as tform).caption) or (DARR^.TT='Clb_'+(sender as tform).caption)
  401.     then
  402.        DARR^.Del:='D';
  403. end;
  404. Line_ReDraw;
  405. (sender as tform).controls[0].Free;
  406. SQLStringReCreate(sender);
  407. if (findComponent('checkListBoxTables')<>nil)  then
  408. begin
  409.    vtablescheckFalse:=(findcomponent('checkListBoxTables') as tchecklistbox) ;
  410.    vtablescheckFalse.Checked[vtablescheckFalse.items.indexof((sender as tform).caption)]:=false;
  411.    vtablescheckFalse:=nil;
  412. end;
  413.  
  414. end;
  415.  
  416. procedure Tform1.CloseAllChildForm;
  417. var v_sayac:integer;
  418. begin
  419. for v_sayac:=0 to MDIChildCount-1 do
  420. begin
  421.    mdiChildren[v_sayac].close;
  422. end;
  423. end;
  424.  
  425. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  426. var v_sayac:integer;
  427.     vpopdbitems:Tstringlist;
  428. begin
  429. CloseAllChildForm;
  430.  
  431. if popdbconnect.Items.Count>0 then
  432. begin
  433.    vpopdbitems:=tstringlist.Create;
  434.    for v_sayac:=0 to popdbconnect.Items.Count-1 do
  435.    begin
  436.        vpopdbitems.Add(popdbconnect.items[v_sayac].Caption);
  437.    end;
  438.  
  439.    vpopdbitems.SaveToFile(vcurdir+'\popdbit.dat');
  440.    vpopdbitems.Free;
  441. end;
  442. if popsql.Items.Count>0 then
  443. begin
  444.    vpopdbitems:=tstringlist.Create;
  445.    for v_sayac:=0 to popsql.Items.Count-1 do
  446.    begin
  447.        vpopdbitems.Add(popsql.items[v_sayac].Caption);
  448.    end;
  449.  
  450.    vpopdbitems.SaveToFile(vcurdir+'\popsql.dat');
  451.    vpopdbitems.Free;
  452. end;
  453.  
  454. for v_sayac:=0 to vRlist.Count-1 do
  455. begin
  456.     DARR:=vRlist.Items[v_sayac];
  457.     Dispose(DARR);
  458. end;
  459. vRList.free;
  460.  
  461. end;
  462.  
  463. procedure TForm1.SQLStringReCreate(Sender: TObject);
  464. var v_sayac,v_sayacclb,v_checkkontrol,v_sayac2:integer;
  465.     vclbTemp:TcheckListBox;
  466.     v_fromStr:Tstringlist;
  467.     v_ST,v_TT:string;
  468. begin
  469. MemoSQLstr.Lines.text:='';
  470.  
  471.  
  472. v_fromstr:=Tstringlist.Create;
  473. MemoSqlStr.Lines.Add('Select ');
  474. v_sayac2:=0;
  475. for v_sayac:=0 to MDIChildCount-1 do
  476. begin
  477.    if (mdiChildren[v_sayac].caption='Tables') or (copy(mdiChildren[v_sayac].name,1,12)='frmSQLresult') then
  478.       continue;
  479.    if (sender.classname='TForm') and (mdiChildren[v_sayac].Name=(Sender as Tform).name) then
  480.    begin
  481.      continue;
  482.    end;
  483.    if (mdiChildren[v_sayac].ControlCount=0) then continue;
  484.    v_checkkontrol:=0;
  485.    vclbTemp:=TcheckListbox(FindComponent('Clb_'+form1.mdiChildren[v_sayac].name));
  486.    for v_sayacclb:=0 to vclbTemp.Items.Count-1 do
  487.    begin
  488.       if vclbTemp.Checked[v_sayacclb] then
  489.       begin
  490.          Inc(v_sayac2);
  491.  
  492.          if v_sayac2=1 then
  493.             MemoSqlStr.Lines.Add(mdiChildren[v_sayac].name+'.'+vclbTemp.items.strings[v_sayacclb])
  494.          else
  495.          begin
  496.             memoSqlstr.Lines.Strings[memoSqlstr.Lines.count-1]:=memoSqlstr.Lines.Strings[memoSqlstr.Lines.count-1]+',';
  497.             MemoSqlStr.Lines.Add(mdiChildren[v_sayac].name+'.'+vclbTemp.items.strings[v_sayacclb]);
  498.          end;
  499.          v_checkkontrol:=1;
  500.       end;
  501.    end;
  502.    if v_checkkontrol=1 then
  503.    begin
  504.       v_fromStr.Add(mdiChildren[v_sayac].name)
  505.    end;
  506.    vclbTemp:=nil;
  507. end;
  508.  
  509. MemoSqlStr.Lines.Add('From ');
  510. v_sayac2:=0;
  511.  
  512.  
  513. if v_fromstr.Count=0 then
  514.    MemoSqlStr.Lines.text:=''
  515. else
  516. begin
  517.    // Joins
  518.  
  519.    if  vRlist.count>0 then
  520.    begin
  521.       v_fromstr.Clear;
  522.      for v_sayac:=0 to vRlist.count-1 do
  523.      begin
  524.        DARR:=vRlist.Items[v_sayac];
  525.        v_ST:=copy(DARR^.ST,pos('_',DARR^.ST)+1,length(DARR^.ST));
  526.        v_TT:=copy(DARR^.TT,pos('_',DARR^.TT)+1,length(DARR^.TT));
  527.        if v_sayac=0 then
  528.           MemoSqlStr.Lines.add(v_ST+' '+DARR^.JT+' join '+ V_Tt+' on '+ v_ST+'.'+copy(DARR^.RN,1,pos('_',DARR^.RN)-1)+'='+v_Tt+'.'+copy(DARR^.RN,pos('_',DARR^.RN)+1,length(DARR^.RN)))
  529.        else
  530.           MemoSqlStr.Lines.add(DARR^.JT+' join '+ v_Tt+' on '+ v_ST+'.'+copy(DARR^.RN,1,pos('_',DARR^.RN)-1)+'='+v_Tt+'.'+copy(DARR^.RN,pos('_',DARR^.RN)+1,length(DARR^.RN)));
  531.      end; //for vRlist
  532.  
  533.  
  534.    end
  535.    else  //if vRlistcount>0
  536.    begin
  537.       for v_sayac:=0 to v_fromStr.Count-1 do
  538.       begin
  539.           v_sayac2:=v_sayac2+1;
  540.           if v_sayac2=1 then
  541.              MemoSqlStr.Lines.Add(v_fromStr.Strings[v_sayac])
  542.           else
  543.           begin
  544.              MemoSqlStr.Lines.strings[MemoSqlStr.Lines.count-1]:=MemoSqlStr.Lines.strings[MemoSqlStr.Lines.count-1]+',';
  545.              MemoSqlStr.Lines.Add(v_fromStr.Strings[v_sayac]);
  546.           end;
  547.       end;
  548.  
  549.    end;// if vRlist.count>0
  550.  
  551. end; //if v_fromstr.Count=0
  552.  
  553. v_fromStr.Free;
  554. end;
  555.  
  556.  
  557.  
  558. procedure TForm1.CLBDragOver(Sender, Source: TObject; X,
  559.   Y: Integer; State: TDragState; var Accept: Boolean);
  560. begin
  561.  Accept := Source is TCheckListBox;
  562. end;
  563.  
  564. procedure TForm1.CLBDragDrop(Sender, Source: TObject; X, Y: Integer);
  565.   var vpoint,vMoveP,vLineP:Tpoint;
  566.       vtr:Trect;
  567.       vtr1:Trect;
  568.       vSender,vSource:TCheckListBox;
  569. begin
  570.   if (Sender is TCheckListBox) and (Source is TCheckListBox) and ((Sender as TcheckListbox).name<>(Source as TcheckListBox).name)
  571.   then
  572.   begin
  573.     vSource:=(Source as TcheckListBox);
  574.     vSender:=(Sender as TcheckListBox);
  575.     with vSender do
  576.     begin
  577.        vpoint.x:=x;
  578.        vpoint.y:=y;
  579.       if vSender.ItemAtPos(vpoint,true)<0 then
  580.       begin
  581.         vSender.items.Add(vSource.items.Strings[vSource.itemindex]);
  582.         exit;
  583.       end
  584.       else
  585.       begin
  586.         with mainImage do
  587.         begin
  588.           vtr:=vSource.ItemRect(vSource.itemindex);
  589.           vtr1:=vtr;
  590.           vMoveP.x:=(vSource.Parent.BoundsRect.BottomRight.x);
  591.           vMoveP.y:=(vSource.Parent.top)+vSource.top+vtr.BottomRight.y+20;
  592.  
  593.           vSender.itemindex:=vSender.ItemAtPos(vpoint,true);
  594.           vtr:=vSender.ItemRect(vSender.itemindex);
  595.           vLineP.x:=(vSender.Parent.BoundsRect.Left);
  596.           vLineP.y:=(vsENDER.Parent.Top)+vSender.top+vtr.Bottom+20;
  597.           canvas.Pen.color:=clSilver;
  598.           canvas.Pen.width:=2;
  599.  
  600.           vMoveP.y:=vMoveP.y-1;
  601.           vLineP.y:=vLineP.y-1;
  602.           Canvas.polyline([vMoveP,vLineP]);
  603.  
  604.           vMoveP.y:=vMoveP.y+2;
  605.           vLineP.y:=vLineP.y+2;
  606.           Canvas.polyline([vMoveP,vLineP]);
  607.  
  608.           canvas.Pen.width:=1;
  609.           canvas.Pen.color:=clBlack;
  610.           vMoveP.y:=vMoveP.y-1;
  611.           vLineP.y:=vLineP.y-1;
  612.           Canvas.polyline([vMoveP,vLineP]);
  613.  
  614.           New(DARR);
  615.           DARR^.RN:=vSource.items.Strings[vSource.itemindex]+'_'+Items.Strings[vSender.itemindex];
  616.           DARR^.ST:=vSource.name;
  617.           DARR^.Tt:=vSender.name;
  618.           DARR^.SI:=vSource.itemindex;
  619.           DARR^.TI:=vSender.itemindex;
  620.           DARR^.SIX:=vMoveP.x;
  621.           DARR^.SIY:=vMoveP.y;
  622.           DARR^.TIX:=vLineP.x;
  623.           DARR^.TIY:=vLineP.y;
  624.           DARR^.Del:=#0;
  625.           DARR^.JT:='Inner';
  626.  
  627.           vRlist.Add(DARR);
  628.           vRlist.Capacity := vRlist.Count;
  629.           InvalidateRect(ClientHandle, nil, True);   //ClientHandle  update 
  630.           SQLStringReCreate(self);
  631.         end;
  632.       end;
  633.     end;
  634.   end;
  635. end;
  636.  
  637.  
  638. procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  639.   Y: Integer);
  640. var vsy:integer;
  641. begin
  642. vmpoint.x:=x;
  643. vmpoint.y:=y;
  644. v_DDAok:=False;
  645. statusbar1.Panels[0].Text:='';
  646.  
  647. if (mainImage.Canvas.Pixels[X,Y]=clBlack) or (mainImage.Canvas.Pixels[X,Y]=clSilver) then
  648. begin
  649.    For vsy:=0 to vRlist.Count-1 do
  650.    begin
  651.      DARR:=vRlist.Items[vsy];
  652.      //..........................................................................//
  653.      // The LineDDA function determines which pixels should be highlighted for a
  654.      // line defined by the specified starting and ending points.
  655.      //..........................................................................//
  656.      LineDDA(DARR^.SIX,DARR^.SIY-1,DARR^.TIX,DARR^.TIY-1,@JoinLineDDAFunction,LongInt(MainImage.Canvas));
  657.      if v_DDAok then break;
  658.      LineDDA(DARR^.SIX,DARR^.SIY+2,DARR^.TIX,DARR^.TIY+1,@JoinLineDDAFunction,LongInt(MainImage.Canvas));
  659.      if v_DDAok then break;
  660.      LineDDA(DARR^.SIX,DARR^.SIY,DARR^.TIX,DARR^.TIY,@JoinLineDDAFunction,LongInt(MainImage.Canvas));
  661.      if v_DDAok then break;
  662.    end;
  663.    if v_DDAok then
  664.       statusbar1.Panels[0].Text:=DARR^.JT+' '+DARR^.RN ;
  665. end;
  666. end;
  667.  
  668.  
  669.  
  670.  
  671. procedure TForm1.MouseClick(Sender: TObject);
  672. var vsy:integer;
  673. begin
  674. v_DDAok:=False;
  675. statusbar1.Panels[0].Text:='';
  676.  
  677. if (mainImage.Canvas.Pixels[vmpoint.x,vmpoint.y]=clBlack) or (mainImage.Canvas.Pixels[vmpoint.x,vmpoint.y]=clSilver) then
  678. begin
  679.    For vsy:=0 to vRlist.Count-1 do
  680.    begin
  681.      DARR:=vRlist.Items[vsy];
  682.      LineDDA(DARR^.SIX,DARR^.SIY-1,DARR^.TIX,DARR^.TIY-1,@JoinLineDDAFunction,LongInt(MainImage.Canvas));
  683.      if v_DDAok then break;
  684.      LineDDA(DARR^.SIX,DARR^.SIY+2,DARR^.TIX,DARR^.TIY+1,@JoinLineDDAFunction,LongInt(MainImage.Canvas));
  685.      if v_DDAok then break;
  686.      LineDDA(DARR^.SIX,DARR^.SIY,DARR^.TIX,DARR^.TIY,@JoinLineDDAFunction,LongInt(MainImage.Canvas));
  687.      if v_DDAok then break;
  688.    end;
  689.    if v_DDAok then
  690.    begin
  691.       statusbar1.Panels[0].Text:=DARR^.JT+' '+DARR^.RN;
  692.       (findcomponent(DARR^.JT) as TmenuItem).checked:=true;
  693.       popJoin.Popup(vmpoint.x,mainimage.top+vmpoint.y) ;
  694.       vselecteditem:=vsy;   end;
  695. end;
  696.  
  697. end;
  698.  
  699.  
  700.  
  701.  
  702.  
  703. procedure TForm1.Line_ReDraw;
  704. var vsy,vsilinen:integer;
  705.     vMoveP,vLineP:Tpoint;
  706.     vSource,vSender:TcheckListbox;
  707.     vtr,vtr1:Trect;
  708. begin
  709.      mainimage.Picture.Graphic:=nil;
  710.     try
  711.        for vsy:=0 to vRlist.count-1 do
  712.        begin
  713.            DARR:=vRlist.items[vsy];
  714.            if DARR^.Del='S' then continue;
  715.  
  716.            if DARR^.Del='D' then
  717.            begin
  718.              DARR^.Del:='S';
  719.              continue;
  720.            end;
  721.  
  722.  
  723.            vSource:=(form1.findcomponent(DARR^.ST) as TcheckListBox);
  724.            vSender:=(form1.findcomponent(DARR^.Tt) as TcheckListBox);
  725.            vtr:=vSource.ItemRect(DARR^.SI);
  726.            vtr1:=vSender.ItemRect(DARR^.TI);
  727.  
  728.           vMoveP.x:=(vSource.Parent.BoundsRect.BottomRight.x);
  729.           if ((vtr.Bottom+20) > vSource.BoundsRect.Bottom)  then
  730.              vMoveP.y:=(vSource.Parent.BoundsRect.Bottom)
  731.           else
  732.           if  ((vtr.Bottom+20) < vSource.BoundsRect.top) then
  733.              vMoveP.y:=(vSource.Parent.top)+vSource.top
  734.           else
  735.              vMoveP.y:=(vSource.Parent.top)+vSource.top+vtr.BottomRight.y+20;
  736.  
  737.           vLineP.x:=(vSender.Parent.BoundsRect.Left);
  738.           if ((vtr1.Bottom+20) > vsender.BoundsRect.Bottom) then
  739.               vLineP.y:=(vsENDER.Parent.BoundsRect.Bottom)
  740.           else
  741.           if  ((vtr1.Bottom+20) < vsender.BoundsRect.top)  then
  742.               vLineP.y:=(vsENDER.Parent.Top)+vSender.top
  743.  
  744.           else
  745.              vLineP.y:=(vsENDER.Parent.Top)+vSender.top+vtr1.Bottom+20;
  746.           MainImage.Canvas.pen.color:=clSilver;
  747.           MainImage.canvas.Pen.width:=2;
  748.           vMoveP.y:=vMoveP.y-1;
  749.           vLineP.y:=vLineP.y-1;
  750.           MainImage.canvas.polyline([vMoveP,vLineP]);
  751.  
  752.           vMoveP.y:=vMoveP.y+2;
  753.           vLineP.y:=vLineP.y+2;
  754.           MainImage.canvas.polyline([vMoveP,vLineP]);
  755.           MainImage.Canvas.pen.color:=clBlack;
  756.           MainImage.canvas.Pen.width:=1;
  757.  
  758.           vMoveP.y:=vMoveP.y-1;
  759.           vLineP.y:=vLineP.y-1;
  760.           MainImage.canvas.polyline([vMoveP,vLineP]);
  761.           DARR^.SIX:= vMoveP.x;
  762.           DARR^.SIY:= vMoveP.y;
  763.           DARR^.TIX:= vLineP.x;
  764.           DARR^.TIY:= vLineP.y;
  765.          end; //for
  766.          InvalidateRect(ClientHandle, nil, True);   //ClientHandle update
  767.          vSilinen:=0;
  768.          for vsy:=0 to vRlist.Count-1 do
  769.          begin
  770.              DARR:=vRlist.items[vsy-vsilinen];
  771.              if DARR^.Del = 'S' then
  772.              begin
  773.                 Dispose(DARR);
  774.                 vRlist.Delete(vsy-vsilinen);
  775.                 vRlist.Capacity:=vRlist.Count;
  776.                 vsilinen:=vsilinen+1;
  777.              end;
  778.          end;  //for (Deleted records)
  779.     except
  780.       exit;
  781.     end;
  782. end;
  783.  
  784. procedure TForm1.SQLRun(Sender: TObject);
  785. var vSQLfrm:Tform;
  786.     vdbg:TdbGrid;
  787.     vds:Tdatasource;
  788.     vibq:Tibquery;
  789.     vre:TrichEdit;
  790. begin
  791. try
  792.  vSQLFrm:=tform.Create(application);
  793.  vSQLfrm.name:='frmSQLresult'+inttostr(mdiChildCount) ;
  794.  
  795.  with Tbutton.create(self) do
  796.  begin
  797.     parent:=vSQLfrm;
  798.     name:='btn_'+inttostr(mdiChildCount);
  799.     Caption:='Refresh SQL';
  800.     align:=alTop;
  801.     onClick:=sqlActive;
  802.  end;
  803.  
  804.  
  805.  vibq:=tibquery.Create(vSQLfrm);
  806.  vibq.name:='ibq_frmSQLresult'+   inttostr(mdiChildCount);
  807.  vibq.Database:=ibd;
  808.  vibq.Transaction:=ibt;
  809.  vibq.SQL:=memoSQLStr.Lines;
  810.  AnimateRun('sqlanim',form1);
  811.  form1.Repaint;
  812.  vSQLfrm.Caption:='(Start Time:'+timetostr(now);
  813.  ibt.Active:=true;
  814.  vibq.Prepare;
  815.  vibq.Active:=true;
  816.  if btnExcel.Down then
  817.  begin
  818.     SendToExcel(vibq);
  819.     AnimateFree('sqlanim',form1);
  820.     vsqlfrm.free;
  821.     vibq.free;
  822.     exit;
  823.  end;
  824.  
  825.  
  826.  vds:=tdatasource.Create(vSQLfrm);
  827.  vds.name:='dssql_frmSQLresult' +  inttostr(mdiChildCount);
  828.  vds.DataSet:=vibq;
  829.  
  830.  with Tmemo.create(vSQLfrm) do
  831.  begin
  832.     parent:=vSQLfrm;
  833.     name:='mem_frmSQLresult'+inttostr(mdiChildCount);
  834.     lines:=memoSQLstr.Lines;
  835.     align:=alTop;
  836.     height:=80;
  837.     scrollBars:=ssBoth;
  838.  end;
  839.  
  840.  if btnSQLOutBrowse.Down then
  841.  begin
  842.    vdbg:=TdbGrid.Create(vSQLfrm);
  843.    vdbg.parent:=vSQLfrm;
  844.    vdbg.align:=alClient;
  845.    vdbg.DataSource:=vds;
  846.    vdbg.name:='dbg_frmSQLresult'+ inttostr(mdiChildCount);
  847.    vdbg.Options:=[dgTitles,dgIndicator,dgColumnResize,dgColLines,dgRowLines,dgTabs,dgConfirmDelete,dgCancelOnExit];
  848.  end
  849.  else
  850.  begin
  851.    vre:=TrichEdit.Create(vSQLfrm);
  852.    with vre do
  853.    begin
  854.       parent:=vSQLfrm;
  855.       align:=alClient;
  856.       name:='rie_frmSQLresult'+ inttostr(mdiChildCount);
  857.       HideScrollBars:=False;
  858.       WantReturns:=True;
  859.       ScrollBars:=ssboth;
  860.       PlainText:=true;
  861.       WordWrap:=false;
  862.       Wanttabs:=false;
  863.       Font.name:='Lucida Console';
  864.    end;
  865.    RichEditFormat(vre,vibq);
  866.  end; //else browse=down
  867.  AnimateFree('sqlanim',form1);
  868.  vibq.Last;
  869.  vibq.first;
  870.  vSQLfrm.FormStyle:=fsMDIChild;
  871.  vSQLfrm.Caption:=vSQLfrm.Caption+' End Time:'+timetostr(now)+ ') '+'Record Count:'+inttostr(vibq.recordcount);
  872.  vsqlfrm.onclose:=tempformClose;
  873.  vSqlFrm.Show;
  874.  if btnSQLOutBrowse.Down then
  875.  begin
  876.     vdbg.SetFocus;
  877.     vdbg.SelectedIndex:=0;
  878.     dbGridColEnter(vdbg);
  879.     vdbg.OnColEnter:=dbGridColEnter;
  880.  end;
  881.  ibt.CommitRetaining;
  882. except
  883.     on E : EibInterbaseError do
  884.       Begin
  885.        showmessage(E.Message +' - '+inttostr(E.IBErrorCode));
  886.        ibt.Rollback;
  887.        AnimateFree('sqlanim',form1);
  888.        vre.Free;
  889.        vsqlfrm.free;
  890.        vdbg.free;
  891.        vds.free;
  892.        vibq.free;
  893.        ibt.active:=true;
  894.       End;
  895. else
  896.        ibt.Rollback;
  897.        AnimateFree('sqlanim',form1);
  898.        vre.Free;
  899.        vsqlfrm.free;
  900.        vdbg.free;
  901.        vds.free;
  902.        vibq.free;
  903.        ibt.active:=true;
  904. end;
  905.  
  906. end;
  907.  
  908. procedure TForm1.RichEditFormat(vrie:TrichEdit;vdataset:Tdataset);
  909. var v_sql,v_labelsize,v_kayitsayi,v_datasize:integer;
  910.     v_str,v_strciz,v_cizgi,v_cizdata:string;
  911.     v_bos,v_ciz:string;
  912. begin
  913. v_bos:='                                                                                                                                                                                                      ';
  914. v_cizdata:='___________________________________________________________________________________________________________________________________';
  915. v_ciz:='======================================================================================================================================================================================================================';
  916.  
  917. try
  918.    v_str:='';
  919.    v_cizgi:='';
  920.    if btnSQLOutCsv.Down then
  921.       vrie.Lines.clear // E≡er csv formatl² yaz²lacaksa ╟²kt²n²n yaz²laca≡² edit÷r temizleniyor
  922.    else
  923.    begin
  924.    vrie.Lines.Clear;
  925.    end;
  926.  
  927.    if btnSQLOutCsv.Down=false then
  928.    begin
  929.  
  930.      for v_sql:=0 to vdataset.FieldCount -1 do
  931.      begin
  932.        v_labelsize:=length(vdataset.fields[v_sql].Fieldname);
  933.  
  934.        if vdataset.fields[v_sql].DataType= ftDate then // tarih alan²
  935.          v_datasize:=10
  936.        else
  937.          v_datasize:=vdataset.fields[v_sql].DataSize;
  938.  
  939.        if vdataset.fields[v_sql].isBlob then // BLOB
  940.          v_datasize:=8;
  941.  
  942.        v_str:=v_str+vdataset.fields[v_sql].Fieldname;
  943.        if v_labelsize>v_datasize then
  944.        begin
  945.           v_str:=v_str+'ª';
  946.           v_cizgi:=v_cizgi+ copy(v_ciz,1,v_labelsize)+'ª';
  947.        end
  948.        else
  949.        begin
  950.           v_str:=v_str+copy(v_bos,1,v_datasize-(v_labelsize))+'ª';
  951.           v_cizgi:=v_cizgi+ copy(v_ciz,1,v_datasize)+'ª';
  952.        end;
  953.      end; //For
  954.    end
  955.    else
  956.    begin
  957.      for v_sql:=0 to vdataset.FieldCount -1 do
  958.      begin
  959.        if v_str='' then
  960.        begin
  961.          v_str:=v_str+'"'+vdataset.fields[v_sql].Fieldname+'"'
  962.        end
  963.        else
  964.          v_str:=v_str+',"'+vdataset.fields[v_sql].Fieldname+'"';
  965.      end; //For
  966.  
  967.  
  968.    end; //if CSV
  969.    RieOutRenk(vrie,clRed);
  970.    if btnSQLOutCsv.Down=false then
  971.       vrie.lines.add(v_cizgi);
  972.    vrie.lines.add(v_str);
  973.    if btnSQLOutCsv.Down=false then
  974.       vrie.lines.add(v_cizgi);
  975.    RieOutRenk(vrie,clBlack);
  976.  
  977.     v_kayitsayi:=0;
  978.    while not vdataset.eof do
  979.    begin
  980.       v_str:='';
  981.       v_strciz:='';
  982.       for v_sql:=0 to vdataset.FieldCount -1 do
  983.       begin
  984.        v_labelsize:=length(vdataset.fields[v_sql].Fieldname);
  985.        if vdataset.fields[v_sql].DataType = ftDate then // Date field
  986.           v_datasize:=10
  987.        else
  988.           v_datasize:=vdataset.fields[v_sql].DataSize;
  989.        if vdataset.fields[v_sql].isBlob then // BLOB
  990.           v_datasize:=8;
  991.  
  992.        if btnSQLOutCsv.Down=false  then
  993.        begin
  994.          if vdataset.fields[v_sql].isblob then // BLOB
  995.             v_str:=v_str+'BLOB    '
  996.          else
  997.             v_str:=v_str+vdataset.fields[v_sql].asstring;
  998.          if vdataset.fields[v_sql].isBlob then // BLOB
  999.            v_strciz:=v_strciz+copy(v_cizdata,1,8)
  1000.          else
  1001.            v_strciz:=v_strciz+copy(v_cizdata,1,length(vdataset.fields[v_sql].asstring));
  1002.          if v_labelsize>v_datasize then
  1003.          begin
  1004.          if vdataset.fields[v_sql].isBlob then // BLOB
  1005.          Begin
  1006.             v_str:=v_str+copy(v_bos,1,v_labelsize-(8))+'ª';
  1007.             v_strciz:=v_strciz+copy(v_cizdata,1,v_labelsize-(8))+'ª';
  1008.          end
  1009.          else
  1010.          Begin
  1011.             v_str:=v_str+copy(v_bos,1,v_labelsize-(LENGTH(vdataset.fields[v_sql].asstring)))+'ª';
  1012.             v_strciz:=v_strciz+copy(v_cizdata,1,v_labelsize-(LENGTH(vdataset.fields[v_sql].asstring)))+'ª';
  1013.          end; //blob
  1014.          end
  1015.          else
  1016.          begin
  1017.           v_str:=v_str+copy(v_bos,1,v_datasize-(LENGTH(vdataset.fields[v_sql].asstring)))+'ª';
  1018.           v_strciz:=v_strciz+copy(v_cizdata,1,v_datasize-(LENGTH(vdataset.fields[v_sql].asstring)))+'ª';
  1019.          end; // if v_labelsize
  1020.       end //if CSV
  1021.       else
  1022.       begin
  1023.          if v_str='' then
  1024.            v_str:=v_str+'"'+vdataset.fields[v_sql].asstring+'"'
  1025.          else
  1026.            v_str:=v_str+',"'+vdataset.fields[v_sql].asstring+'"';
  1027.       end; //if CSV
  1028.    end; //for
  1029.         v_kayitsayi:=v_kayitsayi+1;
  1030.         vrie.lines.add(v_str);
  1031.        if btnSQLOutCsv.Down=false  then
  1032.           vrie.lines.add(v_strciz);
  1033.         vdataset.next;
  1034.   end; //for
  1035.   if btnSQLOutCsv.Down=false  then
  1036.   begin
  1037.      RieOutRenk(vrie,clRed);
  1038.      vrie.lines.add(inttostr(v_kayitsayi)+' Records');
  1039.      RieOutRenk(vrie,clBlack);
  1040.   end;
  1041.  
  1042. except
  1043. end;
  1044.  
  1045. end;
  1046.  
  1047. procedure TForm1.AnimateRun(v_animname:string;v_parent:TWinControl);
  1048. begin
  1049.   with Tanimate.Create(self) do
  1050.   begin
  1051.     parent:=v_parent;
  1052.     name:=v_parent.Name+'_'+v_animname;
  1053.     Align:=alclient;
  1054.     CommonAVI:=aviFindFolder;
  1055.     active:=true;
  1056.   end;
  1057. end;
  1058.  
  1059.  
  1060. procedure TForm1.AnimateFree(v_animname:string;v_parent:TWinControl);
  1061. begin
  1062.   if (findComponent(v_parent.Name+'_'+v_animname) is Tanimate) then
  1063.      (findComponent(v_parent.Name+'_'+v_animname) as Tanimate).free;
  1064. end;
  1065.  
  1066. //////////////////////////////////////////////////////////////
  1067. //  TForm1.SQLActive = SQL Refresh in Result form
  1068. //////////////////////////////////////////////////////////////
  1069. procedure TForm1.SQLActive(Sender: TObject);
  1070. var vfrmName:string;
  1071.     vmemo:Tmemo;
  1072.     vrie:TrichEdit;
  1073.     vdset:Tdataset;
  1074. begin
  1075.  
  1076.    vfrmName:= (sender as tbutton).parent.Name;
  1077.    vmemo:=(activeMDIchild.findComponent('mem_'+vfrmName) as Tmemo);
  1078.    with (activeMDIchild.findComponent('ibq_'+vfrmName) as TIBQuery) do
  1079.    begin
  1080.       active:=false;
  1081.       SQL:=vmemo.Lines;
  1082.       AnimateRun('anim',(sender as Tbutton));
  1083.       active:=true;
  1084.    end; // with
  1085.  
  1086.    if (activeMDIchild.findComponent('rie_'+vfrmName) as TRichEdit) <>nil then
  1087.    begin
  1088.       vrie:=(activeMDIchild.findComponent('rie_'+vfrmName) as TRichEdit);
  1089.       vdset:=(activeMDIchild.findComponent('ibq_'+vfrmName) as TIBQuery);
  1090.       RichEditFormat(vrie,vdset);
  1091.       vdset:=nil;
  1092.       vrie:=nil
  1093.    end;
  1094.    AnimateFree('anim',(sender as Tbutton));
  1095.    vmemo:=nil;
  1096. end; //TForm1.SQLActive(Sender: TObject)
  1097. //////////////////////////////////////////////////////////////
  1098.  
  1099.  
  1100.  
  1101. procedure TForm1.k1Click(Sender: TObject);
  1102. begin
  1103. close;
  1104. end;
  1105.  
  1106. procedure TForm1.Sil1Click(Sender: TObject);
  1107. begin
  1108. DARR:=vRlist.items[vselecteditem];
  1109. DARR^.Del:='D';
  1110.  
  1111. Line_Redraw;
  1112. SQLStringReCreate(sender);
  1113. vselecteditem:=0;
  1114. end;
  1115.  
  1116. procedure TForm1.CheckListBoxDblClick(Sender: TObject);
  1117. begin
  1118. if (sender is TcheckListBox) then
  1119. begin
  1120.    (sender as Tchecklistbox).checked[(sender as Tchecklistbox).ItemIndex]:= not (sender as Tchecklistbox).checked[(sender as Tchecklistbox).ItemIndex];
  1121.    (sender as Tchecklistbox).onClickCheck(sender);
  1122. end;
  1123. end;
  1124.  
  1125. procedure TForm1.CheckListBoxKeyEnter(Sender: TObject;var Key: Char);
  1126. begin
  1127. if (sender is TcheckListBox) and (key= #13) then
  1128. begin
  1129.    CheckListBoxDblClick(sender);
  1130. end;
  1131. end;
  1132.  
  1133. procedure TForm1.btnTablesClick(Sender: TObject);
  1134. var  vclbtablo:TcheckListBox;
  1135.      vtempform:Tform;
  1136.      v_sayac:integer;
  1137. begin
  1138.  
  1139. if application.findComponent('Tables')<>nil then exit;
  1140.  
  1141. vtempform:=tform.create(application);
  1142. with vtempform do
  1143. begin
  1144.    formstyle:=fsMDIChild;
  1145.    width:=200;
  1146.    height:=200;
  1147.    onClose:=TempFormClose;
  1148.    caption:='Tables';
  1149.    name:='Tables';
  1150.    left:=0;
  1151.    top:=0;
  1152.  
  1153. end;
  1154. vclbTablo:=TcheckListBox.create(self);
  1155.  
  1156. with vclbtablo do
  1157. begin
  1158.     parent:=vtempform;
  1159.     name:='checkListBoxTables';
  1160.     align:=alClient;
  1161.     sorted:=true;
  1162.     onClickCheck:=lbTableDblClick;
  1163.     onDblClick:=CheckListBoxDblClick;
  1164.     onkeyPress:= CheckListBoxKeyEnter;
  1165. end;
  1166.  
  1167. ibd.GetTableNames(vclbTablo.items,False);
  1168. for v_sayac:=0 to  vclbTablo.items.count-1 do
  1169. begin
  1170.     if (findcomponent('Clb_'+vclbtablo.Items.Strings[v_sayac])) <> nil then
  1171.        vclbtablo.Checked[v_sayac] :=true;
  1172. end;
  1173.  
  1174. end;
  1175.  
  1176. procedure TForm1.tempFormClose(Sender: TObject; var Action: TCloseAction);
  1177. begin
  1178. action:=caFree;
  1179. end;
  1180.  
  1181. procedure TForm1.btndbConnectClick(Sender: TObject);
  1182. var OdiaDB:TopenDialog;
  1183. begin
  1184. with tform.create(application) do
  1185. begin
  1186.    formstyle:=fsMDIChild;
  1187.    onClose:=TempFormClose;
  1188.    caption:='Database';
  1189.    left:=0;
  1190.    top:=0;
  1191.    width:=300;
  1192.    height:=100;
  1193.    name:='FrmdbConnect';
  1194. end;
  1195. with Tedit.Create(self) do
  1196. begin
  1197.    parent:=ActiveMDIChild;
  1198.    Width:=250;
  1199.    name:='edtDBName';
  1200.    text:='';
  1201. end;
  1202. with Tbutton.create(self) do
  1203. begin
  1204.    parent:=ActiveMDIChild;
  1205.    top:=30;
  1206.    Caption:='Connect';
  1207.    OnClick:=ConnectDB;
  1208. end;
  1209.   OdiaDb:=Topendialog.create(self);
  1210.   with OdiaDB do
  1211.   begin
  1212.     DefaultExt:='gdb';
  1213.     OncanClose:=OdiaDBCanClose;
  1214.     Execute;
  1215.   end;
  1216.   OdiaDB.free;
  1217.  
  1218. end;
  1219.  
  1220. procedure TForm1.DisConnectDB(Sender: TObject);
  1221. begin
  1222. ibd.connected:=false;
  1223. actDBConnect.Enabled:=true;
  1224. actDBDisconnect.enabled:=false;
  1225. actOpenSQLtext.enabled:=false;
  1226. actRunSQl.Enabled:=false;
  1227. actTables.enabled:=false;
  1228. resultview1.Enabled:=false;
  1229. btnSQLoutBrowse.Enabled:=false;
  1230. btnExcel.enabled:=false;
  1231. btnSQLoutcsv.Enabled:=false;
  1232. btnSQLoutText.Enabled:=false;
  1233. statusbar1.Panels[1].Text:='';
  1234. CloseAllChildForm;
  1235. memoSQLstr.Lines.text:='';
  1236. end;
  1237.  
  1238. procedure TForm1.ConnectDB(Sender: TObject);
  1239. begin
  1240. if ibd.Connected then
  1241.    Disconnectdb(sender);
  1242. if (sender is Tbutton) then
  1243.    ibd.databasename:=(findcomponent('edtDBName') as Tedit).text;
  1244. if (sender is Tmenuitem) then
  1245.    ibd.databasename:=(sender as tmenuitem).caption;
  1246. try
  1247.   ibd.Connected:=true;
  1248.   ibt.Active:=true;
  1249.   statusbar1.Panels[1].text:=ibd.databasename;
  1250.  
  1251.   actDBDisconnect.enabled:=true;
  1252.   actOpenSQLtext.enabled:=true;
  1253.   actTables.enabled:=true;
  1254.  
  1255.   resultview1.Enabled:=true;
  1256.   btnSQLoutBrowse.Enabled:=true;
  1257.   btnExcel.enabled:=true;
  1258.   btnSQLoutcsv.Enabled:=true;
  1259.   btnSQLoutText.Enabled:=true;
  1260.   actDBConnect.Enabled:=false;
  1261.   popItemAdd(ibd.databasename);
  1262.  
  1263. except
  1264.   showmessage('Connect unsuccessful');
  1265.   statusbar1.Panels[1].text:='';
  1266. end;
  1267. if (sender is Tbutton) then
  1268.    ActiveMDIChild.close;
  1269. end;
  1270.  
  1271. procedure TForm1.ODiaDBCanClose(Sender: TObject; var CanClose: Boolean);
  1272. begin
  1273.   if (sender as TopenDialog).defaultext='gdb' then
  1274.    (findcomponent('edtDBName') as Tedit).text:=(sender as TopenDialog).FileName;
  1275.   if (sender as TopenDialog).defaultext='sql' then
  1276.     memoSQlstr.Lines.LoadFromFile((sender as Topendialog).FileName);
  1277. end;
  1278.  
  1279. procedure tform1.popItemAdd(vdbname:string);
  1280. var vi:integer;
  1281. begin
  1282.   for vi:=0 to popdbconnect.Items.Count-1 do
  1283.   begin
  1284.      if vdbname= popdbconnect.items[vi].Caption then
  1285.      begin
  1286.         vdbname:='';
  1287.         break;
  1288.      end;
  1289.   end;
  1290.   if vdbname<>'' then
  1291.      popdbconnect.Items.Add(NewItem(vdbname,TextToShortCut('') ,False, True, connectdb, 0, 'mi_db'+inttostr(popdbconnect.Items.Count))  );
  1292. end;
  1293.  
  1294. procedure tform1.popsqlitemekle(vsqlname:string);
  1295. var vi:integer;
  1296. begin
  1297.   for vi:=0 to popsql.Items.Count-1 do
  1298.   begin
  1299.      if vsqlname= popsql.items[vi].Caption then
  1300.      begin
  1301.         vsqlname:='';
  1302.         break;
  1303.      end;
  1304.   end;
  1305.   if vsqlname<>'' then
  1306.      popsql.Items.Add(NewItem(vsqlname,TextToShortCut('') ,False, True, btngetsqltextclick, 0, 'mi_sql'+inttostr(popsql.Items.Count))  );
  1307. end;
  1308.  
  1309. procedure TForm1.btngetsqltextClick(Sender: TObject);
  1310. var OdiaDB:TopenDialog;
  1311. begin
  1312.  
  1313. if (sender is Tmenuitem) and (copy((sender as Tmenuitem).name,1,2)='mi') then
  1314. begin
  1315.    memoSqlstr.Lines.LoadFromFile((sender as tmenuitem).caption);
  1316. end
  1317. else
  1318. begin
  1319.   OdiaDb:=Topendialog.create(self);
  1320.   with OdiaDB do
  1321.   begin
  1322.     DefaultExt:='sql';
  1323.     FileName:='';
  1324.     OncanClose:=OdiaDBCanClose;
  1325.     Execute;
  1326.   end;
  1327.   OdiaDB.free;
  1328. end;
  1329. end;
  1330.  
  1331. procedure TForm1.btnsqltextsaveClick(Sender: TObject);
  1332. var SaveDia:TSaveDialog;
  1333. begin
  1334. with tform.create(application) do
  1335. begin
  1336.    formstyle:=fsMDIChild;
  1337.    onClose:=TempFormClose;
  1338.    caption:='Save SQL Text';
  1339.    left:=0;
  1340.    top:=0;
  1341.    width:=300;
  1342.    height:=100;
  1343.    name:='Frmsavesqltext';
  1344. end;
  1345. with Tedit.Create(self) do
  1346. begin
  1347.    parent:=ActiveMDIChild;
  1348.    Width:=250;
  1349.    name:='edtsqltextfilename';
  1350.    text:='';
  1351. end;
  1352. with Tbutton.create(self) do
  1353. begin
  1354.    parent:=ActiveMDIChild;
  1355.    top:=30;
  1356.    Caption:='Save';
  1357.    NAME:='btnsqlsave';
  1358.    OnClick:=SaveSQLText;
  1359. end;
  1360. SaveDia:=TSaveDialog.create(self);
  1361.  
  1362. if SAVEdia.Execute then
  1363. begin
  1364.       (findcomponent('edtsqltextfilename') as Tedit).text:=savedia.FileName;
  1365.       (findcomponent('btnsqlsave') as Tbutton).click;
  1366. end;
  1367. saveDia.free;
  1368. end;
  1369.  
  1370. procedure TForm1.SaveSqltext(Sender: TObject);
  1371. begin
  1372.   try
  1373.   memoSQLstr.Lines.SaveToFile((findcomponent('edtsqltextfilename') as tedit).text);
  1374.   ActiveMDIChild.Close;
  1375.   popsqlitemekle((findcomponent('edtsqltextfilename') as tedit).text);
  1376.   except
  1377.  
  1378.   end;
  1379. end;
  1380. procedure Tform1.RieOutRenk(vrie:TrichEdit;v_color:Tcolor);
  1381. begin
  1382.   vrie.SelStart:=vrie.GetTextLen;
  1383.   vrie.SelAttributes.color:=v_Color;
  1384. end;
  1385.  
  1386. procedure TForm1.Browse1Click(Sender: TObject);
  1387. begin
  1388. btnSQLoutBrowse.down:=true;
  1389. end;
  1390.  
  1391. procedure TForm1.Report1Click(Sender: TObject);
  1392. begin
  1393. btnSQLoutText.down:=true;
  1394.  
  1395. end;
  1396.  
  1397. procedure TForm1.AsciTextCSV1Click(Sender: TObject);
  1398. begin
  1399. btnSQLoutCSV.down:=true;
  1400.  
  1401. end;
  1402.  
  1403. procedure TForm1.actExitExecute(Sender: TObject);
  1404. begin
  1405. Close;
  1406. end;
  1407.  
  1408. procedure TForm1.MemoSQLstrChange(Sender: TObject);
  1409. begin
  1410.  
  1411. if trim(memoSqlstr.text)='' then
  1412.   actRunSQl.Enabled:=false
  1413. else
  1414.   actRunSQl.Enabled:=true;
  1415.  
  1416. end;
  1417.  
  1418. procedure TForm1.PopJoinTypeClick(Sender: TObject);
  1419. begin
  1420. if (sender is tmenUitem) then
  1421. begin
  1422.   DARR:=vRlist.Items[vselecteditem];
  1423.   DARR^.JT:=(sender as tmenuitem).name;
  1424.   sqlStringReCreate(sender);
  1425. end;
  1426. end;
  1427.  
  1428. procedure TForm1.SaveResult1Click(Sender: TObject);
  1429. var SaveDia:TsaveDialog;
  1430. begin
  1431.  
  1432. if (FindComponent('rie_'+activeMdichild.name)<>nil) then
  1433. begin
  1434.     SaveDia:=TSaveDialog.create(self);
  1435.     if savedia.Execute then
  1436.     begin
  1437.        (FindComponent('rie_'+activeMdichild.name) as TrichEdit).lines.savetoFile(savedia.filename);
  1438.     end;
  1439.     SaveDia.free;
  1440. end;
  1441. end;
  1442.  
  1443. procedure TForm1.DBGridColEnter(Sender: TObject);
  1444. begin
  1445.  
  1446.      if (FindComponent('dbIma_'+activeMdiChild.name)) <> nil  then
  1447.       begin
  1448.          (FindComponent('dbIma_'+activeMdiChild.name)).free;
  1449.       end;
  1450.  
  1451.    if ((sender as tdbgrid).selectedfield.DataType=ftBlob) or ((sender as tdbgrid).selectedfield.DataType=ftmemo) then
  1452.    begin
  1453.       if FindComponent('dbIma_'+activeMdiChild.name) = nil  then
  1454.       begin
  1455.           if ((sender as tdbgrid).selectedfield.DataType=ftBlob) then
  1456.           begin
  1457.              with tdbImage.create(self) do
  1458.              begin
  1459.                 parent := activeMdiChild;
  1460.                 name:='dbIma_'+activeMdiChild.name;
  1461.                 align:=albottom;
  1462.                 datasource:=(sender as tdbgrid).DataSource  ;
  1463.                 Datafield:=trim((sender as tdbgrid).selectedfield.DisplayName);
  1464.                 Stretch:=true;
  1465.              end;
  1466.            end
  1467.            else
  1468.            begin
  1469.              with tdbmemo.create(self) do
  1470.              begin
  1471.                 parent := activeMdiChild;
  1472.                 name:='dbIma_'+activeMdiChild.name;
  1473.                 align:=albottom;
  1474.                 datasource:=(sender as tdbgrid).DataSource  ;
  1475.                 Datafield:=trim((sender as tdbgrid).selectedfield.DisplayName);
  1476.              end;
  1477.            end ;
  1478.  
  1479.        end;
  1480.    end
  1481.    else
  1482.    begin
  1483.       if (FindComponent('dbIma_'+activeMdiChild.name)) <> nil  then
  1484.       begin
  1485.          (FindComponent('dbIma_'+activeMdiChild.name)).free;
  1486.       end;
  1487.    end;
  1488.  
  1489. end;
  1490.  
  1491.  
  1492.  
  1493. procedure TForm1.SendtoExcel1Click(Sender: TObject);
  1494. begin
  1495. btnExcel.Down:=true;
  1496. end;
  1497.  
  1498.  
  1499. procedure TForm1.SendToExcel(v_Dset:Tdataset);
  1500. var WorkBk : _WorkBook;     //  Define a WorkBook
  1501.     WorkSheet : _WorkSheet; //  Define a WorkSheet
  1502.     I, J, R, C : Integer;
  1503.     IIndex : OleVariant;
  1504.     TabGrid : Variant;
  1505.     vSg:TstringGrid;
  1506.     xlApp:TExcelApplication;
  1507. begin
  1508.  
  1509.  xlApp:=TexcelApplication.create(self);
  1510.  xlApp.ConnectKind:= ckNewInstance;
  1511.  vsg:=TstringGrid.Create(self);
  1512.  
  1513.  v_dset.Last;
  1514.  with vsg do
  1515.  begin
  1516.      FixedCols:=0;
  1517.      FixedRows:=0;
  1518.      RowCount:=v_dset.RecordCount+1;
  1519.      ColCount:=v_dset.FieldCount;
  1520.  end; //with vsg do
  1521.  //Column labels
  1522.  
  1523.  For i:=0 to v_dset.FieldCount-1 do
  1524.  begin
  1525.      vsg.Cells[i,0]:=v_dset.Fields[i].DisplayName;
  1526.  end;
  1527.  //data
  1528.  v_dset.First;
  1529.  r:=1;
  1530.  While not v_dset.Eof do
  1531.  begin
  1532.     For i:=0 to v_dset.FieldCount-1 do
  1533.     begin
  1534.         if  v_dset.Fields[i].IsBlob then
  1535.            vsg.Cells[i,r]:=v_dset.Fields[i].AsString
  1536.         else
  1537.            vsg.Cells[i,r]:=v_dset.Fields[i].AsString;
  1538.  
  1539.     end;
  1540.     r:=r+1;
  1541.     v_dset.Next;
  1542.  end;
  1543.  r:=0;
  1544.  
  1545.  if vsg.Cells[0,1] <> '' then
  1546.   begin
  1547.    IIndex := 1;
  1548.    R := vsg.RowCount;
  1549.    C := vsg.ColCount;
  1550.    // Create the Variant Array
  1551.    TabGrid := VarArrayCreate([0,(R - 1),0,(C - 1)],VarOleStr);
  1552.    I := 0;
  1553.    //  Define the loop for filling in the Variant
  1554.    repeat
  1555.    for J := 0 to (C - 1) do
  1556.      TabGrid[I,J] := vsg.Cells[J,I];
  1557.     Inc(I,1);
  1558.    until
  1559.     I > (R - 1);
  1560.    try
  1561.    // Connect to the server TExcelApplication
  1562.    XLApp.Connect;
  1563.     // Add WorkBooks to the ExcelApplication
  1564.    XLApp.WorkBooks.Add(xlWBatWorkSheet,0);
  1565.    // Select the first WorkBook
  1566.    WorkBk := XLApp.WorkBooks.Item[IIndex];
  1567.    // Define the first WorkSheet
  1568.    WorkSheet := WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;
  1569.    // Assign the Delphi Variant Matrix to the Variant associated with the WorkSheet
  1570.    Worksheet.Range['A1',Worksheet.Cells.Item[R,C]].Value := TabGrid;
  1571.    // Quit and Disconnect the Server
  1572.    XLApp.Quit;
  1573.    XLApp.Disconnect;
  1574.    showmessage(inttostr(v_dset.RecordCount)+' Records Send to Excel') ;
  1575.    except
  1576.    end;
  1577.    // Unassign the Delphi Variant Matrix
  1578.    TabGrid := Unassigned;
  1579.   end;
  1580.  
  1581. vsg.free;
  1582. vsg:=nil;
  1583. xlApp.free;
  1584. xlApp:=nil;
  1585. end;
  1586.  
  1587.  
  1588.  
  1589. end.
  1590.