dbctrlseh.pas

delphi控件类

implementation

uses Commctrl, Clipbrd, DbConsts;

type
  TWinControlCracker = class(TWinControl) end;

const
  InitRepeatPause:Integer = 500;  { pause before first repeat timer (ms) }
  RepeatPause:Integer     = 100;  { pause before next repeat timers (ms) }

{ TEditButtonControlEh }

procedure TEditButtonControlEh.CMHitTest(var Message: TCMHitTest);
begin
  Message.Result := 0;
end;

function TEditButtonControlEh.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TEditButtonControlEh.Paint;
const
  StyleFlags : array [TEditButtonStyleEh] of TDrawButtonControlStyleEh =
   (bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh, bcsUpDownEh);
var Rgn, SaveRgn: HRgn;
    r:Integer;
    BRect: TRect;
    IsClipRgn:Boolean;
begin
  if not (Style = ebsGlyphEh) then
    PaintButtonControlEh(Canvas.Handle,Rect(0,0,Width,Height),
      TWinControlCracker(Parent).Color,StyleFlags[Style],FButtonNum,
      Flat, FActive, Enabled, cbUnchecked)
  else
  begin
    IsClipRgn := Flat and not FActive;
    BRect := BoundsRect;
    r := 0;
    SaveRgn := 0;
    if IsClipRgn then
    begin
      SaveRgn := CreateRectRgn(0,0,0,0);
      r := GetClipRgn(Canvas.Handle, SaveRgn);
      with BRect do
        Rgn := CreateRectRgn(Left+1, Top+1, Right-1, Bottom-1);
      SelectClipRgn(Canvas.Handle, Rgn);
      DeleteObject(Rgn);
    end;

    inherited Paint;

    if IsClipRgn then
    begin
      if r = 0 then
        SelectClipRgn(Canvas.Handle, 0)
      else
        SelectClipRgn(Canvas.Handle, SaveRgn);
      DeleteObject(SaveRgn);
      OffsetRect(BRect,-Left,-Top);
      Canvas.Brush.Color := TWinControlCracker(Parent).Color;
      Canvas.FrameRect(BRect);
    end;
  end;
end;

procedure TEditButtonControlEh.SetState(NewState:TButtonState; IsActive:Boolean; ButtonNum:Integer);
begin
  if (FState <> NewState) or (IsActive <> FActive) or (ButtonNum <> FButtonNum) then
  begin
    if (IsActive <> FActive) then
      if IsActive = True
        then Perform(CM_MOUSEENTER,0,0)
        else Perform(CM_MOUSELEAVE,0,0);
    FActive := IsActive;
    FState := NewState;
    FButtonNum := ButtonNum;
    Invalidate;
  end;
end;

procedure TEditButtonControlEh.SetStyle(const Value: TEditButtonStyleEh);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TEditButtonControlEh.SetWidth(const Value: Integer);
begin
  if inherited Width <> Value then
  begin
    inherited Width := Value;
    Parent.Perform(CM_CHILDWIDTHCHANGEDEH,Integer(Self),0);
  end;
end;

procedure TEditButtonControlEh.SetWidthNoNotify(AWidth: Integer);
begin
  inherited Width := AWidth;
end;

{ TEditButtonEh }

constructor TEditButtonEh.Create(EditControl: TWinControl; EditButtonControl: TEditButtonControlEh);
begin
  inherited Create;
  FEditControl := EditControl;
  FEditButtonControl := EditButtonControl;
  FShortCut := Menus.ShortCut(VK_DOWN, [ssAlt]); //32808
end;

destructor TEditButtonEh.Destroy;
begin
  inherited Destroy;
end;

procedure TEditButtonEh.Assign(Source: TPersistent);
begin
  if Source is TEditButtonEh then
  begin
    Glyph := TEditButtonEh(Source).Glyph;
    NumGlyphs := TEditButtonEh(Source).NumGlyphs;
    Style := TEditButtonEh(Source).Style;
    ShortCut := TEditButtonEh(Source).ShortCut;
    Visible := TEditButtonEh(Source).Visible;
    Width := TEditButtonEh(Source).Width;
  end else
    inherited Assign(Source);
end;

function TEditButtonEh.GetGlyph: TBitmap;
begin
  Result := FEditButtonControl.Glyph;
end;

function TEditButtonEh.GetNumGlyphs: Integer;
begin
  Result := FEditButtonControl.NumGlyphs;
end;

procedure TEditButtonEh.SetGlyph(const Value: TBitmap);
begin
  FEditButtonControl.Glyph := Value;
end;

procedure TEditButtonEh.SetNumGlyphs(const Value: Integer);
begin
  FEditButtonControl.NumGlyphs := Value;
end;

procedure TEditButtonEh.SetStyle(const Value: TEditButtonStyleEh);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    FEditButtonControl.Style := Value;
  end;
end;

procedure TEditButtonEh.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    if FEditControl <> nil then FEditControl.Perform(CM_CHILDWIDTHCHANGEDEH,Integer(Self),0);
    //FEditButtonControl.Width := Value;
  end;
end;

procedure TEditButtonEh.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    if FEditControl <> nil then FEditControl.Perform(CM_CHILDWIDTHCHANGEDEH,Integer(Self),0);
  end;
end;

{ TEditImageEh }

constructor TEditImageEh.Create(EditControl: TWinControl);
begin
  inherited Create;
  FEditControl := EditControl;
  FUseImageHeight := True;
end;

destructor TEditImageEh.Destroy;
begin
  inherited Destroy;
end;

procedure TEditImageEh.Assign(Source: TPersistent);
begin
  if Source is TEditImageEh then
  begin
    Images := TEditImageEh(Source).Images;
    ImageIndex := TEditImageEh(Source).ImageIndex;
    Visible := TEditImageEh(Source).Visible;
    Width := TEditImageEh(Source).Width;
  end else
    inherited Assign(Source);
end;

procedure TEditImageEh.SetImageIndex(const Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    if FEditControl <> nil then FEditControl.Invalidate;
  end;
end;

procedure TEditImageEh.SetImages(const Value: TCustomImageList);
begin
  if FImages <> Value then
  begin
    FImages := Value;
    if FEditControl <> nil then
    begin
      FEditControl.Perform(CM_EDITIMAGECHANGEDEH,Integer(Self),0);
      if Value <> nil then Value.FreeNotification(FEditControl);
    end;
  end;
end;

procedure TEditImageEh.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    if FEditControl <> nil then FEditControl.Perform(CM_EDITIMAGECHANGEDEH,Integer(Self),0);
  end;
end;

procedure TEditImageEh.SetWidth(const Value: Integer);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    if FEditControl <> nil then FEditControl.Perform(CM_EDITIMAGECHANGEDEH,Integer(Self),0);
  end;
end;

procedure TEditImageEh.SetUseImageHeight(const Value: Boolean);
begin
  if FUseImageHeight <> Value then
  begin
    FUseImageHeight := Value;
    if FEditControl <> nil then FEditControl.Perform(CM_EDITIMAGECHANGEDEH,Integer(Self),0);
  end;
end;

{ TFieldDataLinkEh }

constructor TFieldDataLinkEh.Create;
begin
  inherited Create;
  VisualControl := True;
  FDataIndepended := True;
  DataIndependentValue := Null;
end;

function TFieldDataLinkEh.Edit: Boolean;
begin
  if DataIndepended then
  begin
    if not Editing and not ReadOnly then
    begin
      FEditing := True;
      FModified := False;
      if Assigned(OnEditingChange) then OnEditingChange(Self);
    end;
  end else if CanModify then
    inherited Edit;
 Result := FEditing;
end;

function TFieldDataLinkEh.GetActive: Boolean;
begin
  if DataIndepended then Result := True
  else Result := inherited Active and (Field <> nil);
end;

function TFieldDataLinkEh.GetDataSetActive: Boolean;
begin
  Result := (DataSource <> nil) and (DataSource.DataSet <> nil) and DataSource.DataSet.Active;
end;

function TFieldDataLinkEh.GetCanModify: Boolean;
begin
//  Result := inherited CanModify or DataIndepended;
  Result := ((Field <> nil) and Field.CanModify) or DataIndepended;
end;

function TFieldDataLinkEh.GetDataSource: TDataSource;
begin
  Result := inherited DataSource;
end;

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

procedure TFieldDataLinkEh.RecordChanged(Field: TField);
begin
  if (Field = nil) or FieldFound(Field) then
  begin
    if Assigned(FOnDataChange) then FOnDataChange(Self);
    FModified := False;
  end;
end;

procedure TFieldDataLinkEh.SetDataSource(const Value: TDataSource);
begin
  if Value <> inherited DataSource then
  begin
    inherited DataSource := Value;
    UpdateDataIndepended;
  end;
end;

procedure TFieldDataLinkEh.SetFieldName(const Value: string);
begin
  if FFieldName <> Value then
  begin
    FFieldName :=  Value;
    UpdateField;
    UpdateDataIndepended;
  end;
end;

procedure TFieldDataLinkEh.SetText(Text:String);
begin
  if DataIndepended then
  begin
    DataIndependentValue := Text;
    RecordChanged(nil);
  end else if (Field is TMemoField) then {if Field <> nil then}
    Field.AsString := Text
  else
    Field.Text := Text;
end;

procedure TFieldDataLinkEh.SetValue(Value: Variant);
var i:Integer;
begin
  if DataIndepended then
  begin
    DataIndependentValue := Value;
    RecordChanged(nil);
  end else {if Field <> nil then} if FieldsCount > 1 then
  begin
    if VarEquals(Value,Null)
      then for i := 0 to FieldsCount-1 do Fields[i].AsVariant := Null
      else for i := 0 to FieldsCount-1 do Fields[i].AsVariant := Value[i]
  end else
    Field.AsVariant := Value;
end;

procedure TFieldDataLinkEh.UpdateData;
begin
  if DataIndepended then
  begin
    if FModified then
      if Assigned(OnUpdateData) then OnUpdateData(Self);
    FEditing := False;
    FModified := False;
  end else if FModified then
  begin
    if (Field <> nil) and Assigned(FOnUpdateData) then FOnUpdateData(Self);
    FModified := False;
  end;
end;

procedure TFieldDataLinkEh.UpdateDataIndepended;
begin
  if FDataIndepended <> ((DataSource = nil) and (FieldName = '')) then
  begin
    FDataIndepended := (DataSource = nil) and (FieldName = '');
    DataIndependentValue := Null;
    //if {FDataIndepended and} Assigned(OnRecordChange) then OnActiveChange(Self);
    LayoutChanged;
  end;
end;

procedure TFieldDataLinkEh.ActiveChanged;
begin
  UpdateField;
  if Assigned(FOnActiveChange) then FOnActiveChange(Self);
end;

procedure TFieldDataLinkEh.EditingChanged;
begin
  SetEditing(inherited Editing and CanModify);
end;

function TFieldDataLinkEh.FieldFound(Value: TField): Boolean;
var i:Integer;
begin
  Result := False;
  for i := 0 to Length(FFields)-1 do
    if FFields[i] = Value then
    begin
      Result := True;
      Exit;
    end;
end;

procedure TFieldDataLinkEh.FocusControl(Field: TFieldRef);
begin
  if (Field^ <> nil) and FieldFound(Field^) and (FControl is TWinControl) then
    if TWinControl(FControl).CanFocus then
    begin
      Field^ := nil;
      TWinControl(FControl).SetFocus;
    end;
end;

function TFieldDataLinkEh.GetField: TField;