home *** CD-ROM | disk | FTP | other *** search
- unit janSQLDemoU;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- FileCtrl,Grids, ExtCtrls, ComCtrls, ToolWin, Menus, janSQL, janSQLStrings,StdCtrls, Buttons;
-
-
-
- type
- TjanSQLDemoF = class(TForm)
- MainMenu1: TMainMenu;
- StatusBar1: TStatusBar;
- Panel1: TPanel;
- Splitter1: TSplitter;
- viewgrid: TStringGrid;
- sqlmemo: TMemo;
- Insert1: TMenuItem;
- ApplicationFolder1: TMenuItem;
- SelectedFolder1: TMenuItem;
- Help1: TMenuItem;
- Contents1: TMenuItem;
- File1: TMenuItem;
- Open1: TMenuItem;
- Save1: TMenuItem;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- GroupBox1: TGroupBox;
- edmessage: TEdit;
- SQL1: TMenuItem;
- Execute1: TMenuItem;
- GroupBox2: TGroupBox;
- hisbox: TComboBox;
- AddtoHistory1: TMenuItem;
- memopop: TPopupMenu;
- SELECT1: TMenuItem;
- FROM1: TMenuItem;
- WHERE1: TMenuItem;
- GROUPBY1: TMenuItem;
- HAVING1: TMenuItem;
- ORDERBY1: TMenuItem;
- N1: TMenuItem;
- CONNECTTO1: TMenuItem;
- COMMIT1: TMenuItem;
- CREATETABLE1: TMenuItem;
- ATERTABLE1: TMenuItem;
- N2: TMenuItem;
- UPDATE1: TMenuItem;
- INSERT2: TMenuItem;
- DELETEFROM1: TMenuItem;
- VALUES1: TMenuItem;
- Edit1: TMenuItem;
- Cut1: TMenuItem;
- Copy1: TMenuItem;
- Paste1: TMenuItem;
- Delete1: TMenuItem;
- N3: TMenuItem;
- SelectAll1: TMenuItem;
- Undelete1: TMenuItem;
- Samples1: TMenuItem;
- Options1: TMenuItem;
- LoadSamples1: TMenuItem;
- N4: TMenuItem;
- procedure FormCreate(Sender: TObject);
- procedure cmdExecuteClick(Sender: TObject);
- procedure ApplicationFolder1Click(Sender: TObject);
- procedure SelectedFolder1Click(Sender: TObject);
- procedure Contents1Click(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure Open1Click(Sender: TObject);
- procedure Save1Click(Sender: TObject);
- procedure viewgridDrawCell(Sender: TObject; ACol, ARow: Integer;
- Rect: TRect; State: TGridDrawState);
- procedure FormShow(Sender: TObject);
- procedure hisboxClick(Sender: TObject);
- procedure AddtoHistory1Click(Sender: TObject);
- procedure SELECT1Click(Sender: TObject);
- procedure FROM1Click(Sender: TObject);
- procedure WHERE1Click(Sender: TObject);
- procedure GROUPBY1Click(Sender: TObject);
- procedure HAVING1Click(Sender: TObject);
- procedure ORDERBY1Click(Sender: TObject);
- procedure CONNECTTO1Click(Sender: TObject);
- procedure COMMIT1Click(Sender: TObject);
- procedure CREATETABLE1Click(Sender: TObject);
- procedure ATERTABLE1Click(Sender: TObject);
- procedure UPDATE1Click(Sender: TObject);
- procedure INSERT2Click(Sender: TObject);
- procedure DELETEFROM1Click(Sender: TObject);
- procedure VALUES1Click(Sender: TObject);
- procedure SelectAll1Click(Sender: TObject);
- procedure Cut1Click(Sender: TObject);
- procedure Copy1Click(Sender: TObject);
- procedure Paste1Click(Sender: TObject);
- procedure Delete1Click(Sender: TObject);
- procedure Undelete1Click(Sender: TObject);
- procedure viewgridDblClick(Sender: TObject);
- procedure runsampleClick(Sender: TObject);
- procedure LoadSamples1Click(Sender: TObject);
- private
- procedure showresults(resultset:integer);
- procedure showHint(var HintStr:string; var CanShow:boolean; var HintInfo:THintInfo);
- procedure aid(atext: string);
- procedure setSampleMenu;
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- janSQLDemoF: TjanSQLDemoF;
- gen:TStringList;
- appldir:string;
- thefile:string;
- samples:string;
- db:TjanSQL;
-
- implementation
-
- {$R *.DFM}
-
- procedure TjanSQLDemoF.FormCreate(Sender: TObject);
- begin
- appldir:=extractfiledir(application.exename);
- db:=TjanSQL.create;
- gen:=TStringList.Create;
- sqlmemo.Text:='connect to '''+appldir+'\db''';
- application.OnShowHint:=showhint;
- setsamplemenu;
- end;
-
- procedure TjanSQLDemoF.setSampleMenu;
- var
- i,c:integer;
- tmp:string;
- mnu:TMenuItem;
- begin
- if fileexists(appldir+'\samples.txt') then
- samples:=loadstring(appldir+'\samples.txt');
- if samples='' then exit;
- samples1.Clear;
- ListSections(samples,gen);
- c:=gen.count;
- if c=0 then exit;
- for i:=0 to c-1 do begin
- mnu:=TmenuItem.Create(self);
- mnu.caption:=gen[i];
- mnu.OnClick:=runsampleClick;
- samples1.add(mnu);
- end;
- end;
-
- procedure TjanSQLDemoF.cmdExecuteClick(Sender: TObject);
- var
- sqlresult:integer;
- sqltext:string;
- begin
- sqltext:=sqlmemo.text;
- sqlresult:=db.SQLDirect(sqltext);
- if sqlresult<>0 then begin
- edmessage.Text:='OK';
- if sqlresult>0 then begin
- showresults(sqlresult);
- if not db.RecordSets[sqlresult].intermediate then
- db.ReleaseRecordset(sqlresult);
- end;
- end
- else
- edmessage.Text:=db.Error;
- sqlmemo.SetFocus;
- end;
-
- procedure TjanSQLDemoF.showresults(resultset:integer);
- var
- r1:integer;
- i,arow,acol,rc,fc:integer;
- begin
- r1:=resultset;
- rc:=db.RecordSets[r1].recordcount;
- if rc=0 then exit;
- fc:=db.RecordSets[r1].fieldcount;
- if fc=0 then exit;
- viewgrid.RowCount:=rc+1;
- viewgrid.ColCount:=fc;
- for i:=0 to fc-1 do
- viewgrid.Cells[i,0]:=db.recordsets[r1].FieldNames[i];
- for arow:=0 to rc-1 do
- for acol:=0 to fc-1 do
- viewgrid.cells[acol,arow+1]:=db.RecordSets[r1].records[arow].fields[acol].value;
- end;
-
- procedure TjanSQLDemoF.ApplicationFolder1Click(Sender: TObject);
- begin
- sqlmemo.SelText:=appldir+'\db';
- end;
-
- procedure TjanSQLDemoF.SelectedFolder1Click(Sender: TObject);
- var
- adir:string;
- begin
- if not selectdirectory('Select Catalog Folder to insert','',adir) then exit;
- sqlmemo.SelText:=adir;
- end;
-
-
-
- procedure TjanSQLDemoF.Contents1Click(Sender: TObject);
- begin
- application.HelpFile:=appldir+'\janSQL.hlp';
- application.HelpJump('janSQL');
- end;
-
- procedure TjanSQLDemoF.FormDestroy(Sender: TObject);
- begin
- db.free;
- gen.free;
- end;
-
- procedure TjanSQLDemoF.Open1Click(Sender: TObject);
- begin
- if thefile='' then
- opendialog1.InitialDir:=appldir+'\sql'
- else
- opendialog1.InitialDir:=extractfiledir(thefile);
- if not opendialog1.Execute then exit;
- thefile:=opendialog1.FileName;
- sqlmemo.lines.LoadFromFile(thefile);
- end;
-
- procedure TjanSQLDemoF.Save1Click(Sender: TObject);
- begin
- if thefile='' then
- savedialog1.InitialDir:=appldir+'\sql'
- else
- savedialog1.InitialDir:=extractfiledir(thefile);
- if not savedialog1.Execute then exit;
- thefile:=savedialog1.FileName;
- sqlmemo.lines.SaveToFile(thefile);
- end;
-
- procedure TjanSQLDemoF.viewgridDrawCell(Sender: TObject; ACol,
- ARow: Integer; Rect: TRect; State: TGridDrawState);
- var
- s:string;
- myrect:TRect;
- begin
- s:=viewgrid.Cells[acol,arow];
- myrect:=rect;
- // drawtext(viewgrid.canvas.handle,pchar(s),-1,myrect,DT_WORDBREAK or DT_CALCRECT);
- drawtext(viewgrid.canvas.handle,pchar(s),-1,myrect,DT_WORDBREAK);
- end;
-
- procedure TjanSQLDemoF.showHint(var HintStr: string; var CanShow: boolean;
- var HintInfo: THintInfo);
- var
- pt:TPoint;
- acol,arow:integer;
- begin
- with HintInfo do begin
- if HintControl<>ViewGrid then exit;
- viewgrid.mousetocell(cursorpos.x,cursorpos.y,acol,arow);
- if (acol=-1) or (arow=-1) then exit;
- Hintstr:=viewgrid.cells[acol,arow];
- cursorrect:=viewgrid.CellRect(acol,arow);
- end;
- end;
-
- procedure TjanSQLDemoF.FormShow(Sender: TObject);
- var
- h,w,x,y:integer;
- begin
- w:=screen.DesktopWidth;
- h:=screen.DesktopHeight;
- x:=screen.DesktopLeft;
- y:=screen.DesktopTop;
- left:=x+20;
- top:=y+20;
- width:=round(w*0.9);
- height:=round(h*0.9);
- end;
-
- procedure TjanSQLDemoF.hisboxClick(Sender: TObject);
- begin
- if hisbox.itemindex=-1 then exit;
- sqlmemo.text:=hisbox.items[hisbox.itemindex];
- sqlmemo.setfocus;
- end;
-
- procedure TjanSQLDemoF.AddtoHistory1Click(Sender: TObject);
- begin
- if hisbox.items.IndexOf(sqlmemo.text)=-1 then
- hisbox.items.Append(sqlmemo.text);
- end;
-
- procedure TjanSQLDemoF.aid(atext:string);
- begin
- sqlmemo.SelText:=atext;
- sqlmemo.setfocus;
- end;
-
- procedure TjanSQLDemoF.SELECT1Click(Sender: TObject);
- begin
- aid('SELECT ');
- end;
-
- procedure TjanSQLDemoF.FROM1Click(Sender: TObject);
- begin
- aid('FROM ')
- end;
-
- procedure TjanSQLDemoF.WHERE1Click(Sender: TObject);
- begin
- aid('WHERE ');
- end;
-
- procedure TjanSQLDemoF.GROUPBY1Click(Sender: TObject);
- begin
- aid('GROUP BY ');
- end;
-
- procedure TjanSQLDemoF.HAVING1Click(Sender: TObject);
- begin
- aid('HAVING ');
- end;
-
- procedure TjanSQLDemoF.ORDERBY1Click(Sender: TObject);
- begin
- aid('ORDER BY ');
- end;
-
- procedure TjanSQLDemoF.CONNECTTO1Click(Sender: TObject);
- begin
- aid('CONNECT TO ');
- end;
-
- procedure TjanSQLDemoF.COMMIT1Click(Sender: TObject);
- begin
- aid('COMMIT');
- end;
-
- procedure TjanSQLDemoF.CREATETABLE1Click(Sender: TObject);
- begin
- aid('CREATE TABLE');
- end;
-
- procedure TjanSQLDemoF.ATERTABLE1Click(Sender: TObject);
- begin
- aid('ALTER TABLE');
- end;
-
- procedure TjanSQLDemoF.UPDATE1Click(Sender: TObject);
- begin
- aid('UPDATE ');
- end;
-
- procedure TjanSQLDemoF.INSERT2Click(Sender: TObject);
- begin
- aid('INSERT INTO ');
- end;
-
- procedure TjanSQLDemoF.DELETEFROM1Click(Sender: TObject);
- begin
- aid('DELETE FROM ');
- end;
-
- procedure TjanSQLDemoF.VALUES1Click(Sender: TObject);
- begin
- aid('VALUES ');
- end;
-
- procedure TjanSQLDemoF.SelectAll1Click(Sender: TObject);
- begin
- sqlmemo.SelectAll;
- end;
-
- procedure TjanSQLDemoF.Cut1Click(Sender: TObject);
- begin
- sqlmemo.CutToClipboard;
- end;
-
- procedure TjanSQLDemoF.Copy1Click(Sender: TObject);
- begin
- sqlmemo.CopyToClipboard;
- end;
-
- procedure TjanSQLDemoF.Paste1Click(Sender: TObject);
- begin
- sqlmemo.PasteFromClipboard;
- end;
-
- procedure TjanSQLDemoF.Delete1Click(Sender: TObject);
- begin
- sqlmemo.ClearSelection;
- end;
-
- procedure TjanSQLDemoF.Undelete1Click(Sender: TObject);
- begin
- if sqlmemo.CanUndo then
- sqlmemo.Undo;
- end;
-
- procedure TjanSQLDemoF.viewgridDblClick(Sender: TObject);
- var
- acol,arow:integer;
- begin
- acol:=viewgrid.Col;
- arow:=viewgrid.row;
- if (acol>=0) and (arow>0) then
- sqlmemo.seltext:=viewgrid.cells[acol,0]+'='+viewgrid.cells[acol,arow];
- sqlmemo.setfocus;
- end;
-
- procedure TjanSQLDemoF.runsampleClick(Sender: TObject);
- var
- tmp:string;
- begin
- tmp:=getSection(samples,TmenuItem(sender).caption);
- sqlmemo.text:=stringreplace(tmp,'{appldir}',appldir,[rfignorecase]);
- end;
-
- procedure TjanSQLDemoF.LoadSamples1Click(Sender: TObject);
- begin
- setsamplemenu;
- end;
-
- end.
-