⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wwdbedit.pas

📁 胜天进销存源码,国产优秀的进销存
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    property ShowVertScrollBar;
    property ShowHint;
    property TabOrder;
    property TabStop;
//    property Transparent;
    property UnboundDataType;
    property UnboundAlignment;
    property UsePictureMask;
    property Visible;
    property WantReturns;
    property WordWrap;
//    property UnderlineControl;

    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnCheckValue;
//    property OnValidationErrorUsingMask;
  end;
{
  TwwPictureEdit = class(TwwCustomMaskEdit)
  published
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property Picture;
    property WordWrap;

    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnCheckValue;

  end;
}

  procedure Register;

implementation

uses Consts, wwdblook, wwpict, wwtable, wwcommon, wwsystem, wwstr, wwdotdot,
  {$ifdef wwDelphi6Up}
  maskutils, variants,
  {$endif}
  {$ifdef wwDelphi7Up}
  themes,
  {$endif}
  BDE;

type
  TCheatGridCast = class(TCustomGrid);
  TwwDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines,
    dgTabs, dgRowSelect, {dgRowSelectEditable,}
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit,
    dgWordWrap, dgPerfectRowFit, dgMultiSelect, dgShowFooter, dgFooter3DCells,
    dgNoLimitColSize,  dgTrailingEllipsis, dgShowCellHint, dgTabExitsOnLastCol,
    dgFixedResizable, dgFixedEditable, dgProportionalColResize, dgRowResize,
    dgRowLinesDisableFixed, dgColLinesDisableFixed, dgFixedProportionalResize,
    dgHideBottomDataLine);
  TwwDBGridOptions = set of TwwDBGridOption;

function wwGetGridOptions(AControl:TControl): TwwDBGridOptions;
begin
  Result := [];
  if wwIsClass(AControl.Parent.ClassType, 'TwwDBGrid') then
    PChar(@result)^ := Char(wwGetOrdProp(AControl.Parent, 'Options'));
end;

//  TwwCheatGridCast = class(TwwDBGrid);
(*
{$ifdef wwDelphi6Up}
function MaskGetMaskBlank(const EditMask: string): Char;
const DefaultBlank: Char = '_';
begin
  Result := DefaultBlank;
  if Length(EditMask) >= 4 then
  begin
    if (MaskGetCharType(EditMask, Length(EditMask) - 1) =
                                                  mcFieldSeparator) then
    begin
        {in order for blank specifier to be valid, there
         must also be a save specifier }
      if (MaskGetCharType(EditMask, Length(EditMask) - 2) =
                                                  mcFieldSeparator) or
        (MaskGetCharType(EditMask, Length(EditMask) - 3) =
                                                  mcFieldSeparator) then
      begin
        Result := EditMask [Length(EditMask)];
      end;
    end;
  end;
end;
{$endif}
*)

Function HaveAnyRowLines(EditControl: TWinControl): boolean;
var Options: TwwDBGridOptions;
begin
   Options:= wwGetGridOptions(EditControl);
   result:= (dgRowLines in Options) or
       not (dgRowLinesDisableFixed in Options);
end;

constructor TwwDBPicture.Create(Owner: TComponent);
begin
   RelatedComponent:= Owner;
   FAutoFill:= True;
   FAllowInvalidExit:= False;
   FPictureMaskFromDataSet:= True;
end;

constructor TwwRegexMask.Create(Owner: TComponent);
begin
   RelatedComponent:= Owner;
   FMask:= '';
   FCaseSensitive:= true;
end;

procedure TwwRegexMask.SetMask(value: string);
begin
    FMask:= value;
end;

{
procedure TwwPicture.Assign(Source: TPersistent);
begin
  if Source is TwwPicture then
  begin
     FPictureMask:= TwwPicture(Source).PictureMask;
     FAutoFill:= TwwPicture(Source).AutoFill;
     Exit;
  end;
  inherited Assign(Source);
end;
}

procedure TwwDBPicture.Assign(Source: TPersistent);
begin
  if Source is TwwDBPicture then
  begin
     { Update this class }
     FPictureMask:= TwwDBPicture(Source).PictureMask;
     FAutoFill:= TwwDBPicture(Source).AutoFill;
     Exit;
  end;
  inherited Assign(Source);
end;

procedure TwwRegexMask.Assign(Source: TPersistent);
begin
  if Source is TwwRegexMask then
  begin
     { Update this class }
     FMask:= TwwRegexMask(Source).Mask;
     FCaseSensitive:= TwwRegexMask(Source).CaseSensitive;
     FErrorMessage:= TwwRegexMask(Source).ErrorMessage;
     Exit;
  end;
  inherited Assign(Source);
end;

{.$R *.RES}

procedure ResetMaxLength(DBEdit: TwwDBCustomEdit);
var
  F: TField;
begin
  with DBEdit do
  if (MaxLength > 0) and (DataSource<>Nil) and (DataSource.DataSet<>Nil) then
  begin
    F := DataSource.DataSet.FindField(DataField);
    if Assigned(F) and (F.DataType = ftString) and (F.Size = MaxLength) then
      MaxLength := 0;
  end;
end;

constructor TwwDBCustomEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;  { Allow editing even if unbound }
  AutoSize:= True;

{$IFDEF WIN32}
  ControlStyle := ControlStyle + [csReplicatable];
{$ENDIF}

  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FUsePictureMask:= True;
  FAutoFillDate:= True;
  CalcTextMargin;

  Patch:= VarArrayCreate([0, 6], varVariant);
  FEpochYear:= 0;
  Patch[0]:= False;     { InfoPower 2001 - Set to true to not auto-fill prefix }
  Patch[1]:= False; { Skip data change event in wwdbcombobox}
  Patch[2]:= True;  { Set to True to disable new behavior of
                      allowingCombo-box to drop-down in MouseDown event for Delphi 4}
                    { incorporate Patch[2] functionality in IP 5, disabled for now }
  Patch[3]:= False;  { Set to True to disable new behavior of passing
                       cr/escape to form with es_multiline style }
  Patch[4]:= False; { Set to True to allow any character to be typed in instead of beeping for integers}
  Patch[5]:= False; { Used internally by wwdbcomb.pas }
  Patch[6]:= False;

//  FUnderlineControl:= True;

end;

{procedure TwwCustomMaskEdit.SetTransparent(val: boolean);
begin
   if val<>FTransparent then
   begin
     FCreateTransparent:= val;
     FTransparent:= val;
   end
end;
}

destructor TwwDBCustomEdit.Destroy;
begin
  FDataLink.OnDataChange := nil;
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  inherited Destroy;
end;

constructor TwwCustomMaskEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FwwPicture:= TwwDBPicture.create(self);
  FRegexMask:= TwwRegexMask.create(self);
  FWordWrap:= False;
//  Transparent:= True;
  FFrame:= TwwEditFrame.create(self);
  OrigForeColor:= clNone;
  OrigBackColor:= clNone;
end;

destructor TwwCustomMaskEdit.Destroy;
begin
  FwwPicture.Free;
  FRegexMask.Free;
  FFrame.Free;
  inherited Destroy;
end;

procedure TwwCustomMaskEdit.SetWordWrap(val: boolean);
begin
   FWordWrap:= val;
   RecreateWnd;
end;

function TwwDBCustomEdit.isTransparentEffective: boolean;
begin
   result:= Frame.Transparent and Frame.IsFrameEffective
     and not wwIsDesigning(self)
end;

procedure TwwCustomMaskEdit.SetShowVertScrollBar(Value: Boolean);
begin
  if FShowVertScrollBar <> Value then
  begin
    FShowVertScrollBar := Value;
    RecreateWnd;
  end;
end;

procedure TwwCustomMaskEdit.SetController(Value: TwwController);
begin
   if FController<>Value then
   begin
      wwUpdateController(TComponent(FController), Value, self);
      if FController<>nil then
      begin
         FFrame.Assign(FController.Frame);
         if HandleAllocated then RecreateWnd;
      end
   end
end;

procedure TwwCustomMaskEdit.WMVScroll(var Message: TWMVScroll);
begin
   if (parent<>nil) and wwIsClass(parent.classtype, 'TwwCustomDBGrid') and (not Focused) then SetFocus; { Give focus to edit control }
//   if (parent is TwwCustomDBGrid) and (not Focused) then SetFocus;  { Give focus to edit control }
   inherited;
end;

procedure TwwCustomMaskEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not (ES_AUTOVSCROLL or ES_WANTRETURN);
  if (BorderStyle = bsNone) or WordWrap then Params.Style:= Params.Style or ES_MULTILINE;
  if WordWrap then Params.Style := (Params.Style or ES_AUTOVSCROLL) and not ES_AUTOHSCROLL;
  if FWantReturns then Params.Style:= Params.Style or ES_WANTRETURN;
  if FShowVertScrollBar then Params.Style:= Params.Style or WS_VSCROLL;

//  Params.WindowClass.Style := CS_SAVEBITS;
end;

{function TwwDBCustomEdit.IsPasswordCharAssigned: boolean;
begin
   result:= PasswordChar<>#0;
end;
}
procedure TwwDBCustomEdit.CreateParams(var Params: TCreateParams);
var R:TRect;
//    hdc:Integer;
    dc:HDC; { 10/30/98 - Use HDC to avoid range checking problems }
begin
   inherited CreateParams(Params);

   if Frame.enabled then Params.Style:= Params.Style and not WS_BORDER;

   {If WordWrap and SingleLineEditControl then Allow Horizontal Scroll}
   R:= Rect(Left,Top,Left+Width-GetIconIndent,Top+Height);
   dc:= 0;
   try
     dc := GetDC(0);
     if (wwIsSingleLineEdit(dc,R,0)) then
     begin
        if WordWrap then
           Params.Style := Params.Style or ES_AUTOHSCROLL;
        if (((BorderStyle=bsNone) or Frame.enabled) and
           (PasswordChar<>#0)) then { 5/28/98 - Support password char in grid }
//        if (((BorderStyle=bsNone) or Frame.enabled) {and IsPasswordCharAssigned}) then { 5/28/98 - Support password char in grid }
           Params.Style:= Params.Style and not ES_MULTILINE;
     end
   finally
     ReleaseDC(0,dc);
   end;
  // 8/22/00
  //2/20/2002 - Added check for BidiMode.  Otherwise alignment isn't correct when this ws is removed.
  if (EditAlignment = eaRightAlignEditing) or (IsRightToLeft and (BidiMode=bdRightToLeft)) then
     Params.ExStyle := Params.ExStyle or WS_EX_RIGHT
  else Params.ExStyle := Params.ExStyle and not WS_EX_RIGHT;

  if IsTransparentEffective and Frame.CreateTransparent then
  begin
     Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
//     ControlStyle:= ControlStyle - [csOpaque]
  end;

end;

procedure TwwCustomMaskEdit.DoOnCheckValue(Valid: boolean);
begin
   if Assigned(FOnCheckValue) then
      FOnCheckValue(self, Valid);
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -