dbctrlseh.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToBottom),0);
  end;

  case Align of
    daRight: Dec(P.X, DropDownWin.Width - MasterWin.Width);
    daCenter: Dec(P.X, (DropDownWin.Width - MasterWin.Width) div 2);
  end;

  if (DropDownWin.Width > WorkArea.Right - WorkArea.Left) then
    DropDownWin.Width := WorkArea.Right - WorkArea.Left;
  if (P.X + DropDownWin.Width > WorkArea.Right) then
  begin
    P.X := WorkArea.Right - DropDownWin.Width;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToLeft),0);
  end
  else if P.X < 0 then
  begin
    P.X := 0;
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToRight),0);
  end else if Align = daRight then
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToLeft),0)
  else
    DropDownWin.Perform(cm_SetSizeGripChangePosition,Ord(sgcpToRight),0);

  Result := Point(P.X,Y);
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;
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 }

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;

  UpdateControlReadOnly;
end;

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

procedure TCustomDBEditEh.ResetMaxLength;
var
  F: TField;
begin
  if (MaxLength > 0) then