dbctrlseh.pas

delphi控件类

end;

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

procedure TCustomDBEditEh.CreateWnd;
begin
  inherited CreateWnd;
  UpdateHeight;
  UpdateDrawBorder;
  if not EditButton.Visible then
    FButtonWidth := 0
  else if EditButton.Width > 0 then
    FButtonWidth := EditButton.Width
  else if Flat then
    FButtonWidth := FlatButtonWidth
  else
    FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);

  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.ResetTimer(Interval: Integer);
begin
  if FTimerActive = False then
    SetTimer(Handle, 1, Interval, nil)
  else if Interval <> FTimerInterval then
  begin
    StopTimer;
    SetTimer(Handle, 1, Interval, nil);
  end;
  FTimerInterval := Interval;
  FTimerActive := True;
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 EditButton.Visible
    then SetRect(Loc, 0, 0, ClientWidth - FButtonWidth, ClientHeight)
    else SetRect(Loc, 0, 0, ClientWidth, ClientHeight);
  if EditImage.Visible and (EditImage.Images <> nil)
    then 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);
  if AClientHeight > Round(FButtonWidth * 3 / 2)
    then FButtonHeight := FButtonWidth
    else FButtonHeight := AClientHeight;
  if Flat and EditButton.Visible
    then FButtonLineWidth := 1
    else FButtonLineWidth := 0;

  with ButtonRect do
    FEditSpeedButton.BoundsRect := Rect(Left+FButtonLineWidth,Top,Right,Top+FButtonHeight);
  FEditSpeedButton.Visible := EditButton.Visible;
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;
  UpdateButtonState;
  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.StopTracking;
begin
  if FTracking then
  begin
    TrackButton(-1, -1);
    FTracking := False;
    MouseCapture := False;
    FPressed := False;
    FDownButton := 0;
    FPressedRect := Rect(0,0,0,0);
    UpdateButtonState;
    Repaint;
    StopTimer;
  end;
end;

procedure TCustomDBEditEh.TrackButton(X, Y: Integer);
var
  NewState: Boolean;
begin
  NewState := PtInRect(FPressedRect, Point(X, Y));
  if FPressed <> NewState then
  begin
    FPressed := NewState;
    UpdateButtonState;
    Repaint;
  end;
end;

procedure TCustomDBEditEh.UpdateButtonState;
begin
  with TEditButtonControlEh(FEditSpeedButton) do
    if not ButtonEnabled then
    begin
      Enabled := False;
      SetState(bsDisabled,FBorderActive,FDownButton)
    end else if FPressed then
    begin
      Enabled := True;
      SetState(bsDown,FBorderActive,FDownButton);
    end else
    begin
      Enabled := True;
      SetState(bsUp,FBorderActive,0);
    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;
  UpdateButtonState;
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);
  FrameRect (DC, R, BtnFaceBrush);

  if NeedReleaseDC then
    ReleaseDC(Handle, DC);
end;

procedure TCustomDBEditEh.DrawButtonLine(DC: HDC);
var BRect: TRect;
    NeedReleaseDC: Boolean;
    Brush: HBRUSH;
begin
  if FButtonLineWidth = 0 then Exit;

  NeedReleaseDC := False;
  if DC = 0 then
  begin
    DC := GetDC(Handle);
    NeedReleaseDC := True;
  end;

  BRect := ButtonRect;
  BRect.Right := BRect.Left + FButtonLineWidth;
  BRect.Bottom := BRect.Top + FButtonHeight;
  if FBorderActive then
    FrameRect(DC, BRect,GetSysColorBrush(COLOR_BTNFACE))
  else
  begin
    Brush := CreateSolidBrush(ColorToRGB(Color));
    FrameRect(DC, BRect,Brush);
    DeleteObject(Brush);
  end;

  if NeedReleaseDC then
    ReleaseDC(Handle, DC);
end;

function GetRGBColor(Value: TColor): DWORD;
begin
  Result := ColorToRGB(Value);
  case Result of
    clNone: Result := CLR_NONE;
    clDefault: Result := CLR_DEFAULT;
  end;
end;

procedure DrawImage(DC: HDC; ARect:TRect; Images:TCustomImageList;
                    ImageIndex:Integer; Selected: Boolean);
const
  ImageTypes: array[TImageType] of Longint = (0, ILD_MASK);
  ImageSelTypes: array[Boolean] of Longint = (0, ILD_SELECTED);
var CheckedRect,AUnionRect:TRect;
    OldRectRgn,RectRgn:HRGN;
    r,x,y:Integer;
    procedure DrawIm;
    var ABlendColor: TColor;
    begin
      with Images do
        if HandleAllocated then
        begin
          if Selected then  ABlendColor := clHighlight
          else ABlendColor := BlendColor;
          ImageList_DrawEx(Handle, ImageIndex, DC, x, y, 0, 0,
            GetRGBColor(BkColor), GetRGBColor(ABlendColor),
            ImageTypes[ImageType] or ImageSelTypes[Selected]);
        end;
    end;
begin
  with Images do
  begin
    x := (ARect.Right + ARect.Left - Images.Width) div 2;
    y := (ARect.Bottom + ARect.Top - Images.Height) div 2;
    CheckedRect := Rect(X,Y,X+Images.Width,Y+Images.Height);
    UnionRect(AUnionRect,CheckedRect,ARect);
    if EqualRect(AUnionRect,ARect) then // ARect containt image
      DrawIm
    else
    begin                          // Need clip
      OldRectRgn := CreateRectRgn(0,0,0,0);
      r := GetClipRgn(DC, OldRectRgn);
      RectRgn := CreateRectRgn(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom);
      SelectClipRgn(DC, RectRgn);
      DeleteObject(RectRgn);

      DrawIm;

      if r = 0
        then SelectClipRgn(DC, 0)
        else SelectClipRgn(DC, OldRectRgn);
      DeleteObject(OldRectRgn);
    end;
  end;
end;

procedure TCustomDBEditEh.DrawEditImage(DC: HDC);
var ImRect:TRect;
begin
  with EditImage do
  begin
    if not Visible or (Images = nil) or (ImageIndex < 0) then Exit;
    ImRect := ImageRect;
    InflateRect(ImRect,-2,-1);
    DrawImage(DC,ImRect,Images,ImageIndex,False);
  end;
end;

procedure TCustomDBEditEh.EditingChange(Sender: TObject);
begin
  EditingChanged;
end;

function TCustomDBEditEh.PostDataEvent: Boolean;
begin
  Result := False;
  FDataPosting := True;
  try
    if Assigned(FOnUpdateData) then FOnUpdateData(Self,Result);
  finally
    FDataPosting := False;
  end;
end;

procedure TCustomDBEditEh.ReadEditMask(Reader: TReader);
begin
  EditMask := Reader.ReadString;
end;

procedure TCustomDBEditEh.WriteEditMask(Writer: TWriter);
begin
  Writer.WriteString(EditMask);
end;

procedure TCustomDBEditEh.InternalUpdateData(Sender: TObject);
begin
  UpdateData;
end;

procedure TCustomDBEditEh.UpdateDrawBorder;
var NewBorderActive:Boolean;
begin
  if (csLoading in ComponentState) then Exit;
  NewBorderActive := (csDesigning in ComponentState) or (GetFocus = Handle)
                  or FMouseAboveControl or AlwaysShowBorder;
  if NewBorderActive <> FBorderActive then
  begin
    FBorderActive := NewBorderActive;
    if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) and Flat
      then DrawBorder(0,FBorderActive);
    UpdateButtonState;
    DrawButtonLine(0);
  end;
end;

procedure TCustomDBEditEh.WMUndo(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TCustomDBEditEh.WMPaste(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TCustomDBEditEh.WMCut(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;

procedure TCustomDBEditEh.WMGetDlgCode(var Message: TMessage);
begin
  Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_HASSETSEL;
end;

procedure TCustomDBEditEh.CMWantSpecialKey(var Message: TCMWantSpecialKey);
begin
  inherited;
  if (Message.CharCode = VK_ESCAPE) and Modified then
    Message.Result := 1;
end;

procedure TCustomDBEditEh.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  ClearButtonsBitmapCache;
end;

procedure TCustomDBEditEh.CMEnter(var Message: TCMEnter);
begin
  SetFocused(True);
  inherited;
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  if SysLocale.FarEast and FDataLink.CanModify then
    SetControlReadOnly(False);