dbctrlseh.pas

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

    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);
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))) and
            not MouseCapture 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.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.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
  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.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;

procedure TCustomDBEditEh.WMChar(var Message: TWMChar);
var CharMsg: TMsg;
    DBC: Boolean;
begin
  FCompleteKeyPress := Char(Message.CharCode);
  try
    DBC := False;
    if (Char(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);
          DBC := True;
        end;

    inherited;

    if DBC and (Char(Message.CharCode) = #0) then
      PeekMessage(CharMsg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE);
  finally
    FCompleteKeyPress := '';
  end;
end;

function TCustomDBEditEh.GetCompleteKeyPress: String;
begin
  Result := FCompleteKeyPress;
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);
  if inherited UseRightToLeftAlignment then
    OffsetRect(Result,FButtonWidth-FImageWidth,0);
end;

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

procedure TCustomDBEditEh.SetFlat(const Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    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);
end;

function TCustomDBEditEh.CreateEditButtons: TEditButtonsEh;
begin
  Result := TEditButtonsEh.Create(Self, TVisibleEditButtonEh);
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;
end;

procedure TCustomDBEditEh.CreateParams(var Params: TCreateParams);
const
  Alignments: array[Boolean, Boolean, TAlignment] of DWORD =
    (((ES_LEFT, ES_LEFT, ES_LEFT),(ES_RIGHT, ES_RIGHT, ES_RIGHT)),
     ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER)));
  WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
  PasswordChars: array[Boolean] of DWORD = (ES_MULTILINE, 0);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WordWraps[FWordWrap] or
                  PasswordChars[PasswordChar <> #0] or
                  Alignments[FWordWrap, UseRightToLeftAlignment, Alignment];
end;

procedure TCustomDBEditEh.CreateWnd;
begin
  inherited CreateWnd;
  UpdateHeight;
  UpdateDrawBorder;

  UpdateEditButtonControlList;
  UpdateEditButtonControlsState;

  if not EditImage.Visible or (EditImage.Images = nil) then
    FImageWidth := 0
  else if (EditImage.Width > 0) and (EditImage.Images <> nil) then
    FImageWidth := EditImage.Width + 4 //  two pixel indent from left and right
  else if EditImage.Images <> nil then
    FImageWidth := EditImage.Images.Width + 4;
  SetEditRect;
end;

function TCustomDBEditEh.DataIndepended:Boolean;
begin
  Result := FDataLink.DataIndepended;
end;

function TCustomDBEditEh.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TCustomDBEditEh.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState))
    then FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
  DataChange(nil);
  Invalidate;
end;

procedure TCustomDBEditEh.SetEditRect;
var
  Loc: TRect;
//  AClientHeight:Integer;
begin
  if inherited UseRightToLeftAlignment
     then SetRect(Loc, FButtonWidth, 0, ClientWidth, ClientHeight)
     else SetRect(Loc, 0, 0, ClientWidth - FButtonWidth, ClientHeight);
  if EditImage.Visible and (EditImage.Images <> nil) then
    if inherited UseRightToLeftAlignment
      then Dec(Loc.Right,FImageWidth)
      else Inc(Loc.Left,FImageWidth);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));

//  AClientHeight := ClientHeight;
//  if NewStyleControls and not Ctl3D and (BorderStyle = bsSingle) then
//    Dec(AClientHeight,2);
end;

function TCustomDBEditEh.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TCustomDBEditEh.SetDataField(const Value: string);
begin
  if not (csDesigning in ComponentState) then
    ResetMaxLength;
  FDataLink.FieldName := Value;
  UpdateEditButtonControlsState;
  Invalidate;
end;

function TCustomDBEditEh.GetReadOnly: Boolean;
begin
  Result := FReadOnly;
end;

procedure TCustomDBEditEh.SetEditButton(const Value: TEditButtonEh);
begin
  FEditButton.Assign(Value);
end;

procedure TCustomDBEditEh.SetEditImage(const Value: TEditImageEh);
begin
  FEditImage.Assign(Value);
end;

procedure TCustomDBEditEh.SetReadOnly(Value: Boolean);
begin
  if FReadOnly <> Value then
  begin
    FReadOnly := Value;
    EditingChanged;
  end;
end;

procedure TCustomDBEditEh.UpdateControlReadOnly;
begin
  SetControlReadOnly(not FDataLink.CanModify or ReadOnly);
end;

function TCustomDBEditEh.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TCustomDBEditEh.ActiveChange(Sender: TObject);
begin
  ActiveChanged;
end;

procedure TCustomDBEditEh.DataChange(Sender: TObject);
begin
  DataChanged;
  UpdateEditButtonControlsState;
end;

procedure TCustomDBEditEh.DrawBorder(DC: HDC; ActiveBorder: Boolean);
var
  R: TRect;
  BtnFaceBrush: HBRUSH;
  NeedReleaseDC: Boolean;
begin
  if not (NewStyleControls and Ctl3D and (BorderStyle = bsSingle))
    or not HandleAllocated then Exit;

  NeedReleaseDC := False;
  if DC = 0 then
  begin
    DC := GetWindowDC(Handle);
    NeedReleaseDC := True;
  end;
  BtnFaceBrush := GetSysColorBrush(COLOR_BTNFACE);

  GetWindowRect(Handle, R);
  OffsetRect (R, -R.Left, -R.Top);

  if ActiveBorder
    then DrawEdge (DC, R, BDR_SUNKENOUTER, BF_RECT)
    else FrameRect(DC, R, BtnFaceBrush);

  OffsetRect (R, -R.Left, -R.Top);
  InflateRect(R, -1, -1);