dbctrlseh.pas

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

  FrameRect (DC, R, BtnFaceBrush);

  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 (Focused{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);
    UpdateEditButtonControlsState;
  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);
  UpdateDrawBorder;
  Invalidate;
end;

procedure TCustomDBEditEh.CMExit(var Message: TCMExit);
var i:Integer;
begin
  try
    FDataLink.UpdateRecord;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  SetFocused(False);
  CheckCursor;
  DoExit;
  UpdateDrawBorder;
  Invalidate;
  for i := 0 to ControlCount-1 do
    if GetCaptureControl = Controls[i] then
    begin
      Controls[i].Perform(WM_CANCELMODE, 0, 0);
      Break;
    end;
end;

procedure TCustomDBEditEh.CMFontChanged(var Message: TMessage);
begin
  inherited;
  if (csFixedHeight in ControlStyle) and not ((csDesigning in
    ComponentState) and (csLoading in ComponentState)) then AdjustHeight;
end;

procedure TCustomDBEditEh.CMColorChanged(var Message: TMessage);
begin
  inherited;
  UpdateEditButtonControlsState;
end;

procedure TCustomDBEditEh.CMMouseEnter(var Message: TMessage);
begin
  //if Message.LParam = 0 then
  //begin
    FMouseAboveControl := True;
    UpdateDrawBorder;
  //end;
end;

procedure TCustomDBEditEh.CMMouseLeave(var Message: TMessage);
begin
//  if Message.LParam = 0 then
//  begin
    FMouseAboveControl := False;
    UpdateDrawBorder;
//  end;
end;

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

procedure TCustomDBEditEh.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TCustomDBEditEh.WMNCPaint(var Message: TMessage);
begin
  if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) and Flat then
  begin
    DrawBorder(0,FBorderActive);
    Message.Result := 1;
  end else
    inherited;
end;

procedure TCustomDBEditEh.WMSetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  if PtInRect(ButtonRect,Point(P.X,P.Y)) or PtInRect(ImageRect,Point(P.X,P.Y))
    then Windows.SetCursor(LoadCursor(0, idc_Arrow))
    else inherited;
end;

procedure TCustomDBEditEh.CheckCursor;
var
  SelStart, SelStop: Integer;
begin
  if not HandleAllocated then  Exit;
  if (IsMasked) then
  begin
    GetSel(SelStart, SelStop);
    if SelStart = SelStop then
      if SelStart-2 < 0
        then SetCursor(0)
        else SetCursor(SelStart-2);
  end;
end;

{ // Fixing up bug with mouseclick cursor pos in masked mode
procedure TCustomDBEditEh.EMGetSel(var Message: TMessage);
begin
  inherited;
  if FFixingCurPos and (PInteger(Message.WParam)^ = PInteger(Message.LParam)^) then
  begin
    PInteger(Message.WParam)^ := PInteger(Message.WParam)^ - 3;
    if PInteger(Message.WParam)^ < 0 then PInteger(Message.WParam)^ := 0;
    PInteger(Message.LParam)^ := PInteger(Message.LParam)^ - 3;
    if PInteger(Message.LParam)^ < 0 then PInteger(Message.LParam)^ := 0;
  end;
end;
}

procedure TCustomDBEditEh.PaintWindow(DC: HDC);
const
  AlignStyle : array[Boolean, TAlignment] of DWORD =
   ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
    (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
var
  Left: Integer;
  Margins: TPoint;
  R: TRect;
//  DC: HDC;
  PS: TPaintStruct;
  S: string;
  AAlignment: TAlignment;
  ExStyle: DWORD;
  PaintControlName:Boolean;
//  TextPainted:Boolean;
begin
  DrawEditImage(DC);
  AAlignment := Alignment;
  if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  PaintControlName := (csDesigning in ComponentState) and not (FDataLink.Active);
//  TextPainted := False;
  if ((AAlignment = taLeftJustify) or FFocused or FWordWrap) and
    not (csPaintCopy in ControlState) and not PaintControlName then
  begin
    if SysLocale.MiddleEast and HandleAllocated and (IsRightToLeft) then
    begin { This keeps the right aligned text, right aligned }
      ExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and
        (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR);
      if UseRightToLeftReading then ExStyle := ExStyle or WS_EX_RTLREADING;
      if UseRightToLeftScrollbar then ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
      ExStyle := ExStyle or
        AlignStyle[UseRightToLeftAlignment, AAlignment];
      if DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) <> ExStyle then
        SetWindowLong(Handle, GWL_EXSTYLE, ExStyle);
    end;
    inherited PaintWindow(DC);
//    with EditImage do
//      if not Visible or (ImageList = nil) or (ImageIndex < 0) then Exit;
//    TextPainted := True;
    Exit;
  end;
{ Since edit controls do not handle justification unless multi-line (and
  then only poorly) we will draw right and center justify manually unless
  the edit has the focus. }
  if FCanvas = nil then
  begin
    FCanvas := TControlCanvas.Create;
    FCanvas.Control := Self;
  end;
//  DC := Message.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  FCanvas.Handle := DC;
  try
//    with EditImage do
//      if Visible and (ImageList <> nil) and (ImageIndex >= 0) then
//        DrawEditImage(FCanvas);
//    if TextPainted then Exit;

    FCanvas.Font := Font;
    with FCanvas do
    begin
      R := ClientRect;
      if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
      begin
        Brush.Color := clWindowFrame;
        FrameRect(R);
        InflateRect(R, -1, -1);
      end;
      R := EditRect;
      Brush.Color := Color;
      if not Enabled then
        Font.Color := clGrayText;
      if PaintControlName then
        S := Name
      else if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then
      begin
        S := FDataLink.Field.DisplayText;
        case CharCase of
          ecUpperCase: S := AnsiUpperCase(S);
          ecLowerCase: S := AnsiLowerCase(S);
        end;
      end else
        S := EditText;
      if PasswordChar <> #0 then FillChar(S[1], Length(S), PasswordChar);
      Margins := GetTextMargins;
      case AAlignment of
        taLeftJustify: Left := Margins.X;
        taRightJustify: Left := EditRect.Right {ClientWidth} - TextWidth(S) - Margins.X;
      else
        Left := (EditRect.Right {ClientWidth} - TextWidth(S)) div 2;
      end;
      if SysLocale.MiddleEast then UpdateTextFlags;
      TextRect(R, Left, Margins.Y, S);
    end;
  finally
    FCanvas.Handle := 0;
    if DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TCustomDBEditEh.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TCustomDBEditEh.GetVariantValue: Variant;
begin
  if DataIndepended then
    Result := Variant({Edit}Text)
  else
    Result := Variant(Text);
end;

function TCustomDBEditEh.IsValidChar(InputChar: Char): Boolean;
begin
  if (FDataLink.Field <> nil) then
    Result := FDataLink.Field.IsValidChar(InputChar)
  else
    Result := True;
end;

procedure TCustomDBEditEh.CMDialogKey(var Message: TCMDialogKey);
begin
  inherited;
end;

procedure TCustomDBEditEh.CMEditImageChangedEh(var Message: TMessage);
begin
  Re