cxrichedit.pas

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

function cxRichEditGetOleInterface(ARichEdit: TcxRichInnerEdit;
  out AOleInterface: IcxRichEditOle): Boolean;
begin
  Result := Assigned(ARichEdit) and ARichEdit.HandleAllocated and
    Boolean(SendMessage(ARichEdit.Handle, EM_GETOLEINTERFACE, 0, longint(@AOleInterface)));
end;

function cxRichEditSetOleCallback(ARichEdit: TcxRichInnerEdit;
  AOleInterface: IcxRichEditOleCallback): Boolean;
begin
  Result := Assigned(ARichEdit) and ARichEdit.HandleAllocated and
    Boolean(SendMessage(ARichEdit.Handle, EM_SETOLECALLBACK, 0, longint(AOleInterface)));
end;

function cxGetVCLFrameForm(AForm: TCustomForm): IVCLFrameForm;
begin
  if AForm.OleFormObject = nil then
    TOleForm.Create(AForm);
  Result := AForm.OleFormObject as IVCLFrameForm;
end;

function cxSendStructMessageEx(AHandle: THandle; AMsg: UINT; const AStructure; AParam: Integer; AStructureIsLParam: Boolean): LRESULT; overload;
begin
  if AStructureIsLParam then
    Result := SendMessage(AHandle, AMsg, AParam, Integer(@AStructure))
  else
    Result := SendMessage(AHandle, AMsg, Integer(@AStructure), AParam);
end;

function cxSendStructMessage(AHandle: THandle; AMsg: UINT; WParam: WPARAM; const LParam): LRESULT; overload;
begin
  Result := cxSendStructMessageEx(AHandle, AMsg, LParam, WParam, True);
end;

function cxSendStructMessage(AHandle: THandle; AMsg: UINT; const WParam; LParam: LParam): LRESULT; overload;
begin
  Result := cxSendStructMessageEx(AHandle, AMsg, WParam, LParam, False);
end;

function cxRichEditDLLNames: TcxRichEditNames;

  procedure InitRichEditDLLNames;
  const
    cxRichEditDLLNamesCount = 3;
  begin
    SetLength(FRichEditDLLNames, cxRichEditDLLNamesCount);
    FRichEditDLLNames[0] :=  'Riched32.dll';
    FRichEditDLLNames[1] :=  'Riched20.dll';
    FRichEditDLLNames[2] :=  'Msftedit.dll';
  end;

begin
  if Length(FRichEditDLLNames) = 0 then
    InitRichEditDLLNames;
  Result := FRichEditDLLNames;
end;

function cxRichEditClassNames: TcxRichEditNames;

  procedure InitRichEditClassNames;
  const
    cxRichEditClassNamesCount = 5;
  begin
    SetLength(FRichEditClassNames, cxRichEditClassNamesCount);
    FRichEditClassNames[0] := 'RICHEDIT';
    FRichEditClassNames[1] := 'RICHEDIT20';
    FRichEditClassNames[2] := 'RICHEDIT30';
    FRichEditClassNames[3] := 'RICHEDIT41';
    FRichEditClassNames[4] := 'RICHEDIT50';
  end;

begin
  if Length(FRichEditClassNames) = 0 then
    InitRichEditClassNames;
  Result := FRichEditClassNames;
end;

function AdjustRichLineBreaksW(ADest, ASource: PWideChar; AShortBreak: Boolean = False): Integer;
var
  APrevDest: PWideChar;
begin
  APrevDest := ADest;
  repeat
    if ASource^ in [WideChar($0D), WideChar($0A)] then
    begin
      if AShortBreak then
        ADest^ := WideChar($0D)
      else
      begin
        ADest^ := WideChar($0A);
        Inc(ADest);
        ADest^ := WideChar($0D);
      end;
      if (ASource^ = WideChar($0D)) and ((ASource + 1)^ = WideChar($0A)) then
        Inc(ASource);
    end
    else
      ADest^ := ASource^;
    Inc(ASource);
    Inc(ADest);
  until ASource^ = WideChar($00);
  ADest^ := WideChar($00);
  Result := ADest - APrevDest;
end;

function AdjustRichLineBreaks(ADest, ASource: PChar; AShortBreak: Boolean = False): Integer;
var
  APrevDest: PChar;
begin
  APrevDest := ADest;
  repeat
    if ASource^ in [#13, #10] then
    begin
      if AShortBreak then
        ADest^ := #13
      else
      begin
        PWord(ADest)^ := $0A0D;
        Inc(ADest);
      end;
      if PWord(ASource)^ = $0A0D then
        Inc(ASource);
    end
    else
      ADest^ := ASource^;
    Inc(ASource);
    Inc(ADest);
  until ASource^ = Char(0);
  ADest^ := #0;
  Result := ADest - APrevDest;
end;

function cxRichEditStreamLoad(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
var
  ABuffer, P: PChar;
  AStreamInfo: PRichEditStreamInfo;
begin
  Result := cxRichNoError;
  AStreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  ABuffer := StrAlloc(cb + 1);
  try
    cb := cb div 2;
    pcb := 0;
    P := ABuffer + cb;
    try
      if AStreamInfo^.Converter <> nil then
        pcb := AStreamInfo^.Converter.ConvertReadStream(AStreamInfo^.Stream, P,
          cb);
      if pcb > 0 then
      begin
        P[pcb] := #0;
        if P[pcb - 1] = #13 then
          P[pcb - 1] := #0;
        pcb := AdjustRichLineBreaks(ABuffer, P);
        Move(ABuffer^, pbBuff^, pcb);
      end;
    except
      Result := cxRichReadError;
    end;
  finally
    StrDispose(ABuffer);
  end;
end;

function cxRichEditStreamSave(dwCookie: Longint; pbBuff: PByte; cb: Longint;
  var pcb: Longint): Longint; stdcall;
var
  AStreamInfo: PRichEditStreamInfo;
begin
  Result := cxRichNoError;
  AStreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  try
    pcb := 0;
    if AStreamInfo^.Converter <> nil then
      pcb := AStreamInfo^.Converter.ConvertWriteStream(AStreamInfo^.Stream,
        PChar(pbBuff), cb);
  except
    Result := cxRichWriteError;
  end;
end;

function IsRichText(const AText: string): Boolean;
const
  ARichPrefix = '{\rtf';
begin
  Result := Copy(AText, 1, Length(ARichPrefix)) = ARichPrefix;
end;

procedure LoadRichFromString(ALines: TStrings; const S: string);

  procedure PrepareStream(
    AStream: TStringStream);
  begin
  end;

var
  AStream: TStringStream;
begin
  AStream := TStringStream.Create(S);
  try
    PrepareStream(AStream);
    ALines.LoadFromStream(AStream);
  finally
    AStream.Free;
  end;
end;

procedure ReleaseConversionFormatList;
var
  AConversionFormatList: PConversionFormat;
begin
  while FConversionFormatList <> @TextConversionFormat do
  begin
    AConversionFormatList := FConversionFormatList^.Next;
    Dispose(FConversionFormatList);
    FConversionFormatList := AConversionFormatList;
  end;
end;

function CreateInnerRich: TcxRichInnerEdit;
begin
  Result := nil;
  if Application.Handle <> 0 then
  begin
    Result := TcxRichInnerEdit.Create(nil);
    Result.ParentWindow := Application.Handle;
    SendMessage(Result.Handle, EM_SETEVENTMASK, 0, 0);
  end;
end;

function RichRenderer: TcxRichInnerEdit;
begin
  if FRichRenderer = nil then
    FRichRenderer := CreateInnerRich;
  Result := FRichRenderer;
end;

function RichConverter: TcxRichInnerEdit;
begin
  if FRichConverter = nil then
    FRichConverter := CreateInnerRich;
  Result := FRichConverter;
end;

procedure InternalSetRichEditText(ARichEdit: TRichEdit; const AText: string);
begin
  if not ARichEdit.PlainText then
    LoadRichFromString(ARichEdit.Lines, AText)
  else
    ARichEdit.Perform(WM_SETTEXT, 0, Longint(PChar(AText)));
end;

function ConvertRichText(const AText: string): string;
begin
  InternalSetRichEditText(RichConverter, AText);
  Result := RichConverter.Text;
end;

procedure SetRichDefAttributes(AEdit: TRichEdit; AFont: TFont; ATextColor: TColor);
begin
  if not AEdit.HandleAllocated then
    Exit;

  AEdit.DefAttributes.Assign(AFont);
  AEdit.DefAttributes.Color := ATextColor;
end;

procedure InitRichRenderer(AProperties: TcxCustomRichEditProperties;
  AFont: TFont; AColor, ATextColor: TColor; const AText: string);
begin
  with RichRenderer do
  begin
    MemoMode := TcxCustomRichEditProperties(AProperties).MemoMode;
    PlainText := TcxCustomRichEditProperties(AProperties).PlainText;
    Alignment := TcxCustomRichEditProperties(AProperties).Alignment;
    AutoURLDetect := TcxCustomRichEditProperties(AProperties).AutoURLDetect;
    AllowObjects := TcxCustomRichEditProperties(AProperties).AllowObjects;
    HandleNeeded;

    if not RichRenderer.MemoMode then
      LoadRichFromString(RichLines, AText)
    else
      Text := AText;

    if not IsRichText(AText) or MemoMode or PlainText then
      SetRichDefAttributes(RichRenderer, AFont, ATextColor);
    SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(AColor));
  end;
end;

procedure DrawRichEdit(ADC: HDC; const ARect: TRect; const AText: string;
  AProperties: TcxCustomRichEditProperties; AFont: TFont;
  AColor, ATextColor: TColor; ACalculateHeight: Boolean; out AHeight: Integer);
const
  TwipsPerInch = 1440;
var
  AFormatRange: TFormatRange;
  AStartIndex: Integer;
begin
  if not ACalculateHeight then
    FillRect(ADC, Rect(0, 0, ARect.Right - ARect.Left,
      ARect.Bottom - ARect.Top), GetSolidBrush(AColor));
  InitRichRenderer(AProperties, AFont, AColor, ATextColor, AText);
  SendMessage(RichRenderer.Handle, EM_FORMATRANGE, 0, 0);

  if ACalculateHeight then
    AHeight := 0;
  AFormatRange.hdc := ADC;
  AFormatRange.hdcTarget := ADC;
  AFormatRange.chrg.cpMin := 0;
  AFormatRange.chrg.cpMax := -1;
  repeat
    AFormatRange.rc := cxEmptyRect;
    AFormatRange.rc.Right := (ARect.Right - ARect.Left) * TwipsPerInch div GetDeviceCaps(ADC, LOGPIXELSX);
    if ACalculateHeight then
      AFormatRange.rc.Bottom := TwipsPerInch
    else
      AFormatRange.rc.Bottom := (ARect.Bottom - ARect.Top)(*65535*) * TwipsPerInch div GetDeviceCaps(ADC, LOGPIXELSY);
    AFormatRange.rcPage := AFormatRange.rc;
    AStartIndex := AFormatRange.chrg.cpMin;
    AFormatRange.chrg.cpMin := cxSendStructMessage(RichRenderer.Handle, EM_FORMATRANGE,
      WPARAM(not ACalculateHeight), AFormatRange);
    if AFormatRange.chrg.cpMin <= AStartIndex then
      Break;
    if ACalculateHeight then
      Inc(AHeight, AFormatRange.rc.Bottom - AFormatRange.rc.Top);
  until not ACalculateHeight;
  if ACalculateHeight then
    AHeight := AHeight * GetDeviceCaps(ADC, LOGPIXELSY) div TwipsPerInch;

  SendMessage(RichRenderer.Handle, EM_FORMATRANGE, 0, 0);
end;

procedure SetRichEditText(ARichEdit: TRichEdit; const AEditValue: TcxEditValue);
begin
  InternalSetRichEditText(ARichEdit, VarToStr(AEditValue));
end;

{ TcxRichEdit }

class function TcxRichEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxRichEditProperties;
end;

function TcxRichEdit.GetActiveProperties: TcxRichEditProperties;
begin
  Result := TcxRichEditProperties(InternalGetActiveProperties);
end;

function TcxRichEdit.GetProperties: TcxRichEditProperties;
begin
  Result := TcxRichEditProperties(FProperties);
end;

procedure TcxRichEdit.SetProperties(Value: TcxRichEditProperties);
begin
  FProperties.Assign(Value);
end;

{ TcxRichInnerEditHelper }

constructor TcxRichInnerEditHelper.Create(AEdit: TcxRichInnerEdit);
begin
  inherited Create(nil);
  FEdit := AEdit;
  FEdit.PlainText := False;
  FEdit.WordWrap := False;
end;

function TcxRichInnerEditHelper.GetControl: TWinControl;
begin
  Result := Edit;
end;