请提供程序源码,谢谢

解决方案 »

  1.   

    DBGrid 应用全书[感谢archonwang] 
    airii的blog上看到的文章,动了动手
    原文http://www.delphibbs.com/keylife/iblog_show.asp?xid=4091原文非常完整。经整理,每项都在delphi7下测试过,可以到http://www.efile.com.cn/Home.asp?User=jin2004下载演示代码1、{外观}
    {======================
     表头、隔行、网格
     ======================}
    procedure TForm1.DBGridDrawColumnCell_A(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    var i :integer;
    begin
    if gdSelected in State then Exit;
    //定义表头的字体和背景颜色:
      for i :=0 to (Sender as TDBGrid).Columns.Count-1 do
      begin
        (Sender as TDBGrid).Columns[i].Title.Font.Name :='宋体'; //字体
        (Sender as TDBGrid).Columns[i].Title.Font.Size :=9; //字体大小
        (Sender as TDBGrid).Columns[i].Title.Font.Color :=$000000ff; //字体颜色(红色)
        (Sender as TDBGrid).Columns[i].Title.Color :=$0000ff00; //背景色(绿色)
      end;
    //隔行改变网格背景色:
    if (Sender as TDBGrid).DataSource.DataSet.RecNo mod 2 = 0 then
        (Sender as TDBGrid).Canvas.Brush.Color := clInfoBk //定义背景颜色
    else
        (Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); //定义背景颜色
    //定义网格线的颜色:
        TDBGrid(sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);
    with (Sender as TDBGrid).Canvas do //画 cell 的边框
    begin
        Pen.Color := $00ff0000; //定义画笔颜色(蓝色)
        MoveTo(Rect.Left, Rect.Bottom); //画笔定位
        LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线
        Pen.Color := $0000ff00; //定义画笔颜色(绿色)
        MoveTo(Rect.Right, Rect.Top); //画笔定位
        LineTo(Rect.Right, Rect.Bottom); //画绿色的竖线
    end;
    end;
    {======================
      焦点单元变色
      =====================}
    procedure TForm1.DBGridDrawColumnCell_B(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
      if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
        TDBGrid(sender).Canvas.Brush.color:=clRed; //当前行以红色显示,其它行使用背景的浅绿色
        TDBGrid(sender).Canvas.pen.mode:=pmmask;
        TDBGrid(sender).DefaultDrawColumnCell (Rect,DataCol,Column,State);
    end;
    {====================
      单元字体变色
     ===================}
    procedure TForm1.DBGridDrawColumnCell_C(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
    if copy(TDbgrid(sender).DataSource.DataSet.fieldbyname(column.Title.Caption).AsString,1,1)='A' then
      TDBGrid(sender).Canvas.Font.Color := clRed
    else
      if ((State=[gdSelected,gdFocused])) then
       TDBGrid(sender).Canvas.Font.Color := clWhite
       else
     TDBGrid(sender).Canvas.Font.Color := clBlack;
     TDBGrid(sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);
    end;{=======================
      纵向斑马线
      =======================}
    procedure TForm1.DBGridDrawColumnCell_D(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
      Case DataCol Mod 2 = 0 of
        True: DbGrid1.Canvas.Brush.Color:= clinfobk; //偶数列用蓝色
        False: DbGrid1.Canvas.Brush.Color:= clMoneygreen; //奇数列用浅绿色
      End;
        if ((State=[gdSelected,gdFocused])) then
      TDBGrid(sender).Canvas.Font.Color := clblue;
      TDBGrid(sender).Canvas.pen.mode:=pmmask;
      DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
    end;{============================
      突出行显示
      ==========================}
    procedure TForm1.DBGridDrawColumnCell_E(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
      Tdbgrid(sender).Color:=clAqua;
      Tdbgrid(sender).Options:=Tdbgrid(sender).Options +[dgRowSelect];
      if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
      DbGrid1.Canvas.Brush.color:=clRed; //当前行以红色显示,其它行使用背景的浅绿色
      DbGrid1.Canvas.pen.mode:=pmmask;
      DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
    end;{=============================
      突出行列显示
      ===========================}
    procedure TForm1.DBGridDrawColumnCell_F(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
      Tdbgrid(sender).Color:=clAqua;
      Tdbgrid(sender).Options:=Tdbgrid(sender).Options +[dgRowSelect];
      if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
      begin
        Case DataCol Mod 2 = 0 of
          True : DbGrid1.Canvas.Brush.color:=clRed; //当前选中行的偶数列显示红色
          False: DbGrid1.Canvas.Brush.color:=clblue; //当前选中行的奇数列显示蓝色
        end;
        DbGrid1.Canvas.pen.mode:=pmmask;
        DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
      end;
    end;{============================
        眼花缭乱 @_@
      ===========================}
    procedure TForm1.DBGridDrawColumnCell_G(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
    Case Table1.RecNo mod 2 = 0 of//根据数据集的记录号进行判断
    True : DbGrid1.Canvas.Brush.color:=Clinfobk; //偶数行用浅绿色显示
    False: DbGrid1.Canvas.Brush.color:= clmoneygreen; //奇数行用蓝色表示
    end;
    If ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then
    Case DataCol mod 2 = 0 of
    True : DbGrid1.Canvas.Brush.color:=clRed; //当前选中行的偶数列用红色
    False: DbGrid1.Canvas.Brush.color:= clGreen; //当前选中行的奇数列用绿色表示
    end;
    DbGrid1.Canvas.pen.mode:=pmMask;
    DbGrid1.DefaultDrawColumnCell (Rect,DataCol,Column,State);
    end;{图像}
    procedure TForm1.DBGridDrawColumnCell_H(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    var
    Bmp: TBitmap;
    begin
    if (Column.Field.DataType = ftBLOB) or (Column.Field.DataType = ftGraphic) then
    begin
     Bmp:=TBitmap.Create;
     try
     Bmp.Assign(Column.Field);
     DBGrid1.Canvas.StretchDraw(Rect,Bmp);
     Bmp.Free;
    Except
     Bmp.Free;
    end;
    end;
    end;{============
     自动调整列宽
     =============}
    function DBGridRecordSize(mColumn: TColumn): Boolean;
    { 返回记录数据网格列显示最大宽度是否成功 }
    begin
    Result := False;
    if not Assigned(mColumn.Field) then Exit;
    mColumn.Field.Tag := Max(mColumn.Field.Tag,
     TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));
    Result := True;
    end; { DBGridRecordSize }function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;
    { 返回数据网格自动适应宽度是否成功 }
    var
    I: Integer;
    begin
    Result := False;
    if not Assigned(mDBGrid) then Exit;
    if not Assigned(mDBGrid.DataSource) then Exit;
    if not Assigned(mDBGrid.DataSource.DataSet) then Exit;
    if not mDBGrid.DataSource.DataSet.Active then Exit;
    for I := 0 to mDBGrid.Columns.Count - 1 do begin
     if not mDBGrid.Columns[I].Visible then Continue;
     if Assigned(mDBGrid.Columns[I].Field) then
     mDBGrid.Columns[I].Width := Max(mDBGrid.Columns[I].Field.Tag,
     mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset
     else mDBGrid.Columns[I].Width :=
     mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;
     mDBGrid.Refresh;
    end;
    Result := True;
    end; { DBGridAutoSize }
    ///////源代码结束
    {列宽}
    procedure TForm1.DBGridDrawColumnCell_I(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
       DBGridRecordSize(Column);
    end;
      

  2.   

    {增加右键菜单}
    procedure TForm1.DBGridDrawColumnCell_J(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
      vCurRect:=Rect;//vCurRect在实现部分定义
    end;
    procedure TForm1.DBGridMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    var
    CurPost:TPoint;
    begin
    GetCursorPos(CurPost);//获得鼠标当前坐标
    if (y<=17) and (x<=vCurRect.Right) then
    begin
     if button=mbright then
     begin
       PmTitle.Popup(CurPost.x,CurPost.y);
    end;
    end;
    end;2、其他技巧{============
      文字也可以托放
      ============}
    procedure TForm1.DBGridDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    begin
       accept:=true;
    end;procedure TForm1.DBGridDragDrop(Sender, Source: TObject; X, Y: Integer);
    begin
      if Source<>Edit1 then exit;
      with Sender as TDbGrid do begin
        Perform(wm_LButtonDown,0,MakeLong(x,y));
        PerForm(WM_LButtonUp,0,MakeLong(x,y));
        if  SelectedField.DataType=ftString then
        begin
          SelectedField.Dataset.edit;
          SelectedField.AsString:=Edit1.text;
        end;
      end;
    end;
    //指针控制
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      Button1.Enabled:=false;
      with Dbgrid1.DataSource.DataSet do
      try
        if not checkbox1.Checked then  DisableControls;
        first;
        while not eof do
        begin
         sleep(50);
         application.ProcessMessages;
         button1.Caption:=inttostr(RecNo);
         next;
        end;
        first;
      finally
        if not checkbox1.Checked then EnableControls;
      end;
      Button1.Enabled:=True;
      button1.Caption:='Go';
    end;//定制下拉框
    procedure TForm1.Button2Click(Sender: TObject);
    var i:integer;
    begin
      for i:=0 to dbgrid1.Columns.Count-1 do
        if dbgrid1.Columns[i].FieldName=combobox1.Text then
        begin
          dbgrid1.Columns[1].PickList:=memo1.Lines;
          TDrawGrid(dbgrid1).col:=i;
          dbgrid1.SetFocus;
        end;
    end; {Excel}//导出到excel
    procedure Tform1.ExportDBGrid(toExcel: Boolean);
    var
    bm: TBook;
    col, row: Integer;
    sline: String;
    mem: TMemo;
    ExcelApp: Variant;
    begin 
     Screen.Cursor := crHourglass;
     DBGrid1.DataSource.DataSet.DisableControls;
     bm := DBGrid1.DataSource.DataSet.GetBook;
     DBGrid1.DataSource.DataSet.First;
     // create the Excel object
     if toExcel then
     begin
     ExcelApp := CreateOleObject('Excel.Application');
     ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
     ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Grid Data';
    end; // First we send the data to a memo
     // works faster than doing it directly to Excel
     mem := TMemo.Create(Self);
     mem.Visible := false;
     mem.Parent := self;
     mem.Clear;
     sline := '';
     // add the info for the column names
     for col := 0 to DBGrid1.FieldCount-1 do
     sline := sline + DBGrid1.Fields[col].DisplayLabel + #9;
    mem.Lines.Add(sline);
     // get the data into the memo
     for row := 0 to DBGrid1.DataSource.DataSet.RecordCount-1 do
     begin
     sline := '';
     for col := 0 to DBGrid1.FieldCount-1 do
     sline := sline + DBGrid1.Fields[col].AsString + #9;
    mem.Lines.Add(sline);
    DBGrid1.DataSource.DataSet.Next;
    end;
     // we copy the data to the clipboard
    mem.SelectAll;
    mem.CopyToClipboard;
     // if needed, send it to Excel
    // if not, we already have it in the clipboard
    if toExcel then
    begin
     ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste;
     ExcelApp.Visible := true;
    end;
     FreeAndNil(mem);
    // FreeAndNil(ExcelApp);
     DBGrid1.DataSource.DataSet.GotoBook(bm);
     DBGrid1.DataSource.DataSet.FreeBook(bm);
     DBGrid1.DataSource.DataSet.EnableControls;
     Screen.Cursor := crDefault;
    end;procedure TForm1.N4Click(Sender: TObject);
    begin
      AboutBox.ShowModal;
    end;
    {
    功能描述:把DBGrid输出到Excel表格(支持多Sheet)
    设计:CoolSlob
    日期:2002-10-23
    支持:[email protected]
    调用格式:CopyDbDataToExcel([DBGrid1, DBGrid2]);
    }procedure CopyDbDataToExcel(Args: array of const);
    var
    iCount, jCount: Integer;
    XLApp: Variant;
    Sheet: Variant;
    I: Integer;
    begin
    Screen.Cursor := crHourGlass;
    if not VarIsEmpty(XLApp) then
    begin
     XLApp.DisplayAlerts := False;
     XLApp.Quit;
     VarClear(XLApp);
    end;try
     XLApp := CreateOleObject('Excel.Application');
    Except
     Screen.Cursor := crDefault;
    Exit;
    end;XLApp.WorkBooks.Add;
    XLApp.SheetsInNewWorkbook := High(Args) + 1;for I := Low(Args) to High(Args) do
    begin
     XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
     Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
     if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
     begin
     Screen.Cursor := crDefault;
     Exit;
     end; TDBGrid(Args[I].VObject).DataSource.DataSet.first;
     for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
     Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption; jCount := 1;
     while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
     begin
     for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
     Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString; Inc(jCount);
     TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
     end;
    end;XlApp.Visible := True;
    Screen.Cursor := crDefault;
    end;  procedure TForm1.BitBtn1Click(Sender: TObject);
    begin
       CopyDbDataToExcel([dbgrid1])
    end;
      

  3.   

    如使dbgrid1中'序号'为'合计'的一行为淺黄色,用dbgrid的ondrawcolumncell事件,代码如下:
    procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    var
       oldcolor:tcolor;
       oldpm:tpenmode;
    begin
     if table1.fieldbyname('序号').asString='合计' then {设定变色的行的条件}
        begin
           oldpm:= DBGrid1.Canvas.pen.mode;
           oldcolor:= dbGrid1.Canvas.Brush.color;
           dbGrid1.Canvas.Brush.color:=clinfobk;
           dbGrid1.Canvas.pen.mode:=pmmask;
           dbGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
           dbGrid1.Canvas.Brush.color:=oldcolor;
           dbGrid1.Canvas.pen.mode:=oldpm;
        end;
     end;
      

  4.   

    列:和下面代码类似,自己根据实际要求改改吧!
    procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    begin
      if Column.FieldName <> 'SIZE' then Exit;
      if Table1.FieldByName('SIZE').AsInteger>10 then
      begin
        DBGrid1.Canvas.Brush.Color:=clblue; //改变底色
        DBGrid1.Canvas.Font.Color:=clred; //改变字体颜色
        DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
      end;
    end;