home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d456 / JANSQL.ZIP / janSQLDemo / demosource / janSQLDemoU.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-03-31  |  10.5 KB  |  428 lines
  1. unit janSQLDemoU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   FileCtrl,Grids, ExtCtrls, ComCtrls, ToolWin, Menus, janSQL, janSQLStrings,StdCtrls, Buttons;
  8.  
  9.  
  10.  
  11. type
  12.   TjanSQLDemoF = class(TForm)
  13.     MainMenu1: TMainMenu;
  14.     StatusBar1: TStatusBar;
  15.     Panel1: TPanel;
  16.     Splitter1: TSplitter;
  17.     viewgrid: TStringGrid;
  18.     sqlmemo: TMemo;
  19.     Insert1: TMenuItem;
  20.     ApplicationFolder1: TMenuItem;
  21.     SelectedFolder1: TMenuItem;
  22.     Help1: TMenuItem;
  23.     Contents1: TMenuItem;
  24.     File1: TMenuItem;
  25.     Open1: TMenuItem;
  26.     Save1: TMenuItem;
  27.     OpenDialog1: TOpenDialog;
  28.     SaveDialog1: TSaveDialog;
  29.     GroupBox1: TGroupBox;
  30.     edmessage: TEdit;
  31.     SQL1: TMenuItem;
  32.     Execute1: TMenuItem;
  33.     GroupBox2: TGroupBox;
  34.     hisbox: TComboBox;
  35.     AddtoHistory1: TMenuItem;
  36.     memopop: TPopupMenu;
  37.     SELECT1: TMenuItem;
  38.     FROM1: TMenuItem;
  39.     WHERE1: TMenuItem;
  40.     GROUPBY1: TMenuItem;
  41.     HAVING1: TMenuItem;
  42.     ORDERBY1: TMenuItem;
  43.     N1: TMenuItem;
  44.     CONNECTTO1: TMenuItem;
  45.     COMMIT1: TMenuItem;
  46.     CREATETABLE1: TMenuItem;
  47.     ATERTABLE1: TMenuItem;
  48.     N2: TMenuItem;
  49.     UPDATE1: TMenuItem;
  50.     INSERT2: TMenuItem;
  51.     DELETEFROM1: TMenuItem;
  52.     VALUES1: TMenuItem;
  53.     Edit1: TMenuItem;
  54.     Cut1: TMenuItem;
  55.     Copy1: TMenuItem;
  56.     Paste1: TMenuItem;
  57.     Delete1: TMenuItem;
  58.     N3: TMenuItem;
  59.     SelectAll1: TMenuItem;
  60.     Undelete1: TMenuItem;
  61.     Samples1: TMenuItem;
  62.     Options1: TMenuItem;
  63.     LoadSamples1: TMenuItem;
  64.     N4: TMenuItem;
  65.     procedure FormCreate(Sender: TObject);
  66.     procedure cmdExecuteClick(Sender: TObject);
  67.     procedure ApplicationFolder1Click(Sender: TObject);
  68.     procedure SelectedFolder1Click(Sender: TObject);
  69.     procedure Contents1Click(Sender: TObject);
  70.     procedure FormDestroy(Sender: TObject);
  71.     procedure Open1Click(Sender: TObject);
  72.     procedure Save1Click(Sender: TObject);
  73.     procedure viewgridDrawCell(Sender: TObject; ACol, ARow: Integer;
  74.       Rect: TRect; State: TGridDrawState);
  75.     procedure FormShow(Sender: TObject);
  76.     procedure hisboxClick(Sender: TObject);
  77.     procedure AddtoHistory1Click(Sender: TObject);
  78.     procedure SELECT1Click(Sender: TObject);
  79.     procedure FROM1Click(Sender: TObject);
  80.     procedure WHERE1Click(Sender: TObject);
  81.     procedure GROUPBY1Click(Sender: TObject);
  82.     procedure HAVING1Click(Sender: TObject);
  83.     procedure ORDERBY1Click(Sender: TObject);
  84.     procedure CONNECTTO1Click(Sender: TObject);
  85.     procedure COMMIT1Click(Sender: TObject);
  86.     procedure CREATETABLE1Click(Sender: TObject);
  87.     procedure ATERTABLE1Click(Sender: TObject);
  88.     procedure UPDATE1Click(Sender: TObject);
  89.     procedure INSERT2Click(Sender: TObject);
  90.     procedure DELETEFROM1Click(Sender: TObject);
  91.     procedure VALUES1Click(Sender: TObject);
  92.     procedure SelectAll1Click(Sender: TObject);
  93.     procedure Cut1Click(Sender: TObject);
  94.     procedure Copy1Click(Sender: TObject);
  95.     procedure Paste1Click(Sender: TObject);
  96.     procedure Delete1Click(Sender: TObject);
  97.     procedure Undelete1Click(Sender: TObject);
  98.     procedure viewgridDblClick(Sender: TObject);
  99.     procedure runsampleClick(Sender: TObject);
  100.     procedure LoadSamples1Click(Sender: TObject);
  101.   private
  102.     procedure showresults(resultset:integer);
  103.     procedure showHint(var HintStr:string; var CanShow:boolean; var HintInfo:THintInfo);
  104.     procedure aid(atext: string);
  105.     procedure setSampleMenu;
  106.     { Private declarations }
  107.   public
  108.     { Public declarations }
  109.   end;
  110.  
  111. var
  112.   janSQLDemoF: TjanSQLDemoF;
  113.   gen:TStringList;
  114.   appldir:string;
  115.   thefile:string;
  116.   samples:string;
  117.   db:TjanSQL;
  118.  
  119. implementation
  120.  
  121. {$R *.DFM}
  122.  
  123. procedure TjanSQLDemoF.FormCreate(Sender: TObject);
  124. begin
  125.   appldir:=extractfiledir(application.exename);
  126.   db:=TjanSQL.create;
  127.   gen:=TStringList.Create;
  128.   sqlmemo.Text:='connect to '''+appldir+'\db''';
  129.   application.OnShowHint:=showhint;
  130.   setsamplemenu;
  131. end;
  132.  
  133. procedure TjanSQLDemoF.setSampleMenu;
  134. var
  135.   i,c:integer;
  136.   tmp:string;
  137.   mnu:TMenuItem;
  138. begin
  139.   if fileexists(appldir+'\samples.txt') then
  140.     samples:=loadstring(appldir+'\samples.txt');
  141.   if samples='' then exit;
  142.   samples1.Clear;
  143.   ListSections(samples,gen);
  144.   c:=gen.count;
  145.   if c=0 then exit;
  146.   for i:=0 to c-1 do begin
  147.     mnu:=TmenuItem.Create(self);
  148.     mnu.caption:=gen[i];
  149.     mnu.OnClick:=runsampleClick;
  150.     samples1.add(mnu);
  151.   end;
  152. end;
  153.  
  154. procedure TjanSQLDemoF.cmdExecuteClick(Sender: TObject);
  155. var
  156.   sqlresult:integer;
  157.   sqltext:string;
  158. begin
  159.   sqltext:=sqlmemo.text;
  160.   sqlresult:=db.SQLDirect(sqltext);
  161.   if sqlresult<>0 then begin
  162.     edmessage.Text:='OK';
  163.     if sqlresult>0 then begin
  164.       showresults(sqlresult);
  165.       if not db.RecordSets[sqlresult].intermediate then
  166.         db.ReleaseRecordset(sqlresult);
  167.     end;
  168.   end
  169.   else
  170.     edmessage.Text:=db.Error;
  171.   sqlmemo.SetFocus;
  172. end;
  173.  
  174. procedure TjanSQLDemoF.showresults(resultset:integer);
  175. var
  176.   r1:integer;
  177.   i,arow,acol,rc,fc:integer;
  178. begin
  179.   r1:=resultset;
  180.   rc:=db.RecordSets[r1].recordcount;
  181.   if rc=0 then exit;
  182.   fc:=db.RecordSets[r1].fieldcount;
  183.   if fc=0 then exit;
  184.   viewgrid.RowCount:=rc+1;
  185.   viewgrid.ColCount:=fc;
  186.   for i:=0 to fc-1 do
  187.     viewgrid.Cells[i,0]:=db.recordsets[r1].FieldNames[i];
  188.   for arow:=0 to rc-1 do
  189.     for acol:=0 to fc-1 do
  190.       viewgrid.cells[acol,arow+1]:=db.RecordSets[r1].records[arow].fields[acol].value;
  191. end;
  192.  
  193. procedure TjanSQLDemoF.ApplicationFolder1Click(Sender: TObject);
  194. begin
  195.   sqlmemo.SelText:=appldir+'\db';
  196. end;
  197.  
  198. procedure TjanSQLDemoF.SelectedFolder1Click(Sender: TObject);
  199. var
  200.   adir:string;
  201. begin
  202.   if not selectdirectory('Select Catalog Folder to insert','',adir) then exit;
  203.   sqlmemo.SelText:=adir;
  204. end;
  205.  
  206.  
  207.  
  208. procedure TjanSQLDemoF.Contents1Click(Sender: TObject);
  209. begin
  210.   application.HelpFile:=appldir+'\janSQL.hlp';
  211.   application.HelpJump('janSQL');
  212. end;
  213.  
  214. procedure TjanSQLDemoF.FormDestroy(Sender: TObject);
  215. begin
  216.   db.free;
  217.   gen.free;
  218. end;
  219.  
  220. procedure TjanSQLDemoF.Open1Click(Sender: TObject);
  221. begin
  222.   if thefile='' then
  223.     opendialog1.InitialDir:=appldir+'\sql'
  224.   else
  225.    opendialog1.InitialDir:=extractfiledir(thefile);
  226.   if not opendialog1.Execute then exit;
  227.   thefile:=opendialog1.FileName;
  228.   sqlmemo.lines.LoadFromFile(thefile);
  229. end;
  230.  
  231. procedure TjanSQLDemoF.Save1Click(Sender: TObject);
  232. begin
  233.   if thefile='' then
  234.     savedialog1.InitialDir:=appldir+'\sql'
  235.   else
  236.     savedialog1.InitialDir:=extractfiledir(thefile);
  237.   if not savedialog1.Execute then exit;
  238.   thefile:=savedialog1.FileName;
  239.   sqlmemo.lines.SaveToFile(thefile);
  240. end;
  241.  
  242. procedure TjanSQLDemoF.viewgridDrawCell(Sender: TObject; ACol,
  243.   ARow: Integer; Rect: TRect; State: TGridDrawState);
  244. var
  245.   s:string;
  246.   myrect:TRect;
  247. begin
  248.   s:=viewgrid.Cells[acol,arow];
  249.   myrect:=rect;
  250. //  drawtext(viewgrid.canvas.handle,pchar(s),-1,myrect,DT_WORDBREAK or DT_CALCRECT);
  251.   drawtext(viewgrid.canvas.handle,pchar(s),-1,myrect,DT_WORDBREAK);
  252. end;
  253.  
  254. procedure TjanSQLDemoF.showHint(var HintStr: string; var CanShow: boolean;
  255.   var HintInfo: THintInfo);
  256. var
  257.   pt:TPoint;
  258.   acol,arow:integer;
  259. begin
  260.   with HintInfo do begin
  261.     if HintControl<>ViewGrid then exit;
  262.     viewgrid.mousetocell(cursorpos.x,cursorpos.y,acol,arow);
  263.     if (acol=-1) or (arow=-1) then exit;
  264.     Hintstr:=viewgrid.cells[acol,arow];
  265.     cursorrect:=viewgrid.CellRect(acol,arow);
  266.   end;
  267. end;
  268.  
  269. procedure TjanSQLDemoF.FormShow(Sender: TObject);
  270. var
  271.   h,w,x,y:integer;
  272. begin
  273.   w:=screen.DesktopWidth;
  274.   h:=screen.DesktopHeight;
  275.   x:=screen.DesktopLeft;
  276.   y:=screen.DesktopTop;
  277.   left:=x+20;
  278.   top:=y+20;
  279.   width:=round(w*0.9);
  280.   height:=round(h*0.9);
  281. end;
  282.  
  283. procedure TjanSQLDemoF.hisboxClick(Sender: TObject);
  284. begin
  285.   if hisbox.itemindex=-1 then exit;
  286.   sqlmemo.text:=hisbox.items[hisbox.itemindex];
  287.   sqlmemo.setfocus;
  288. end;
  289.  
  290. procedure TjanSQLDemoF.AddtoHistory1Click(Sender: TObject);
  291. begin
  292.   if hisbox.items.IndexOf(sqlmemo.text)=-1 then
  293.     hisbox.items.Append(sqlmemo.text);
  294. end;
  295.  
  296. procedure TjanSQLDemoF.aid(atext:string);
  297. begin
  298.   sqlmemo.SelText:=atext;
  299.   sqlmemo.setfocus;
  300. end;
  301.  
  302. procedure TjanSQLDemoF.SELECT1Click(Sender: TObject);
  303. begin
  304.   aid('SELECT ');
  305. end;
  306.  
  307. procedure TjanSQLDemoF.FROM1Click(Sender: TObject);
  308. begin
  309.   aid('FROM ')
  310. end;
  311.  
  312. procedure TjanSQLDemoF.WHERE1Click(Sender: TObject);
  313. begin
  314.  aid('WHERE ');
  315. end;
  316.  
  317. procedure TjanSQLDemoF.GROUPBY1Click(Sender: TObject);
  318. begin
  319.  aid('GROUP BY ');
  320. end;
  321.  
  322. procedure TjanSQLDemoF.HAVING1Click(Sender: TObject);
  323. begin
  324.  aid('HAVING ');
  325. end;
  326.  
  327. procedure TjanSQLDemoF.ORDERBY1Click(Sender: TObject);
  328. begin
  329.  aid('ORDER BY ');
  330. end;
  331.  
  332. procedure TjanSQLDemoF.CONNECTTO1Click(Sender: TObject);
  333. begin
  334.  aid('CONNECT TO ');
  335. end;
  336.  
  337. procedure TjanSQLDemoF.COMMIT1Click(Sender: TObject);
  338. begin
  339.   aid('COMMIT');
  340. end;
  341.  
  342. procedure TjanSQLDemoF.CREATETABLE1Click(Sender: TObject);
  343. begin
  344.   aid('CREATE TABLE');
  345. end;
  346.  
  347. procedure TjanSQLDemoF.ATERTABLE1Click(Sender: TObject);
  348. begin
  349.   aid('ALTER TABLE');
  350. end;
  351.  
  352. procedure TjanSQLDemoF.UPDATE1Click(Sender: TObject);
  353. begin
  354.   aid('UPDATE ');
  355. end;
  356.  
  357. procedure TjanSQLDemoF.INSERT2Click(Sender: TObject);
  358. begin
  359.   aid('INSERT INTO ');
  360. end;
  361.  
  362. procedure TjanSQLDemoF.DELETEFROM1Click(Sender: TObject);
  363. begin
  364.   aid('DELETE FROM ');
  365. end;
  366.  
  367. procedure TjanSQLDemoF.VALUES1Click(Sender: TObject);
  368. begin
  369.   aid('VALUES ');
  370. end;
  371.  
  372. procedure TjanSQLDemoF.SelectAll1Click(Sender: TObject);
  373. begin
  374.   sqlmemo.SelectAll;
  375. end;
  376.  
  377. procedure TjanSQLDemoF.Cut1Click(Sender: TObject);
  378. begin
  379.   sqlmemo.CutToClipboard;
  380. end;
  381.  
  382. procedure TjanSQLDemoF.Copy1Click(Sender: TObject);
  383. begin
  384.   sqlmemo.CopyToClipboard;
  385. end;
  386.  
  387. procedure TjanSQLDemoF.Paste1Click(Sender: TObject);
  388. begin
  389.   sqlmemo.PasteFromClipboard;
  390. end;
  391.  
  392. procedure TjanSQLDemoF.Delete1Click(Sender: TObject);
  393. begin
  394.   sqlmemo.ClearSelection;
  395. end;
  396.  
  397. procedure TjanSQLDemoF.Undelete1Click(Sender: TObject);
  398. begin
  399.   if sqlmemo.CanUndo then
  400.     sqlmemo.Undo;
  401. end;
  402.  
  403. procedure TjanSQLDemoF.viewgridDblClick(Sender: TObject);
  404. var
  405.   acol,arow:integer;
  406. begin
  407.   acol:=viewgrid.Col;
  408.   arow:=viewgrid.row;
  409.   if (acol>=0) and (arow>0) then
  410.     sqlmemo.seltext:=viewgrid.cells[acol,0]+'='+viewgrid.cells[acol,arow];
  411.   sqlmemo.setfocus;
  412. end;
  413.  
  414. procedure TjanSQLDemoF.runsampleClick(Sender: TObject);
  415. var
  416.   tmp:string;
  417. begin
  418.   tmp:=getSection(samples,TmenuItem(sender).caption);
  419.   sqlmemo.text:=stringreplace(tmp,'{appldir}',appldir,[rfignorecase]);
  420. end;
  421.  
  422. procedure TjanSQLDemoF.LoadSamples1Click(Sender: TObject);
  423. begin
  424.   setsamplemenu;
  425. end;
  426.  
  427. end.
  428.