crgrid.pas

医院信息管理系统 后台采用ORACLE

  else begin
    Value := '';
    isDrawButton := False;
  end;

  isDrawButton := isDrawButton and (gdSelected in State)
    and not (dgRowSelect in Options);
  if isDrawButton and (Rect.Right - Rect.Left < Rect.Bottom - Rect.Top + 5) then
    isDrawButton := False;
  Alignment := Column.Alignment;

  if Alignment = taRightJustify then
    TextMargin:= 4
  else
    TextMargin := 2;

  ThreeDotWidth := Canvas.TextWidth(ThreeDot);
  TextWidth := Canvas.TextWidth(Value) + TextMargin;

  ColWidth := Column.Width;  // changes font and brush
  Canvas.Font := Self.Font;
  if isDrawButton then begin
    ColWidth := ColWidth - (Rect.Bottom - Rect.Top);
  end;
  if TextWidth > ColWidth then begin
    if Field is TNumericField then begin
      for i := 1 to Length(Value) do
        if Value[i] in ['0'..'9'] then
          Value[i] := '#';
    end
    else begin
      while (TextWidth > ColWidth) and (Length(Value) > 1) do begin
        SetLength(Value, Length(Value) - 1);
        TextWidth := Canvas.TextWidth(Value) + TextMargin + ThreeDotWidth;
      end;
      Value := Value + ThreeDot;
    end;
    Alignment := taLeftJustify;
  end;

  if HighlightCell(Col, Row, Value, State) then begin
    Include(StateEx, geHighlight);
    if not FActiveRowSelected then
      Include(StateEx, geMultiSelected);
  end;
  if FActiveRowSelected then
    Include(StateEx, geActiveRow);

  if HighlightCell(Col, Row, Value, State) then begin
    Canvas.Brush.Color := clHighlight;
    Canvas.Font.Color := clHighlightText;
  end;

  if Enabled then begin
    NewBackgrnd := Canvas.Brush.Color;

    GetCellProps(Field, Canvas.Font, NewBackgrnd, State, StateEx);
    Canvas.Brush.Color := NewBackgrnd;
  end
  else
    Canvas.Font.Color := clGrayText;

  if FDefaultDrawing then
    WriteText(Canvas, Rect, 2, 2, Value, Alignment,
      UseRightToLeftAlignmentForField(Column.Field, Alignment));

  if FDefaultDrawing and (gdSelected in State)
    and ((dgAlwaysShowSelection in Options) or Focused)
    and not (csDesigning in ComponentState)
    and not (dgRowSelect in Options)
    and (UpdateLock = 0)
    and (ValidParentForm(Self).ActiveControl = Self)
  then
    Windows.DrawFocusRect(Canvas.Handle, Rect);

  inherited DrawColumnCell(Rect, DataCol, Column, State);
  if isDrawButton then
    if FCellButtonDown > -1 then
      DrawButton(Col, Row, FCellButtonPressed)
    else
      DrawButton(COl, Row, False);
end;

procedure TCRDBGrid.ClearSorting;
var
  i: integer;
begin
  for i := 0 to FSortInfo.Count - 1 do
    Dispose(FSortInfo[i]);
  FSortInfo.Clear;
end;

procedure TCRDBGrid.ClearFilters;
var
  i: integer;
begin
  for i := 0 to Columns.Count - 1 do
    TCRColumn(Columns[i]).FilterExpression := '';
end;

function TCRDBGrid.FindSortColInfo(Index: integer; var SortNum: integer): PSortColInfo;
var
  i: integer;
begin
  Result := nil;
  SortNum := 0;
  for i := 0 to FSortInfo.Count - 1 do
    if PSortColInfo(FSortInfo[i]).Index = Index then begin
      Result := FSortInfo[i];
      if FSortInfo.Count > 1 then
        SortNum := i + 1;
      break;
    end;
end;

function  TCRDBGrid.GetTitleLevel(Level: integer): TRect;
begin
  if Columns.Count = 0 then begin
    Result := Rect(0, 0, 0, 0);
    Exit;
  end;
  Result.Top    := Level*(DefaultRowHeight + 1);
  Result.Bottom := Result.Top + (DefaultRowHeight + 1);
  Result.Left   := 0;
  Result.Right  := 0;
  if dgRowLines in Options then
    dec(Result.Bottom);
end;

procedure TCRDBGrid.CalcTitleLevel(Level: integer; var aRect: TRect);
var
  X: TRect;
begin
  if Columns.Count = 0 then begin
    aRect.Top   := 0;
    aRect.Bottom:= 0;
    Exit;
  end;
  X := GetTitleLevel(Level);
  aRect.Top    := X.Top;
  aRect.Bottom := X.Bottom;
end;

procedure TCRDBGrid.DrawCell(ACol,ARow: longint; ARect: TRect; AState: TGridDrawState);
var
  FrameOffs: Byte;

  procedure DrawTitleCell(ACol, ARow: integer; Column: TColumn; var AState: TGridDrawState);
  const
    ScrollArrows: array [boolean, boolean] of integer =
      ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
  var
    MasterCol: TColumn;
    CellRect: TRect;
    TitleRect, TextRect, ButtonRect: TRect;
    LastTextRect,LastTitleRect: TRect;
    i: integer;
    InBiDiMode: boolean;
    ArrowX,
    ArrowY: integer;
    SortColInfo: PSortColInfo;
    OldBkMode: integer;
    OldTextColor: TColor;
    SortNum: integer;
    Caption: string;
    CaptionWidth: integer;
    CharWidth: integer;
    CurLevel: integer;
    LevelHeight: integer;
    CurCaption: string;
    lvCheckLeft,
    lvCheckRight,
    lvShowCaption,
    lvUpBorder,
    lvDownBorder,
    lvLeftBorder,
    lvRightBorder: boolean;
    TmpCaption: string;
    lvTmpCol: TColumn;
    lvTmpColIndex: integer;
    lvCaptionXOffset: integer;
    CellFlag: cardinal;
    CaptionDepth: integer;
    PressOffset: integer;
  begin
    CellRect  := CalcTitleRect(Column, ARow, MasterCol);
    TitleRect := CellRect;

    if MasterCol = nil then begin
      Canvas.FillRect(ARect);
      Exit;
    end;
    // Prevent from drawing areas for SEARCH and FILTER Bars
    if dgeFilterBar in OptionsEx then
      dec(TitleRect.Bottom,DefaultRowHeight + 10);
    if dgeSearchBar in OptionsEx then
      dec(TitleRect.Bottom,DefaultRowHeight + 10);

    Canvas.Font := MasterCol.Title.Font;
    Canvas.Brush.Color := MasterCol.Title.Color;
    Canvas.FillRect(ARect);
    TextRect := TitleRect;
    //canvas.Brush.color := clAqua;
    //canvas.FillRect(CellRect);

    Caption := MasterCol.Title.Caption;
    lvCheckLeft  := True;
    lvCheckRight := True;
    lvShowCaption:= True;
    lvLeftBorder := True;
    lvRightBorder:= True;
    if TCRColumnTitle(MasterCol.Title).IsCaptionStored then
      CaptionDepth := GetCaptionDepth(Caption,FLevelDelimiterChar)
    else
      CaptionDepth := 1;
    FrameOffs := 1;
    if (Column.Index = FTitleButtonDown) and (dgRowLines in Options) then
      PressOffset := 1
    else
      PressOffset := 0;
    for CurLevel := 0 to FHeaderHeight - 1 do begin
      // Check dependencies
      if TCRColumnTitle(MasterCol.Title).IsCaptionStored then
        CurCaption := GetCaptionLevel(Caption,CurLevel,FLevelDelimiterChar)
      else
        CurCaption := Caption;
      lvDownBorder := (FHeaderHeight - 1 = CurLevel) or (GetCaptionLevel(Caption,CurLevel+1,FLevelDelimiterChar)<>'');
      lvUpBorder   := (CurCaption <> '');
      lvCaptionXOffset := 0;
      if CurCaption <> '' then begin
        if lvCheckLeft then begin
          lvLeftBorder := True;
          lvShowCaption:= True;
          if Column.Index = 0 then
            lvCheckLeft := False
          else begin
            lvTmpColIndex := Column.Index-1;
            while lvTmpColIndex >= 0 do begin
              lvTmpCol := TColumn(MasterCol.Collection.Items[lvTmpColIndex]);
              tmpCaption := GetCaptionLevel(lvTmpCol.Title.Caption,CurLevel,FLevelDelimiterChar);
              if UpperCase(tmpCaption) <> UpperCase(CurCaption) then begin
                if lvTmpColIndex = Column.Index - 1 then
                    lvCheckLeft := False;
                break;
              end
              else begin
                lvShowCaption := False;
                lvLeftBorder := False;
                inc(lvCaptionXOffset, lvTmpCol.Width);
                if dgColLines in Options then
                  inc(lvCaptionXOffset);
                dec(lvTmpColIndex)
              end;
            end;
          end;
        end;
        if lvCheckRight then begin
          lvRightBorder := True;
          if Column.Index = MasterCol.Collection.Count - 1 then
            lvCheckRight := False
          else begin
            lvTmpColIndex := Column.Index+1;
            lvTmpCol := TColumn(MasterCol.Collection.Items[lvTmpColIndex]);
            tmpCaption := GetCaptionLevel(lvTmpCol.Title.Caption,CurLevel,FLevelDelimiterChar);
            if UpperCase(tmpCaption) <> UpperCase(CurCaption) then
                lvCheckRight := False
            else
                lvRightBorder := False;
          end;
        end;
      end;
      // draw text for level
      TitleRect := CellRect;
      CalcTitleLevel(CurLevel,TitleRect);
      TextRect := TitleRect;
      InflateRect(TextRect,-1,-1);

      if not lvRightBorder then begin
        inc(TextRect.Right);
         if (dgColLines in Options) then
            inc(TextRect.Right);
      end;

      if lvShowCaption then begin
        CaptionWidth := Canvas.TextWidth(CurCaption);
        if CaptionWidth > TextRect.Right - TextRect.Left then begin
          while (CaptionWidth > TextRect.Right - TextRect.Left) and (Length(CurCaption) > 1) do begin
            SetLength(CurCaption, Length(CurCaption) - 1);
            CaptionWidth := Canvas.TextWidth(CurCaption) + Canvas.TextWidth('...');
          end;
          CurCaption := CurCaption + '...';
        end;
        WriteText(Canvas, TextRect, FrameOffs + PressOffset,
          FrameOffs + PressOffset, CurCaption, MasterCol.Title.Alignment, IsRightToLeft);
      end
      else
        if CurCaption = '' then
          WriteText(Canvas, TextRect, FrameOffs, FrameOffs, '', MasterCol.Title.Alignment,
            IsRightToLeft)
        else begin // mean there is coninue of previous column
          if dgColLines in Options then begin
            dec(TextRect.Left,1);
            dec(lvCaptionXOffset,1);
          end;
          WriteText(Canvas, TextRect, FrameOffs - lvCaptionXOffset, FrameOffs, CurCaption, MasterCol.Title.Alignment,
            IsRightToLeft);
          //if dgColLines in Options then
        end;
      // draw borders for level
      CellFlag := BDR_RAISEDINNER;
      if (FTitleButtonDown = Column.Index)and(CurLevel >= CaptionDepth-1) then
        CellFlag := BDR_SUNKENINNER;
      if not lvDownBorder then begin
        Inc(TitleRect.Bottom,1);
        Canvas.Pen.Color := clBtnFace;
        Canvas.MoveTo(TitleRect.Left,TitleRect.Bottom - 2);
        Canvas.LineTo(TitleRect.Right + 1, TitleRect.Bottom - 2);
        if dgRowLines in Options then begin
          Canvas.MoveTo(TitleRect.Left, TitleRect.Bottom - 1);
          Canvas.LineTo(TitleRect.Right + 1, TitleRect.Bottom - 1);
        end;
      end;
      if not lvUpBorder then begin
        Canvas.Pen.Color := clBtnFace;
        Canvas.MoveTo(TitleRect.Left, TitleRect.Top);
        Canvas.LineTo(TitleRect.Right + 1, TitleRect.Top);
      end;

      if lvRightBorder then begin
        if (dgRowLines in Options) and (dgColLines in Options) then
          DrawEdge(Canvas.Handle, TitleRect, CellFlag, BF_RIGHT);
      end
      else
        Inc(TitleRect.Right,1);
      if dgColLines in Options then begin
        Canvas.Pen.Color := clBlack;
        Canvas.MoveTo(TitleRect.Right, TitleRect.Top);
        Canvas.LineTo(TitleRect.Right, TitleRect.Bottom + 1);
      end;
      if lvDownBorder and ((dgRowLines in Options) and (dgColLines in Options)) then begin
//        if not(dgRowlines in Options) then
//          Inc(TitleRect.Bottom);
          DrawEdge(Canvas.Handle, TitleRect, CellFlag, BF_BOTTOM);
      end;
      if dgRowLines in Options then begin
        Canvas.Pen.Color := clBlack;
        Canvas.MoveTo(TitleRect.Left,TitleRect.Bottom);
        Canvas.LineTo(TitleRect.Right + 1,TitleRect.Bottom);
      end;
      if lvUpBorder and ((dgRowLines in Options) and (dgColLines in Options)) then
        DrawEdge(Canvas.Handle, TitleRect, CellFlag, BF_TOP);

      if lvLeftBorder and ((dgRowLines in Options) and (dgColLines in Options)) then
        DrawEdge(Canvas.Handle, TitleRect, CellFlag, BF_LEFT);
    end;

  // Draw sort indicators
    SortColInfo := FindSortColInfo(MasterCol.Index, SortNum);
    if (SortColInfo <> nil) then begin
      i := SaveDC(Canvas.Handle);
      try
        if SortNum = 0 then
          ArrowX := TextRect.Right - 12
        else begin
          Canvas.Font := TitleFont;
          CharWidth := Canvas.TextWidth('0');
          ArrowX := TextRect.Right - 12 - CharWidth - 2;
        end;
        CaptionWidth := GetCaptionDepth(Caption, FLevelDelimiterChar);
        CalcTitleLevel(CaptionWidth - 1, TextRect);
        ArrowY := TextRect.Top + ((TextRect.Bottom - TextRect.Top - bmpSortAsc.Height) div 2);
        CurCaption := GetCaptionLevel(Caption, CaptionWidth - 1, FLevelDelimiterChar);
        CaptionWidth := Canvas.TextWidth(CurCaption);

        if TextRect.Left + CaptionWidth + 20 < ArrowX then
          ArrowX := TextRect.Left + CaptionWidth + 20;

        if TextRect.Left + CaptionWidth + 4 > ArrowX then begin
          ArrowX := TextRect.Left + CaptionWidth + 4;
          IntersectClipRect(Canvas.Handle, TextRect.Left,
            TextRect.Top, TextRect.Right - 1, TextRect.Bottom);
        end;

        if SortColInfo^.Desc then
          Canvas.Draw(ArrowX + PressOffset, ArrowY + PressOffset, bmpSortDesc)
        else
          Canvas.Draw(ArrowX + PressOffset, ArrowY + PressOffset, bmpSortAsc);

        if SortNum > 0 then begin
          OldBkMode := SetBkMode(Canvas.Handle, TRANSPARENT);
          OldTextColor := GetTextColor(Canvas.Handle);
          SetTextColor(Canvas.Handle, clWhite);
          ArrowY := TextRect.Top + ((TextRect.Bottom - TextRect.Top - canvas.textHeight('X')) div 2);
          Canvas.TextOut(ArrowX + 12 + PressOffset, ArrowY + PressOffset, IntToStr(SortNum));
          SetTextColor(Canvas.Handle, clGray);
          Canvas.TextOut(ArrowX + 11 + PressOffset, ArrowY - 1 + PressOffset, IntToStr(SortNum));
          SetBkMode(Canvas.Handle, OldBkMode);
          SetTextColor(Canvas.Handle, OldTextColor);
          Canvas.Font := MasterCol.Title.Font;
        end;
      finally
        RestoreDC(Canvas.Handle, i);
      end;
    end;

    if dgeFilterBar in OptionsEx then begin
      TitleRect.Top := TitleRect.Bottom;
      if dgRowLines in Options then
        Inc(TitleRect.Top);
//      if not(dgRowLines in Options) then
//        Dec(TitleRect.Top);
      TitleRect.Bottom :=  TitleRect.Top + DefaultRowHeight + 9;
      if CRGridTitleEdit.EditingFilter then
        DrawTitleBarCell(Canvas,Column,TitleRect,
          CRGridTitleEdit.FFilterExpressions[Column.Index])
      else
        DrawTitleBarCell(Canvas,Column,TitleRect,TCRColumn(Column).FilterExpression);
    end;
    if dgeSearchBar in OptionsEx then begin
      TitleRect.Top := TitleRect.Bottom ;
      if dgRowLines in Options then
        Inc(TitleRect.Top);