dbctrlseh.pas

我对ehlib的修改,优化了计算效率,修正了其本身存在的BUG

end;

function TFieldDataLinkEh.GetFieldsCount: Integer;
begin
  Result := Length(FFields);
end;

function TFieldDataLinkEh.GetFieldsField(Index: Integer): TField;
begin
  if Length(FFields) = 0
    then Result := nil
    else Result := FFields[Index];
end;

procedure TFieldDataLinkEh.LayoutChanged;
begin
  UpdateField;
end;

procedure TFieldDataLinkEh.Reset;
begin
  RecordChanged(nil);
end;

procedure TFieldDataLinkEh.SetMultiFields(const Value: Boolean);
begin
  if FMultiFields <> Value then
  begin
    FMultiFields := Value;
    UpdateField;
  end;
end;

procedure TFieldDataLinkEh.UpdateField;
var
  FieldList: TObjectList;
begin
  FieldList := TObjectList.Create(False);
  if inherited Active and (FFieldName <> '') then
  begin
    if MultiFields then
      if Assigned(FControl)
        then GetFieldsProperty(FieldList, DataSource.DataSet, FControl, FFieldName)
        else DataSet.GetFieldList(FieldList, FFieldName)
    else
      if Assigned(FControl)
        then FieldList.Add(GetFieldProperty(DataSource.DataSet, FControl, FFieldName))
        else FieldList.Add(DataSource.DataSet.FieldByName(FFieldName));
  end;
  SetField(FieldList);
  FieldList.Free;
end;

procedure TFieldDataLinkEh.UpdateRightToLeft;
var
  IsRightAligned: Boolean;
  AUseRightToLeftAlignment: Boolean;
begin
  if Assigned(FControl) and (FControl is TWinControl) then
    with FControl as TWinControl do
      if IsRightToLeft then
      begin
        IsRightAligned :=
          (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_RIGHT) = WS_EX_RIGHT;
        AUseRightToLeftAlignment :=
          DBUseRightToLeftAlignment(TControl(FControl), Field);
        if (IsRightAligned and (not AUseRightToLeftAlignment)) or
          ((not IsRightAligned) and AUseRightToLeftAlignment) then
          Perform(CM_RECREATEWND, 0, 0);
      end;
end;

procedure TFieldDataLinkEh.SetEditing(Value: Boolean);
begin
  if FEditing <> Value then
  begin
    FEditing := Value;
    FModified := False;
    if Assigned(FOnEditingChange) then FOnEditingChange(Self);
  end;
end;

procedure TFieldDataLinkEh.SetField(Value: TObjectList);
  function CompareFieldsAndList(Value: TObjectList): Boolean;
  begin
    Result := True;
  end;
var i: Integer;
begin
  if CompareFieldsAndList(Value) then
  begin
    SetLength(FFields, Value.Count);
    for i := 0 to Value.Count - 1 do
      FFields[i] := TField(Value[i]);
    EditingChanged;
    RecordChanged(nil);
    UpdateRightToLeft;
  end;
end;

procedure TFieldDataLinkEh.SetModified(Value: Boolean);
begin
  FModified := Value;
end;

{$IFDEF CIL}
procedure TFieldDataLinkEh.DataEvent(Event: TDataEvent; Info: TObject);
{$ELSE}
procedure TFieldDataLinkEh.DataEvent(Event: TDataEvent; Info: Integer);
{$ENDIF}
begin
  inherited DataEvent(Event, Info);
{$IFDEF EH_LIB_7}
  if Event = deDisabledStateChange then
  begin
    if Boolean(Info)
      then UpdateField
      else SetLength(FFields, 0);
  end;
{$ENDIF}
end;

{ TCustomDBEditEh }

constructor TCustomDBEditEh.Create(AOwner: TComponent);
{$ifdef eval}
  {$INCLUDE eval}
{$else}
begin
{$endif}

  //ComponentState := ComponentState + [csDesigning];
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable, csCaptureMouse];
  FDataLink := CreateDataLink;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := InternalUpdateData;
  FDataLink.OnActiveChange := ActiveChange;

  FEditButton := CreateEditButton;
  FEditButton.OnChanged := EditButtonChanged;
  FEditButtons := CreateEditButtons;
  FEditButtons.OnChanged := EditButtonChanged;
  FEditImage := CreateEditImage;

  FMRUList := TMRUListEh.Create(Self);
  FMRUList.OnSetDropDown := MRUListDropDown;
  FMRUList.OnSetCloseUp := MRUListCloseUp;

  UpdateControlReadOnly;
  UpdateImageIndex;
end;

destructor TCustomDBEditEh.Destroy;
begin
  FEditImage.Free;
  FEditImage := nil;
  FEditButton.Free;
  FEditButtons.Free;
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  FMRUList.Free;
  inherited Destroy;
end;

procedure TCustomDBEditEh.ResetMaxLength;
var
  F: TField;
begin
  if (MaxLength > 0) then
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
    begin
      F := DataSource.DataSet.FindField(DataField);
      if Assigned(F) and (F.DataType in [ftString, ftWideString]) and (F.Size = MaxLength)
        then MaxLength := 0;
    end //else
//      MaxLength := 0;
end;

procedure TCustomDBEditEh.AdjustHeight;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  if NewStyleControls then
  begin
    if Ctl3D then I := 8 else I := 6;
    if Flat then Dec(I, 2);
    I := GetSystemMetrics(SM_CYBORDER) * I;
  end else
  begin
    I := SysMetrics.tmHeight;
    if I > Metrics.tmHeight then I := Metrics.tmHeight;
    I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  end;
  if (EditImage.Images <> nil) and EditImage.UseImageHeight and
     (EditImage.Images.Height > Metrics.tmHeight)
    then Height := EditImage.Images.Height + I
    else Height := Metrics.tmHeight + I;
end;

function TCustomDBEditEh.ButtonRect: TRect;
begin
  if NewStyleControls and not Ctl3D and (BorderStyle = bsSingle)
    then Result := Rect(ClientWidth - FButtonWidth - 1, 1, ClientWidth - 1, ClientHeight - 1)
    else Result := Rect(ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
  if inherited UseRightToLeftAlignment then
    OffsetRect(Result, FButtonWidth - ClientWidth, 0);
end;

function TCustomDBEditEh.ButtonEnabled: Boolean;
begin
  Result := Enabled and FDataLink.Active;
end;

procedure TCustomDBEditEh.DefaultHandler(var Message);
var
  Msg: TMessage;
begin
  VarToMessage(Message, Msg);
  case Msg.Msg of
    WM_LBUTTONDBLCLK, WM_LBUTTONDOWN, WM_LBUTTONUP,
      WM_MBUTTONDBLCLK, WM_MBUTTONDOWN, WM_MBUTTONUP,
      WM_RBUTTONDBLCLK, WM_RBUTTONDOWN, WM_RBUTTONUP:
{$IFDEF CIL}
      with TWMMouse.Create(Msg) do
{$ELSE}
      with TWMMouse(Message) do
{$ENDIF}
        if (PtInRect(ButtonRect, Point(XPos, YPos)) or PtInRect(ImageRect, Point(XPos, YPos))) and
          not MouseCapture then
          Exit;
    WM_CHAR:
{$IFDEF CIL}
      with TWMKey.Create(Msg) do
{$ELSE}
      with TWMKey(Message) do
{$ENDIF}
      begin
        if (not WantReturns and (CharCode = VK_RETURN)) or
          (not WantTabs and (CharCode = VK_TAB)) or
          (AnsiChar(CharCode) in [#10])
          then
          CharCode := 0;
      end;
  end;
  inherited DefaultHandler(Message);

  if FUserTextChanged then
  begin
    FUserTextChanged := False;
    UserChange;
  end;
end;

procedure TCustomDBEditEh.Loaded;
begin
  inherited Loaded;
  ResetMaxLength;
  if (csDesigning in ComponentState) then DataChange(Self);
  UpdateDrawBorder;
end;

procedure TCustomDBEditEh.Notification(AComponent: TComponent; Operation: TOperation);
var i: Integer;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
    if (FDataLink <> nil) and (AComponent = DataSource)
    then
      DataSource := nil
    else if (EditImage <> nil) and (EditImage.Images <> nil) and (AComponent = EditImage.Images)
    then
      EditImage.Images := nil
    else if (AComponent is TPopupMenu) then
    begin
      if AComponent = EditButton.DropdownMenu then
        EditButton.DropdownMenu := nil;
      for i := 0 to EditButtons.Count - 1 do
        if EditButtons[i].DropdownMenu = AComponent then
          EditButtons[i].DropdownMenu := nil;
    end;
end;

function TCustomDBEditEh.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

procedure TCustomDBEditEh.KeyDown(var Key: Word; Shift: TShiftState);
var AutoRepeat: Boolean;
  eb: TEditButtonEh;
begin
  CheckInplaceEditHolderKeyDown(Key, Shift);
  if Key = 0 then Exit;
  inherited KeyDown(Key, Shift);
  eb := GetEditButtonByShortCut(ShortCut(Key, Shift));
  if (eb <> nil) then
    if (eb = FEditButton) and ButtonEnabled then
    begin
      FEditButtonControlList[0].EditButtonControl.EditButtonDown(False, AutoRepeat);
      FEditButtonControlList[0].EditButtonControl.Click; //DropDown;
      Key := 0;
    end else
    begin
      FEditButtonControlList[eb.Index + 1].EditButtonControl.EditButtonDown(False, AutoRepeat);
      FEditButtonControlList[eb.Index + 1].EditButtonControl.Click; //DropDown;
      Key := 0;
    end;
  if (Key = Word('A')) and (Shift = [ssCtrl]) then
    SelectAll;
  if ((Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift))) and not ReadOnly
    then FDataLink.Edit;
end;

procedure TCustomDBEditEh.KeyUp(var Key: Word; Shift: TShiftState);
begin
  CheckInplaceEditHolderKeyUp(Key, Shift);
  if Key = 0 then Exit;
  inherited KeyUp(Key, Shift);
end;

procedure TCustomDBEditEh.KeyPress(var Key: Char);
begin
  CheckInplaceEditHolderKeyPress(Key);
  if Key = #0 then Exit;
  inherited KeyPress(Key);
  if not DataIndepended then
    if (AnsiChar(Key) in [#32..#255]) and (FDataLink.Field <> nil) and not IsValidChar(Key) then
    begin
      MessageBeep(0);
      Key := #0;
    end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      if not ReadOnly then FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

procedure TCustomDBEditEh.WMChar(var Message: TWMChar);
var
  CharMsg: TMsg;
  DBC: Boolean;
begin
  FCompleteKeyPress := Char(Message.CharCode);
  try
    DBC := False;
    if (AnsiChar(Message.CharCode) in LeadBytes) then
      if PeekMessage(CharMsg, Handle, WM_CHAR, WM_CHAR, PM_NOREMOVE) then
        if CharMsg.Message <> WM_Quit then
        begin
          FCompleteKeyPress := FCompleteKeyPress + Char(CharMsg.wParam);