frxrichedit.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

function TRxParaAttributes.GetHeadingStyle:THeadingStyle;
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 3 then Result:= 0
  else begin
    GetAttributes(Paragraph);
    Result:= Paragraph.sStyle;
  end;
end;

procedure TRxParaAttributes.SetHeadingStyle(Value:THeadingStyle);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 3 then Exit;
  InitPara(Paragraph);
  with Paragraph do begin
    dwMask:= PFM_STYLE;
    sStyle:= Value;
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetLeftIndent:Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.dxOffset div 20;
end;

procedure TRxParaAttributes.SetLeftIndent(Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask:= PFM_OFFSET;
    dxOffset:= Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetRightIndent:Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.dxRightIndent div 20;
end;

procedure TRxParaAttributes.SetRightIndent(Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask:= PFM_RIGHTINDENT;
    dxRightIndent:= Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetSpaceAfter:Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.dySpaceAfter div 20;
end;

procedure TRxParaAttributes.SetSpaceAfter(Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitPara(Paragraph);
  with Paragraph do begin
    dwMask:= PFM_SPACEAFTER;
    dySpaceAfter:= Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetSpaceBefore:Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.dySpaceBefore div 20;
end;

procedure TRxParaAttributes.SetSpaceBefore(Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitPara(Paragraph);
  with Paragraph do begin
    dwMask:= PFM_SPACEBEFORE;
    dySpaceBefore:= Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetLineSpacing:Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.dyLineSpacing div 20;
end;

procedure TRxParaAttributes.SetLineSpacing(Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 2 then Exit;
  GetAttributes(Paragraph);
  with Paragraph do begin
    dwMask:= PFM_LINESPACING;
    dyLineSpacing:= Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetLineSpacingRule:TLineSpacingRule;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= TLineSpacingRule(Paragraph.bLineSpacingRule);
end;

procedure TRxParaAttributes.SetLineSpacingRule(Value:TLineSpacingRule);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 2 then Exit;
  GetAttributes(Paragraph);
  with Paragraph do begin
    dwMask:= PFM_LINESPACING;
    bLineSpacingRule:= Ord(Value);
  end;
  SetAttributes(Paragraph);
end;

function TRxParaAttributes.GetTab(Index:Byte):Longint;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.rgxTabs[Index] div 20;
end;

procedure TRxParaAttributes.SetTab(Index:Byte; Value:Longint);
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    rgxTabs[Index]:= Value * 20;
    dwMask:= PFM_TABSTOPS;
    if cTabCount < Index then cTabCount:= Index;
    SetAttributes(Paragraph);
  end;
end;

function TRxParaAttributes.GetTabCount:Integer;
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  Result:= Paragraph.cTabCount;
end;

procedure TRxParaAttributes.SetTabCount(Value:Integer);
var
  Paragraph:TParaFormat2;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    dwMask:= PFM_TABSTOPS;
    cTabCount:= Value;
    SetAttributes(Paragraph);
  end;
end;

function TRxParaAttributes.GetTableStyle:TParaTableStyle;
var
  Paragraph:TParaFormat2;
begin
  Result:= tsNone;
  if RichEditVersion < 2 then Exit;
  GetAttributes(Paragraph);
  with Paragraph do begin
    if (wReserved and PFE_TABLEROW)<>0 then
      Result:= tsTableRow
    else if (wReserved and PFE_TABLECELLEND)<>0 then
      Result:= tsTableCellEnd
    else if (wReserved and PFE_TABLECELL)<>0 then
      Result:= tsTableCell;
  end;
end;

procedure TRxParaAttributes.SetTableStyle(Value:TParaTableStyle);
var
  Paragraph:TParaFormat2;
begin
  if RichEditVersion < 2 then Exit;
  InitPara(Paragraph);
  with Paragraph do begin
    dwMask:= PFM_TABLE;
    case Value of
      tsTableRow:wReserved:= PFE_TABLEROW;
      tsTableCellEnd:wReserved:= PFE_TABLECELLEND;
      tsTableCell:wReserved:= PFE_TABLECELL;
    end;
  end;
  SetAttributes(Paragraph);
end;

procedure TRxParaAttributes.AssignTo(Dest:TPersistent);
var
  I:Integer;
begin
  if Dest is TParaAttributes then begin
    with TParaAttributes(Dest) do begin
// if Self.Alignment = paJustify then Alignment:= taLeftJustify
// else
        Alignment:= TAlignment(Self.Alignment);
      FirstIndent:= Self.FirstIndent;
      LeftIndent:= Self.LeftIndent;
      RightIndent:= Self.RightIndent;
      if Self.Numbering<>nsNone then
        Numbering:= TNumberingStyle(nsBullet)
      else Numbering:= TNumberingStyle(nsNone);
      for I:= 0 to MAX_TAB_STOPS-1 do
        Tab[I]:= Self.Tab[I];
    end;
  end
  else inherited AssignTo(Dest);
end;

procedure TRxParaAttributes.Assign(Source:TPersistent);
var
  I:Integer;
  Paragraph:TParaFormat2;
begin
  if Source is TParaAttributes then begin
    Alignment:= TParaAlignment(TParaAttributes(Source).Alignment);
    FirstIndent:= TParaAttributes(Source).FirstIndent;
    LeftIndent:= TParaAttributes(Source).LeftIndent;
    RightIndent:= TParaAttributes(Source).RightIndent;
    Numbering:= TRxNumbering(TParaAttributes(Source).Numbering);
    for I:= 0 to MAX_TAB_STOPS-1 do
      Tab[I]:= TParaAttributes(Source).Tab[I];
  end
  else if Source is TRxParaAttributes then begin
    TRxParaAttributes(Source).GetAttributes(Paragraph);
    SetAttributes(Paragraph);
  end
  else inherited Assign(Source);
end;

{ OLE utility routines }

function WStrLen(Str:PWideChar):Integer;
begin
  Result:= 0;
  while Str[Result]<>#0 do Inc(Result);
end;

procedure ReleaseObject(var Obj);
begin
  if IUnknown(Obj)<>nil then begin
    IUnknown(Obj):= nil;
  end;
end;

procedure CreateStorage(var Storage:IStorage);
var
  LockBytes:ILockBytes;
begin
  OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
  try
    OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_READWRITE
      or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Storage));
  finally
    ReleaseObject(LockBytes);
  end;
end;

procedure DestroyMetaPict(MetaPict:HGlobal);
begin
  if MetaPict<>0 then begin
    DeleteMetaFile(PMetaFilePict(GlobalLock(MetaPict))^.hMF);
    GlobalUnlock(MetaPict);
    GlobalFree(MetaPict);
  end;
end;

function OleSetDrawAspect(OleObject:IOleObject; Iconic:Boolean;
  IconMetaPict:HGlobal; var DrawAspect:Longint):HResult;
var
  OleCache:IOleCache;
  EnumStatData:IEnumStatData;
  OldAspect, AdviseFlags, Connection:Longint;
  TempMetaPict:HGlobal;
  FormatEtc:TFormatEtc;
  Medium:TStgMedium;
  ClassID:TCLSID;
  StatData:TStatData;
begin
  Result:= S_OK;
  OldAspect:= DrawAspect;
  if Iconic then begin
    DrawAspect:= DVASPECT_ICON;
    AdviseFlags:= ADVF_NODATA;
  end
  else begin
    DrawAspect:= DVASPECT_CONTENT;
    AdviseFlags:= ADVF_PRIMEFIRST;
  end;
  if (DrawAspect<>OldAspect) or (DrawAspect = DVASPECT_ICON) then begin
    Result:= OleObject.QueryInterface(IOleCache, OleCache);
    if Succeeded(Result) then
    try
      if DrawAspect<>OldAspect then begin
        { Setup new cache with the new aspect }
        FillChar(FormatEtc, SizeOf(FormatEtc), 0);
        FormatEtc.dwAspect:= DrawAspect;
        FormatEtc.lIndex:=-1;
        Result:= OleCache.Cache(FormatEtc, AdviseFlags, Connection);
      end;
      if Succeeded(Result) and (DrawAspect = DVASPECT_ICON) then begin
        TempMetaPict:= 0;
        if IconMetaPict = 0 then begin
          if Succeeded(OleObject.GetUserClassID(ClassID)) then begin
            TempMetaPict:= OleGetIconOfClass(ClassID, nil, True);
            IconMetaPict:= TempMetaPict;
          end;
        end;
        try
          FormatEtc.cfFormat:= CF_METAFILEPICT;
          FormatEtc.ptd:= nil;
          FormatEtc.dwAspect:= DVASPECT_ICON;
          FormatEtc.lIndex:=-1;
          FormatEtc.tymed:= TYMED_MFPICT;
          Medium.tymed:= TYMED_MFPICT;
          Medium.hMetaFilePict:= IconMetaPict;
          Medium.unkForRelease:= nil;
          Result:= OleCache.SetData(FormatEtc, Medium, False);
        finally
          DestroyMetaPict(TempMetaPict);
        end;
      end;
      if Succeeded(Result) and (DrawAspect<>OldAspect) then begin
        { remove any existing caches that are set up for the old display aspect }
        OleCache.EnumCache(EnumStatData);
        if EnumStatData<>nil then
        try
          while EnumStatData.Next(1, StatData, nil) = 0 do
            if StatData.formatetc.dwAspect = OldAspect then
              OleCache.Uncache(StatData.dwConnection);
        finally
          ReleaseObject(EnumStatData);
        end;
      end;
    finally
      ReleaseObject(OleCache);
    end;
    if Succeeded(Result) and (DrawAspect<>DVASPECT_ICON) then
      OleObject.Update;
  end;
end;

function GetIconMetaPict(OleObject:IOleObject; DrawAspect:Longint):HGlobal;
var
  DataObject:IDataObject;
  FormatEtc:TFormatEtc;
  Medium:TStgMedium;
  ClassID:TCLSID;
begin
  Result:= 0;
  if DrawAspect = DVASPECT_ICON then begin
    OleObject.QueryInterface(IDataObject, DataObject);
    if DataObject<>nil then begin
      FormatEtc.cfFormat:= CF_METAFILEPICT;
      FormatEtc.ptd:= nil;
      FormatEtc.dwAspect:= DVASPECT_ICON;
      FormatEtc.lIndex:=-1;
      FormatEtc.tymed:= TYMED_MFPICT;
      if Succeeded(DataObject.GetData(FormatEtc, Medium)) then
        Result:= Medium.hMetaFilePict;
      ReleaseObject(DataObject);
    end;
  end;
  if Result = 0 then begin
    OleCheck(OleObject.GetUserClassID(ClassID));
    Result:= OleGetIconOfClass(ClassID, nil, True);
  end;
end;

{ Return the first piece of a moniker }

function OleStdGetFirstMoniker(Moniker:IMoniker):IMoniker;
var
  Mksys:Longint;
  EnumMoniker:IEnumMoniker;
begin