bsdbgrids.pas

漂亮的皮肤控件 for delphi 567

      FDataList.Color := Color;
      FDataList.Font := Font;
      FDataList.RowCount := Column.DropDownRows;
      FLookupSource.DataSet := LookupDataSet;
      FDataList.KeyField := LookupKeyFields;
      FDataList.ListField := LookupResultField;
      FDataList.ListSource := FLookupSource;
      FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
   end
    else
    begin
      //
      with FPickList do
      begin
        SkinData := Grid.SkinData;
        SkinDataName := TbsSkinCustomDbGrid(Grid).PickListBoxSkinDataName;
        CaptionMode := TbsSkinCustomDbGrid(Grid).PickListBoxCaptionMode;
        if CaptionMode
        then
        begin
          Caption := Column.Title.Caption;
          OnCheckButtonClick := TbsSkinCustomDbGrid(Grid).PickListBoxOnCheckButtonClick;
        end;
      end;  
      FPickList.ChangeSkinData;
      //
      if FPickList.FIndex = -1
      then
        begin
          FPickList.Font := Font;
        end;
      FPickList.Items := Column.Picklist;
      if FPickList.Items.Count >= Integer(Column.DropDownRows) then
        FPickList.Height := Integer(Column.DropDownRows) * FPickList.ListBox.ItemHeight + 4
      else
        FPickList.Height := FPickList.Items.Count * FPickList.ListBox.ItemHeight + 4;
      if Column.Field.IsNull then
        FPickList.ItemIndex := -1
      else
        FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Text);
      J := FPickList.ClientWidth;
      for I := 0 to FPickList.Items.Count - 1 do
      begin
        Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
        if Y > J then J := Y;
      end;
      FPickList.ClientWidth := J;
    end;
    P := Parent.ClientToScreen(Point(Left, Top));
    Y := P.Y + Height;
    if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
    TbsDBPopupListBox(FActiveList).Show(Point(P.X, Y));
    FListVisible := True;
    Invalidate;
    Windows.SetFocus(Handle);
  end;
end;

type
  TWinControlCracker = class(TWinControl) end;

procedure TDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
  begin
    TbsSkinCustomDBGrid(Grid).EditButtonClick;
    KillMessage(Handle, WM_CHAR);
  end
  else
    inherited KeyDown(Key, Shift);
end;

procedure TDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
end;

procedure TDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if (Button = mbLeft) and (FEditStyle <> esSimple) and
    OverButton(Point(X,Y)) then
  begin
    if FListVisible then
      CloseUp(False)
    else
    begin
      MouseCapture := True;
      FTracking := True;
      TrackButton(X, Y);
      if Assigned(FActiveList) then
        DropDown;
    end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ListPos: TPoint;
  MousePos: TSmallPoint;
begin
  if FTracking then
  begin
    TrackButton(X, Y);
    if FListVisible then
    begin
      ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
      if PtInRect(FActiveList.ClientRect, ListPos) then
      begin
        StopTracking;
        MousePos := PointToSmallPoint(ListPos);
        SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
        Exit;
      end;
    end;
  end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  WasPressed: Boolean;
begin
  WasPressed := FPressed;
  StopTracking;
  if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
    TbsSkinCustomDBGrid(Grid).EditButtonClick;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDBGridInplaceEdit.PaintWindow(DC: HDC);
var
  CIndex: Integer;
  ButtonData: TbsDataSkinButtonControl;
  SkinColor: TColor;

procedure DrawSkinButton(C: TCanvas; R: TRect; ADown: Boolean);
var
  B: TBitMap;
  NewCLRect: TRect;
  FSkinPicture: TBitMap;
  NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
  XO, YO: Integer;
begin
  B := TBitMap.Create;
  B.Width := RectWidth(R);
  B.Height := RectHeight(R);
  with ButtonData do
  begin
    XO := RectWidth(R) - RectWidth(SkinRect);
    YO := RectHeight(R) - RectHeight(SkinRect);
    NewLTPoint := LTPoint;
    NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
    NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
    NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
    NewClRect := Rect(CLRect.Left, ClRect.Top,
      CLRect.Right + XO, ClRect.Bottom + YO);
    FSkinPicture := TBitMap(TParentGrid(Grid).SkinData.FActivePictures.Items[ButtonData.PictureIndex]);
    //
    if ADown and not IsNullRect(DownSkinRect)
    then
      begin
        CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
        NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
        B, FSkinPicture, DownSkinRect, B.Width, B.Height, True);
        SkinColor := DownFontColor;
      end
    else
       begin
         CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
         NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
         B, FSkinPicture, SkinRect, B.Width, B.Height, True);
         SkinColor := FontColor;
       end;
   end;
  C.Draw(R.Left, R.Top, B);
  B.Free;
end;

procedure DrawButton(R: TRect);
var
  SaveIndex: Integer;
  C: TCanvas;
begin
  SaveIndex := SaveDC(DC);
  C := TCanvas.Create;
  C.Handle := DC;
  with C do
  begin
    if ButtonData = nil
    then
      begin
        Brush.Color := Color;
        Brush.Style := bsClear;
        Rectangle(R.Left, R.Top, R.Right, R.Bottom);
        DrawArrowImage(C, R, Font.Color, 4);
      end
    else
      begin
        DrawSkinButton(C, R, FPressed);
        DrawArrowImage(C, R, SkinColor, 4);
      end;
  end;
  C.Handle := 0;
  C.Free;
  RestoreDC(DC, SaveIndex);
end;

procedure DrawButton2(R: TRect);
var
  SaveIndex: Integer;
  C: TCanvas;
  W, X, Y: Integer;
begin
  SaveIndex := SaveDC(DC);
  C := TCanvas.Create;
  C.Handle := DC;
  with C do
  begin
    X := R.Left + ((R.Right - R.Left) shr 1) - 1;
    Y := R.Top + ((R.Bottom - R.Top) shr 1) - 1;
    W := FButtonWidth shr 3;
    if W = 0 then W := 1;
    if ButtonData = nil
    then
      begin
        Brush.Color := Color;
        FillRect(R);
        Pen.Color := Font.Color;
      end
    else
      begin
        DrawSkinButton(C, R, FPressed);
        Pen.Color := SkinColor;
      end;
    Rectangle(X, Y, X + W, Y + W);
    Rectangle(X - (W * 2), Y, X - (W * 2) + W, Y + W);
    Rectangle(X + (W * 2), Y, X + (W * 2) + W, Y + W);
  end;
  C.Handle := 0;
  C.Free;
  RestoreDC(DC, SaveIndex);
end;

var
  R: TRect;
begin
  //
  ButtonData := nil;
  if (TParentGrid(Grid).SkinData <> nil)
  then
    CIndex := TParentGrid(Grid).SkinData.GetControlIndex('resizebutton')
  else
    CIndex := -1;
  if CIndex <> -1
  then
    ButtonData := TbsDataSkinButtonControl(TParentGrid(Grid).SkinData.CtrlList[CIndex]);

  if FEditStyle <> esSimple
  then
    begin
      R := ButtonRect;
      if FEditStyle in [esDataList, esPickList]
      then
        DrawButton(R)
      else
        DrawButton2(R);
    ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  end;
  inherited PaintWindow(DC);
end;

procedure TDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
begin
  with TbsSkinCustomDBGrid(Grid) do
    Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
  if Value = FEditStyle then Exit;
  FEditStyle := Value;
  case Value of
    esPickList:
      begin
        if FPickList = nil then
        begin
          FPickList := TbsDBPopupListbox.Create(Self);
          FPickList.Visible := False;
          FPickList.Parent := Self;
          FPickList.OnMouseUp := ListMouseUp;
        end;
        FActiveList := FPickList;
      end;
    esDataList:
      begin
        if FDataList = nil then
        begin
          FDataList := TPopupDataList.Create(Self);
          FDataList.Visible := False;
          FDataList.Parent := Self;
          FDataList.OnMouseUp := ListMouseUp;
        end;
        FActiveList := FDataList;
      end;
  else  { cbsNone, cbsEllipsis, or read only field }
    FActiveList := nil;
  end;
  Repaint;
end;

procedure TDBGridInplaceEdit.StopTracking;
begin
  if FTracking then
  begin
    TrackButton(-1, -1);
    FTracking := False;
    MouseCapture := False;
  end;
end;

procedure TDBGridInplaceEdit.TrackButton(X,Y: Integer);
var
  NewState: Boolean;
  R: TRect;
begin
  R := ButtonRect;
  NewState := PtInRect(R, Point(X, Y));
  if FPressed <> NewState then
  begin
    FPressed := NewState;
    InvalidateRect(Handle, @R, False);
  end;
end;

procedure TDBGridInplaceEdit.UpdateContents;
var
  Column: TbsColumn;
  NewStyle: TEditStyle;
  MasterField: TField;
begin
  with TbsSkinCustomDBGrid(Grid) do
    Column := Columns[SelectedIndex];
  NewStyle := esSimple;
  case Column.ButtonStyle of
   cbsEllipsis: NewStyle := esEllipsis;
   cbsAuto:
     if Assigned(Column.Field) then
     with Column.Field do
     begin
       { Show the dropdown button only if the field is editable }
       if FieldKind = fkLookup then
       begin
         MasterField := Dataset.FieldByName(KeyFields);
         { Column.DefaultReadonly will always be True for a lookup field.
           Test if Column.ReadOnly has been assigned a value of True }
         if Assigned(MasterField) and MasterField.CanModify and
           not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
           with TbsSkinCustomDBGrid(Grid) do
             if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
               NewStyle := esDataList
       end
       else
       if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
         not Column.Readonly then
         NewStyle := esPickList
       else if DataType in [ftDataset, ftReference] then
         NewStyle := esEllipsis;
     end;
  end;
  EditStyle := NewStyle;
  inherited UpdateContents;
 // Font.Assign(Column.Font);
  //
  if Grid.FIndex > -1
   then
      begin
        Self.Color := Grid.BGColor;
        if TParentGrid(Grid).UseSkinFont
        then
          with Font do
          begin
            Name := Grid.FontName;
            Color := Grid.FontColor;
            Style := Grid.FontStyle;
            Height := Grid.FontHeight;
            CharSet := TParentGrid(Grid).Font.CharSet;
          end
        else
          begin
            Font.Assign(TParentGrid(Grid).Font);
            Font.Color := Grid.FontColor;
          end;
      end
    else
      begin
        Color := clWindow;
        Font := TParentGrid(Grid).Font;
      end;
  //
  ImeMode := Column.ImeMode;
  ImeName := Column.ImeName;
end;

procedure TDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);

function NotActiveListHandle: Boolean;
begin
  if FActiveList <> nil
  then
    with TbsDBPopupListbox(FActiveList) do
    begin
      Result := (Message.Sender <> FPickList) and
                (Message.Sender <> FPickList.ListBox);
      if FPickList.ScrollBar <> nil
      then
        Result := Result and (Message.Sender <> FPickList.ScrollBar);
    end
  else
    Result := False;
end;

begin
  if (Message.Sender <> Self) and (Message.Sender <> FActiveList) and
     NotActiveListHandle
  then
    CloseUp(False);
end;

procedure TDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
begin
  StopTracking;