bsskingrids.pas

漂亮的皮肤控件 for delphi 567

procedure TbsSkinCustomGrid.CMVisibleChanged;
begin
  inherited;
  if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
  if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible; 
end;

procedure TbsSkinCustomGrid.SetDefaultCellHeight(Value: Integer);
begin
  FDefaultCellHeight := Value;
  if FIndex = -1 then DefaultRowHeight := FDefaultCellHeight;
end;

procedure TbsSkinCustomGrid.SetGridLineColor;
begin
  FGridLineColor := Value;
  if FIndex = -1 then RePaint; 
end;

procedure TbsSkinCustomGrid.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FHScrollBar)
  then FHScrollBar := nil;
  if (Operation = opRemove) and (AComponent = FVScrollBar)
  then FVScrollBar := nil;
end;

procedure TbsSkinCustomGrid.SetHScrollBar;
begin
  FHScrollBar := Value;
  if FHScrollBar <> nil
  then
    begin
      FHScrollBar.Enabled := True;
      FHScrollBar.Visible := False;
      FHScrollBar.OnLastChange := OnHScrollBarChange;
      FHScrollBar.OnUpButtonClick := OnHScrollBarUpButtonClick;
      FHScrollBar.OnDownButtonClick := OnHScrollBarDownButtonClick;
      FHScrollBar.OnPageUp := OnHScrollBarPageUp;
      FHScrollBar.OnPageDown := OnHScrollBarPageDown;
      UpdateScrollRange(True);
    end;
end;

procedure TbsSkinCustomGrid.SetVScrollBar;
begin
  FVScrollBar := Value;
  if FVScrollBar <> nil
  then
    begin
      FVScrollBar.Enabled := True;
      FVScrollBar.Visible := False;
      FVScrollBar.OnLastChange := OnVScrollBarChange;
      FVScrollBar.OnUpButtonClick := OnVScrollBarUpButtonClick;
      FVScrollBar.OnDownButtonClick := OnVScrollBarDownButtonClick;
      FVScrollBar.OnPageUp := OnVScrollBarPageUp;
      FVScrollBar.OnPageDown := OnVScrollBarPageDown;
      UpdateScrollRange(True);
    end;  
end;

procedure TbsSkinCustomGrid.OnVScrollBarUpButtonClick(Sender: TObject);
begin
  SendMessage(Handle, WM_VSCROLL,
    MakeWParam(SB_LINEDOWN, VScrollBar.Position), 0);
end;

procedure TbsSkinCustomGrid.OnVScrollBarDownButtonClick(Sender: TObject);
begin
  SendMessage(Handle, WM_VSCROLL,
    MakeWParam(SB_LINEUP, VScrollBar.Position), 0);
end;

procedure TbsSkinCustomGrid.OnHScrollBarUpButtonClick(Sender: TObject);
begin
  FHScrollBar.Position := FHScrollBar.Position + FHScrollBar.SmallChange;
  SendMessage(Handle, WM_HSCROLL,
    MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
end;

procedure TbsSkinCustomGrid.OnHScrollBarDownButtonClick(Sender: TObject);
begin
  FHScrollBar.Position := FHScrollBar.Position - FHScrollBar.SmallChange;
  SendMessage(Handle, WM_HSCROLL,
    MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
end;

procedure TbsSkinCustomGrid.OnVScrollBarPageUp(Sender: TObject);
begin
  SendMessage(Handle, WM_VSCROLL,
  MakeWParam(SB_PAGEUP, 0), 0);
end;

procedure TbsSkinCustomGrid.OnVScrollBarPageDown(Sender: TObject);
begin
  SendMessage(Handle, WM_VSCROLL,
  MakeWParam(SB_PAGEDOWN, 0), 0);
end;

procedure TbsSkinCustomGrid.OnHScrollBarPageUp(Sender: TObject);
begin
  SendMessage(Handle, WM_HSCROLL,
  MakeWParam(SB_PAGEUP, 0), 0);
end;

procedure TbsSkinCustomGrid.OnHScrollBarPageDown(Sender: TObject);
begin
  SendMessage(Handle, WM_HSCROLL,
  MakeWParam(SB_PAGEDOWN, 0), 0);
end;

procedure TbsSkinCustomGrid.OnVScrollBarChange(Sender: TObject);
begin
  SendMessage(Handle, WM_VSCROLL,
  MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
end;

procedure TbsSkinCustomGrid.OnHScrollBarChange(Sender: TObject);
begin
  SendMessage(Handle, WM_HSCROLL,
  MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
end;

function TbsSkinCustomGrid.GetNewTextRect;
var
  SR1, SR2, R: TRect;
  OX, OY: Integer;
begin
  if FIndex < 0
  then
    begin
      Result := CellR;
      Exit;
    end
  else
    begin
      R := CellR;
      if gdFixed in AState
      then
        begin
          SR1 := FixedCellRect;
          SR2 := FixedCellTextRect;
        end
      else
        begin
          SR1 := SelectCellRect;
          SR2 := CellTextRect;
        end;

      if not IsNullRect(SR2)
      then
        begin
          if not UseSkinCellHeight
          then
            OY := RectHeight(R) - RectHeight(FixedCellRect)
          else
            OY := 0;  
          OX := RectWidth(CellR) - RectWidth(SR1);
          Inc(R.Left, SR2.Left);
          Inc(R.Top, SR2.Top);
          R.Right := R.Left + RectWidth(SR2) + OX;
          R.Bottom := R.Top + RectHeight(SR2) + OY;
        end;
      Result := R;
    end
end;

procedure TbsSkinCustomGrid.ChangeSkinData;
var
  i, Old: Integer;
begin
  GetSkinData;
  if FIndex > -1
  then
    begin
      Old := DefaultRowHeight;
      i := RectHeight(SelectCellRect);
      if (i <> Old) and FUseSkinCellHeight
      then
        DefaultRowHeight := i
      else
        Invalidate;
    end
  else
    begin
      DefaultRowHeight := FDefaultCellHeight;
      Invalidate;
    end;
  UpDateScrollRange(True);
  if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
  if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;

procedure TbsSkinCustomGrid.GetSkinData;
begin
  Picture := nil;
  FIndex := -1;
  inherited;
  if FIndex > -1
  then
    if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinGridControl
    then
      with TbsDataSkinGridControl(FSD.CtrlList.Items[FIndex]) do
      begin
        //
        if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
        then
          Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
        else
          Picture := nil;
        //
        Self.FixedCellRect := FixedCellRect;
        Self.SelectCellRect := SelectCellRect;
        Self.FocusCellRect := FocusCellRect;
        Self.FixedCellLeftOffset := FixedCellLeftOffset;
        Self.FixedCellRightOffset := FixedCellRightOffset;
        Self.FixedCellTextRect := FixedCellTextRect;
        Self.CellLeftOffset := CellLeftOffset;
        Self.CellRightOffset := CellRightOffset;
        Self.CellTextRect := CellTextRect;
        Self.LinesColor := LinesColor;
        Self.BGColor := BGColor;
        //
        Self.FontName := FontName;
        Self.FontStyle := FontStyle;
        Self.FontHeight := FontHeight;
        Self.FontColor := FontColor;
        Self.SelectFontColor := SelectFontColor;
        Self.FocusFontColor := FocusFontColor;
        Self.FixedFontName := FixedFontName;
        Self.FixedFontStyle := FixedFontStyle;
        Self.FixedFontHeight := FixedFontHeight;
        Self.FixedFontColor := FixedFontColor;

        if IsNullRect(Self.SelectCellRect)
        then
          Self.SelectCellRect := Self.FocusCellRect; 
        if IsNullRect(Self.FocusCellRect)
        then
          Self.FocusCellRect := Self.SelectCellRect;

        if IsNullRect(Self.FixedCellRect)
        then
          begin
            FIndex := -1;
            Picture := nil;
          end;
          
      end;
end;

procedure TbsSkinCustomGrid.AdjustSize(Index, Amount: Longint; Rows: Boolean);
var
  NewCur: TGridCoord;
  OldRows, OldCols: Longint;
  MovementX, MovementY: Longint;
  MoveRect: TGridRect;
  ScrollArea: TRect;
  AbsAmount: Longint;

  function DoSizeAdjust(var Count: Longint; var Extents: Pointer;
    DefaultExtent: Integer; var Current: Longint): Longint;
  var
    I: Integer;
    NewCount: Longint;
  begin
    NewCount := Count + Amount;
    if NewCount < Index then InvalidOp(STooManyDeleted);
    if (Amount < 0) and Assigned(Extents) then
    begin
      Result := 0;
      for I := Index to Index - Amount - 1 do
        Inc(Result, PIntArray(Extents)^[I]);
    end
    else
      Result := Amount * DefaultExtent;
    if Extents <> nil then
      ModifyExtents(Extents, Index, Amount, DefaultExtent);
    Count := NewCount;
    if Current >= Index then
      if (Amount < 0) and (Current < Index - Amount) then Current := Index
      else Inc(Current, Amount);
  end;

begin
  if Amount = 0 then Exit;
  NewCur := FCurrent;
  OldCols := ColCount;
  OldRows := RowCount;
  MoveRect.Left := FixedCols;
  MoveRect.Right := ColCount - 1;
  MoveRect.Top := FixedRows;
  MoveRect.Bottom := RowCount - 1;
  MovementX := 0;
  MovementY := 0;
  AbsAmount := Amount;
  if AbsAmount < 0 then AbsAmount := -AbsAmount;
  if Rows then
  begin
    MovementY := DoSizeAdjust(FRowCount, FRowHeights, DefaultRowHeight, NewCur.Y);
    MoveRect.Top := Index;
    if Index + AbsAmount <= TopRow then MoveRect.Bottom := TopRow - 1;
  end
  else
  begin
    MovementX := DoSizeAdjust(FColCount, FColWidths, DefaultColWidth, NewCur.X);
    MoveRect.Left := Index;
    if Index + AbsAmount <= LeftCol then MoveRect.Right := LeftCol - 1;
  end;
  GridRectToScreenRect(MoveRect, ScrollArea, True);
  if not IsRectEmpty(ScrollArea) then
  begin
    ScrollWindow(Handle, MovementX, MovementY, @ScrollArea, @ScrollArea);
    UpdateWindow(Handle);
  end;
  SizeChanged(OldCols, OldRows);
  if (NewCur.X <> FCurrent.X) or (NewCur.Y <> FCurrent.Y) then
    MoveCurrent(NewCur.X, NewCur.Y, True, True);
end;

function TbsSkinCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
var
  GridRect: TGridRect;
begin
  GridRect.Left := ALeft;
  GridRect.Right := ARight;
  GridRect.Top := ATop;
  GridRect.Bottom := ABottom;
  GridRectToScreenRect(GridRect, Result, False);
end;

procedure TbsSkinCustomGrid.DoExit;
begin
  inherited DoExit;
  if not (goAlwaysShowEditor in Options) then HideEditor;
end;

function TbsSkinCustomGrid.CellRect(ACol, ARow: Longint): TRect;
begin
  Result := BoxRect(ACol, ARow, ACol, ARow);
end;

function TbsSkinCustomGrid.CanEditAcceptKey(Key: Char): Boolean;
begin
  Result := True;
end;

function TbsSkinCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
begin
  Result := True;
end;

function TbsSkinCustomGrid.CanEditModify: Boolean;
begin
  Result := FCanEditModify;
end;

function TbsSkinCustomGrid.CanEditShow: Boolean;
begin
  Result := ([goRowSelect, goEditing] * Options = [goEditing]) and
    FEditorMode and not (csDesigning in ComponentState) and HandleAllocated and
    ((goAlwaysShowEditor in Options) or IsActiveControl);
end;

function TbsSkinCustomGrid.IsActiveControl: Boolean;
var
  H: Hwnd;
  ParentForm: TCustomForm;
begin
  Result := False;
  ParentForm := GetParentForm(Self);
  if Assigned(ParentForm) then
  begin
    if (ParentForm.ActiveControl = Self) then
      Result := True
  end
  else
  begin
    H := GetFocus;
    while IsWindow(H) and (Result = False) do
    begin
      if H = WindowHandle then
        Result := True
      else
        H := GetParent(H);
    end;
  end;
end;

function TbsSkinCustomGrid.GetEditMask(ACol, ARow: Longint): string;
begin
  Result := '';
end;

function TbsSkinCustomGrid.GetEditText(ACol, ARow: Longint): string;
begin
  Result := '';
end;

procedure TbsSkinCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
end;

function TbsSkinCustomGrid.GetEditLimit: Integer;
begin
  Result := 0;
end;

procedure TbsSkinCustomGrid.HideEditor;
begin
  FEditorMode := False;
  HideEdit;
end;

procedure TbsSkinCustomGrid.ShowEditor;
begin
  FEditorMode := True;
  UpdateEdit;
end;

procedure TbsSkinCustomGrid.ShowEditorChar(Ch: Char);