博客园_jiangyuxuan

在Delphi中如何获得SQL中存储过程的返回值?

2012-03-22T16:54:00Z

示例存储过程：
create procedure proc_login
username varchar(20),
password varchar(20)
as
declare @result int
select @result=count(*) from loginuser where user=@username and pass=@password
if @result=0
return 0
return 1
go

Delphi代码：
var ret:integer;
......
      with ADOStoredProc1 do
        begin
          Close;
          ProcedureName:='proc_login';
          Parameters.Clear;
          Parameters.Refresh;
          Parameters.ParamByName('@username').Value:= Edit1.text;
          Parameters.ParamByName('@password').Value:= Edit2.text;
          ExecProc;
          ret:= Parameters.ParamByName('@return_value').Value;
        end;

      if ret=1 //用户名密码匹配
     begin
       //你想要的操作
      end

示例二

在delphi中取存储过程的返回值
   Close;
    SQL.Clear;
    SQL.Text:='declare @ReturnCount int exec Pr_SelStockHead '''+StockNo+''',@ReturnCount output select @ReturnCount';
    open;
    CountNO:=fields[0].value;
    cxtxtdtNameCSHYH.Text:=IntToStr(CountNO);
在sql语句里面如果有返回值的话,可以是用return 返回,,其他的都是参数返回,如果取参数的话从 Parameters[1].Value 开始,如果取return 的返回值要用Parameters[0].Value

调用存储过程的方法，用adodataset控件
function TfrmPower_Cut.HasNewPowerCutInfo: Boolean;
begin
Result := False;
with spPower_Cut do //spPower_Cut为Tadostoredproc控件
begin
    Close;
    ProcedureName := 'p_Has_PowerCut_Info';
    with Parameters do
    begin
      Clear;
      Refresh;
      ParamByName('@BiggestID').Direction := pdInputOutput;
      ParamByName('@BiggestID').Value := FPower_Cut_ID_Refresh;
      ParamByName('@NoProcess').Direction := pdInputOutput;
      ParamByName('@NoProcess').Value := FNoProcess;
      ParamByName('@IsPassTimeAndNoProc').Direction := pdInputOutput;
      ParamByName('@IsPassTimeAndNoProc').Value := FIsPassTimeAndNoProc;
      ParamByName('@IsNearestTime').Direction := pdInputOutput;
      ParamByName('@IsNearestTime').Value := FIsNearestTime;
      ParamByName('@IsDelete').Direction := pdInputOutput;
      ParamByName('@IsDelete').Value := FIsNearestTime;
      ParamByName('@Hour').Value := 3;
    end;
    Prepared;
    try
      ExecProc;
      if Parameters[0].Value <> FPower_Cut_ID_Refresh then
      begin
        FPower_Cut_ID_Refresh := Parameters[1].Value;
        Result := True;
      end;
      if Parameters[2].Value <> FNoProcess then
      begin
        FNoProcess := Parameters[2].Value;
        Result := True;
      end;
      if Parameters[3].Value <> FIsPassTimeAndNoProc then
      begin
        FIsPassTimeAndNoProc := Parameters[3].Value;
        Result := True;
      end;
      if Parameters[4].Value <> FIsNearestTime then
      begin
        FIsNearestTime := Parameters[4].Value;
        Result := True;
      end;
      if Parameters[5].Value <> FIsDelete then
      begin
        FIsDelete := Parameters[5].Value;
        Result := True;
      end;
    except
      on e: Exception do
        ShowMessage(e.Message);
    end;
end;
end;
存储过程
/*
功能: 判断数据库内是否有新的呼叫中心停电信息
参数: @BiggestID 客户端最大的记录ID,如果小于当前表中的ID,则返回最大的ID,客户端据此判断是否刷新
返回值: 无
*/
ALTER procedure p_Has_PowerCut_Info @BiggestID bigint=0 output, @NoProcess int=0 output,
@IsPassTimeAndNoProc int=0 output, @IsNearestTime int=0 output, @IsDelete int=0 output, @Hour int=3 as
begin
declare @tmp_ID bigint,@tmp_NoProcess int
select @tmp_ID=Power_Cut_ID from Power_Cut
if (@@error=0) and (@@rowcount>0)
    if @tmp_id>@BiggestID
      set @BiggestID=@tmp_ID
select @tmp_NoProcess=count(*) from Power_Cut where PC_ProcType=0
if (@@error=0) and (@@rowcount>0)
    set @NoProcess=@tmp_NoProcess
--超过发送时间未处理
select @IsPassTimeAndNoProc=count(case when (getdate()>PC_StartTime and PC_ProcType=0) then 1 end) from Power_Cut
--距离发送时间还有3小时未处理
select @IsNearestTime=count(case when (DATEDIFF(minute, getdate(), PC_StartTime)>=0 and DATEDIFF(minute, getdate(), PC_StartTime)<@Hour*60
    and PC_ProcType=0) then 1 end) from Power_Cut
select @IsDelete=count(*) from Power_Cut where PC_State=2
return @BiggestID
end
return 返回的是正确或错误的标志,比如 100: 成功 0: 失败(未知原因) 1: 参数错误 2: .... 然后参数里面返回具体需要的数据

本文链接

Delphi StringGrid使用全书

2012-03-06T16:02:00Z

StringGrid行列的增加和删除
type
TExCell = class(TStringGrid)

public
procedure DeleteRow(ARow: Longint);
procedure DeleteColumn(ACol: Longint);
procedure InsertRow(ARow: LongInt);
procedure InsertColumn(ACol: LongInt);
end;

procedure TExCell.InsertColumn(ACol: Integer);
begin
ColCount :=ColCount +1;
MoveColumn(ColCount-1, ACol);
end;

procedure TExCell.InsertRow(ARow: Integer);
begin
RowCount :=RowCount +1;
MoveRow(RowCount-1, ARow);
end;

procedure TExCell.DeleteColumn(ACol: Longint);
begin
MoveColumn(ACol, ColCount -1);
ColCount := ColCount - 1;
end;

procedure TExCell.DeleteRow(ARow: Longint);
begin
MoveRow(ARow, RowCount - 1);
RowCount := RowCount - 1;
end;

如何编写使StringGrid中的一列具有Check功能，和CheckBox效果一样
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids;

type
TForm1 = class(TForm)
grid: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure gridClick(Sender: TObject);

private
{ Private declarations }

public
{ Public declarations }

end;

var
Form1: TForm1;
fcheck,fnocheck:tbitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
i:SmallInt;
bmp:TBitmap;
begin
FCheck:= TBitmap.Create;
FNoCheck:= TBitmap.Create;
bmp:= TBitmap.create;
try
　 bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));
　 With FNoCheck Do Begin
width := bmp.width div 4;
height := bmp.height div 3;
canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );
　 End;
With FCheck Do Begin
　 width := bmp.width div 4;
　 height := bmp.height div 3;
　 canvas.copyrect(canvas.cliprect, bmp.canvas, rect( width, 0, 2*width, height ));
End;
finally
　 bmp.free
end;
end;

procedure TForm1.gridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if not (gdFixed in State) then
　 with TStringGrid(Sender).Canvas do
begin
　 brush.Color:=clWindow;
　 FillRect(Rect);
　 if Grid.Cells[ACol,ARow]='yes' then
Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FCheck )
　 else
Draw( (rect.right + rect.left - FCheck.width) div 2, (rect.bottom + rect.top - FCheck.height) div 2, FNoCheck );
end;
end;

procedure TForm1.gridClick(Sender: TObject);
begin
if grid.Cells[grid.col,grid.row]='yes' then
　 grid.Cells[grid.col,grid.row]:='no'
else
　 grid.Cells[grid.col,grid.row]:='yes';
end;

end.

StringGrid组件Cells内容分行显示在Tstringgrid.ondrawcell事件中

DrawText(StringGrid1.Canvas.Handle,pchar(StringGrid1.Cells[Acol,Arow]),Length(StringGrid1.Cells[Acol,Arow]),Rect,DT_WORDBREAK or DT_LEFT);

可以实现文字换行！

在StringGrid怎样制作只读的列在 OnSelectCell事件处理程序中,加入: (所有的列均设成可修改的)

if Col mod 2 = 0 then
　 grd.Options := grd.Options + [goEditing]
else
　 grd.Options := grd.Options - [goEditing];

stringgrid从文本读入的问题（Save/Load a TStringGrid to/from a file?）stringgrid从文本读入的问题

// Save a TStringGrid to a file
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
i, k: Integer;
begin
AssignFile(f, FileName);
Rewrite(f);
with StringGrid do
begin
　 // Write number of Columns/Rows
　 Writeln(f, ColCount);
　 Writeln(f, RowCount);
　 // loop through cells
　 for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
　 Writeln(F, Cells[i, k]);
end;
CloseFile(F);
end;

// Load a TStringGrid from a file
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
iTmp, i, k: Integer;
strTemp: String;
begin
AssignFile(f, FileName);
Reset(f);
with StringGrid do
begin
　 // Get number of columns
　 Readln(f, iTmp);
　 ColCount := iTmp;
　 // Get number of rows
　 Readln(f, iTmp);
　 RowCount := iTmp;
　 // loop through cells & fill in values
　 for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
begin
　 Readln(f, strTemp);
　 Cells[i, k] := strTemp;
end;
　 end;
CloseFile(f);
end;

// Save StringGrid1 to 'c:.txt':
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveStringGrid(StringGrid1, 'c:.txt');
end;

// Load StringGrid1 from 'c:.txt':
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadStringGrid(StringGrid1, 'c:.txt');
end;

*******************************************

打开一个已有的文本文件,并将内容放到stringgrid中,文本行与stringgrid行一致;
在文本中遇到空格则放入下一cells.
搞定！注意，我只写了一个空格间隔的，你自己修改一下splitstring可以用多个空格分隔！

procedure TForm1.Button1Click(Sender: TObject);
var
aa,bb:tstringlist;
i:integer;
begin
aa:=tstringlist.Create;
bb:=tstringlist.Create;
aa.LoadFromFile('c:.txt');
for i:=0 to aa.Count-1 do
begin
　 bb:=SplitString(aa.Strings[i],' ');
　 stringgrid1.Rows[i]:=bb;
end;
aa.Free;
bb.Free;
end;

其中splitstring为：

function SplitString(const source,ch:string):tstringlist;
var
temp:string;
i:integer;
begin
result:=tstringlist.Create;
temp:=source;
i:=pos(ch,source);
while i<>0 do
begin
　 result.Add(copy(temp,0,i-1));
　 delete(temp,1,i);
　 i:=pos(ch,temp);
end;
result.Add(temp);
end;

StringGrid组件Cells内容对齐

在StringGrid的DrawCell事件中添加类似的代码就可以了：

VAR
vCol, vRow : LongInt;
begin
vCol := ACol; vRow := ARow;
WITH Sender AS TStringGrid, Canvas DO
　 IF vCol = 2 THEN BEGIN ///对于第2列设置为右对齐
SetTextAlign(Handle, TA_RIGHT);
FillRect(Rect);
TextRect(Rect, Rect.RIGHT-2, Rect.Top+2, Cells[vCol, vRow]);
　 END;
end;

当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行，则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？当我将StringGird的options属性中包含goRowSelect项时每当我选中StringGrid中一行，则选中行用深蓝色显示，我想将深蓝色改为其他颜色应怎样该？
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
With StringGrid1 do
begin
　 If　(ARow= Krow) and not (acol = 0) then
　 begin
　Canvas.Brush.Color :=clYellow;// ClBlue;
　Canvas.FillRect(Rect);
　Canvas.font.color:=ClBlack;
　Canvas.TextOut(rect.left , rect.top, cells[acol, arow]);
　 end;
end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
krow := Arow;　//*
kcol := Acol;
end;　

注意：必须把变量KROW的值初始为1或其他不为0的值，否则如果锁定第一行的话，第一行的颜色将被自设颜色取代，而锁定行不会被重画。

怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.怎么改变StringGrid控件某一列的背景和某一列的只读属性,StringGrid控件标题栏的对齐.
请参考以下代码：
在OnDrawCell事件中处理背景色。程序如下：
//将第二列背景变为红色。
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if not((acol=1) and (arow>=stringgrid1.fixedrows)) then exit;
with stringgrid1 do
begin
　 canvas.Brush.color:=clRed;
　 canvas.FillRect(Rect);
　 canvas.TextOut(rect.left+2,rect.top+2,cells[acol,arow])
end;
end;

//加入如下代码,那么StringGrid的第四列就只读了.其他列非只读
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
with StringGrid1 do begin
　 if ACol = 4 then
Options := Options - [goEditing]
　 else Options := Options + [goEditing];
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
dx,dy:byte;
begin
if (acol = 4) and not (arow = 0) then
　 with stringgrid1 do
　 begin
canvas.Brush.color := clYellow;
canvas.FillRect(Rect);
canvas.font.color := clblue;
dx:=2;//调整此值，控制字在网格中显示的水平位置
dy:=2;//调整此值，控制字在网格中显示的垂直位置
canvas.TextOut(rect.left+dx , rect.top+dy , cells[acol, arow]);
　 end;
//控制标题栏的对齐
if (arow = 0) then
　 with stringgrid1 do
　 begin
canvas.Brush.color := clbtnface;
canvas.FillRect(Rect);
dx := 12; //调整此值，控制字在网格中显示的水平位置
dy := 5; //调整此值，控制字在网格中显示的垂直位置
canvas.TextOut(rect.left + dx, rect.top + dy, cells[acol, arow]);
　 end;
end;　

在stringGrid中使用回车键模拟TAB键切换单元格的功能实现......procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
label
nexttab;
begin
if key=#13 then
begin
　 key:=#0;
　 nexttab:
　 if (stringgrid1.Col begin
　 stringgrid1.Col:=stringgrid1.Col+1;
end
　 else
　 begin
if stringgrid1.Row>=stringgrid1.RowCount-1 then
　 stringgrid1.RowCount:=stringgrid1.rowCount+1;
stringgrid1.Row:=stringgrid1.Row+1;
stringgrid1.Col:=0;
goto nexttab;
　 end;
end;
end;
.........　

stringgrid如何清空
with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear;

选中某单元格,然后在该单元格中修改-> 选中某单元格,然后在该单元格中修改设置属性:
　 StringGrid1.Options:=StringGrid1.Options+[goEditing];

让记录在StringGrid中分页显示在Uses中加入： ADOInt
//首先设定PageSize，取出PageCount
procedure TForm1.Button1Click(Sender: TObject);
begin
ADoquery1.Recordset.PageSize :=spinedit1.Value;
Edit1.Text := IntToStr(ADoquery1.Recordset.PageCount);
ShowData(spinedit2.Value);
end;

//然后将AbsolutePage的数据乾坤大挪移到StringGrid1中
procedure TForm1.ShowData(page:integer);
var
iRow, iCol, iCount : Integer;
rs : ADOInt.Recordset;
begin
ADoquery1.Recordset.AbsolutePage:=Page;
Currpage:=page;　
iRow := 0;
iCol := 1;
stringgrid1.Cells[iCol, iRow] := 'FixedCol1';
Inc(iCol);
stringgrid1.Cells[iCol, iRow] := 'FixedCol2';
Inc(iRow);
Dec(iCol);
rs := adoquery1.Recordset;
for iCount := 1 to SpinEdit1.Value do
begin
　 stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
　 Inc(iCol);
　 stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
　 Inc(iRow);
　 Dec(iCol);
　 rs.MoveNext;
end;
　
//上一页
procedure TForm1.Button2Click(Sender: TObject);
begin
If (CurrPage)<>1 then
　 ShowData(CurrPage-1);
end;

//下一页
procedure TForm1.Button3Click(Sender: TObject);
begin
If CurrPage<>ADoquery1.Recordset.PageCount then
　 ShowData(CurrPage+1);
end;

打印StringGrid的程序源码这段代码没有看懂，但是可能有的朋友需要，所以共享一下子：）
procedure TForm1.SpeedButton11Click(Sender: TObject);
Var
Index_R ,ALeft: Integer;
Index : Integer;
begin
StringGrid_File('D:\AAA.TXT');
if Not LinkTextFile then
begin
　 ShowMessage('失败');
　 Exit;
end;
//
QuickRep1.DataSet := ADOTable1;
Index_R := ReSize(StringGrid1.Width);
ALeft := 13;
Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[0].Width,20,
HeaderControl1.Sections[0].Text,taLeftJustify);
with Create_QRDBText(DetailBand1,ALeft,8,StringGrid1.ColWidths[0],20,
StringGrid1.Font,taLeftJustify) do
begin
　 DataSet := ADOTable1;
　 DataField := ADOTable1.Fields[0].DisplayName;
end;
ALeft := ALeft + StringGrid1.ColWidths[0] * Index_R + Index_R;
For Index := 1 to ADOTable1.FieldCount - 1 do
begin
　 Create_VLine(TitleBand1,ALeft - 13,16,1,40);
　 Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[Index].Width,20,
HeaderControl1.Sections[Index].Text,taLeftJustify);
　 Create_VLine(DetailBand1,ALeft - 13,-1,1,31);
　 with Create_QRDBText(DetailBand1,ALeft ,8,StringGrid1.ColWidths[Index] * Index_R,20,
StringGrid1.Font,taLeftJustify) do
　 begin
DataSet := ADOTable1;
DataField := ADOTable1.Fields[Index].DisplayName;
　 end;
　 ALeft := ALeft + StringGrid1.ColWidths[Index] *　Index_R + Index_R;
end;
QuickRep1.Preview;
end;

function TForm1.ReSize(AGridWidth: Integer): Integer;
begin
Result := Trunc(718 / AGridWidth);
end;

function TForm1.StringGrid_File(AFileName: String): Boolean;
var
StrValue : String;
Index : Integer;
ACol , ARow : Integer;
AFileValue : System.TextFile;
begin
StrValue := '';
Try
　 AssignFile(AFileValue , AFileName);
　 ReWrite(AFileValue);
　 StrValue := HeaderControl1.Sections[0].Text;
　 For Index := 1 to HeaderControl1.Sections.Count - 1 do
StrValue := StrValue + ',' + HeaderControl1.Sections[Index].Text;
　 Writeln(AFileValue,StrValue);
　 StrValue := '';
　 For　ARow := 0 To StringGrid1.RowCount - 1 do
　 begin
StrValue := '';
StrValue := StringGrid1.Cells[0,ARow];
For ACol := 1 To StringGrid1.ColCount - 1 do
begin
　 StrValue := StrValue + ', ' + StringGrid1.Cells[ACol,ARow];
end;
Writeln(AFileValue,StrValue);
　 end;
Finally
　 CloseFile(AFileValue);
end;
end;

function TForm1.LinkTextfile: Boolean;
begin
Result := False;
with ADOTable1 do
begin
　 {ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
　 'Data Source= D:\;Extended Properties=Text;' +
　 'Persist Security Info=False';
　 TableName := 'AAA#TXT';
　 Open;　 }
　 if Active then
Result := True;
end;
end;

function TForm1.Create_QRDBText(Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer; AFont: TFont; AAlignMent: TAlignment): TQRDBText;
var
AQRDBText : TQRDBText;
begin
AQRDBText := TQRDBText.Create(Nil);
with AQRDBText do
begin
　 Parent := Sender;
　 Left := ALeft;
　 Top := ATop;
　 Width := AWidth;
　 Height := AHight;
　 AlignMent := AAlignMent;
　 Font.Assign(AFont);
end;
Result := AQRDBText;
end;

function TForm1.Create_VLine(Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer): TQRShape;
var
AQRShapeV : TQRShape;
begin
AQRShapeV := TQRShape.Create(Nil);
with AQRShapeV do
begin
　 Parent := Sender;
　 Left := ALeft;
　 Top := ATop;
　 Width := AWidth;
　 Height := AHight;
end;
Result := AQRShapeV;
end;

procedure TForm1.Create_Title(Sender: TWinControl; ALeft, ATop, AWidth,
AHight: Integer; ACaption: String; AAlignMent: TAlignment);
var
AQRLabel : TQRLabel;
begin
AQRLabel := TQRLabel.Create(Nil);
with AQRLabel do
begin
　 Parent := Sender;
　 Left := ALeft;
　 Top := ATop;
　 Width := AWidth;
　 AlignMent := AAlignMent;
　 Caption := ACaption;
end;
end;

本文链接

delphi 数据导出进度条自己生成

2012-03-04T10:49:00Z

unit U_func;

interface
uses forms,SysUtils,ComCtrls,DBGrids,DB,Dialogs,Messages,Windows,ComObj,Controls,ADODB,StdCtrls,Graphics;

function ProgressBarform(max:integer):tProgressBar;
function ExportToExcel(dbgrid:tdbgrid):boolean;
function queryExportToExcel(queryexport:tadoquery):boolean;

implementation

//生成一个显示进度条的窗体
function ProgressBarform(max:integer):tProgressBar;
   var
       ProgressBar1:TProgressBar;
       form:tform;
   begin
       application.CreateForm(tform,form);
       form.Position:=poScreenCenter;
       form.BorderStyle:=bsnone;
       form.Height:=30;
       form.Width:=260;
       ProgressBar1:=TProgressBar.Create(form);
       ProgressBar1.Visible:=true;
       ProgressBar1.Smooth:=true;
       ProgressBar1.Max:=max;
       ProgressBar1.ParentWindow:=form.Handle;
       ProgressBar1.Height:=20;
       ProgressBar1.Width:=250;
       ProgressBar1.Left:=form.Left+5;
       ProgressBar1.Top:=form.Top+5;
       ProgressBar1.Step:=1;
       form.show;
       result:=ProgressBar1;
   end;

//将DBGRID中的内容导入到EXCEL中
function ExportToExcel(dbgrid:tdbgrid):boolean;
   const
       xlNormal=-4143;
   var
       i,j,k:integer;
       str,filename:string;
       excel:OleVariant;
       SavePlace:    TBookmark;
       savedialog:tsavedialog;
       ProgressBar1:TProgressBar;
   begin
       result:=false;
       filename:='';
       if   dbgrid.DataSource.DataSet.RecordCount>65536    then
             begin
                 if application.messagebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno    then
                    exit;
             end;
       screen.Cursor:=crHourGlass;
       try
           excel:=CreateOleObject('Excel.Application');
           excel.workbooks.add;
       except
           screen.cursor:=crDefault;
           showmessage('无法调用Excel！');
           exit;
       end;
       savedialog:=tsavedialog.Create(nil);
       savedialog.Filter:='Excel文件(*.xls)|*.xls';
       if    savedialog.Execute    then
             begin
                 if    FileExists(savedialog.FileName)    then
                       try
                           if    application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes    then
                                 DeleteFile(PChar(savedialog.FileName))
                           else
                                 begin
                                     Excel.Quit;
                                     savedialog.free;
                                     screen.cursor:=crDefault;
                                     Exit;
                                 end;
                       except
                           Excel.Quit;
                           savedialog.free;
                             screen.cursor:=crDefault;
                           Exit;
                       end;
                 filename:=savedialog.FileName;
             end;
       savedialog.free;
       application.ProcessMessages;
       if    filename=''    then
             begin
                 result:=false;
                 Excel.Quit;
                 screen.cursor:=crDefault;
                 exit;
             end;
       k:=0;
       for    i:=0    to    dbgrid.Columns.count-1    do
           begin
               if    dbgrid.Columns.Items[i].Visible    then
                     begin
                         //Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;
                         excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;
                         inc(k);
                     end;
           end;

       dbgrid.DataSource.DataSet.DisableControls;
       saveplace:=dbgrid.DataSource.DataSet.GetBookmark;
       dbgrid.DataSource.dataset.First;
       i:=2;
       if    dbgrid.DataSource.DataSet.recordcount>65536    then
             ProgressBar1:=ProgressBarform(65536)
       else
             ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.recordcount);
       while    not    dbgrid.DataSource.dataset.Eof    do
           begin
               k:=0;
               for    j:=0    to    dbgrid.Columns.count-1    do
                   begin
                       if    dbgrid.Columns.Items[j].Visible    then
                             begin
                                 excel.cells[i,k+1].NumberFormat:='@';
                                 if    not    dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull    then
                                       begin
                                           str := dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;
                                           Excel.Cells[i, k + 1] := Str;
                                       end;
                                 inc(k);
                             end
                       else
                             continue;
                   end;
               if    i=65536    then
                     break;
               inc(i);
               ProgressBar1.StepBy(1);
               dbgrid.DataSource.dataset.next;
           end;
       progressbar1.Owner.Free;
       application.ProcessMessages;
       dbgrid.DataSource.dataset.GotoBookmark(SavePlace);
       dbgrid.DataSource.dataset.EnableControls;

       try
           if    copy(FileName,length(FileName)-3,4)<>'.xls'    then
                 FileName:=FileName+'.xls';
           Excel.ActiveWorkbook.SaveAs(FileName,xlNormal,'', '',False,False);
       except
           Excel.Quit;
             screen.cursor:=crDefault;
           exit;
       end;
       //Excel.Visible    :=    true;
       Excel.Quit;
       screen.cursor:=crDefault;
       Result:= true;
   end;

//将ADOQUERY的数据集导入到EXCEL中
function queryExportToExcel(queryexport:tadoquery):boolean;
   const
       xlNormal=-4143;
   var
       i,j,k:integer;
       str,filename:string;
       excel:OleVariant;
       savedialog:tsavedialog;
       ProgressBar1:TProgressBar;
   begin
       result:=false;
       filename:='';
       if   queryexport.RecordCount>65536    then
             begin
                 if    application.messagebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？','询问',mb_yesno+mb_iconquestion)=idno    then
                       exit;
             end;
       screen.Cursor:=crHourGlass;
       try
           excel:=CreateOleObject('Excel.Application');
           excel.workbooks.add;
       except
             screen.cursor:=crDefault;
           showmessage('无法调用Excel！');
           exit;
       end;
       savedialog:=tsavedialog.Create(nil);
       savedialog.Filter:='Excel文件(*.xls)|*.xls';
       if    savedialog.Execute    then
             begin
                 if    FileExists(savedialog.FileName)    then
                       try
                           if    application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes    then
                                 DeleteFile(PChar(savedialog.FileName))
                           else
                                 begin
                                     Excel.Quit;
                                     savedialog.free;
                                     screen.cursor:=crDefault;
                                     Exit;
                                 end;
                       except
                           Excel.Quit;
                           savedialog.free;
                             screen.cursor:=crDefault;
                           Exit;
                       end;
                 filename:=savedialog.FileName;
             end;
       savedialog.free;
       application.ProcessMessages;
       if filename='' then
          begin
             result:=false;
             Excel.Quit;
             screen.cursor:=crDefault;
             exit;
          end;
       k:=0;
       for i:=0 to queryexport.FieldCount-1    do
           begin
            excel.cells[1,k+1]:=queryexport.Fields[i].FieldName;
            inc(k);
           end;
       queryexport.First;
       i:=2;
       if    queryexport.recordcount>65536    then
             ProgressBar1:=ProgressBarform(65536)
       else
             ProgressBar1:=ProgressBarform(queryexport.recordcount);
       while    not    queryexport.Eof    do
           begin
               k:=0;
               for j:=0 to queryexport.FieldCount-1    do
                   begin
                      excel.cells[i,k+1].NumberFormat:='@';
                      if not queryexport.fieldbyname(queryexport.Fields[j].FieldName).isnull    then
                         begin
                            str:=queryexport.fieldbyname(queryexport.Fields[j].FieldName).AsString;
                            Excel.Cells[i,    k    +    1]    :=    Str;
                         end;
                   inc(k);
                   end;
               if i=65536 then
                  break;
               inc(i);
               ProgressBar1.StepBy(1);
               queryexport.next;
           end;
       progressbar1.Owner.Free;
       application.ProcessMessages;
       try
           if copy(FileName,length(FileName)-3,4)<>'.xls' then
              FileName:=FileName+'.xls';
           Excel.ActiveWorkbook.SaveAs(FileName,xlNormal,'', '',False,False);
       except
           Excel.Quit;
             screen.cursor:=crDefault;
           exit;
       end;
       //Excel.Visible    :=    true;
       Excel.Quit;
       screen.cursor:=crDefault;
       Result := true;
   end;

end.

本文链接

delphi执行查询语句时的进度条怎么做

2012-03-04T10:01:00Z

procedure TForm1.FormCreate(Sender: TObject);
begin
ADOQuery1.ExecuteOptions := [eoAsyncFetch];//设为异步读取
end;
//ADOQuery的OnFetchProgress事件
procedure TForm1.ADOQuery1FetchProgress(DataSet: TCustomADODataSet; Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
begin
ProgressBar1.Position := Progress;
ProgressBar1.Max := MaxProgress;
end;
//ADOQuery的OnFetchComplete事件
procedure TForm1.ADOQuery1FetchComplete(DataSet: TCustomADODataSet; const Error: Error; var EventStatus: TEventStatus);
begin
ProgressBar1.Position := ProgressBar1.Max;
ShowMessage('OK');
end;

本文链接

Delphi中动态链接库(DLL)的建立和使用

2012-02-07T15:44:00Z

动态链接库是一个能够被应用程序和其它的DLL调用的过程和函数的集合体,它里面包含的是公共代码或资源。由于 DLL代码使用了内存共享技术,在某些地方windows也给了DLL一些更高的权限,因而DLL中可以实现一些一般程序所不能实现的功能,如实现 windows的HOOK、ISAPI等。同时,DLL还为不同语言间代码共享提供了一条方便的途径。因而DLL在编程时应用较为广泛,本文将介绍如何在 Delphi 中建立和使用DLL。

一．DLL 库内存共享机制

从使用效果看,DLL和unit 很像,它们都可以被别的工程模块所调用,但二者在内部的实现机制上确存在着差别。如果一个程序模块中用uses语句引用了某个unit,编译程序在编译该模块时,便会连同unit一起编译,并把编译后的可执行代码链接到本程序模块中,这就是一个程序模块能够调用所引用unit中过程和函数的原因。当同一个 unit被多个工程所引用时,则每个工程中都含有该unit的可执行代码,当含有该unit的多个工程同时执行时,unit的可执行代码会随不同工程而多次被调入内存,造成内存资源的浪费。DLL则不同,它即使被某个工程调用,编译后仍是独立的,也就是说编译后,一个DLL库形成一个单独的可执行文件,而不与任何其它的可执行文件连接在一起,因而DLL库并不从属于某个特定的工程,当多个工程调用同一个DLL库时只有第一个工程把DLL库调入内存,其余工程并不重复调入同一个DLL库到内存,而是到同一个共享内存区读取。并且,DLL的执行代码是在程序运行期间动态调入的,而不是如unit在程序运行时就与整个工程一起调入内存。这样便可消除unit带来的相同代码多处占用内存的弊病。

二 Delphi中DLL库的建立

在Delphi环境中,编写一个DLL同编写一个一般的应用程序并没有太大的区别。事实上作为DLL主体的DLL函数的编写,除了在内存、资源的管理上有所不同外,并不需要其它特别的手段。

一般工程文件的格式为:

program工程标题;　

uses子句;　

程序体

而DLLs工程文件的格式为:

library 工程标题;　

uses 子句;　

exprots 子句;　

程序体

它们主要的区别有两点:

1.一般工程文件的头标用program关键字,而DLL工程文件头标用library 关键字。不同的关键字通知编译器生成不同的可执行文件。用program关键字生成的是.exe文件,而用library关键字生成的是.dll文件;

2.假如DLL要输出供其它应用程序使用的函数或过程,则必须将这些函数或过程列在exports子句中。而这些函数或过程本身必须用export编译指令进行编译。

在Delphi主菜单file 中选new...项,在弹出的窗口中双击DLL图标,便会自动给出DLL源模块框架,如下:

Library project1;

{...注释...}

uses

SysUtils, Classes;

begin

end.　

接下来便可在USES和begin之间加入想在该DLL中实现的过程和函数的定义,并用export和exprots保字把它们引出,以便别的模块引用,在begin和end之间加入初始化代码,初始化代码是用来对DLL变量初始化的。应注意,即便无初始化代码begin与end也不可省略,如下例:

library minmax;

function Min(X, Y: Integer): Integer; export;

begin

if X < Y then Min := X else Min := Y;

end;

function Max(X, Y: Integer): Integer; export;

begin

if X > Y then Max := X else Max := Y;

end;

exports

Min index 1,

Max index 2;

begin

end.

经编译后,并以minmax.DLL存盘后,一个DLL库文件便形成了。

三 DLL库的访问

访问DLL库有两种方式,一种是静态引用,另一种是动态引用。

用静态引用这种方法装入DLL要做两件事情:为DLL 库创建一个输入单元,以及用USES把输入单元连接到要使用DLL 函数的程序模块中。为DLL库创建的输入单元与普通的单元的区别仅在于:在它的接口处声明的过程、函数,并不在它的实现部分给出真正的实现代码,而是用 external关键字把过程、函数的实现细节委托给外部DLL模块。

external命令的使用语法如下:

procedure /function 过程/函数名;external DLL模块名;

下面给出为上面创建的minmax.DLL库写的输入单元源文件testdll .pas,从中可看出输入单元与一般单元的一些差别,代码如下所示:

unit testdll;

interfacuses

function Min (X, Y: Integer): Integer;

function Max (X, Y: Integer): Integer;　

implementation　

function Min; external ‘minmax.DLL’;

function Max; external ‘minmax.DLL’;

end.　

一个应用程序若想调用minmax.DLL中的函数,只须在其uses语句中加入testdll 单元即可。

动态装入DLL,要用到Windows的三个API函数。Loadlibrary、Freelibrary和GetprocAddress 。loadlibrary函数用来装入DLL库,其调用格式如下:

function loadlobrary (DLLfileName:Pchar): THandle:

当不再需要一个DLL库时,应调用FreeLibrary函数将其释放,以空出宝贵的内存资源,其调用格式如下:

procedure FreeLibrary (Libmodule:THandle)

Libmodule 为由LoadLibrary调用得到的DLL库句柄。在用loadlobrary 函数装入某个DLL库和调用FreeLibrary释放该DLL库之间的程序段中, 可以使用该DLL库中的过程和函数,具体使用方法是:用GetprocAddress函数把DLL库中函数的地址传递给程序中某个函数变量,再用该变量实现DLL函数的调用。GetprocAddress函数声名如下,

function GetprocAddress (Libmodule:THandle:procname:pchar):TFarProc:　

如下例所示:

type

TTimeRec = record

Second: Integer;

Minute: Integer;

Hour: Integer;

end;

TGetTime = procedure(var Time: TTimeRec);

THandle = Integer;

var

Time: TTimeRec;

Handle: THandle;

GetTime: TGetTime;

...

begin

Handle := LoadLibrary('DATETIME.DLL');

if Handle <> 0 then

begin

@GetTime := GetProcAddress(Handle, 'GetTime');

if @GetTime <> nil then

begin

GetTime(Time);

with Time do

WriteLn('The time is ', Hour, ':', Minute, ':', Second);

end;

FreeLibrary(Handle);

end;

end;

在调用动态链接库时应注意, 所需动态链接库须与应用程序在同一目录或Windows System 目录下。动态链接库是 Windows下程序组织的一种重要方式,使用动态链接库可以极大地保护用户在不同开发工具、不同时期所做的工作,提高编程效率。

本文链接

术语表

2012-02-06T04:59:00Z

这里列出了本书中用到的一些技术术语，在别的地方你也能找到它们，不过我想还是把它们集中一处，以便查找。

堆(内存)

堆表示程序可用的内存区，也叫动态内存区。堆内存的分配与释放次序是随机的，这就是说，如果你按次序分配三块内存，那么到时并不按分配时的次序释放内存。堆管理器会负责所有操作，你只需简单地使用GetMem 函数请求新内存或调用constructor 建立对象， Delphi 会返回一个新的内存块(随意重用已经丢弃的内存块)。

堆是应用程序可用的三种内存区之一，其它两种分别是全局内存区(存放全程变量) 和栈。与堆相反，全程变量内存在程序启动时就分配，然后一直保留到程序终止才释放；栈的内容请详见术语表。

Delphi 使用堆为对象、字符串、动态数组及特殊的动态内存请求(GetMem)内存分配。

Windows 应用程序的地址空间最大允许有 2 GigaByte, 其中大部分能被堆使用。

栈(内存)

栈表示程序可用的内存区，栈内存动态分配，并按特定次序分配、释放。栈内存按后进先出次序(LIFO)分配，这表示最后分配的内存区先被释放。栈内存一般在例程中使用(过程、函数及方法调用)。当你调用例程时，例程参数及返回值是放在栈中的(除非使用Delphi缺省调用方式，对调用过程进行优化)。此外，例程中声明的变量(在begin语句前的 var 块中)也存放在栈中，所以当例程终止时，这些变量会被自动清除(在返回调用点之前以LIFO次序释放)。

栈是应用程序可用的三种内存区之一，其它两种分别是全局内存区和堆。堆的内容请详见术语表。

Delphi 使用栈存放例程参数及其返回值(除非你使用Delphi缺省的 register 调用协定)、局部例程变量、Windows API 函数调用等等。

Windows 应用程序可以预留大量的栈内存，在 Delphi 中你可以通过工程选项的 linker 页设置, 不过一般采用缺省设置就可以了。如果你收到一个栈溢出错误信息，这可能是因为你的函数进入了死循环自调用，而不是栈空间太小。

其它

Dynamic
Static
Virtual
memory leak
painting
literal
array
API
class reference
class method
parent
owner
self

本文链接

Variant类型

2012-02-06T04:58:00Z

为了完全支持OLE，32位Delphi 增加了Variant 数据类型，本节将从宏观角度来分析这种数据类型。实际上，Variant类型对Pascal语言有普遍而深入的影响，Delphi 控件库中与OLE 无关的地方也使用到这种类型。

Variant变量没有类型

一般说来，你可以用Variant 变量存储任何数据类型，对它执行各种操作和类型转换。需要注意的是：这违反了Pascal 语言的一贯原则，有悖于良好的编程习惯。variant 变量的类型检查和计算在运行期间才进行，编译器不会提示代码中的潜在错误，这些错误在进一步测试中才能发现。总之，你可以认为包含variant变量的代码是解释性代码，正如解释性代码一样，许多操作直到执行时才能知道，这对代码运行速度会有很大的影响。

上面对Variant 类型的使用提出了警告，现在来看看Variant 类型究竟能干什么。基本上说，如果声明了一个variant 变量：

var
V: Variant;

你就可以把各种不同类型的值赋给它：

V := 10;
V := 'Hello, World';
V := 45.55;

一旦得到一个variant 值，你可以把它拷贝给任何兼容或不兼容的数据类型。如果你把值赋给不兼容的数据类型，Delphi 会力尽所能进行转换，无法转换则颁布一个运行时间错误。实际上，variant变量中不仅包含了数据还包含有类型信息，并允许一系列运行时间操作,这些操作很方便，但运行速度慢且安全性差。

见例VariTest，它是上面代码的扩展。窗体上有三个编辑框，一对按钮，第一个按钮的OnClick 事件代码如下：

procedure TForm1.Button1Click(Sender: TObject);
var
V: Variant;
begin
V := 10;
Edit1.Text := V;
V := 'Hello, World';
Edit2.Text := V;
V := 45.55;
Edit3.Text := V;
end;

很有趣是不是？你可以把一个值为字符串的variant 变量赋给编辑框Text 属性，还可以把值为整数或浮点数的variant 变量赋给Text属性。正如你在图10.1中所看到的，一切正常。

（图10.1）按Assign按钮后，例VariTest的输出结果

图 10.1: 例 VariTest 的 Assign 按钮 Click 事件输出结果

更糟糕的是:你还可以用variant变量计算数值，从第二个按钮的Click事件代码就可看到这一点：

procedure TForm1.Button2Click(Sender: TObject);
var
V: Variant;
N: Integer;
begin
V := Edit1.Text;
N := Integer(V) * 2;
V := N;
Edit1.Text := V;
end;

至少这种代码带有一定危险性，如果第一个编辑框包含了一个数字，那么一切运行正常；如果不是，将会引发异常。这里再重申一遍，如果不到万不得以，不要随便使用Variant 类型，还是应坚持使用传统的Pascal 数据类型和类型检查方法。在Delphi 和 VCL中，variant变量主要是用于 OLE 支持和数据库域的访问。

Variant类型内部结构

Delphi中定义了一个 variant 记录类型，TVarData，它与Variant 类型有相同的内存布局。你可以通过TVarData访问variant变量的实际类型。TVarData 结构中包含了Variant类型信息(由Vtype域表示)、一些保留域及当前值。

VType域的取值包括OLE 自动化中的所有数据类型，这些类型通常叫OLE 类型或variant 类型。以下是variant 类型的完整列表，按字母顺序排列：

varArray
varBoolean
varByRef
varCurrency
varDate
varDispatch
varDouble
varEmpty
varError
varInteger
varNull
varOleStr
varSingle
varSmallint
varString
varTypeMask
varUnknown
varVariant

你可以在Delphi 帮助系统的variants 主题下找到这些类型的说明。

还有许多操作variant 变量的函数，你可以用它们进行特定的类型转换，或通过它们获取variant变量的类型信息（例如VarType 函数），当你用variant变量写表达式时，Delphi会自动调用这些类型转换和赋值函数。另外还有操作variant 数组的例程，你可以通过帮助文件的Variant support routines 主题了解相关内容。

Variant类型运行很慢！

Variant 类型代码运行很慢，不仅数据类型转换如此，两个值为整数的Variant 变量相加也是如此。它们几乎跟Visual Basic这种解释性代码一样慢！为了比较Variant变量和整型变量的运行速度，请看例VSpeed 。

程序中设置了一个循环，记录运行时间并在进程条中显示运行状态。下面是基于variant类型的一段代码，基于整型的代码与此相似：

procedure TForm1.Button1Click(Sender: TObject);
var
time1, time2: TDateTime;
n1, n2: Variant;
begin
time1 := Now;
n1 := 0;
n2 := 0;
ProgressBar1.Position := 0;
while n1 < 5000000 do
begin
n2 := n2 + n1;
Inc (n1);
if (n1 mod 50000) = 0 then
begin
ProgressBar1.Position := n1 div 50000;
Application.ProcessMessages;
end;
end;
// we must use the result
Total := n2;
time2 := Now;
Label1.Caption := FormatDateTime (
'n:ss', Time2-Time1) + ' seconds';
end;

记时这段代码值得一看，因为你可以把它用到任何类型的性能测试中。正如你所看到的，程序用Now 函数获取当前的时间，用FormatDateTime 函数格式化时间差，输出结果以分("n")和秒("ss")表示。除此之外，你可以用Windows API的GetTickCount 函数，该函数能精确显示操作系统启动后至当前的毫秒数。

从上例可见两者的速度差异非常之大，以至于不用精确记时也能看到这种差异。图10.2是在本人计算机上运行程序看到的结果。当然运行结果取决于运行程序的计算机，但是两者的数值比不会有太大变化。

图 10.2: 例Vspeed中整型与Variant类型的计算速度差异

结束语

Variant类型与传统Pascal 数据类型差别很大，所以本章以短小篇幅单独阐述了Variant类型的有关内容。尽管Variant类型主要用于OLE 编程，但用来写一些潦潦草草的程序倒也便利，因为不用考虑数据类型，不过正如以上所述，这样做会影响程序执行速度。

通过前面各章我们已经介绍了绝大部分的语言特征，下一章将讨论程序的总体框架和单元模块。

本文链接

程序和单元

2012-02-06T04:58:00Z

Delphi 应用程序中的单元，或说程序模块可谓老道精深。实际上，单元是程序模块化的基础，类是继它之后才有的。在Delphi 应用程序中，每个窗体都有一个相对应的单元。用相应的工具按钮, 或File > New Form 菜单命令，在工程中添加一个新窗体，实际上是增加了一个新单元，也就是建立了该新窗体的类。

单元

虽然所有窗体都在单元中定义，但反之则不然。除窗体外，单元中还可以定义一系列能访问的例程。选择File > New菜单命令，然后在Object Repository的New 页中选择Unit 图标，随即当前工程中就会加入一个空白单元。单元代码分区存放，空白单元的代码如下：

unit Unit1;

interface

implementation

end.

单元的概念比较简单，单元名与文件名相同，而且必须唯一。单元包括界面区（interface）及实现区(implementation)，界面区用于声明其它单元能看到的部分；实现区存放界面的实现代码及外部不可见的声明。此外还有两个可选的区，即初始化区及结束区，其中初始化区存放初始化代码，当程序加载到内存时执行；结束区存放程序终止时执行的代码。

单元总体结构如下：

unit unitName;

interface

// other units we need to refer to
uses
A, B, C;

// exported type definition
type
newType = TypeDefinition;

// exported constants
const
Zero = 0;

// global variables
var
Total: Integer;

// list of exported functions and procedures
procedure MyProc;

implementation

uses
D, E;

// hidden global variable
var
PartialTotal: Integer;

// all the exported functions must be coded
procedure MyProc;
begin
// ... code of procedure MyProc
end;

initialization
// optional initialization part

finalization
// optional clean-up code

end.

界面区头部的uses子句表示需要访问的外部单元，这些外部单元中定义了你需要引用的数据类型，如自定义窗体内所用的控件。

实现区头部的uses子句用于表示只在实现部分访问的单元。如果例程或方法的代码需要引用其他单元，你应该把这些单元加到实现区子句中，而不是界面区。你所引用的单元必须在工程文件目录中能找到，或在工程选项对话框的 Directories/Conditionals 页设定这些单元的搜索路径。

C++程序员应该知道uses语句和include 指令是不同的。uses语句只是用于输入引用单元的预编译界面部分，引用单元的实现部分在单元编译时才考虑。你引用的单元可以是源代码格式（PAS），也可以是编译格式（DCU），但是必须用同一版本的Delphi进行编译。

在单元的界面区中可以声明许多不同的元素，包括过程、函数、全程变量及数据类型。在Delphi 应用程序中，数据类型可能用得最频繁。每创建一个窗体，Delphi 会在单元中自动建立一个新的数据类型--类(class)。在Delphi 单元中不仅能定义窗体；还能象传统单元一样，只包含过程及函数；还可以定义与窗体和任何可视控件无关的类。

单元的工作空间

Pascal单元是封装性和可视性的关键，它很可能比类中的 private 和 public 关键字还要重要。(实际上，private关键字与类单元的工作空间有关)。一个标识符（如一个变量、过程、函数或数据类型）的工作空间是指能访问标识符的代码段。基本原则是:标识符在它工作空间内才有意义，也就是说，只在其声明的代码块中才有意义，在工作空间外你不能访问这些标识符。例如：

局部变量：如果你在例程或方法代码块内声明一个变量，那么单元外部不能访问这个变量。该标识符的工作空间就是定义标识符的整个例程，其中包括嵌套例程（除非嵌套例程内有一个同名标识符覆盖了外部定义）。当调用到例程时，其变量压入栈内存中，例程一结束，栈中的内存就自动释放。
全程隐藏变量：如果你在单元的实现部分声明一个标识符，那么在单元外你不能使用它，但是能在单元内任一代码块及过程中使用它。程序一启动就会为全程隐藏变量分配内存，程序终止内存释放，你可以在单元初始化区给它赋初值。
全程变量：如果你在单元的界面部分声明标识符，那么该标识符的工作空间就扩大了，任何Use它的单元都能访问它。这类变量的内存分配及生命周期与上类变量相同，唯一不同的是其可见性。

只要程序单元的uses子句中列出某一单元名，那么所列单元界面区中声明的任何标识符该程序都能访问。窗体类的变量就是这样声明的，所以你可以在其他窗体代码中访问这个窗体以及它的公共域、方法、属性和组件。当然把什么都声明为全局标识这种编程习惯并不好。除了明显的内存消耗问题外，使用全程变量使代码维护和更新变得困难。一句话，你应该尽量少用全程变量。

单元用作命名空间

uses 语句是访问其他单元工作空间的标准技术，通过该语句你能访问其它单元的定义内容。如果恰巧两个单元声明的标识符同名，也就是说你可能有两个同名的类或例程，遇到这种情况，你可以用单元名作前缀定义类型或过程名，由此进行区分。例如用Totals.ComputeTotal访问Totals 单元中的ComputeTotal 过程。不过这种情况最好不要经常遇到，因此强烈建议不要在同一程序中用同一名字表示两个不同的东西。

然而，如果查阅VCL库和Windows 文件，你会发现一些Delphi 函数和Delphi 可用的Windows API 函数同名，不过参数往往不同，下面以Beep 过程为例说明这个问题。

新建一个Delphi 程序，添加一个按钮，然后写入以下代码：

procedure TForm1.Button1Click(Sender: TObject);
begin
Beep;
end;

执行程序，单击按钮，你会听到一个短促的声音。现在移到单元的uses语句，把原先的代码：

uses
Windows, Messages, SysUtils, Classes, ...

改为下面的样式，只要把SysUtils单元移到Windows之前：

uses
SysUtils, Windows, Messages, Classes, ...

现在如果重新编译这段代码，你会得到一个编译错误：”Not enough actual parameters”（实际参数不够）。问题在于Windows 单元定义了另一个带两个参数的Beep 函数。应该说uses子句中第一个单元的定义被后面单元的定义覆盖，解决方法很简单：

procedure TForm1.Button1Click(Sender: TObject);
begin
SysUtils.Beep;
end;

不管uses子句中单元顺序如何排列，以上代码都能编译通过。在Delphi中很少有其他命名冲突的情况，因为Delphi 代码通常放在类的方法中，如果不同类中有两个同名的方法不会产生任何冲突，只是使用全程例程会产生冲突问题。

单元和程序

Delphi 应用程序源代码文件可分成两类，它们是一个或多个单元文件及一个程序文件，单元文件可以看成是次一级的文件，它被应用程序的主体——程序文件——引用。理论上如此，实际上程序文件通常是自动产生的，作用有限，程序启动并运行主窗体时才会用到它。程序文件的代码，或说Delphi 工程文件（DPR），可用手工进行编辑，也可通过工程管理器及其与应用程序、窗体相关的选项进行编辑。

程序文件的结构通常比单元文件的结构简单得多。下面是一个程序文件的源代码：

program Project1;

uses
Forms,
Unit1 in Unit1.PAS� {Form1DateForm};

begin
Application.Initialize;
Application.CreateForm (TForm1, Form1);
Application.Run;
end.

从上可见，文件中只有一个uses区和应用程序的主体代码，主体代码包含在begin 和 end 关键字之间。程序的uses子句特别重要，因为需要通过它来管理应用程序的编译和连接。

结束语

讨论完Delphi中Pascal 应用程序的结构，本书就翻过了最后一章，至少目前是这样，欢迎来email发表你的意见和要求。

如果想进一步学习Delphi Object Pascal中面向对象的内容，你可以参考我已出版的书《精通Delphi 5》（Mastering Delphi 5 ，Sybex,1999），详细情况可访问网址http://www.marcocanto.com/，你也可以从该网址上下载本书的最新版本。

本文链接

Windows 编程

2012-02-06T04:57:00Z

Delphi 利用Object Pascal 和可视控件库（VCL）对底层的Windows API 进行了完美的封装，所以很少需要使用基础Pascal 语言来建立Windows应用程序，也无需直接调用Windows API 函数。尽管如此，如果遇到特殊情况，VCL 又不支持，Delphi程序员还得直接面对Windows编程。不过只有在极其特殊的情况下，例如：基于不寻常API 调用的Delphi新控件开发，你才需要这样做，这里我不想讨论这方面内容，我只想让大家看一下与操作系统交互的几个Delphi元素以及Delphi程序员能从中获益的Windows编程技术。

Windows 句柄

Delphi从Windows 引入了不少数据类型，其中句柄最重要。这种数据类型名为THandle，该类型在Windows 单元中定义：

type
THandle = LongWord;

句柄数据类型通过数字实现，但并不当数字用。在Windows 中，句柄是一个系统内部数据结构的引用。例如，当你操作一个窗口，或说是一个Delphi 窗体时，系统会给你一个该窗口的句柄，系统会通知你：你正在操作142号窗口，就此，你的应用程序就能要求系统对142号窗口进行操作——移动窗口、改变窗口大小、把窗口极小化为图标，等等。实际上许多Windows API 函数把句柄作为它的第一个参数，如GDI （图形设备接口）句柄、菜单句柄、实例句柄、位图句柄等等，不仅仅局限于窗口函数，。

换句话说，句柄是一种内部代码，通过它能引用受系统控制的特殊元素，如窗口、位图、图标、内存块、光标、字体、菜单等等。Delphi中很少需要直接使用句柄，因为句柄藏在窗体、位图及其他Delphi对象的内部。当你要调用Delphi不支持的Windows API 函数时，句柄才会有用。

现在举一个简单的Windows句柄例子，完善这节内容。例WHandle 程序的窗体很简单，只有一个按钮。正如下面主窗体文本所定义的那样，我在代码中添加了窗体的OnCreate 事件和按钮的OnClick 事件：

object FormWHandle: TFormWHandle
Caption = 'Window Handle'
OnCreate = FormCreate
object BtnCallAPI: TButton
Caption = 'Call API'
OnClick = BtnCallAPIClick
end
end

窗体一创建，程序就会通过窗体本身的Handle 属性，获取窗体对应的窗口句柄。调用IntToStr ，把句柄数值转换为一个字符串，然后再把它添加到窗体标题中，如图9.1：

procedure TFormWHandle.FormCreate(Sender: TObject);
begin
Caption := Caption + ' ' + IntToStr (Handle);
end;

因为FormCreate 是窗体类的方法，它可直接访问同类的其他属性和方法。因此，在这个过程中我们能够直接访问窗体的Caption 属性和Handle 属性。

图 9.1: 例 WHandle 显示窗体句柄，每次运行程序得到的句柄值不同

如果你多此次执行该程序，通常会获得不同的句柄值。这个值实际上是由Windows 操作系统确定并返回给应用程序的。（句柄从来不是由程序决定的，而且句柄没有预定义值，句柄是由系统决定的，每执行一次程序，产生一个新值。）

当你单击按钮，程序将调用Windows API 函数SetWindowText，它会根据第一个传递参数改变窗口的标题。更准确地说，所用的API 函数其第一个参数是需要修改窗体的句柄：

procedure TFormWHandle.BtnCallAPIClick(Sender: TObject);
begin
SetWindowText (Handle, 'Hi');
end;

这段代码与前面所讲的事件处理程序等效，它通过给窗体的Caption 属性赋一个新值，改变窗体的标题。对上面这种情况，调用一个API 函数没有什么意义，因为用Delphi来做更简单。然而有些API在Delphi中没有相应的函数，就需要直接调用API，这一点你会在后面的高级例子中看到。

外部声明

Windows 编程中涉及的另一个重要元素是外部声明。外部声明原先用于在Pascal代码中连接汇编语言写的外部函数，现在外部声明用于Windows编程，用来调用动态连接库DLL函数。在Delphi的Windows 单元中有许多这种声明：

// forward declaration
function LineTo (DC: HDC; X, Y: Integer): BOOL; stdcall;

// external declaration (instead of actual code)
function LineTo; external 'gdi32.dll' name 'LineTo';

这段声明表示函数LineTo 的代码同名保存在GDI32.DLL 动态链接库中（最重要的Windows 系统库之一）。实际应用时，外部声明中的函数名与DLL中的函数名可以不同。

一般你不需要象刚才所例举的那样写声明，因为Windows 单元和一些Delphi 系统单元中已包含了这些声明。只有在调用自定义DLL，或调用Delphi 中未定义的Windows 函数时，你才能需要写外部声明。

注意：在16位Delphi中，外部声明使用不带扩展名的库名，后面跟name指令（如上所示）或是一个index指令，后面跟DLL中函数的序号。尽管Win32 仍然允许通过序号访问DLL函数，但是微软公司已经声明未来将不支持这种访问方式，这一改变反映了系统库访问方式的改变。还要注意的是:目前Delphi的Windows 单元已取代了16位Delphi的WinProcs 和WinTypes 单元。

回调函数

从第六章已经了解到Objet Pascal 支持过程类型。过程类型常用于给Windows API函数传递回调函数。

首先，什么是回调函数呢？回调函数就是能对一系列系统内部元素执行给定操作的API函数，例如能对所有同类窗口进行操作的函数。这种函数也叫枚举函数，它是作为参数传递的函数，代表对所有内部元素执行的操作，该函数或过程的类型必须与给定的过程类型兼容。Windows 回调函数的应用不止上述一种，不过这里仅研究以上简单应用。

现在考虑 EnumWindows API 函数，它的原型如下（从Win32 帮助文件拷贝而来）：

BOOL EnumWindows(
WNDENUMPROC lpEnumFunc, // address of callback function
LPARAM lParam // application-defined value
);

当然，这是个C语言的定义。我们可以查看Windows 单元，从中找到相应的Pascal 语言定义：

function EnumWindows (
lpEnumFunc: TFNWndEnumProc;
lParam: LPARAM): BOOL; stdcall;

查阅帮助文件，我们发现作为参数传递的函数应该属于下面的类型（也是在C中）：

BOOL CALLBACK EnumWindowsProc (
HWND hwnd, // handle of parent window
LPARAM lParam // application-defined value
);

这与下面的Delphi 过程类型定义一致：

type
EnumWindowsProc = function (Hwnd: THandle;
Param: Pointer): Boolean; stdcall;

其中第一个参数是各主窗体的句柄，第二个参数则是调用EnumWindows 函数时所传递的值。实际上，Pascal 中没有相应的TFNWndEnumProc类型定义，它只是个指针。这意味着我们需要传递一个带有合适参数的函数，将它用作一个指针，也就是取函数的地址而不是调用它。不幸的是，这也意味着如果某个参数类型出现错误时，编译器不会给予提示。

每当调用Windows API函数或传递一个回调函数给系统时，Windows 要求程序员遵循stdcall 调用协定。缺省情况下，Delphi使用另一种更高效的调用协定，其关键字为register。

下面是一个与定义兼容的回调函数，此函数把窗口的标题读到字符串中，然后添加到给定窗体的一个列表框中：

function GetTitle (Hwnd: THandle; Param: Pointer): Boolean; stdcall;
var
Text: string;
begin
SetLength (Text, 100);
GetWindowText (Hwnd, PChar (Text), 100);
FormCallBack.ListBox1.Items.Add (
IntToStr (Hwnd) + ': ' + Text);
Result := True;
end;

窗体有一个几乎覆盖整个窗体的列表框，窗体顶部有一个小面板，面板上有一个按钮。当按下按钮时，EnumWindows API函数被调用，并且GetTitle 函数作为参数传递给它：

procedure TFormCallback.BtnTitlesClick(Sender: TObject);
var
EWProc: EnumWindowsProc;
begin
ListBox1.Items.Clear;
EWProc := GetTitle;
EnumWindows (@EWProc, 0);
end;

你可以直接调用GetTitle函数，不必先把值保存到过程类型临时变量中，上例这么做是为了使回调过程更清楚。程序运行结果确实很有意思，正如你在图9.2中看到的那样，结果显示了系统中正在运行的所有主窗口，其中大部分是隐藏的，你通常看不到，许多实际上没有标题。

图 9.2: 例CallBack输出结果--当前所有主窗体，其中包括可见及隐藏的窗体

最小的Windows 程序

为了完整介绍Windows 编程及Pascal 语言，现在我展示一个简单但完整的应用程序，建立该程序没有使用VCL库。这个程序只是简单地采用命令行参数（保存在系统全程变量cmdLine中），并利用ParamCount 和 ParamStr 这两个Pascal 函数从参数中提取信息。其中第一个函数返回参数的个数，第二个返回给定位置的参数。

尽管在图形用户界面环境下用户很少操纵命令行参数，但是Windows 命令行参数对系统本身却很重要。例如，一旦你定义了文件扩展名和应用程序的关联，只要双击所关联的文件就能执行这个程序。实际上，当你双击一个文件，Windows 即启动关联程序并把选定的文件作为命令行参数传递给它。

下面是工程文件的完整源代码（一个DPR 文件，不是PAS 文件）：

program Strparam;

uses
Windows;

begin
// show the full string
MessageBox (0, cmdLine,
'StrParam Command Line', MB_OK);

// show the first parameter
if ParamCount > 0 then
MessageBox (0, PChar (ParamStr (1)),
'1st StrParam Parameter', MB_OK)
else
MessageBox (0, PChar ('No parameters'),
'1st StrParam Parameter', MB_OK);
end.

输出代码使用MessageBox API 函数，很容易就避开了VCL库。实际上，象上面那样纯粹的Windows 程序，其优点就是占的内存少，程序执行文件大约才16k字节。

为了给程序提供命令行参数，你可以用Delphi的 Run > Parameters 菜单命令。另一个方法是：打开Windows 资源管理器，查找包含程序执行文件的目录，然后把你要执行的文件拖到可执行文件上，Windows 资源管理器会把拖放的文件名用作命令行参数，开始执行程序。图9.3显示了资源管理器及相应的输出。

图9.3: 把一个文件拖放到执行文件上，给例StrParam提供命令行参数

结束语

在这一章中，我们对Windows 编程的底层内容进行了介绍，讨论了句柄和简单的Windows 程序。对于常规的Windows 编程任务，通常只需使用Delphi 提供的可视开发工具及VCL可视控件库。但是这超出了本书讨论的范围，因为本书讨论的是Pascal 语言。

下一章介绍variant类型。对Pascal 数据类型系统来说，它是一个非常特殊的外来物，引入它是为了提供完全的OLE 支持。

本文链接

内存

2012-02-06T04:56:00Z

Delphi 4 的动态数组

传统的Pascal 语言其数组大小是预先确定的，当你用数组结构声明数据类型时，你必须指定数组元素的个数。专业程序员也许知道些许动态数组的实现技术，一般是采用指针，用手工分配并释放所需的内存。

Delphi 4中增加了非常简单的动态数组实现方法，实现过程效仿我前面讲过的动态长字符串。与长字符串一样，动态数组的内存动态分配并且引用记数，不过动态数组不支持 copy-on-write 技术。这不是个大问题，因为你可以把变量值设置为nil释放数组内存。

这样你就可以声明一个不指定元素个数的数组，并用SetLength 过程给数组分配一个特定大小的内存，SetLength 过程还可以改变数组大小而不影响其内容，除此外还有一些字符串过程也可用于数组，如Copy 函数。

以下摘录的代码突出了一点，这就是：定义数组后必须先为它分配内存，然后才能开始使用：

procedure TForm1.Button1Click(Sender: TObject);
var
Array1: array of Integer;
begin
Array1 [1] := 100; // error
SetLength (Array1, 100);
Array1 [99] := 100; // OK
...
end;

如果你只定义一个数组元素个数，那么索引总是从0开始。Pascal 中的普通数组既能用不为零的下标，也能用非整数的下标，但动态数组均不支持这两种下标。象普通数组一样，你可以通过Length、High和Low 函数了解到动态数组的状况，不过对于动态数组，Low 函数返回值总是0，High函数返回数组大小减1，这意味着空的动态数组其函数High返回值是-1，这是一个很怪的值，因为它比Low的返回值还小。

图 8.1: 例 DynArr 窗体

以上作了简短的介绍，现在举个简例，例名DynArr ，见图8.1。例子实在是很简单，其实动态数组没有什么特别复杂地方。我想通过该例说明几个程序员可能犯的错误。程序中声明了两个全程数组并在OnCreate 事件中初始化了第一个数组：

var
Array1, Array2: array of Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
// allocate
SetLength (Array1, 100);
end;

这样就把数组所有值设置为0。完成这段代码你马上就能读写数组元素的值，而不用害怕内存出错，当然条件是你没有试图访问超过数组上界的元素。为了更好地初始化，程序中添加了一个按钮，执行数组元素赋值操作：

procedure TForm1.btnFillClick(Sender: TObject);
var
I: Integer;
begin
for I := Low (Array1) to High (Array1) do
Array1 [I] := I;
end;

Grow 按钮用于修改数组大小，但并不影响数组内容。单击Grow 按钮后，你可以用Get value按钮进行检验：

procedure TForm1.btnGrowClick(Sender: TObject);
begin
// grow keeping existing values
SetLength (Array1, 200);
end;

procedure TForm1.btnGetClick(Sender: TObject);
begin
// extract
Caption := IntToStr (Array1 [99]);
end;

Alias 按钮的OnClick 事件代码稍复杂些，程序通过 := 算子把一个数组拷贝给另一个数组，从而有效地创建了一个别名（一个新变量，但引用内存中同一数组）。从中可见，如果你改变了其中一个数组，那么另一个同样也会改变，因为它们指向同一个内存区：

procedure TForm1.btnAliasClick(Sender: TObject);
begin
// alias
Array2 := Array1;
// change one (both change)
Array2 [99] := 1000;
// show the other
Caption := IntToStr (Array1 [99]);

在btnAliasClick 事件中增加了两部分操作内容。第一部分是数组等同测试，不过并不是测试实际的数组元素，而是测试数组所引用的内存区，检测变量是不是内存中同一数组的两个别名：

procedure TForm1.btnAliasClick(Sender: TObject);
begin
...
if Array1 = Array2 then
Beep;
// truncate first array
Array1 := Copy (Array2, 0, 10);
end;

btnAliasClick 事件的第二部分内容是调用Copy 函数。该函数不仅把数据从一个数组移到另一个数组，而且用函数创建的新数组取代第一个数组，结果变量Array1 所引用的是11个元素的数组，因此，按Get value 和Set value 按钮将产生一个内存错误，并且触发一个异常（除非你把范围检查range-checking 选项关掉，这种情况下，错误仍在但屏幕上不会显示异常）。虽然如此，Fill 按钮仍能正常工作，因为需要修改的数组元素由数组当前的下标范围确定。

结束语

这一章内容暂时只包括动态数组，动态数组的确是内存管理的重要组成部分，但仅仅是其中的一部分，其它内容以后会逐步添加。

本章描述的内存结构属于典型的 Windows 编程内容，这方面内容将在下一章进行讨论。

本文链接

博客园_jiangyuxuan

在Delphi中如何获得SQL中存储过程的返回值?

Delphi StringGrid使用全书

delphi 数据导出 进度条自己生成

delphi执行查询语句时的进度条怎么做

Delphi中动态链接库(DLL)的建立和使用

术语表

Variant类型

程序和单元

Windows 编程

内存

delphi 数据导出进度条自己生成