crgrid.pas

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

{ TCRDBGridColumns }

function TCRDBGridColumns.GetColumn(Index: Integer): TCRColumn;
begin
  Result := TCRColumn(inherited Items[Index]);
end;

procedure TCRDBGridColumns.SetColumn(Index: Integer; Value: TCRColumn);
begin
  inherited Items[Index] := Value;
end;

{ TCRDBGrid }

procedure UsesBitmap;
begin
  if UserCount = 0 then
    DrawBitmap := TBitmap.Create;
  Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
  Dec(UserCount);
  if UserCount = 0 then
    DrawBitmap.Free;
end;

constructor TCRDBGrid.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  Columns.State := csDefault;
  FSortInfo := TList.Create;
  FPopupMenu := TPopupMenu.Create(Self);
  FFiltered := True;
  UsesBitmap;
  FOnMemoClick := nil;
  FLevelDelimiterChar := '|';
  inherited DefaultDrawing := False;
  FDefaultDrawing := True;
  FSoft := False;
  SetOptionsEx([dgeEnableSort, dgeLocalFilter, dgeRecordCount]);
  DefaultColWidth := 60;  // DEBUG

  FExecSizing := False;
  FTitleButtonDown := -1;
  FOldTitleButtonDown := -1;
  FIndicatorColBtnDown := icbNone;
  FOldIndicatorColBtnDown := icbNone;
  FCellButtonDown := -1;
  CRGridTitleEdit := TCRGridTitleEdit.Create(Self);
  InsertControl(CRGridTitleEdit);
  BuildMenu;
end;

procedure TCRDBGRid.ActivateSearchEdit(Column: TColumn);
var
  CellRect: TRect;
begin
  if not (Assigned(Column) and (dgeSearchBar in OptionsEx)) then
    Exit;
  CellRect := CalcSearchBar(Column);
  InflateRect(CellRect, -5, -5);
  if not (dgRowLines in Options) then
    Dec(CellRect.Top);
  CRGridTitleEdit.ActivateAt(CellRect, Column, False);
end;

destructor TCRDBGrid.Destroy;
begin
  ReleaseBitmap;
  ClearSorting;
  ClearFilters;
  FSortInfo.Free;

  inherited;
end;

procedure TCRDBGrid.Loaded;
begin
  inherited;
  CalcTableSpacePercent;
  FPopupMenu.Items[0].Checked := FFiltered;
  FPopupMenu.Items[2].Checked := dgeFilterBar in OptionsEx;
  FPopupMenu.Items[3].Checked := dgeSearchBar in OptionsEx;

  FLoaded := True;
end;

function TCRDBGrid.CreateColumns: TDBGridColumns;
begin
  Result := TCRDBGridColumns.Create(Self, TCRColumn);
end;

procedure TCRDBGrid.Resize;
begin
  inherited;

  CRGridTitleEdit.StopEdit(False);
  if (dgeStretch in FOptionsEx) and FLoaded and (not FExecSizing) then begin
    FExecSizing := True;
    try
      ResizeColumns;
    finally
      FExecSizing := False;
    end;
  end;
  if CRGridTitleEdit.Focused then begin
    if CRGridTitleEdit.FAsFilter then
      ActivateFilterEdit(CRGridTitleEdit.FActiveColumn)
    else
      ActivateSearchEdit(CRGridTitleEdit.FActiveColumn);
  end;
  Invalidate;
end;

procedure TCRDBGrid.ColWidthsChanged;
var
  i: integer;
  ResizedColumn: integer;
begin
  if (dgeStretch in FOptionsEx) and FLoaded and not FExecSizing then begin
    FExecSizing := True;
    ResizedColumn := -1;
    for i := 0 to Columns.Count - 1 do
      if ColWidths[i + IndicatorOffset] <> Columns[i].Width then begin
        ResizedColumn := i;
        break;
      end;

    ResizeColumns(ResizedColumn);
    //ResizeColumns(-1);

    FExecSizing := False;
  end;

  inherited;
end;

function  TCRDBGrid.GetGridSize: integer;
begin
  Result := ClientWidth - 1;
  if dgIndicator in Options then
    Dec(Result, IndicatorWidth);
  if dgColLines in Options then
    Dec(Result, Columns.Count*GridLineWidth);
end;

procedure TCRDBGrid.ResizeColumns(ResizedColumn: integer);
const
  MinWidth = 10;
var
  i: integer;
  GridSize, ColumnsSize:integer;
  UnresizedSize: integer;
  K: double;
  Curr,Prev: double;
  Width: integer;
  MinimizeRest: boolean;
  //Sized       : integer;

  function Max(i1,i2: integer): integer;
  begin
    if i1 > i2 then
      Result := i1
    else
      Result := i2
  end;

begin
  if Columns.Count = 0 then
    Exit;

  GridSize := ClientWidth - 1;
  if dgIndicator in Options then
    Dec(GridSize, IndicatorWidth);
  if dgColLines in Options then
    Dec(GridSize, Columns.Count*GridLineWidth);

  if ResizedColumn > -1 then begin
    ColumnsSize := 0;
    UnresizedSize := 0;
    MinimizeRest := False;
    for i := 0 to Columns.Count - 1 do begin
      if i <= ResizedColumn then begin
        Inc(UnresizedSize, ColWidths[i + IndicatorOffset]);
        if i = ResizedColumn then
          if ColumnsSize + ColWidths[i + IndicatorOffset] +
          (Columns.Count - i) * MinWidth > GridSize then begin
            ColWidths[i + IndicatorOffset] := GridSize - ColumnsSize -
              (Columns.Count - i - 1) * MinWidth;
            MinimizeRest := True;
          end
          else
            if i = Columns.Count - 1 then
              ColWidths[i + IndicatorOffset] := GridSize - ColumnsSize;
      end
      else
        if MinimizeRest {(ResizedColumn >= 0) and (ColumnsSize + (Columns.Count - i)*MinWidth >= GridSize)} then
          ColWidths[i + IndicatorOffset] := MinWidth;

      Inc(ColumnsSize, ColWidths[i + IndicatorOffset]);
    end;

    if ColumnsSize = UnresizedSize then
      Exit;

    K := (GridSize - UnresizedSize) / (ColumnsSize - UnresizedSize);

    ColumnsSize := 0;
    Prev := 0;
    for i := 0 to Columns.Count - 1 do begin
      if i <= ResizedColumn then
        Curr := Prev + ColWidths[i + IndicatorOffset]
      else
      begin
        Curr := Prev + ColWidths[i + IndicatorOffset]*K;

        if i < Columns.Count - 1 then
          Width := Round(Curr - Prev)
        else
          Width := GridSize - ColumnsSize;

        if Width < TCRColumn(Columns[i]).MinWidth then
          Width := TCRColumn(Columns[i]).MinWidth;
        ColWidths[i + IndicatorOffset] := Width;
      end;
      Inc(ColumnsSize, ColWidths[i + IndicatorOffset]);
      Prev := Curr;
    end;
    CalcTableSpacePercent;
  end
  else begin // for full resize
    Inc(GridSize,2);
    for i := 0 to Columns.Count - 1 do
      ColWidths[i + IndicatorOffset] := Trunc(TCRColumn(Columns[i]).FTableSpacePercent * GridSize);
    end;
end;

{ Grid drawing }

procedure TCRDBGrid.GetCellProps(Field: TField; AFont: TFont;
  var Background: TColor; State: TGridDrawState; StateEx: TGridDrawStateEx);
begin
  if Assigned(FOnGetCellParams) then
    FOnGetCellParams(Self, Field, AFont, Background, State, StateEx);
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: integer;
  const Text: string; Alignment: TAlignment; ARightToLeft: boolean);
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 );
  RTL: array [boolean] of integer = (0, DT_RTLREADING);
var
  B, R: TRect;
  Hold, Left: integer;
  I: TColorRef;
begin
  I := ColorToRGB(ACanvas.Brush.Color);
  if GetNearestColor(ACanvas.Handle, I) = I then
  begin                       { Use ExtTextOut for solid colors }
    { In BiDi, because we changed the window origin, the text that does not
      change alignment, actually gets its alignment changed. }
    if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
      ChangeBiDiModeAlignment(Alignment);
    case Alignment of
      taLeftJustify:
        Left := ARect.Left + DX;
      taRightJustify:
        Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
    else { taCenter }
      Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
        - (ACanvas.TextWidth(Text) shr 1);
    end;
    ACanvas.TextRect(ARect, Left, ARect.Top + DY, Text);
  end
  else begin                  { Use FillRect and Drawtext for dithered colors }
    DrawBitmap.Canvas.Lock;
    try
      with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
      begin                     { brush origin tics in painting / scrolling.    }
        Width := Max(Width, Right - Left);
        Height := Max(Height, Bottom - Top);
        R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
        B := Rect(0, 0, Right - Left, Bottom - Top);
      end;
      with DrawBitmap.Canvas do
      begin
        Font := ACanvas.Font;
        Font.Color := ACanvas.Font.Color;
        Brush := ACanvas.Brush;
        Brush.Style := bsSolid;
        FillRect(B);
        SetBkMode(Handle, TRANSPARENT);
        if (ACanvas.CanvasOrientation = coRightToLeft) then
          ChangeBiDiModeAlignment(Alignment);
        DrawText(Handle, PChar(Text), Length(Text), R,
          AlignFlags[Alignment] or RTL[ARightToLeft]);
      end;
      if (ACanvas.CanvasOrientation = coRightToLeft) then
      begin
        Hold := ARect.Left;
        ARect.Left := ARect.Right;
        ARect.Right := Hold;
      end;
      ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
    finally
      DrawBitmap.Canvas.Unlock;
    end;
  end;
end;

function TCRDBGrid.GetButtonRect(Cell: TGridCoord): TRect;
var
  aCellRect: TRect;
begin
  aCellRect := CellRect(Cell.X, Cell.Y);
  if (aCellRect.Right - aCellRect.Left < aCellRect.Bottom - aCellRect.Top + 5)
  then begin
    Result := rect(0,0,0,0);
    exit;
  end;
  Result.Left := aCellRect.Right - (aCellRect.Bottom - aCellRect.Top)+1;
  Result.Right := aCellRect.Right-1;
  Result.Top := aCellRect.Top+1;
  Result.Bottom := aCellRect.Bottom-1;
end;

function TCRDBGrid.IsOnButton(X, Y: integer): boolean;
var
  Cell: TGridCoord;
  Column: TColumn;
  aCellRect: TRect;
  ButtonRect: TRect;
begin
  Cell := MouseCoord(X,Y);
  Column := Columns[RawToDataColumn(Cell.X)];
  // detecting - is there a button on cell?
  if Assigned(Column.Field) then
    Result := Column.Field.DataType in [ftMemo,ftFmtMemo
      {$IFNDEF VER4}, ftOraClob {$ENDIF}]
  else
    Result := False;
  aCellRect := CellRect(Cell.X, Cell.Y);
  //Result := Result and (gdSelected in State);
  if Result and (aCellRect.Right - aCellRect.Left < aCellRect.Bottom - aCellRect.Top + 5) then
    Result := False;
  if Result then begin // button present
    ButtonRect := GetButtonRect(Cell);
    Result := PtInRect(ButtonRect,Point(X,Y))
  end
  else // there is no button on cell
    Result := False;
end;

procedure TCRDBGrid.DrawButton(X,Y: integer; State: boolean);
var
  ButtonRect: TRect;
  Cell: TGridCoord;
  Hi, i, Diam: integer;
  Flag: integer;
begin
  Cell.X := X; Cell.Y := Y;
  ButtonRect := GetButtonRect(Cell);
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect(ButtonRect);
  Canvas.Pen.Color := clBlack;
  Canvas.Pen.Style := psSolid;
  Canvas.Brush.Color := clBlack;

  if State then
    Flag := BDR_SUNKENINNER
  else
    Flag := BDR_RAISEDINNER;

  DrawEdge(Canvas.Handle, ButtonRect, Flag, BF_TOPLEFT );
  InflateRect(ButtonRect, -1, -1);
  DrawEdge(Canvas.Handle, ButtonRect, Flag, BF_BOTTOMRIGHT);
  InflateRect(ButtonRect, 1, 1);
  Canvas.MoveTo(ButtonRect.Left, ButtonRect.Bottom - 1);
  Canvas.LineTo(ButtonRect.Right - 1, ButtonRect.Bottom - 1);
  Canvas.LineTo(ButtonRect.Right - 1, ButtonRect.Top - 1);

  Diam := (ButtonRect.Bottom - ButtonRect.Top) div 7;
  Hi := (ButtonRect.Bottom - ButtonRect.Top - Diam) div 2;
  inc(ButtonRect.Left,Diam * 2 - 1);
  if State then begin
    inc(ButtonRect.Left);
    inc(ButtonRect.Top);
  end;
  for i := 0 to 2 do
    Canvas.Ellipse(ButtonRect.Left + i * Diam * 2 ,ButtonRect.Top + Hi, ButtonRect.Left + i * Diam * 2 + Diam, ButtonRect.Top + Hi + Diam);
end;

procedure TCRDBGrid.DrawColumnCell(const Rect: TRect; DataCol: integer;
  Column: TColumn; State: TGridDrawState);
const
  ThreeDot = '...';
var
  NewBackgrnd: TColor;
  Field: TField;
  Value: string;
  TextWidth: integer;
  ThreeDotWidth: integer;
  Alignment: TAlignment;
  ColWidth: integer;
  StateEx: TGridDrawStateEx;
  TextMargin: integer;
  i: integer;
  isDrawButton: boolean;
begin
  Field := Column.Field;
  if Assigned(Column.Field) then begin
    Value := Column.Field.DisplayText;
    isDrawButton := Column.Field.DataType in [ftMemo, ftFmtMemo
      {$IFNDEF VER4}, ftOraClob {$ENDIF}];
  end