⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 crgrid.pas

📁 医院信息管理系统 后台采用ORACLE
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      TitleRect.Bottom :=  TitleRect.Top + DefaultRowHeight + 9;
//      if not(dgRowLines in Options) then
//        Dec(TitleRect.Top);
      DrawTitleBarCell(Canvas,Column,TitleRect,'');
    end;
    AState := AState - [gdFixed];  // prevent box drawing later
  end;

var
  DrawColumn: TColumn;
begin
  if (ARow = 0) and (dgTitles in Options) then begin
    if ACol >= IndicatorOffset then begin
      DrawColumn := Columns[ACol - IndicatorOffset];
      DrawTitleCell(ACol - IndicatorOffset, ARow, DrawColumn, AState);
    end
    else begin
      inherited DrawCell(ACol, ARow, ARect, AState);
      DrawTitleIndicatorCell(Canvas,ARect);
    end
  end
  else begin
    if DataLink.Active then
      if dgTitles in Options then
        FActiveRowSelected := ARow - 1 = DataLink.ActiveRecord
      else
        FActiveRowSelected := ARow = DataLink.ActiveRecord
    else
      FActiveRowSelected := False;
    inherited DrawCell(ACol, ARow, ARect, AState);
    if gdFixed in AState then begin
      if dgColLines in Options then begin
        Canvas.Pen.color := clBlack;
        Canvas.Pen.style := psSolid;
        Canvas.MoveTo(aRect.Right, aRect.Top);
        Canvas.LineTo(aRect.Right, aRect.Bottom + 1);
      end;
      if dgRowLines in Options then begin
        Canvas.Pen.color := clBlack;
        Canvas.Pen.style := psSolid;
        Canvas.MoveTo(aRect.Left, aRect.Bottom);
        Canvas.LineTo(aRect.Right, aRect.Bottom);
      end;
    end
  end;
end;

procedure TCRDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
var
  State: TGridState;
  DrawInfo: TGridDrawInfo;
  Index: longint;
  Pos, Ofs: integer;
  OldActive: integer;
  Cell: TGridCoord;
  i: integer;
  Column: TColumn;
  Value: string;
  ColWidth, ValueWidth: integer;
begin
  FExecColAjust := False;

  if FGridState = gsNormal then begin
    CalcDrawInfo(DrawInfo);
    CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
  end
  else
    State := FGridState;

  if not (State in [gsColSizing]) and DataLink.Active then begin
    if (Button = mbLeft) and (dgTitles in Options) then
    begin
      Cell := MouseCoord(X,Y);
      if Cell.X >= IndicatorOffset then
      begin
        if not (dgRowSelect in Options) and (Cell.Y >= FixedRows)
          and (TopRow  + Cell.Y - FixedRows = Row) and IsOnButton(X,Y)
        then begin
          FCellButtonDown := RawToDataColumn(Cell.X);
          FCellButtonRow := Cell.Y;
          FCellButtonCol := Cell.X;
          FCellButtonBRect := GetButtonRect(Cell);
          FCellButtonRect := CellRect(Cell.X,Cell.Y);
          //Paint;  // ??
          HideEditor;
          DrawButton(Cell.X,Cell.Y,PtInRect(FCellButtonBRect,Point(x,y)));
          FCellButtonPressed := True;
          //invalidaterect(GetButtonRect(Cell));
          Exit;
        end;

        if Cell.Y = 0  then
        begin
          Column := Columns[RawToDataColumn(Cell.X)];
          if not TCRColumn(Column).CanBeSorted then
            Exit;

          if MouseInFilterEdit(X, Y, Column) then
          begin
            FContinueEditingFilter := True;
            ActivateFilterEdit(Column);
            Exit;
          end
          else
            if MouseInSortEdit(X, Y, Column) then
            begin
              ActivateSearchEdit(Column);
              Exit;
            end;
        end;

        if DataLink.Active and (Cell.Y < FixedRows)
          and (dgeEnableSort in OptionsEx) and MouseInLowerstLevel(X, Y, nil)
        then begin
          i := FTitleButtonDown;
          FTitleButtonDown := RawToDataColumn(Cell.X);
          FOldTitleButtonDown := FTitleButtonDown;
          if i > -1 then
            InvalidateCol(i+1);
          invalidatecol(FTitleButtonDown+1);
        end;
      end
      else
      begin
        FIndicatorColBtnDown := GetIndicatorButton(X,Y);
        FOldIndicatorColBtnDown := FIndicatorColBtnDown;
        if FIndicatorColBtnDown <> icbNone then
          InvalidateCol(0);
      end;
    end;
  end;

  if (mbLeft = Button) and (State = gsColSizing) and DataLink.Active then begin
    if ssDouble in Shift then begin
      Index := Min(RawToDataColumn(MouseCoord(X, Y).X), RawToDataColumn(MouseCoord(X - 7, Y).X));
      if Index < 0 then
        Index := Columns.Count - 1;

      Column := Columns[Index];
      ColWidth := 0;
      OldActive := DataLink.ActiveRecord;
      try
        for i := TopRow - 1 to VisibleRowCount - 1 do begin
          Datalink.ActiveRecord := i;
          if Assigned(Column.Field) then
            Value := Column.Field.DisplayText
          else
            Value := '';
          ValueWidth := Canvas.TextWidth(Value);
          if ValueWidth > ColWidth then
            ColWidth := ValueWidth;
        end;
      finally
        DataLink.ActiveRecord := OldActive;
      end;

      //Column.Width := ColWidth + 4;
      ColWidths[Index + IndicatorOffset] := ColWidth + 4;

      FExecColAjust := True;
      //MessageBox(0, PChar('Row ' + IntToStr(Row) + #13'Row Count ' + IntToStr(RowCount) + #13'TopRow ' + IntToStr(TopRow) + #13'Vis ' + IntToStr(VisibleRowCount)), '', MB_OK);
    end;
    if CRGridTitleEdit.Focused or CRGridTitleEdit.Edit.Focused then begin
      SendMessage(Handle, WM_SETREDRAW, 0, 0);
      try
        inherited;
          CRGridTitleEdit.Visible := True;
          CRGridTitleEdit.SetFocus;
      finally
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
      end;
      Column := CRGridTitleEdit.FActiveColumn;
      if CRGridTitleEdit.FAsFilter then begin
        ActivateFilterEdit(Column);
        Exit;
      end
      else
        ActivateSearchEdit(Column);
    end;
  end;

  InvalidateRect(Handle,@FStatusRect,False);
  CRGridTitleEdit.EditingFilter := False;
  FContinueEditingFilter := False;
  inherited;
end;

procedure TCRDBGrid.MouseMove(Shift: TShiftState; X, Y: integer);
var
  State: TGridState;
  DrawInfo: TGridDrawInfo;
  Index: Longint;
  Pos, Ofs: integer;
//  Column:TColumn;
//  Cell: TGridCoord;
  Rect: TRect;
  Col: TColumn;
begin
  inherited;

  if FGridState = gsNormal then begin
    CalcDrawInfo(DrawInfo);
    CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
  end
  else
    State := FGridState;
  if FCellButtonDown > -1 then
  begin
    FCellButtonPressed := PtInRect(FCellButtonBRect,Point(x,y));
    DrawButton(FCellButtonCol,FCellButtonRow,FCellButtonPressed);
  end;

  if (ssLeft in Shift) and (FOldTitleButtonDown > -1) then begin
    Rect := CalcTitleRect(Columns[FOldTitleButtonDown], 0, Col);

    if dgeSearchBar in OptionsEx then
      Dec(Rect.Bottom,DefaultRowHeight + 10);
    if dgeFilterBar in OptionsEx then
      Dec(Rect.Bottom,DefaultRowHeight + 10);

    if (FTitleButtonDown = -1) and PtInRect(Rect,Point(X,Y)) then begin
      FTitleButtonDown := FOldTitleButtonDown;
      InvalidateCol(FTitleButtonDown + 1);
    end
    else
      if (FTitleButtonDown > -1) and ((Y < Rect.Top) or (Y > Rect.Bottom)
      or ((X < Self.Left) and (Columns[FTitleButtonDown].Index = 0))
      or ((X > Self.Left + Self.Width) and (Columns[FTitleButtonDown].Index = Columns.Count - 1))) then begin
        Index := FTitleButtonDown + 1;
        FTitleButtonDown := -1;
        InvalidateCol(Index)
      end;
  end;

  if (ssLeft in Shift) and (FOldIndicatorColBtnDown <> icbNone) then begin
    if (FIndicatorColBtnDown = icbNone)
    and (GetIndicatorButton(X, Y) = FOldIndicatorColBtnDown) then begin
      FIndicatorColBtnDown := FOldIndicatorColBtnDown;
      InvalidateCol(0);
    end
    else
      if (FIndicatorColBtnDown <> icbNone)
      and (FIndicatorColBtnDown <> GetIndicatorButton(X, Y)) then begin
        FIndicatorColBtnDown := icbNone;
        InvalidateCol(0)
      end;
  end;

{  if not (State in [gsColSizing]) and DataLink.Active then begin
    Cell := MouseCoord(X,Y);
    if (Cell.X >= IndicatorOffset) and (Cell.Y >= 0) and
      (ngTitles in FOptions) and (Cell.Y = 0)
    then begin
      FTitleButtonDown := RawToDataColumn(Cell.X);
      Paint;  // ??
    end
    else begin
      FTitleButtonDown := -1;
      Paint;  // ??
    end;
  end;}
end;

procedure TCRDBGrid.Reorder;
var
  i: integer;
  St: string;
begin
  if DataLink.Active and (DataLink.DataSet is TCustomDADataSet) then
  begin
    St := '';
    for i := 0 to FSortInfo.Count - 1 do
      if TCRColumn(Columns[PSortColInfo(FSortInfo[i])^.Index]).CanBeSorted then
      begin
        if St <> '' then
          St := St + ',';
        St := St + IntToStr(Columns[PSortColInfo(FSortInfo[i])^.Index].Field.FieldNo);
        if PSortColInfo(FSortInfo[i])^.Desc then
          St := St + ' DESC';
      end;
    TCustomDADataSet(DataLink.DataSet).SetOrderBy(St);
    DataLink.DataSet.Open;
  end;
end;

procedure TCRDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: integer);
var
  State: TGridState;
  DrawInfo: TGridDrawInfo;
  Index, i: Longint;
  Pos, Ofs: integer;
  Column: TColumn;
  Cell: TGridCoord;
  SortColInfo: PSortColInfo;
  Desc: boolean;
  SortColNum: integer;
  LastBtn: integer;
  Widths: array of integer;
begin
  if FGridState = gsNormal then begin
    CalcDrawInfo(DrawInfo);
    CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
  end
  else
    State := FGridState;

  if (mbLeft = Button) and (State = gsColSizing) and DataLink.Active then begin
    if CRGridTitleEdit.Focused then begin
      inherited;
      Column := CRGridTitleEdit.FActiveColumn;
      if CRGridTitleEdit.FAsFilter then begin
        ActivateFilterEdit(Column);
      end
      else
        ActivateSearchEdit(Column);
    end;
  end;

  if not (State in [gsColSizing]) and DataLink.Active and not FExecColAjust
  then begin
    Cell := MouseCoord(X,Y);

    if not (dgRowSelect in Options) then
      if FCellButtonDown > -1 then begin
        DrawButton(Cell.X,Cell.Y,False);
        if FCellButtonDown = RawToDataColumn(Cell.X) then
          if FCellButtonPressed then
          begin
            FCellButtonDown := -1;
            FCellButtonRow := -1;
            FCellButtonCol := -1;
            DoOnMemoClick(Columns[RawToDataColumn(Cell.X)]);
            invalidate;
          end;
      end;
    FCellButtonDown := -1;
    FCellButtonRow := -1;
    FCellButtonCol := -1;
    LastBtn := FTitleButtonDown;
    FOldTitleButtonDown := -1;
    if FTitleButtonDown > -1 then begin
      invalidatecol(FTitleButtonDown + 1);
      FTitleButtonDown := - 1;
    end;

    if (Button = mbLeft) and (Cell.Y = 0) and (dgTitles in Options) then begin
      if Cell.X >= IndicatorOffset then
      begin
        Column := Columns[RawToDataColumn(Cell.X)];

        if TCRColumn(Column).CanBeSorted and (dgeEnableSort in OptionsEx)
          and not (MouseInSortBar(X,Y,Column) or MouseInFilterBar(X,Y,Column))
          and MouseInLowerstLevel(X,Y,Column) and (LastBtn = Column.Index)
        then begin
          FExecSorting := True;
          BeginLayout;
          try
            SetLength(Widths, Columns.Count);
            for i := 0 to Columns.Count - 1 do
              Widths[i] := Columns[i].Width;
            if (DataLink.DataSet <> nil) and (DataLink.DataSet is TCustomDADataSet) then
            begin
              SortColInfo := FindSortColInfo(Column.Index, SortColNum);
              Desc := (SortColInfo <> nil) and not SortColInfo.Desc;

              if (ssCtrl in Shift) and (SortColInfo <> nil) then begin
                Dispose(SortColInfo);
                if SortColNum > 0 then
                  Dec(SortColNum);
                FSortInfo.Delete(SortColNum);
              end
              else begin
                if not (ssShift in Shift) then
                  ClearSorting;
                if not (ssShift in Shift) or (SortColInfo = nil) then begin
                  New(SortColInfo);
                  SortColInfo.Index := Column.Index;
                  FSortInfo.Add(SortColInfo);
                end;

                SortColInfo.Desc := Desc;
              end;

              Reorder;
            end;
          finally
            EndLayout;
            for i := 0 to Columns.Count - 1 do
              Columns[i].Width := Widths[i];
            FExecSorting := False;
          end;
        end;
      end
      else
        if FIndicatorColBtnDown <> icbNone then begin
          FIndicatorColBtnDown := icbNone;
          InvalidateCol(0);
          IndicatorClick(FOldIndicatorColBtnDown, X, Y);
        end;
    end;
    FOldIndicatorColBtnDown := icbNone;
  end;

  inherited;
end;

procedure TCRDBGrid.LinkActive(Value: boolean);
var
  St: string;
  Parser: TParser;
  Code: integer;
  Lex: string;
  i: integer;
  FieldName: string;
  SortColInfo: PSortColInfo;
  Ind: integer;
begin
  inherited;
  // need to make header to have multilines
  CRGridTitleEdit.StopEdit

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -