dbctrlseh.pas

delphi控件类

begin
  if Length(FFields) = 0
    then Result := nil
    else Result := FFields[0];
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:TList;
begin
  FieldList := TList.Create;
  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: TList);
  function CompareFieldsAndList(Value: TList): 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] := Value[i];
    EditingChanged;
    RecordChanged(nil);
    UpdateRightToLeft;
  end;
end;

{ TCustomDBEditEh }

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;

constructor TCustomDBEditEh.Create(AOwner: TComponent);
begin
{$ifdef eval}
  {$INCLUDE eval}
{$endif}
  //ComponentState := ComponentState + [csDesigning];
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := CreateDataLink;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := InternalUpdateData;
  FDataLink.OnActiveChange := ActiveChange;

  FEditSpeedButton := CreateEditButtonControl;
  FEditButton := CreateEditButton;
  FEditImage := CreateEditImage;

  UpdateControlReadOnly;
end;

destructor TCustomDBEditEh.Destroy;
begin
  FEditImage.Free;
  FEditButton.Free;
  FEditSpeedButton.Free;
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  inherited Destroy;
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);
end;

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

procedure TCustomDBEditEh.ButtonDown(IsDownButton:Boolean);
begin
  if EditButton.Style <> ebsUpDownEh then
    DropDown;
end;

procedure TCustomDBEditEh.DefaultHandler(var Message);
begin
  case TMessage(Message).Msg of
    WM_LBUTTONDBLCLK,WM_LBUTTONDOWN,WM_LBUTTONUP,
    WM_MBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,
    WM_RBUTTONDBLCLK,WM_RBUTTONDOWN,WM_RBUTTONUP:
      with TWMMouse(Message) do
        if PtInRect(ButtonRect,Point(XPos,YPos)) or PtInRect(ImageRect,Point(XPos,YPos)) then
          Exit;
    WM_CHAR:
      with TWMKey(Message) do
        // Check wordwrap mode in future
        if Char(CharCode) in [#13,#10] then
          CharCode := 0;
  end;
  inherited DefaultHandler(Message);
end;

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

procedure TCustomDBEditEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Handled, AutoRepeat: Boolean;
begin
  Handled := False;
  if EditButton.Style = ebsUpDownEh
    then AutoRepeat := True
    else AutoRepeat := False;
  if (Button = mbLeft) then
  begin
    if csLButtonDown in ControlState then SetFocus;
    //SetFocus;
    if not FFocused then Exit;
    if ButtonEnabled and OverButton(Point(X,Y)) then
    begin
      MouseCapture := True;

      FDownButton := 0;
      FPressed := False;
      FTracking := False;
      if EditButton.Style = ebsUpDownEh then
      begin
        if Y < (FButtonHeight div 2) then
        begin
          FDownButton := 1;
          with ButtonRect do
            FPressedRect := Rect(Left,Top,Right,Top+(FButtonHeight div 2));
        end else if Y > (FButtonHeight - FButtonHeight div 2) then
        begin
          FDownButton := 2;
          with ButtonRect do
            FPressedRect := Rect(Left,Top+(FButtonHeight - FButtonHeight div 2),Right,Top+FButtonHeight);
        end;
      end else
      begin
        FDownButton := 2;
        with ButtonRect do
          FPressedRect := Rect(Left,Top,Right,Top+FButtonHeight);
      end;
      if FDownButton <> 0 then
      begin
        FPressed := True;
        FTracking := True;
        UpdateButtonState;
        Repaint;

        if Assigned(FOnButtonDown) then
          FOnButtonDown(Self,FDownButton <> 2,AutoRepeat,Handled);
        //if not MouseCapture then Exit;
        if not Handled then ButtonDown(FDownButton = 2);
        if AutoRepeat then ResetTimer(InitRepeatPause);

      end;
    end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TCustomDBEditEh.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FTracking then TrackButton(X, Y);
  inherited MouseMove(Shift, X, Y);
end;

procedure TCustomDBEditEh.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var ADownButton: Integer;
    Handled: Boolean;
    APressedRect: TRect;
begin
  ADownButton := FDownButton;
  APressedRect := FPressedRect;
  StopTracking;
  Handled := False;
  if PtInRect(APressedRect,Point(X,Y)) and Assigned(FOnButtonClick) and (ADownButton <> 0) then
    FOnButtonClick(Self, Handled);
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TCustomDBEditEh.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
    if (FDataLink <> nil) and (AComponent = DataSource)
    then
      DataSource := nil
    else if (EditImage.Images <> nil)  and (AComponent = EditImage.Images)
    then
      EditImage.Images := nil;
end;

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

procedure TCustomDBEditEh.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (ShortCut(Key,Shift) = FEditButton.ShortCut) and ButtonEnabled then
  begin
    DropDown;
    Key := 0;
  end else 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.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if not DataIndepended then
    if (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;

function TCustomDBEditEh.EditCanModify: Boolean;
begin
  Result := FDataLink.Edit;
end;

function  TCustomDBEditEh.EditRect:TRect;
begin
  if NewStyleControls and not Ctl3D and (BorderStyle = bsSingle) then
    Result := Rect(1+FImageWidth, 1, ClientWidth - FButtonWidth-2, ClientHeight-1)
  else
    Result := Rect(FImageWidth, 0, ClientWidth - FButtonWidth-1, ClientHeight);
end;

procedure TCustomDBEditEh.Reset;
begin
  FDataLink.Reset;
  SelectAll;
end;

procedure TCustomDBEditEh.SetFlat(const Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    FEditSpeedButton.Flat := FFlat;
    RecreateWnd;
  end;
end;

procedure TCustomDBEditEh.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
    FDataLink.Reset;
  end;
end;

function TCustomDBEditEh.CreateEditButton: TEditButtonEh;
begin
  Result := TEditButtonEh.Create(Self,FEditSpeedButton);
end;

function TCustomDBEditEh.CreateEditButtonControl: TEditButtonControlEh;
begin
  Result := TEditButtonControlEh.Create(Self);
  with Result do
  begin
    ControlStyle := ControlStyle + [csReplicatable];
    Width := 10;
    Height := 17;
    Visible := True;
    Transparent := False;
    Parent := Self;
  end;
end;

function TCustomDBEditEh.CreateEditImage: TEditImageEh;
begin
  Result := TEditImageEh.Create(Self);
end;

function TCustomDBEditEh.CreateDataLink:TFieldDataLinkEh;
begin
  Result := TFieldDataLinkEh.Create;
end;

procedure TCustomDBEditEh.Change;
begin
  FDataLink.Modified;
  Modified := True;
  inherited Change;