bsdbgrids.pas

BusinessSkinForm的控件包与实例

      begin
        if FDataList = nil then
        begin
          FDataList := TbsPopupDataList.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;
  //
  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;
            if (Grid.SkinData <> nil) and (Grid.SkinData.ResourceStrData <> nil)
            then
              CharSet := Grid.SkinData.ResourceStrData.CharSet
            else
              CharSet := TParentGrid(Grid).Font.CharSet;
          end
        else
          begin
            if TParentGrid(Grid).UseColumnsFont
            then
              Font.Assign(Column.Font)
            else
              Font.Assign(TParentGrid(Grid).Font);
            Font.Color := Grid.FontColor;
            if (Grid.SkinData <> nil) and (Grid.SkinData.ResourceStrData <> nil)
            then
              Font.CharSet := Grid.SkinData.ResourceStrData.CharSet;
          end;
      end
    else
      begin
        Color := clWindow;
        Font := TParentGrid(Grid).Font;
        if (Grid.SkinData <> nil) and (Grid.SkinData.ResourceStrData <> nil)
        then
          Font.CharSet := Grid.SkinData.ResourceStrData.CharSet;
      end;
  ImeMode := Column.ImeMode;
  ImeName := Column.ImeName;
end;

procedure TDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);

function NotActiveListHandle: Boolean;
begin
  if FActiveList <> nil
  then
    if FActiveList is TbsDBPopupListbox
    then
      begin
        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
      end
    else
    if FActiveList is TbsPopupDataList
    then
      begin
        with TbsPopupDataList(FActiveList) do
        begin
          Result := (Message.Sender <> FDataList);
          if FDataList.FScrollBar <> nil
          then
            Result := Result and (Message.Sender <> FDataList.FScrollBar);
        end
      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;
  inherited;
end;

procedure TDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
begin
  if not SysLocale.FarEast then inherited
  else
  begin
    ImeName := Screen.DefaultIme;
    ImeMode := imDontCare;
    inherited;
    if HWND(Message.WParam) <> TbsSkinCustomDBGrid(Grid).Handle then
      ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
  end;
  CloseUp(False);
  with TParentGrid(Grid) do
   if FIndex = -1 then InvalidateCell(Col, Row);
end;

function TDBGridInplaceEdit.ButtonRect: TRect;
begin
  if not TbsSkinCustomDBGrid(Owner).UseRightToLeftAlignment then
    Result := Rect(Width - FButtonWidth, 0, Width, Height)
  else
    Result := Rect(0, 0, FButtonWidth, Height);
end;

function TDBGridInplaceEdit.OverButton(const P: TPoint): Boolean;
begin
  Result := PtInRect(ButtonRect, P);
end;

procedure TDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  with Message do
  if (FEditStyle <> esSimple) and OverButton(Point(XPos, YPos)) then
    Exit;
  inherited;
end;

procedure TDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  if (FEditStyle <> esSimple) and OverButton(P) then
    Windows.SetCursor(LoadCursor(0, idc_Arrow))
  else
    inherited;
end;

procedure TDBGridInplaceEdit.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    wm_KeyDown, wm_SysKeyDown, wm_Char:
      if EditStyle in [esPickList, esDataList] then
      with TWMKey(Message) do
      begin
        DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
        if FActiveList is TbsDBPopupListBox
        then
          begin
            if (CharCode <> 0) and FListVisible
            then
              begin
                with TMessage(Message) do
                  SendMessage(TbsDBPopupListbox(FActiveList).ListBox.Handle, Msg, WParam, LParam);
                Exit;
              end;
          end
        else
          begin
            if (CharCode <> 0) and FListVisible
            then
              begin
                with TMessage(Message) do
                  SendMessage(FActiveList.Handle, Msg, WParam, LParam);
                Exit;
              end;
          end;
      end
  end;
  inherited;
end;


{ TbsGridDataLink }

type
  TIntArray = array[0..MaxMapSize] of Integer;
  PIntArray = ^TIntArray;

constructor TbsGridDataLink.Create(AGrid: TbsSkinCustomDBGrid);
begin
  inherited Create;
  FGrid := AGrid;
  VisualControl := True;
end;

destructor TbsGridDataLink.Destroy;
begin
  ClearMapping;
  inherited Destroy;
end;

function TbsGridDataLink.GetDefaultFields: Boolean;
var
  I: Integer;
begin
  Result := True;
  if DataSet <> nil then Result := DataSet.DefaultFields;
  if Result and SparseMap then
  for I := 0 to FFieldCount-1 do
    if FFieldMap[I] < 0 then
    begin
      Result := False;
      Exit;
    end;
end;

function TbsGridDataLink.GetFields(I: Integer): TField;
begin
  if (0 <= I) and (I < FFieldCount) and (FFieldMap[I] >= 0) then
    Result := DataSet.FieldList[FFieldMap[I]]
  else
    Result := nil;
end;

function TbsGridDataLink.AddMapping(const FieldName: string): Boolean;
var
  Field: TField;
  NewSize: Integer;
begin
  Result := True;
  if FFieldCount >= MaxMapSize then RaiseGridError(STooManyColumns);
  if SparseMap then
    Field := DataSet.FindField(FieldName)
  else
    Field := DataSet.FieldByName(FieldName);

  if FFieldCount = Length(FFieldMap) then
  begin
    NewSize := Length(FFieldMap);
    if NewSize = 0 then
      NewSize := 8
    else
      Inc(NewSize, NewSize);
    if (NewSize < FFieldCount) then
      NewSize := FFieldCount + 1;
    if (NewSize > MaxMapSize) then
      NewSize := MaxMapSize;
    SetLength(FFieldMap, NewSize);
  end;
  if Assigned(Field) then
  begin
    FFieldMap[FFieldCount] := Dataset.FieldList.IndexOfObject(Field);
    Field.FreeNotification(FGrid);
  end
  else
    FFieldMap[FFieldCount] := -1;
  Inc(FFieldCount);
end;

procedure TbsGridDataLink.ActiveChanged;
begin
  FGrid.LinkActive(Active);
  FModified := False;
end;

procedure TbsGridDataLink.ClearMapping;
begin
  FFieldMap := nil;
  FFieldCount := 0;
end;

procedure TbsGridDataLink.Modified;
begin
  FModified := True;
end;

procedure TbsGridDataLink.DataSetChanged;
begin
  FGrid.DataChanged;
  FModified := False;
end;

procedure TbsGridDataLink.DataSetScrolled(Distance: Integer);
begin
  FGrid.Scroll(Distance);
end;

procedure TbsGridDataLink.LayoutChanged;
var
  SaveState: Boolean;
begin
  { FLayoutFromDataset determines whether default column width is forced to
    be at least wide enough for the column title.  }
  SaveState := FGrid.FLayoutFromDataset;
  FGrid.FLayoutFromDataset := True;
  try
    FGrid.LayoutChanged;
  finally
    FGrid.FLayoutFromDataset := SaveState;
  end;
  inherited LayoutChanged;
end;

procedure TbsGridDataLink.FocusControl(Field: TFieldRef);
begin
  if Assigned(Field) and Assigned(Field^) then
  begin
    FGrid.SelectedField := Field^;
    if (FGrid.SelectedField = Field^) and FGrid.AcquireFocus then
    begin
      Field^ := nil;
      FGrid.ShowEditor;
    end;
  end;
end;

procedure TbsGridDataLink.EditingChanged;
begin
  FGrid.EditingChanged;
end;

procedure TbsGridDataLink.RecordChanged(Field: TField);
begin
  FGrid.RecordChanged(Field);
  FModified := False;
end;

procedure TbsGridDataLink.UpdateData;
begin
  FInUpdateData := True;
  try
    if FModified then FGrid.UpdateData;
    FModified := False;
  finally
    FInUpdateData := False;
  end;
end;