function GetKbStatus():string; //返回当前键盘状态，包括NumLoce、Caps Lock、Insert //每个状态信息占两个字符，顺序为:NumLoce、Caps Lock、Insert //Copy Right 549@11:29 2003-7-22 var Status:string; KeyStates:TKeyboardState; begin GetKeyboardState(KeyStates); if Odd(KeyStates[VK_NUMLOCK])then Status:=''''数字'''' else Status:=''''光标''''; if Odd(KeyStates[VK_CAPITAL]) then Status:=status+''''大写'''' else Status:=status+''''小写''''; if Odd(KeyStates[VK_INSERT]) then Status:=status+''''插入'''' else Status:=status+''''改写''''; Result:=Status; end;
小技巧： const ErrHead=''''操作出现错误，错误信息为：''''+#13 try ... except on E: Exception do showmessage(ErrHead+E.Message+#13+''''当前操作为：xxxxx''''); end; 可以让用户看到更多的错误信息，有助于客户反馈程序错误。
俺写得比较菜的，但是经常用的就是：
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> //执行Sql //输入参数：SqlString, ADOQuery //类型： string, TADOQuery procedure TMainForm.ExeSql(SqlString: string; ADOQuery: TADOQuery); begin with ADOQuery do begin Connection := DM.DBAccinfo;//这个是我的，可以添加用的connection //或者用use也可以。 if Active then Active := False; Open; SQL.Clear; SQL.Add(SqlString); ExecSQL; Close; end; end;
可能大家都知道这个。不过，我见过的代码里面，
好像很少人这么来写这么独立出来一个过程。
这个保证我自己原创……
//Open Adoquery //根据reallike(爱翔(只有lizzy可以叫其他人不能)) 的过程改编 //支持多行sql //可根据需要自己修改成只支持单行sql的过程，或者exesql过程 //Delphi6下测试通过。 procedure OpenSql(SqlString: tstrings; ADOQuery: TADOQuery); var i:integer; begin with ADOQuery do begin Close; SQL.Clear; for i:=0 to sqlstring.Count-1 do SQL.Add(SqlString[i]); try Open; except on e:exception do showmessage(''''错误：信息如下''''+#13+e.Message); end; end; end; 这个是单行sql的 procedure OpenSql1(SqlString: string; ADOQuery: TADOQuery); begin with ADOQuery do begin Close; SQL.Clear; SQL.Add(SqlString); try Open; except on e:exception do showmessage(''''错误：信息如下''''+#13+e.Message); end; end; end; 嗬嗬，谢谢帮我修理这个东西。
不过你不使用Execsql吗？
我一般都在这个过程外面加try也就是引用他的地方。
也就是
Try Exesql(sqlstring, Adoquery1) except //错误提示，乱七八糟的东西。 end to: reallike(爱翔(只有lizzy可以叫其他人不能)) ExecSql的我也做了 //ExecSql Adoquery //支持多行sql //可根据需要自己修改成只支持单行sql的过程，或者exesql过程 //Delphi6下测试通过。 procedure ExeSql(SqlString: tstrings; ADOQuery: TADOQuery); var i:integer; begin with ADOQuery do begin Close; SQL.Clear; for i:=0 to sqlstring.Count-1 do SQL.Add(SqlString[i]); try ExecSql; except on e:exception do showmessage(''''错误：信息如下''''+#13+e.Message); end; end; end; //我觉得except放在哪里都一样，放在外面好一点，因为，你可以添加一些其他的调试信息 //你说呢？ //有没有人把执行单行和执行多行的这两个过程合并成一个，那样就好了。 我也来两个，可以根据自己的需要进行增删，不过是针对DBGridEh的：
//动态建立Col procedure BuildCol(vFieldName: string; vCaption: string; vWidth: Integer; var vGrid: TDBGridEh; iTag: Integer = 0; FooterType: TFooterValueType = fvtNon; FooterText: string = ''''''''; boolReadOnly: Boolean = True; vColor: TColor = clBtnFace); var cCol: TDBGridColumnEh; cFooterCol: TColumnFooterEh; begin cCol := TDBGridColumnEh.Create(vGrid.Columns); cCol.FieldName := vFieldName; cCol.Width := vWidth; cCol.Title.Caption := vCaption; cCol.Title.Alignment := taCenter; cCol.Title.Color := vColor; cCol.ReadOnly := boolReadOnly; //如果tag值为-1，则打印dbgrid时不打印该列 cCol.Tag := iTag;
if FooterType <> fvtNon then begin cFooterCol := cCol.Footers.Add; cFooterCol.ValueType := FooterType; if FooterType = fvtStaticText then begin vGrid.FooterRowCount := 1; cFooterCol.Value := FooterText; end; //cCol.Footer.FieldName:=; end; end;
procedure TitleBtnClick(Sender: TObject; ACol: Integer; Column: TColumnEh; cdsHelper: TClientDataSetHelper); var cdsTmp: TClientDataSet; begin with (Sender as TDBGridEh) do begin cdsTmp := (DataSource.DataSet as TClientDataSet); if not cdsTmp.Active then Exit; //设置当前行的排序方式 if Column.Title.SortMarker = smNoneEh then begin Column.Title.SortMarker := smUpEh; cdsHelper.SortByField(Column.FieldName, soAscending); end else if Column.Title.SortMarker = smUpEh then begin Column.Title.SortMarker := smDownEh; cdsHelper.SortByField(Column.FieldName, soDescending); end else begin Column.Title.SortMarker := smNoneEh; cdsHelper.SortByField(Column.FieldName, soNoSort); end; end; end;
将DBGrid中各列的位置以及宽度记录入Ini文件，以及从Ini文件读取DBGrid中各列位置以及宽度的函数 procedure f_ReadIni(const Now_DBGrid:TDBGrid;Form_Name:String); var FilePath:String; MyIniFile:Tinifile; Grid_Name,Field_Name:String; Width:integer; i,j,n:integer; Column:Array[0..100] of String; Widths:Array[0..100] of integer; begin FilePath := ExtractFilePath(Application.ExeName); MyIniFile:=TiniFile.Create(FilePath+''''gsp.ini''''); Grid_Name :=Form_Name+'''',''''+Now_DBGrid.Name; n:= Now_DBGrid.Columns.Count-1 ;
for i:=0 to 100 do column[i]:=''''''''; for i:=0 to n do begin Field_Name:=Now_DBGrid.Columns[i].FieldName; j:=MyIniFile.ReadInteger(Grid_Name,Field_Name,i); Column[j]:=Field_Name; Widths[j] :=MyIniFile.ReadInteger(Grid_Name,Field_Name+''''_Width'''',Now_DBGrid.Columns[i].Width); end;
for i:=0 to n do begin Now_DBGrid.Columns[i].FieldName := Column[i]; Now_DBGrid.Columns[i].Width := Widths[i]; end;
MyIniFile.Destroy; end;
procedure f_WriteIni(const Now_DBGrid:TDBGrid;Form_Name:String); var FilePath:String; MyIniFile:Tinifile; Grid_Name,Field_Name:String; Width:Integer; i:integer; begin FilePath := ExtractFilePath(Application.ExeName); MyIniFile:=TiniFile.Create(FilePath+''''gsp.ini''''); Grid_Name :=Form_Name+'''',''''+Now_DBGrid.Name;
for i:=0 to Now_DBGrid.Columns.Count-1 do begin Field_Name := Now_DBGrid.Columns[i].FieldName; Width := Now_DBGrid.Columns[i].Width; MyIniFile.WriteInteger(Grid_Name,Field_Name,i); MyIniFile.WriteInteger(Grid_Name,Field_Name+''''_Width'''',Width); end;
MyIniFile.Destroy; end;
很久以前写得的，现在我都用类封装了。 unit MyFunc;
interface uses Windows, SysUtils, MMSystem, WinSvc, Registry;
function CopyStrLeft(ch: Char; str: string): string; function CopyStrRight(ch: Char; str: string): string; function GetSelfPath: string; procedure HideTask(bHide: Boolean); function SoundCardInstalled: Boolean; function GetHostIP: String; procedure DisableSvc(SvcName: string); function GetRegisteredOwner: string; function GetRe
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
