cxblobedit.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,542 行 · 第 1/4 页

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Math, cxDrawTextUtils, cxEditUtils, cxGeometry, cxVariants;

const
  cxbmBlobNull = 'CXBMBLOB_BLOB_NULL';
  cxbmBlob     = 'CXBMBLOB_BLOB';
  cxbmMemoNull = 'CXBMBLOB_MEMO_NULL';
  cxbmMemo     = 'CXBMBLOB_MEMO';
  cxbmPictNull = 'CXBMBLOB_PICT_NULL';
  cxbmPict     = 'CXBMBLOB_PICT';
  cxbmOleNull  = 'CXBMBLOB_OLE_NULL';
  cxbmOle      = 'CXBMBLOB_OLE';

type
  TcxEditStyleAccess = class(TcxEditStyle);
  TcxMemoAccess = class(TcxMemo);

  { TcxPopupMemo }

  TcxPopupMemo = class(TcxMemo)
  private
    FBlobEdit: TcxCustomBlobEdit;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure SpellCheckerSetValue(const AValue: Variant); override;
  end;

  { TcxPopupImage }

  TcxPopupImage = class(TcxImage)
  private
    FBlobEdit: TcxCustomBlobEdit;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  end;

function GetBlobText(const Value: TcxEditValue;
  AProperties: TcxCustomBlobEditProperties; AFullText: Boolean): WideString;
begin
  Result := '';
  if AFullText and (AProperties.BlobEditKind = bekMemo) and VarIsStr(Value) then
    Result := Value
  else
    if AProperties.BlobPaintStyle = bpsDefault then
    begin
      case AProperties.BlobEditKind of
        bekMemo:
          if not VarIsNull(Value) then
            Result := cxGetResourceString(@cxSBlobMemo)
          else
            Result := cxGetResourceString(@cxSBlobMemoEmpty);
        bekPict:
          if not VarIsNull(Value) then
            Result := cxGetResourceString(@cxSBlobPicture)
          else
            Result := cxGetResourceString(@cxSBlobPictureEmpty);
      end;
    end
    else
      if (AProperties.BlobPaintStyle = bpsText) and
        (AProperties.BlobEditKind = bekMemo) and VarIsStr(Value) then
      begin
        Result := Value;
        ExtractFirstLine(Result);
      end;
end;

{ TcxBlobEditViewData }

procedure TcxBlobEditViewData.Calculate(ACanvas: TcxCanvas;
  const ABounds: TRect; const P: TPoint; Button: TcxMouseButton;
  Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo; AIsMouseEvent: Boolean);

  function GetIconRect: TRect;
  var
    AIconSize: TSize;
  begin
    if imgBlobImages <> nil then
      AIconSize := cxSize(imgBlobImages.Width, imgBlobImages.Height)
    else
      AIconSize := cxNullSize;
    with AViewInfo.ClientRect do
    begin
      Result.Left := Left + (Right - Left - AIconSize.cx) div 2;
      Result.Top := Top + (Bottom - Top - AIconSize.cy) div 2;
    end;
    Result.Right := Result.Left + AIconSize.cx;
    Result.Bottom := Result.Top + AIconSize.cy;
  end;

begin
  inherited Calculate(ACanvas, ABounds, P, Button, Shift, AViewInfo,
    AIsMouseEvent);
  TcxBlobEditViewInfo(AViewInfo).IconRect := GetIconRect;
  if Edit <> nil then
    EditValueToDrawValue(ACanvas, Edit.EditValue, AViewInfo);
  PrepareDrawTextFlags(ACanvas, AViewInfo);
end;

procedure TcxBlobEditViewData.EditValueToDrawValue(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
begin
  with TcxCustomBlobEditProperties(Properties) do
  begin
    CorrectBlobEditKind;
    if BlobPaintStyle = bpsIcon then
    begin
      TcxBlobEditViewInfo(AViewInfo).Text := '';
      case BlobEditKind of
        bekMemo:
          TcxBlobEditViewInfo(AViewInfo).ImageIndex := 2;
        bekPict:
          TcxBlobEditViewInfo(AViewInfo).ImageIndex := 4;
        bekOle:
          TcxBlobEditViewInfo(AViewInfo).ImageIndex := 6;
        bekBlob:
          TcxBlobEditViewInfo(AViewInfo).ImageIndex := 0;
      end;
      if not VarIsSoftNull(AEditValue) then
        Inc(TcxBlobEditViewInfo(AViewInfo).ImageIndex);
    end
    else
    begin
      inherited EditValueToDrawValue(ACanvas, AEditValue, AViewInfo);
      TcxBlobEditViewInfo(AViewInfo).ImageIndex := -1;
    end;
  end;
end;

function TcxBlobEditViewData.InternalGetEditConstantPartSize(ACanvas: TcxCanvas; AIsInplace: Boolean;
  AEditSizeProperties: TcxEditSizeProperties; var MinContentSize: TSize;
  AViewInfo: TcxCustomEditViewInfo): TSize;
begin
  Result := inherited InternalGetEditConstantPartSize(ACanvas, AIsInplace,
    AEditSizeProperties, MinContentSize, AViewInfo);
  if (TcxCustomBlobEditProperties(Properties).BlobPaintStyle = bpsIcon) and (imgBlobImages <> nil) then
    Result.cx := Result.cx + imgBlobImages.Width;
end;

function TcxBlobEditViewData.InternalEditValueToDisplayText(
  AEditValue: TcxEditValue): string;
begin
  Result := GetBlobText(AEditValue, TcxCustomBlobEditProperties(Properties), False);
end;

procedure TcxBlobEditViewData.PrepareDrawTextFlags(ACanvas: TcxCanvas;
  AViewInfo: TcxCustomEditViewInfo);
var
  AEditViewInfo: TcxBlobEditViewInfo;
begin
  AEditViewInfo := TcxBlobEditViewInfo(AViewInfo);
  AEditViewInfo.DrawTextFlags := CXTO_CENTER_VERTICALLY or CXTO_SINGLELINE;
  if not IsInplace or (epoShowEndEllipsis in PaintOptions) then
    AEditViewInfo.DrawTextFlags := AEditViewInfo.DrawTextFlags or CXTO_END_ELLIPSIS;
end;

{ TcxBlobEditViewInfo }

function TcxBlobEditViewInfo.NeedShowHint(ACanvas: TcxCanvas; const P: TPoint;
  out AText: TCaption; out AIsMultiLine: Boolean; out ATextRect: TRect): Boolean;
begin
  Result := False;
end;

procedure TcxBlobEditViewInfo.Offset(DX, DY: Integer);
begin
  inherited Offset(DX, DY);
  OffsetRect(IconRect, DX, DY);
end;

procedure TcxBlobEditViewInfo.InternalPaint(ACanvas: TcxCanvas);
var
  AClipRgn, APrevClipRgn: TcxRegion;
  R: TRect;
begin
  if not RectVisible(ACanvas.Handle, Bounds) then
    Exit;

  with ACanvas do
  begin
    if (ImageIndex = -1) and (Text <> '') then
    begin
      DrawCustomEdit(ACanvas, Self, True, bpsComboListEdit);
      Brush.Style := bsClear;
      Font := Self.Font;
      Font.Color := TextColor;
      cxTextOut(Canvas, PcxCaptionChar(Text), TextRect, DrawTextFlags);
      Brush.Style := bsSolid;
    end
    else
    begin
      if Assigned(imgBlobImages) and (ImageIndex <> -1) then
      begin
        APrevClipRgn := ACanvas.GetClipRegion;
        IntersectRect(R, IconRect, ClientRect);
        AClipRgn := TcxRegion.Create(R);
        ACanvas.SetClipRegion(AClipRgn, roIntersect);
        try
          if Transparent then
            imgBlobImages.Draw(Canvas, IconRect.Left, IconRect.Top, ImageIndex,
               Enabled)
            else
              cxEditUtils.DrawGlyph(ACanvas,
                imgBlobImages, ImageIndex, IconRect, BackgroundColor, Enabled);
        finally
          ACanvas.SetClipRegion(APrevClipRgn, roSet);
        end;
        if not Transparent then
          ACanvas.ExcludeClipRect(R);
      end;
      DrawCustomEdit(ACanvas, Self, True, bpsComboListEdit);
    end;
    if Focused and not IsInplace and not HasPopupWindow then
    begin
      R := ClientRect;
      InflateRect(R, -1, -1);
      Font.Color := clWhite;
      Brush.Color := clBlack;
      DrawFocusRect(R);
    end;
  end;
end;

{ TcxCustomBlobEditProperties }

constructor TcxCustomBlobEditProperties.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  ImmediatePopup := True;
  PopupMinWidth := 160;
  PopupMinHeight := 140;
  FAlwaysSaveData := True;
  FBlobEditKind := bekAuto;
  FBlobPaintStyle := bpsIcon;
  // Memo
  FMemoCharCase := ecNormal;
  FMemoMaxLength := 0;
  FMemoOEMConvert := False;
  FMemoScrollBars := ssNone;
  FMemoWantReturns := True;
  FMemoWantTabs := True;
  FMemoWordWrap := True;
  // Picture
  FPictureAutoSize := True;
  FPictureGraphicClass := GetDefaultPictureGraphicClass;
  FPictureTransparency := gtDefault;
  FShowExPopupItems := True;
  FShowPicturePopup := True;
end;

function TcxCustomBlobEditProperties.GetPictureGraphicClassName: string;
begin
  if FPictureGraphicClass = nil then
    Result := ''
  else
    Result := FPictureGraphicClass.ClassName;
end;

function TcxCustomBlobEditProperties.IsPictureGraphicClassNameStored: Boolean;
begin
  Result := PictureGraphicClass <> GetDefaultPictureGraphicClass;
end;

procedure TcxCustomBlobEditProperties.ReadIsPictureGraphicClassNameEmpty(Reader: TReader);
begin
  Reader.ReadBoolean;
  PictureGraphicClassName := '';
end;

procedure TcxCustomBlobEditProperties.SetBlobEditKind(
  const Value: TcxBlobEditKind);
begin
  if FBlobEditKind <> Value then
  begin
    FBlobEditKind := Value;
    if Value in [bekPict, bekMemo] then
      Buttons[0].Kind := bkDown
    else
      Buttons[0].Kind := bkEllipsis;
    Changed;
  end;
end;

procedure TcxCustomBlobEditProperties.SetBlobPaintStyle(
  const Value: TcxBlobPaintStyle);
begin
  if FBlobPaintStyle <> Value then
  begin
    FBlobPaintStyle := Value;
    Changed;
  end;
end;

procedure TcxCustomBlobEditProperties.SetPictureGraphicClass(Value: TGraphicClass);
begin
  if FPictureGraphicClass <> Value then
  begin
    FPictureGraphicClass := Value;
    Changed;
  end;
end;

procedure TcxCustomBlobEditProperties.SetPictureGraphicClassName(const Value: string);
var
  APictureGraphicClass: TGraphicClass;
begin
  if Value = '' then
    PictureGraphicClass := nil
  else
  begin
    APictureGraphicClass := GetGraphicClassByName(Value);
    if APictureGraphicClass <> nil then
      PictureGraphicClass := APictureGraphicClass;
  end;
end;

procedure TcxCustomBlobEditProperties.WriteIsPictureGraphicClassNameEmpty(Writer: TWriter);
begin
  Writer.WriteBoolean(True);
end;

function TcxCustomBlobEditProperties.CanValidate: Boolean;
begin
  Result := BlobEditKind = bekMemo;
end;

procedure TcxCustomBlobEditProperties.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('IsPictureGraphicClassNameEmpty', ReadIsPictureGraphicClassNameEmpty,
    WriteIsPictureGraphicClassNameEmpty, PictureGraphicClassName = '');
end;

function TcxCustomBlobEditProperties.DropDownOnClick: Boolean;
begin
  Result := True;
end;

function TcxCustomBlobEditProperties.GetDisplayFormatOptions: TcxEditDisplayFormatOptions;
begin
  Result := [];
end;

class function TcxCustomBlobEditProperties.GetPopupWindowClass: TcxCustomEditPopupWindowClass;
begin
  Result := TcxBlobEditPopupWindow;
end;

class function TcxCustomBlobEditProperties.GetViewDataClass: TcxCustomEditViewDataClass;
begin
  Result := TcxBlobEditViewData;
end;

function TcxCustomBlobEditProperties.HasDisplayValue: Boolean;
begin
  Result := False;
end;

procedure TcxCustomBlobEditProperties.CorrectBlobEditKind;
const
  ABlobEditKindCorrectionA: array[TcxBlobKind] of TcxBlobEditKind =
    (bekBlob, bekBlob, bekPict, bekMemo, bekOle);
begin
  if (BlobEditKind = bekAuto) and
    not((IDefaultValuesProvider <> nil) and not IDefaultValuesProvider.IsDataAvailable) then
  begin
    LockUpdate(True);
    try
      if IDefaultValuesProvider <> nil then
        BlobEditKind := ABlobEditKindCorrectionA[IDefaultValuesProvider.DefaultBlobKind]
      else
        BlobEditKind := bekBlob;
    finally
      LockUpdate(False);
    end;
  end;
end;

function TcxCustomBlobEditProperties.GetDefaultPictureGraphicClass: TGraphicClass;
begin
  if GetRegisteredGraphicClasses.Count > 0 then
    Result := TGraphicClass(GetRegisteredGraphicClasses[0])
  else