📄 inherit.~pas
字号:
unit Inherit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ToolWin, ComCtrls, DB, ADODB, Grids, DBGrids, ExtCtrls,
DBCtrls, StdCtrls, Buttons,math, RpCon, RpConDS, RpDefine,RpRave,
RVClass,RVProj,RvCsRpt,RvDirectDataView,Excel2000,OleServer,ComObj,JPEG,
ExtDlgs,imm,Menus,strUtils;//NDCsJPEG,//****Rave报表引用Jpeg组件运行库****
type//imm输入法引用
// TShowDllForm=Procedure(DBGrid:TDBGrid;SheetName:pchar;pHandle:THandle);
TTInherit = class(TForm)
ToolBar1: TToolBar;
ImageList1: TImageList;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ADODataSet1: TADODataSet;
DataSource1: TDataSource;
DBNavigator1: TDBNavigator;
DBGrid1: TDBGrid;
ToolButton13: TToolButton;
BB: TRvProject;
BBDS: TADODataSet;
Rav: TEdit;
RavCN: TEdit;
ToolButton14: TToolButton;
SB1: TStatusBar;
ToolButton15: TToolButton;
SaveDialog1: TSaveDialog;
ToolButton16: TToolButton;
OpenDialog1: TOpenDialog;
ToolButton17: TToolButton;
ReplaceDialog1: TReplaceDialog;
FindDialog1: TFindDialog;
FFn1: TComboBox;
FFv1: TEdit;
Panel3: TPanel;
YSF: TComboBox;
RTF: TRichEdit;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Timer1: TTimer;
SavePictureDialog1: TSavePictureDialog;
TPopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
TPsize1: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton13Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
procedure FormCreate(Sender: TObject);
procedure Enables();
procedure ADODataSet1AfterScroll(DataSet: TDataSet);
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure FormResize(Sender: TObject);
procedure DBGrid1ColExit(Sender: TObject);
procedure ToolButton15Click(Sender: TObject);
// function ExportDBGrid(DBGrid:TDBGrid;SheetName:string;SaveDialog:TSaveDialog):boolean;
procedure ToolButton16Click(Sender: TObject);
procedure ToolButton17Click(Sender: TObject);
procedure ReplaceDialog1Find(Sender: TObject);
procedure ReplaceDialog1Replace(Sender: TObject);
procedure FFn1Change(Sender: TObject);
procedure ADODataSet1AfterOpen(DataSet: TDataSet);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure Image1DblClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ADODataSet1BeforeInsert(DataSet: TDataSet);
procedure ADODataSet1AfterInsert(DataSet: TDataSet);
procedure ADODataSet1AfterEdit(DataSet: TDataSet);
procedure FormActivate(Sender: TObject);
procedure BBCreate(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure DBGrid1Exit(Sender: TObject);
procedure DBGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
//Procedure CallDllForm(DBGrid:TDBGrid;SheetName:pchar;pHandle:Thandle);
// Procedure ReleaseCall;
private//直接保存，不显示EXCEL
{ Private declarations }
public
msg,searchstr,SRBFL,F1TP:string;j:tjpegimage;b:Tbitmap;
vsb:array of boolean;ColW:array of integer;
IMEopen:boolean;MyHKL:HKL;Fhandle1:integer;
end;
var
TInherit: TTInherit;// stdcall;//HandleCall:THandle;//BoolCall:Boolean;
//function ExportDBGrid(DBGrid:TDBGrid;SheetName:string):boolean;External 'F:\ExDLL\FN.dll';
implementation
uses Unit4, Unit3;
{$R *.dfm}
Function Msg1(Txt:string;Cap:string='警告!';uType:UINT=MB_OK):integer;
Begin
Msg1:=Application.MessageBox(PChar(Txt),PChar(Cap),uType);
End;
procedure TTInherit.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (ADODataSet1.State=dsEdit)or(ADODataSet1.State=dsInsert) then
Try ADODataSet1.Post;Except;End;
action:=cafree;
end;
procedure TTInherit.ToolButton1Click(Sender: TObject);//追加记录
begin ADODataSet1.Append;end;//DBNavigator1.BtnClick(nbInsert);
procedure TTInherit.ToolButton2Click(Sender: TObject);//编辑当前记录
begin DBNavigator1.BtnClick(nbEdit);end;
procedure TTInherit.ToolButton3Click(Sender: TObject);//删除当前记录
begin
if Form3.dj>='R' then exit;
if Msg1('确实要'+ToolButton3.Caption+'吗?','警告!',MB_OKCANCEL)<>MrOk
then exit;
DBNavigator1.BtnClick(nbDelete);
end;
procedure TTInherit.ToolButton4Click(Sender: TObject); //保存当前记录
begin DBNavigator1.BtnClick(nbPost);end;
procedure TTInherit.ToolButton5Click(Sender: TObject);//取消当前记录的修改
begin DBNavigator1.BtnClick(nbCancel);end;
procedure TTInherit.ToolButton6Click(Sender: TObject);//到首记录
begin DBNavigator1.BtnClick(nbFirst);end;
procedure TTInherit.ToolButton7Click(Sender: TObject);//上一条记录
begin DBNavigator1.BtnClick(nbPrior);end;
procedure TTInherit.ToolButton8Click(Sender: TObject);//下一条记录
begin DBNavigator1.BtnClick(nbNext);end;
procedure TTInherit.ToolButton9Click(Sender: TObject);//到最后一条记录
begin DBNavigator1.BtnClick(nbLast);end;
procedure TTInherit.ToolButton13Click(Sender: TObject);//刷新操作
Var Bm:TBookmarKstr;//i:integer;
begin //DBNavigator1.BtnClick(nbRefresh);//???
Bm:=ADODataSet1.Bookmark;//ADODataSet1.DisableControls;
ADODataSet1.Close;ADODataSet1.Open;
try ADODataSet1.Bookmark:=Bm;except;end;
Timer1.Enabled:=True;
//try ADODataSet1.EnableControls;except;end;//刷新后定位异常
end;
procedure TTInherit.ToolButton12Click(Sender: TObject);//关闭按钮
begin close;end;
procedure TTInherit.ToolButton11Click(Sender: TObject);//打印报表,不可用
var MyPage:TRavePage;MyRegion:TRaveRegion;myDataView:TRaveDataView;
begin BB.Close;
BB.ProjectFile:=ExtractFilePath(application.ExeName)+Rav.Text;
BB.Open;//myDataView:=BB.ProjMan.FindRaveComponent('Ts',nil) as TRaveDataView;
myDataView:=TRaveDataView(BB.ProjMan.Components[0]);
myDataView.ConnectionName:=RavCN.text;
With BB.ProjMan do
begin
MyPage:=FindRaveComponent('Report2.mainPage',nil) as TRavePage;//找页面对象
MyRegion:=FindRaveComponent('Region',MyPage) as TRaveRegion;//找页面区域对象
MyRegion.Left:=DM.ymleft+IfThen(RavCN.text='CZRKds',0.866,0);
MyRegion.Top:=DM.ymTop;Try//设置页面区域的左上角坐标
MyPage:=FindRaveComponent('Report2.Page1',nil) as TRavePage;//找页面对象
MyRegion:=FindRaveComponent('Region',MyPage) as TRaveRegion;//找页面区域对象
MyRegion.Left:=DM.ymleft;//设置页面区域的左上角坐标
MyRegion.Top:=DM.ymTop;Except;end;
end;
BB.Execute;BB.Close;
end;
procedure TTInherit.ToolButton10Click(Sender: TObject); //查找操作
begin FindDialog1.Execute;FHandle1:=findwindow(nil,'查找');
SetWindowText(FHandle1,PChar('查找"'+DBGrid1.SelectedField.DisplayName+'"列的内容'));
end;
procedure TTInherit.DBGrid1TitleClick(Column: TColumn);
var KS:TKeyboardState;DESC:boolean;
begin//单击列标题后按相应列递增排序
GetKeyboardState(KS);Desc:=KS[vk_shift]<128;//获得键盘状态
try//如何按Ctrl键则累加索引字段
if (KS[vk_Control]<128)or(ADODataSet1.IndexFieldNames='') then
ADODataSet1.IndexFieldNames:=Column.FieldName+ifThen(Desc,' DESC') else
ADODataSet1.IndexFieldNames:=ADODataSet1.IndexFieldNames+';'+Column.FieldName+ifThen(Desc,' DESC');
except
showmessage(ADODataSet1.IndexFieldNames+':无法排序!');
end;
end;
procedure TTInherit.FormCreate(Sender: TObject);
begin
if j=nil then j:=tjpegimage.Create;if b=nil then b:=TBitmap.Create;
Screen.Cursor:=crHourGlass;N2.Visible:=Form3.dj='A';
ADODataSet1.Close;
if ADODataSet1.CommandText<>'' then begin ADODataSet1.Open;Enables();end;
FormResize(Sender);
ToolBar1.ShowCaptions:=Form3.N51.Checked;
ToolBar1.ButtonWidth:=20+ord(Form3.N51.Checked)*11;
ToolBar1.ButtonHeight:=20+ord(Form3.N51.Checked)*16;
ToolBar1.Height:=22+ord(Form3.N51.Checked)*16;
FFn1.Top:=ord(Form3.N51.Checked)*7;FFv1.Top:=FFn1.Top;YSF.Top:=FFn1.Top;
end;
procedure TTInherit.Enables();
begin//控制哪些按钮可以操作
ToolButton2.Enabled:=ADODataSet1.State<>dsEdit;//编辑
ToolButton3.Enabled:=not ADODataSet1.IsEmpty;//删除
ToolButton4.Enabled:=(ADODataSet1.State=dsEdit)or(ADODataSet1.State=dsInsert);//保存
ToolButton5.Enabled:=(ADODataSet1.State=dsEdit)or(ADODataSet1.State=dsInsert);//取消
ToolButton13.Enabled:=not ADODataSet1.IsEmpty;//刷新
ToolButton6.Enabled:=not ADODataSet1.Bof;//最前
ToolButton7.Enabled:=not ADODataSet1.Bof;//向前
ToolButton8.Enabled:=not ADODataSet1.Eof;//向后
ToolButton9.Enabled:=not ADODataSet1.Eof;//最后
ToolButton10.Enabled:=(not ADODataSet1.IsEmpty)and(ADODataSet1.State=dsBrowse);//查找
ToolButton17.Enabled:=(not ADODataSet1.IsEmpty)and(ADODataSet1.State=dsBrowse);//替换
ToolButton15.Enabled:=ADODataSet1.State=dsBrowse;//导出
ToolButton16.Enabled:=ADODataSet1.State=dsBrowse;//导入
DBGrid1.Enabled:=not ADODataSet1.IsEmpty;//
case ADODataSet1.State of
dsBrowse:SB1.Panels[3].Text:='浏览状态';
dsEdit:SB1.Panels[3].Text:='编辑状态';
dsInsert:SB1.Panels[3].Text:='插入记录状态';
dsInactive:SB1.Panels[3].Text:='已关闭状态';
dsCalcFields:SB1.Panels[3].Text:='处理计算字段状态';
dsFilter:SB1.Panels[3].Text:='设置过滤器时的状态';
End;
end;
procedure TTInherit.ADODataSet1AfterScroll(DataSet: TDataSet);
var bF1TP:boolean;
begin
if not ADODataSet1.Active then exit;Enables();
SB1.Panels[1].Text:=Format('%d/%d',[ADODataSet1.RecNo,ADODataSet1.RecordCount]);
bF1TP:=ADODataSet1.FieldList.IndexOf(F1TP)>=0;
ToolButton14.Visible:=bF1TP;Image1.Enabled:=bF1TP;if not bF1TP then exit;
try
if j=nil then j:=tjpegimage.Create;//对象不存在时创建
if ADODataSet1.fieldbyname(F1TP).Value='' then
Begin image1.Picture.Graphic:=nil;
ToolButton14.Caption:=IfThen(F1TP='文件','程序','加图');
N3.Enabled:=false;TPsize1.Caption:='无图';exit;end;
try j.Assign(ADODataSet1.fieldbyname(F1TP));//读图片内容到tjpegimage对象
image1.Picture.Graphic:=j;except;end;
ToolButton14.Caption:='清除';N3.Enabled:=true;
TPsize1.Caption:=Format('%.0nB',[0.0+length(ADODataSet1.fieldbyname(F1TP).AsString)]);
except;end;//将图片内容送Image1组件显示//带千分位格式图片字节
end;
procedure TTInherit.DataSource1DataChange(Sender: TObject; Field: TField);
begin
Enables();
end;
procedure TTInherit.FormResize(Sender: TObject);
begin
DBGrid1.Width:=ClientWidth-DBGrid1.Left-8;
DBGrid1.Height:=ClientHeight-DBGrid1.Top-10-23;
end;
procedure TTInherit.DBGrid1ColExit(Sender: TObject);
begin //ToolButton14.Visible:=False;
end;
function ExportDBGrid0(DBGrid:TDBGrid;SheetName:string):boolean;//直接保存,不显示EXCEL
var c,r,i,j:integer;app:Olevariant;TempFN:string;BM:TBookMarkStr;RE:TRichEdit;
begin//Txt:TDBRichEdit;//引用：ComObj //改成DLL出问题
TempFN:=SheetName;
try
result:=True;app:=CreateOLEObject('Excel.application');
app.WorkBooks.Add(xlWBatWorkSheet);
except
Msg1('Excel没有正确安装！');result:=False;exit;
end;////若没有输入扩展名xls会自动补上,以便删除
app.Workbooks.add;app.Visible:=false;
BM:=DBGrid.DataSource.DataSet.Bookmark;
DBGrid.DataSource.DataSet.DisableControls;
DBGrid.DataSource.DataSet.First;c:=DBGrid.Columns.Count;
r:=DBGrid.DataSource.DataSet.RecordCount;
RE:=TRichEdit.Create(Application.MainForm);RE.Parent:=Application.MainForm;Re.Visible:=false;
// Txt:=TDBRichEdit.Create(Application.MainForm);Txt.Parent:=Application.MainForm;Txt.Visible:=false;
Application.ProcessMessages;//DBGrid.DataSource.DataSet.Fields[i].DisplayLabel;
try
for i:=0 to c-1 do Begin
app.cells(1,1+i):=DBGrid.Columns[i].Title.caption;//表头导出
app.WorkSheets[1].Columns[i+1].ColumnWidth:=dbGrid.Columns.Items[i].Width div 6;
if (DBGrid.Fields[i].DataType=ftWideString)or(DBGrid.Fields[i].DataType=ftString) then //ftSmallint
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -