DBgrid问题请教？

自己写的控件，支持多项选择等功能
///////////////////////////////////////////////////////////////
           自已写控件
///////////////////////////////////////////////////////////////unit MyGrid;
interface
uses menus,Clipbrd,db,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids;type
  TMyGrid = class(TDBGrid)
  private
    { Private declarations }
    FFixedCols :Integer;
    FPopupMenu :TPopupMenu;
    procedure SetFixedCols(Value: Integer);
    function GetFixedCols: Integer;
    function MaxFixed: Integer; // Added 06/16/99 - MDM
    procedure DrawTitleCell(Canvas: TCanvas; ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); virtual;
    procedure OnMenuSetClick(Sender: TObject);
  protected
    { Protected declarations }
    procedure ColWidthsChanged; override;
    procedure LinkActive(Value: Boolean); override;
    procedure LayoutChanged; override;
    procedure SetFixedColumns; virtual;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    function CanEditShow: Boolean; override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    function  GetEditMask(ACol, ARow: Longint): string; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure TitleClick(Column: TColumn); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property FixedCols: Integer read GetFixedCols write SetFixedCols;
    procedure MenuSet;
  end;procedure Register;implementationuses MyGridSet, FormStore, TimeIntField, MacroQuery;procedure Register;
begin
  RegisterComponents('SelfControl', [TMyGrid]);
end;constructor TMyGrid.Create(AOwner: TComponent);
var NewItem :TMenuItem;
begin
  inherited Create(AOwner);  FPopupMenu :=nil;
  if not (csDesigning in ComponentState) then
  if lCanStoreForm then
  begin
   FPopupMenu :=TPopupMenu.Create(Self);
NewItem := TMenuItem.Create(Self);
    NewItem.Caption := '蔍逆ヘ砞竚';
    NewItem.OnClick :=OnMenuSetClick;
    FPopupMenu.Items.Add(NewItem);    PopupMenu :=FPopupMenu;
  end;
end;destructor TMyGrid.Destroy;
begin
if Assigned(FPopupMenu) then FPopupMenu.Free;  inherited Destroy;
end;procedure TMyGrid.OnMenuSetClick(Sender: TObject);
var i :Integer;
ts :string;
begin
frmMyGridSet :=TfrmMyGridSet.Create(Self);
  with frmMyGridSet do
  begin
   chkList.Items.BeginUpdate;
    chkList.Items.Clear;
    for i :=0 to Self.Columns.Count-1 do
    begin
     ts :=Self.Columns[i].Title.Caption +' ('+ Self.Columns[i].FieldName +')';
     chkList.Items.Add(ts);
        chkList.Checked[i] :=Self.Columns[i].Visible;
    end;
   chkList.Items.EndUpdate;      edFixedCols.Value :=Self.FixedCols;
    edFixedCols.MaxValue :=Self.Columns.Count-1;
  // upFixedCols.Position :=Self.FixedCols;
//    upFixedCols.Max :=Self.Columns.Count-1;
  end;
  if frmMyGridSet.ShowModal() =mrOK then
  with frmMyGridSet do
  begin
   for i :=Self.Columns.Count-1 downto 0 do
    begin
        Self.Columns[i].Visible :=chkList.Checked[i];
    end;
    Self.FixedCols :=edFixedCols.Value;
  end;
  frmMyGridSet.Free;
end;procedure TMyGrid.SetFixedCols(Value: Integer);
begin
  FFixedCols := Value;
  SetFixedColumns;
end;function TMyGrid.GetFixedCols: Integer;
begin
  Result := FFixedCols;
end;procedure TMyGrid.SetFixedColumns;
var Value: Integer;
begin
  Value := FFixedCols;
  if (dgIndicator in Options) then inc(Value);
  if DataSource <> nil then
    if DataSource.DataSet <> nil then
      if DataSource.Dataset.Active then
        inherited FixedCols := Value;
end;procedure TMyGrid.ColWidthsChanged;
begin
  inherited;  if (FixedCols > 0) then SetFixedColumns;
end;procedure TMyGrid.LinkActive(Value: Boolean);
begin
  inherited LinkActive(Value);  SetFixedColumns;
end;procedure TMyGrid.LayoutChanged;
begin
  inherited LayoutChanged;  SetFixedColumns;
end;procedure TMyGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var nColumnIndex :Integer;
begin
if (ARow = 0) then
    if (not(dgIndicator in Options)) or (ACol >0)  then
    if (ACol <= FixedCols) then
    begin
     DrawTitleCell(Canvas, ACol, ARow, ARect, AState);
        Exit;
    end;    if (not(dgIndicator in Options)) or (ACol >0)  then
    if (ACol <= FixedCols) then
    //if (gdSelected in AState) then
if DefaultDrawing then
begin
if (dgIndicator in Options) then nColumnIndex := ACol -1
else nColumnIndex := ACol;     Canvas.Font.Color :=Columns[nColumnIndex].Font.Color;
    end;
inherited DrawCell(ACol, ARow, ARect, AState);
end;

procedure TMyGrid.DrawTitleCell(Canvas: TCanvas; ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
const AlignFlags: array[TAlignment] of Integer =
  (DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
var Value: string;
  R: TRect;
  A: TAlignment;
  Column: TColumn;
  Flags: Integer;
begin
  R := ARect;
  with Canvas do
  begin
    (* Removed 06/16/99 - MDM
    Font:=TitleFont;*)
    if (dgIndicator in Options) then
      Column:=Columns.Items[ACol-1]
    else
      Column:=Columns.Items[ACol];
    //Column := Columns.Items[CellToCol(ACol)]; // 06/21/99 - MDM
    Value := Column.Title.Caption;
    Font.Assign(Column.Title.Font); // 06/16/99 - MDM
    Brush.Color := Column.Title.Color; // 06/16/99 - MDM
    (* Removed 06/16/99 - MDM
    Brush.Color:=clBtnFace;
    Font.Color:=clBtnText;*)
    FillRect(R);      DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
      DrawEdge(Canvas.Handle, R, BDR_RAISEDINNER, BF_TOPLEFT);      A := Column.Title.Alignment;
      case A of
        taRightJustify: Dec(R.Right, 2);
        taLeftJustify: Inc(R.Left, 1);
      end;    inc(R.Left, 2);
    Brush.Style := bsClear;
Flags := DT_VCENTER + DT_SINGLELINE;
    DrawText(Handle, PChar(Value), Length(Value), R, Flags + AlignFlags[A]);
    //Reset Font in case user changed it
    // 06/16/99 - MDM
    Font.Assign(Self.Font);
    (* Removed 06/16/99 - MDM
    Font:=Self.Font;*)
  end;
end;function TMyGrid.MaxFixed: Integer;
begin
  { Added 6/16/99 - MDM }
  if (dgIndicator in Options) then Result := FixedCols
  else Result := FixedCols - 1;
end;function TMyGrid.GetEditMask(ACol, ARow: Longint): string;
begin
  Result := '';
  if Datalink.Active then
with Columns[RawToDataColumn(ACol)] do
if Assigned(Field) then
begin
     if Field is TTimeIntField then Result := '>cccccc;0; '
else Result := Field.EditMask;
end;
end;function TMyGrid.CanEditShow: Boolean;
begin
Result :=(inherited CanEditShow);
    if Result then Result :=(Col > MaxFixed) and (not ReadOnly);
end;function TMyGrid.SelectCell(ACol, ARow: Longint): Boolean;
begin
Result :=(inherited SelectCell(ACol, ARow));
    if Result then Result :=(ACol > MaxFixed);
end;procedure TMyGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
if (dgMultiSelect in Options) then
    begin
if ssCtrl in Shift then Shift :=Shift -[ssCtrl]
        else Shift :=Shift +[ssCtrl];
    end;    inherited MouseDown(Button, Shift, X, Y);
end;procedure TMyGrid.TitleClick(Column: TColumn);
var lCtrlDown :Boolean;
oParam :TParam;
    sOrderBy, tsField :string;
    nLen,nPos :integer;
    nKeyState :Short;
begin
inherited TitleClick(Column);    if not (DataLink.DataSet is TMacroQuery) then Exit;
    oParam :=(DataLink.DataSet as TMacroQuery).Params.FindParam('sOrderBy');
    if oParam =nil then Exit;    sOrderBy :=oParam.AsString;
    tsField :='Q.' +Column.Field.FieldName;
    nKeyState :=GetKeyState(VK_CONTROL);
lCtrlDown :=( nKeyState < 0 );
    if lCtrlDown then
    begin
    if sOrderBy =tsField then sOrderBy :=tsField +' DESC'
     else if tsField =tsField +' DESC' then sOrderBy :=tsField
        else begin
         nLen :=Length(tsField);
        if Copy(sOrderBy, Length(sOrderBy)-nLen+1, nLen) =tsField then
             sOrderBy :=sOrderBy +' DESC'
            else if Copy(sOrderBy, Length(sOrderBy)-(nLen+5)+1, nLen+5) =tsField +' DESC' then
             sOrderBy :=Copy(sOrderBy, 1, Length(sOrderBy)-5)
            else begin
             nPos :=Pos(tsField+',', sOrderBy);
                if nPos >0 then sOrderBy :=Copy(sOrderBy, 1, nPos-1+nLen) +' DESC'
                +Copy(sOrderBy, nPos+nLen, 200)
                else begin
               nPos :=Pos(tsField+' DESC,', sOrderBy);
                  if nPos >0 then Delete(sOrderBy, nPos+nLen, 5)
                  else sOrderBy :=sOrderBy +',' +tsField;
                end;
            end;
        end;
    end
    else begin
    if sOrderBy =tsField then sOrderBy :=tsField +' DESC'
     else sOrderBy :=tsField;
    end;
    oParam.AsString :=sOrderBy;
    //showmessage(sOrderBy);
    (DataLink.DataSet as TMacroQuery).ReQuery;
end;procedure TMyGrid.KeyDown(var Key: Word; Shift: TShiftState);
begin
if ssCtrl in Shift then
if Key in [Ord('C'),Ord('c')] then
if not (dgEditing in Options) then
    if DataLink.Active then
    begin
     ClipBoard.AsText :=SelectedField.AsString;
        Exit;
    end;    inherited KeyDown(Key, Shift);
end;procedure TMyGrid.MenuSet;
begin
OnMenuSetClick(Nil);
end;end.

grid 的属性中OPTIONS-->DGMULTISELECT属性设为真

恩控件的本身就是支持多选择的 recno应该是保存的您选择的第一条纪录

调试易

DBgrid问题请教？

解决方案 »