RichEdit

开发平台：

Delphi

RVItem.pas：源码内容

Control.Visible := False;
Control.Parent := TCustomRVData(RVData).GetParentControl;
end;
else
begin
SetExtraPropertyFromRVFStr(s);
end;
end;
end;
else // read from file
begin
if LineNo=0 then
Name := s
else if LineNo=1 then begin
ControlClass := TControlClass(GetClass(s));
if ControlClass<>nil then begin
Control := ControlClass.Create(nil);
Control.Visible := False;
Control.Parent := TCustomRVData(RVData).GetParentControl;
end;
end
else if LineNo=LineCount-1 then begin
if ReadType=2 then
RVFLoadControlBinary(s, TComponent(Control), '', TCustomRVData(RVData).GetParentControl)
else
Result := RVFLoadControl(s, TComponent(Control), '', TCustomRVData(RVData).GetParentControl);
if Result then
if Control=nil then begin
TCustomRVData(RVData).RVFWarnings := TCustomRVData(RVData).RVFWarnings + [rvfwUnknownCtrls];
if not (rvfoIgnoreUnknownCtrls in TCustomRVData(RVData).RVFOptions) then
Result := False;
end;
ReadState := rstSkip;
end
else
SetExtraPropertyFromRVFStr(s);
if (ReadType=2) and (LineNo=LineCount-2) then
ReadMode := rmBeforeBinary;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVControlItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpValid:
Result := Control<>nil;
rvbpDisplayActiveState,rvbpImmediateControlOwner:
Result := True;
rvbpResizable:
Result := FResizable and (PercentWidth=0);
rvbpResizeHandlesOutside:
Result := True;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
function TRVControlItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpAllowsFocus:
Result := (Control<>nil) and (Control is TWinControl) and
TWinControl(Control).TabStop and
TWinControl(Control).CanFocus;
rvbpActualPrintSize:
Result := (PercentWidth>0) and (PercentWidth<=100);
rvbpXORFocus:
Result := False;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
function TRVControlItemInfo.AsText(LineWidth: Integer;
RVData: TPersistent;
const Text, Path: String;
TextOnly,Unicode: Boolean): String;
begin
Result := TCustomRVData(RVData).SaveComponentToFile(Path, Control, rvsfText);
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
Level: Integer; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList);
var s: String;
begin
s := TCustomRVData(RVData).SaveComponentToFile('', Control, rvsfRTF);
if s<>'' then
RVWrite(Stream,s);
end;
{------------------------------------------------------------------------------}
function RVFGetItemOptions(ItemOptions: TRVItemOptions; ForceSameAsPrev: Boolean): TRVItemOptions;
begin
Result := ItemOptions;
if ForceSameAsPrev then begin
Include(Result, rvioSameAsPrev);
Exclude(Result, rvioBR);
Exclude(Result, rvioPageBreakBefore);
end;
end;
{------------------------------------------------------------------------------}
function TRVControlItemInfo.GetRVFExtraPropertyCount: Integer;
begin
Result := inherited GetRVFExtraPropertyCount;
if MinHeightOnPage>0 then
inc(Result);
if FResizable then
inc(Result);
if not FVisible then
inc(Result);
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.SaveRVFExtraProperties(Stream: TStream);
begin
inherited SaveRVFExtraProperties(Stream);
if MinHeightOnPage>0 then
WriteRVFExtraIntPropertyStr(Stream, rvepMinHeightOnPage, MinHeightOnPage);
if FResizable then
WriteRVFExtraIntPropertyStr(Stream, rvepResizable, ord(FResizable));
if not FVisible then
WriteRVFExtraIntPropertyStr(Stream, rvepResizable, ord(FVisible));
end;
{------------------------------------------------------------------------------}
function TRVControlItemInfo.SetExtraIntProperty(Prop: TRVExtraItemProperty; Value: Integer): Boolean;
begin
case Prop of
rvepResizable:
begin
FResizable := Value<>0;
Result := True;
end;
rvepVisible:
begin
FVisible := Value<>0;
if (Control<>nil) and (Control.Parent<>nil) then
Control.Visible := FVisible;
Result := True;
end;
rvepMinHeightOnPage:
begin
MinHeightOnPage := Value;
Result := True;
end;
else
Result := inherited SetExtraIntProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVControlItemInfo.GetExtraIntProperty(Prop: TRVExtraItemProperty; var Value: Integer): Boolean;
begin
case Prop of
rvepResizable:
begin
Value := ord(FResizable);
Result := True;
end;
rvepVisible:
begin
Value := ord(FVisible);
Result := True;
end;
rvepMinHeightOnPage:
begin
Value := MinHeightOnPage;
Result := True;
end;
else
Result := inherited GetExtraIntProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.SaveRVF(Stream: TStream;
RVData: TPersistent;
ItemNo, ParaNo: Integer;
const Name: String;
Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
var SaveType, LineCount: Integer;
begin
if rvfoSaveControlsBody in TCustomRVData(RVData).RVFOptions then begin
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0; // save hex dump
LineCount := 3+GetRVFExtraPropertyCount;
end
else begin
SaveType := 1; // do not save
LineCount := 1+GetRVFExtraPropertyCount;
end;
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, LineCount,
RVFItemSavePara(ParaNo, TCustomRVData(RVData), ForceSameAsPrev),
Byte(RVFGetItemOptions(ItemOptions, ForceSameAsPrev)) and RVItemOptionsMask,
SaveType,
RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options,Tag),
SaveRVFHeaderTail(RVData)]));
RVFWriteLine(Stream, Name);
if SaveType<>1 then begin
RVFWriteLine(Stream, Control.ClassName);
SaveRVFExtraProperties(Stream);
TCustomRVData(RVData).ControlAction(rvcaBeforeRVFSave, ItemNo, Self);
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
RVFSaveControlBinary(Stream, Control)
else
RVFWriteLine(Stream, RVFSaveControl(Control));
TCustomRVData(RVData).ControlAction(rvcaAfterRVFSave, ItemNo, Self);
end
else
SaveRVFExtraProperties(Stream);
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.MovingToUndoList(ItemNo: Integer; RVData, AContainerUndoItem: TObject);
begin
Control.Parent := nil;
TCustomRVData(RVData).ControlAction(rvcaMoveToUndoList, ItemNo, Self);
inherited MovingToUndoList(ItemNo, RVData, AContainerUndoItem);
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.MovingFromUndoList(ItemNo: Integer; RVData: TObject);
begin
TCustomRVData(RVData).ControlAction(rvcaMoveFromUndoList, ItemNo, Self);
Control.Parent := TCustomRVData(RVData).GetParentControl;
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.Inserting(RVData: TObject; var Text: String; Safe: Boolean);
begin
Control.Visible := False;
if not Safe and (RVData<>nil) then
Control.Parent := TCustomRVData(RVData).GetParentControl
else
Control.Parent := nil;
inherited Inserting(RVData, Text, Safe);
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.Focusing;
begin
if Control is TWinControl then
TWinControl(Control).SetFocus;
end;
{------------------------------------------------------------------------------}
procedure TRVControlItemInfo.OnDocWidthChange(DocWidth: Integer;
dli: TRVDrawLineInfo; Printing: Boolean; Canvas: TCanvas;
RVData: TPersistent; sad: PRVScreenAndDevice;
var HShift, Desc: Integer; NoCaching, Reformatting: Boolean);
begin
HShift := 0;
if (PercentWidth>0) and (PercentWidth<=100) then begin
if not Printing then
Control.Width := DocWidth * PercentWidth div 100-Spacing*2;
dli.Width := DocWidth * PercentWidth div 100;
dli.Height := RV_YToDevice(Control.Height+Spacing*2, sad^);
Desc := RV_YToDevice(GetDescent, sad^);
end
else
Desc := GetDescent;
end;
{============================ TRVGraphicItemInfo ==============================}
constructor TRVGraphicItemInfo.CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign);
begin
inherited Create(RVData);
StyleNo := rvsPicture;
Image := AImage;
VAlign := AVAlign;
end;
{------------------------------------------------------------------------------}
destructor TRVGraphicItemInfo.Destroy;
begin
Image.Free;
ImageCopy.Free;
{$IFNDEF RVDONOTUSEANIMATION}
FAnimator.Free;
{$ENDIF}
inherited Destroy;
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.Assign(Source: TCustomRVItemInfo);
var grclass: TGraphicClass;
begin
if Source is TRVGraphicItemInfo then begin
Alt := TRVGraphicItemInfo(Source).Alt;
ImageFileName := TRVGraphicItemInfo(Source).ImageFileName;
ImageWidth := TRVGraphicItemInfo(Source).ImageWidth;
ImageHeight := TRVGraphicItemInfo(Source).ImageHeight;
NoHTMLImageSize := TRVGraphicItemInfo(Source).NoHTMLImageSize;
Image.Free;
ImageCopy.Free;
grclass := TGraphicClass(TRVGraphicItemInfo(Source).Image.ClassType);
Image := RV_CreateGraphics(grclass);
Image.Assign(TRVGraphicItemInfo(Source).Image);
if TRVGraphicItemInfo(Source).ImageCopy<>nil then begin
grclass := TGraphicClass(TRVGraphicItemInfo(Source).ImageCopy.ClassType);
ImageCopy := RV_CreateGraphics(grclass);
ImageCopy.Assign(TRVGraphicItemInfo(Source).ImageCopy);
end
else
ImageCopy := nil;
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.TransferProperties(Source: TCustomRVItemInfo;
RVData: TPersistent);
begin
{$IFNDEF RVDONOTUSEANIMATION}
if (FAnimator=nil) and (Source is TRVGraphicItemInfo) then begin
FAnimator := TRVGraphicItemInfo(Source).FAnimator;
TRVGraphicItemInfo(Source).FAnimator := nil;
if FAnimator<>nil then
TRVAnimator(FAnimator).Update(nil, Self);
UpdateAnimator(RVData);
end;
{$ENDIF}
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetHeight: Integer;
begin
if (ImageHeight>0) then
Result := ImageHeight
else
Result := Image.Height;
inc(Result,Spacing*2);
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetImageHeight(RVStyle: TRVStyle): Integer;
begin
if (ImageHeight>0) then
Result := ImageHeight
else
Result := Image.Height;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetWidth: Integer;
begin
if (ImageWidth>0) then
Result := ImageWidth
else
Result := Image.Width;
inc(Result, Spacing*2);
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetImageWidth(RVStyle: TRVStyle): Integer;
begin
if (ImageWidth>0) then
Result := ImageWidth
else
Result := Image.Width;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas;
RVData: TPersistent): Integer;
begin
if (ImageWidth>0) then
Result := ImageWidth
else
Result := Image.Width;
inc(Result, Spacing*2);
if sad<>nil then
Result := MulDiv(Result, sad.ppixDevice, sad.ppixScreen);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEANIMATION}
procedure TRVGraphicItemInfo.UpdateAnimator(RVData: TObject);
begin
if RVData is TCustomRVFormattedData then begin
if not TCustomRVFormattedData(RVData).AllowAnimation then begin
FAnimator.Free;
FAnimator := nil;
end
else
RV_MakeAnimator(Self, TCustomRVFormattedData(RVData), TRVAnimator(FAnimator));
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
var w,h: Integer;
{...............................................}
procedure DrawBmp;
begin
if (ImageWidth=0) and (ImageHeight=0) then
BitBlt(Canvas.Handle, x, y,
ImageCopy.Width, ImageCopy.Height,
TBitmap(ImageCopy).Canvas.Handle, 0, 0, SRCCOPY)
else
StretchBlt(Canvas.Handle, x, y, w, h,
TBitmap(ImageCopy).Canvas.Handle, 0, 0,
ImageCopy.Width, ImageCopy.Height, SRCCOPY);
end;
{...............................................}
procedure DrawImage(Image: TGraphic);
var DCState: Integer;
begin
DCState := 0;
try
if (ImageWidth=0) and (ImageHeight=0) then begin
if Image is TMetafile then begin
DCState := SaveDC(Canvas.Handle);
IntersectClipRect(Canvas.Handle, x, y, x+Image.Width, y+Image.Height);
end;
try
Canvas.Draw(x, y, Image);
except
end;
end
else begin
if Image is TMetafile then begin
DCState := SaveDC(Canvas.Handle);
IntersectClipRect(Canvas.Handle, x, y, x+w, y+h);
end;
try
Canvas.StretchDraw(Bounds(x, y, w, h), Image);
except
end;
end;
finally
if DCState<>0 then
RestoreDC(Canvas.Handle, DCState);
end;
end;
{...............................................}
begin
w := GetImageWidth(Style);
h := GetImageHeight(Style);
inc(x, Spacing); inc(y, Spacing);
{$IFNDEF RVDONOTUSEANIMATION}
if FAnimator<>nil then
TRVAnimator(FAnimator).Draw(x,y,Canvas, False)
else
{$ENDIF}
if ImageCopy<>nil then
if ImageCopy is TBitmap then
DrawBmp
else
DrawImage(ImageCopy)
else
DrawImage(Image);
if (rvidsCurrent in State) and (Style.CurrentItemColor<>clNone) then begin
Canvas.Pen.Width := 1;
Canvas.Pen.Color := Style.CurrentItemColor;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(x-Spacing-1,y-Spacing-1, x+w+Spacing+1, y+h+Spacing+1);
end;
if (rvidsSelected in State) then begin
if rvidsControlFocused in State then
Canvas.Pen.Color := Style.SelColor
else
Canvas.Pen.Color := Style.InactiveSelColor;
Canvas.Brush.Style := bsClear;
if Canvas.Pen.Color<>clNone then begin
Canvas.Pen.Style := psSolid;
Canvas.Pen.Width := 1;
Canvas.Rectangle(x-Spacing,y-Spacing, x+w+Spacing, y+h+Spacing);
end;
end
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.AsImage: TGraphic;
begin
Result := Image;
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.MovingToUndoList(ItemNo: Integer; RVData, AContainerUndoItem: TObject);
begin
ImageCopy.Free;
ImageCopy := nil;
{$IFNDEF RVDONOTUSEANIMATION}
if FAnimator<>nil then begin
FAnimator.Free;
FAnimator := nil;
end;
{$ENDIF}
inherited MovingToUndoList(ItemNo, RVData, AContainerUndoItem);
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.UpdatePaletteInfo(PaletteAction: TRVPaletteAction;
ForceRecreateCopy: Boolean;
Palette: HPALETTE;
LogPalette: PLogPalette);
begin
if not (PaletteAction in [rvpaCreateCopies,rvpaCreateCopiesEx]) or ForceRecreateCopy or
(Palette=0) then begin
ImageCopy.Free;
ImageCopy := nil;
end;
// if ImageCopy=nil then
// ImageCopy := TBitmap.Create;
// ImageCopy.Width := Image.Width;
// ImageCopy.Height := Image.Height;
// TBitmap(ImageCopy).Canvas.Draw(0,0,Image);
case PaletteAction of
{*} rvpaAssignPalette:
begin
if LogPalette<>nil then
RV_SetPaletteToPicture(Image,LogPalette);
end;
{*} rvpaCreateCopies,rvpaCreateCopiesEx:
begin
if (LogPalette<>nil) and (ImageCopy=nil) then begin
{$IFNDEF RVDONOTUSEJPEGIMAGE}
if (PaletteAction=rvpaCreateCopiesEx) and
(Image is TJpegImage) then
ImageCopy := TBitmap.Create
else
{$ENDIF}
ImageCopy := RV_CreateGraphics(TGraphicClass(Image.ClassType));
ImageCopy.Assign(Image);
RV_SetPaletteToPicture(ImageCopy,LogPalette);
if ImageCopy is TBitmap then
TBitmap(ImageCopy).IgnorePalette := True;
end;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpResizable:
Result := (Image<>nil) and not (Image is TIcon);
rvbpValid:
Result := Image<>nil;
rvbpResizeHandlesOutside:
{$IFNDEF RVDONOTUSEANIMATION}
Result := FAnimator<>nil;
{$ELSE}
Result := False;
{$ENDIF}
rvbpDisplayActiveState, rvbpDrawingChangesFont:
Result := True;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpPrintToBMP:
Result := not (Image is TMetafile);
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
function RV_GetExtraIMGStr(SaveOptions: TRVSaveOptions; Width, Height: Integer;
NoHTMLImageSize: Boolean): String;
begin
if rvsoNoHypertextImageBorders in SaveOptions then
Result := ' border=0 '
else
Result := ' ';
if (rvsoImageSizes in SaveOptions) and not NoHTMLImageSize then
Result := Result+Format('width=%d height=%d ',[Width, Height]);
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
procedure TRVGraphicItemInfo.SaveToHTML(Stream: TStream; RVData: TPersistent;
ItemNo: Integer; const Text, Path: String; const imgSavePrefix: String;
var imgSaveNo: Integer; CurrentFileColor: TColor;
SaveOptions: TRVSaveOptions; UseCSS: Boolean; Bullets: TRVList);
{.................................................................}
function GetExtraIMGStr: String;
var s: String;
RVStyle: TRVStyle;
begin
Result := '';
if rvsoNoHypertextImageBorders in SaveOptions then
RV_AddStr(Result, Format('border=%s',[RV_HTMLGetIntAttrVal(0, SaveOptions)]));
RVStyle := TCustomRVData(RVData).GetRVStyle;
if ((rvsoImageSizes in SaveOptions) and not NoHTMLImageSize) or
(ImageWidth>0) or (ImageHeight>0) then
RV_AddStr(Result,
Format('width=%s height=%s', [
RV_HTMLGetIntAttrVal(GetImageWidth(RVStyle), SaveOptions),
RV_HTMLGetIntAttrVal(GetImageHeight(RVStyle), SaveOptions)]));
if (Alt<>'') or UseCSS then begin
if rvsoUTF8 in SaveOptions then
s := RVU_AnsiToUTF8(RVStyle.DefCodePage, Alt)
else
s := Alt;
RV_AddStr(Result, 'alt="'+s+'"');
end;
if Spacing>0 then
RV_AddStr(Result, Format('hspace=%s vspace=%s', [
RV_HTMLGetIntAttrVal(Spacing, SaveOptions),
RV_HTMLGetIntAttrVal(Spacing, SaveOptions)]));
{$IFNDEF RVDONOTUSEITEMHINTS}
if Hint<>'' then begin
s := RV_GetHintStr(rvsfHTML, Hint);
if rvsoUTF8 in SaveOptions then
s := RVU_AnsiToUTF8(RVStyle.DefCodePage, s);
RV_AddStr(Result, s);
end;
{$ENDIF}
if UseCSS then begin
s := GetVShiftCSS(RVStyle);
if s<>'' then
RV_AddStr(Result, Format('style="{%s}"',[s]));
end;
if Result<>'' then
Result := ' '+Result+' '
else
Result := ' ';
end;
{.................................................................}
var Location: String;
DoDefault: Boolean;
begin
if (ImageFileName<>'') and (rvsoUseItemImageFileNames in SaveOptions) then
Location := ExtractRelativePath(Path, ImageFileName)
else
Location := '';
TCustomRVData(RVData).HTMLSaveImage(TCustomRVData(RVData), ItemNo, Path, CurrentFileColor, Location, DoDefault);
if DoDefault then
if (ImageFileName<>'') and (rvsoUseItemImageFileNames in SaveOptions) then
Location := ExtractRelativePath(Path, ImageFileName)
else
Location := TCustomRVData(RVData).DoSavePicture(rvsfHTML, imgSavePrefix, Path,
imgSaveNo, rvsoOverrideImages in SaveOptions, CurrentFileColor, Image);
if Location<>'' then
RVWrite(Stream, Format('<img%s%ssrc="%s"%s>',
[GetHTMLImageAlign(VAlign, SaveOptions, UseCSS), GetExtraIMGStr,
RV_GetHTMLPath(Location, SaveOptions, TCustomRVData(RVData).GetRVStyle.DefCodePage),
RV_HTMLGetEndingSlash(SaveOptions)]));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.ReadRVFLine(const s: String;
RVData: TPersistent;
ReadType, LineNo, LineCount: Integer;
var Name: String;
var ReadMode: TRVFReadMode;
var ReadState: TRVFReadState): Boolean;
var grcls : TGraphicClass;
ifn: String;
begin
Result := True;
case ReadType of
1: // ask user
begin
case LineNo of
0:
begin
Image := TCustomRVData(RVData).RVFPictureNeeded(s, Tag);
Name := s;
end;
else
begin
ifn := ImageFileName;
SetExtraPropertyFromRVFStr(s);
if (ifn<>ImageFileName) and (ImageFileName<>'') and (Image=nil) then
Image := TCustomRVData(RVData).RVFPictureNeeded(ImageFileName, Tag);
end;
end;
end;
else // load picture from file
begin
if LineNo=0 then
Name := s
else if LineNo=1 then begin
grcls := TGraphicClass(GetClass(s));
if grcls=nil then begin
TCustomRVData(RVData).RVFWarnings := TCustomRVData(RVData).RVFWarnings + [rvfwUnknownPicFmt];
if not (rvfoIgnoreUnknownPicFmt in TCustomRVData(RVData).RVFOptions) then
Result := False;
end
else begin
Image := RV_CreateGraphics(grcls);
end;
end
else if LineNo=LineCount-1 then begin
if Image<>nil then begin
try
if ReadType=2 then
RVFLoadPictureBinary(s, Image)
else
Result := RVFLoadPicture(s, Image);
{$IFNDEF RVDONOTCORRECTWMFSCALE}
if (Image is TMetafile) {$IFNDEF RVCORRECTWMFSCALE2} and not TMetafile(Image).Enhanced{$ENDIF} and (TMetafile(Image).Inch=0) then
TMetafile(Image).Inch := 1440;
{$ENDIF}
except
Image.Free;
Image := RV_CreateGraphics(TGraphicClass(TCustomRVData(RVData).GetRVStyle.InvalidPicture.Graphic.ClassType));
Image.Assign(TCustomRVData(RVData).GetRVStyle.InvalidPicture.Graphic);
TCustomRVData(RVData).RVFWarnings := TCustomRVData(RVData).RVFWarnings+[rvfwInvalidPicture];
end;
end;
ReadState := rstSkip;
end
else
SetExtraPropertyFromRVFStr(s);
if (ReadType=2) and (LineNo=LineCount-2) then
ReadMode := rmBeforeBinary;
end;
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetRVFExtraPropertyCount: Integer;
begin
Result := inherited GetRVFExtraPropertyCount;
if ImageWidth>0 then
inc(Result);
if ImageHeight>0 then
inc(Result);
if MinHeightOnPage>0 then
inc(Result);
if NoHTMLImageSize then
inc(Result);
if Interval>0 then
inc(Result);
{$IFDEF RICHVIEWCBDEF3}
if (Image<>nil) and (Image is TBitmap) and TBitmap(Image).Transparent then begin
inc(Result,2);
if TBitmap(Image).TransparentMode=tmFixed then
inc(Result);
end;
{$ENDIF}
if ImageFileName<>'' then
inc(Result);
if Alt<>'' then
inc(Result);
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.SaveRVFExtraProperties(Stream: TStream);
begin
inherited SaveRVFExtraProperties(Stream);
if ImageWidth>0 then
WriteRVFExtraIntPropertyStr(Stream, rvepImageWidth, ImageWidth);
if ImageHeight>0 then
WriteRVFExtraIntPropertyStr(Stream, rvepImageHeight, ImageHeight);
if MinHeightOnPage>0 then
WriteRVFExtraIntPropertyStr(Stream, rvepMinHeightOnPage, MinHeightOnPage);
if NoHTMLImageSize then
WriteRVFExtraIntPropertyStr(Stream, rvepNoHTMLImageSize, 1);
if Interval>0 then
WriteRVFExtraIntPropertyStr(Stream, rvepAnimationInterval, Interval);
{$IFDEF RICHVIEWCBDEF3}
if (Image<>nil) and (Image is TBitmap) and TBitmap(Image).Transparent then begin
WriteRVFExtraIntPropertyStr(Stream, rvepTransparent, 1);
WriteRVFExtraIntPropertyStr(Stream, rvepTransparentMode, ord(TBitmap(Image).TransparentMode));
if TBitmap(Image).TransparentMode=tmFixed then
WriteRVFExtraIntPropertyStr(Stream, rvepTransparentColor, TBitmap(Image).TransparentColor);
end;
{$ENDIF}
if ImageFileName<>'' then
WriteRVFExtraStrPropertyStr(Stream, rvespImageFileName, ImageFileName);
if Alt<>'' then
WriteRVFExtraStrPropertyStr(Stream, rvespAlt, Alt);
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.SetExtraIntProperty(Prop: TRVExtraItemProperty; Value: Integer): Boolean;
begin
Result := False;
case Prop of
rvepImageWidth:
begin
ImageWidth := Value;
Result := True;
end;
rvepImageHeight:
begin
ImageHeight := Value;
Result := True;
end;
rvepMinHeightOnPage:
begin
MinHeightOnPage := Value;
Result := True;
end;
rvepNoHTMLImageSize:
begin
NoHTMLImageSize := Value<>0;
Result := True;
end;
rvepAnimationInterval:
begin
Interval := Value;
Result := True;
end;
{$IFDEF RICHVIEWCBDEF3}
rvepTransparent:
if (Image<>nil) and (Image is TBitmap) then begin
TBitmap(Image).Transparent := Value<>0;
Result := True;
end;
rvepTransparentMode:
if (Image<>nil) and (Image is TBitmap) then begin
TBitmap(Image).TransparentMode := TTransparentMode(Value);
Result := True;
end;
rvepTransparentColor:
begin
if (Image<>nil) and (Image is TBitmap) then begin
TBitmap(Image).TransparentColor := TColor(Value);
Result := True;
end;
end;
{$ENDIF}
else
Result := inherited SetExtraIntProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetExtraIntProperty(Prop: TRVExtraItemProperty; var Value: Integer): Boolean;
begin
Result := False;
case Prop of
rvepImageWidth:
begin
Value := ImageWidth;
Result := True;
end;
rvepImageHeight:
begin
Value := ImageHeight;
Result := True;
end;
rvepMinHeightOnPage:
begin
Value := MinHeightOnPage;
Result := True;
end;
rvepNoHTMLImageSize:
begin
Value := ord(NoHTMLImageSize);
Result := True;
end;
rvepAnimationInterval:
begin
Value := Interval;
Result := True;
end;
{$IFDEF RICHVIEWCBDEF3}
rvepTransparent:
if (Image<>nil) and (Image is TBitmap) then begin
Value := ord(TBitmap(Image).Transparent);
Result := True;
end;
rvepTransparentMode:
if (Image<>nil) and (Image is TBitmap) then begin
Value := ord(TBitmap(Image).TransparentMode);
Result := True;
end;
rvepTransparentColor:
begin
if (Image<>nil) and (Image is TBitmap) then begin
Value := Integer(TBitmap(Image).TransparentColor);
Result := True;
end;
end;
{$ENDIF}
else
Result := inherited GetExtraIntProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.GetExtraStrProperty(
Prop: TRVExtraItemStrProperty; var Value: String): Boolean;
begin
case Prop of
rvespImageFileName:
begin
Value := ImageFileName;
Result := True;
end;
rvespAlt:
begin
Value := Alt;
Result := True;
end;
else
Result := inherited GetExtraStrProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.SetExtraStrProperty(
Prop: TRVExtraItemStrProperty; const Value: String): Boolean;
begin
case Prop of
rvespImageFileName:
begin
ImageFileName := Value;
Result := True;
end;
rvespAlt:
begin
Alt := Value;
Result := True;
end;
else
Result := inherited SetExtraStrProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.SaveRVF(Stream: TStream;
RVData: TPersistent; ItemNo, ParaNo: Integer;
const Name: String; Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
var SaveType, LineCount: Integer;
begin
if rvfoSavePicturesBody in TCustomRVData(RVData).RVFOptions then begin
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
SaveType := 2 // save binary
else
SaveType := 0; // save hex dump
LineCount := 3+GetRVFExtraPropertyCount;
end
else begin
SaveType := 1; // do not save
LineCount := 1+GetRVFExtraPropertyCount;
end;
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, LineCount,
RVFItemSavePara(ParaNo, TCustomRVData(RVData), ForceSameAsPrev),
Byte(RVFGetItemOptions(ItemOptions,ForceSameAsPrev)) and RVItemOptionsMask,
SaveType,
RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options, Tag),
SaveRVFHeaderTail(RVData)]));
RVFWriteLine(Stream, Name);
if SaveType<>1 then begin
RVFWriteLine(Stream, Image.ClassName);
SaveRVFExtraProperties(Stream);
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
RVFSavePictureBinary(Stream, Image)
else
RVFWriteLine(Stream, RVFSavePicture(Image));
end
else
SaveRVFExtraProperties(Stream);
end;
{------------------------------------------------------------------------------}
procedure RVSaveImageToRTF(Stream: TStream; TwipsPerPixel: Double;
Image: TGraphic; ImageWidth, ImageHeight: Integer;
Options: TRVRTFOptions);
var s: String;
wmf: TMetafile;
FreeWMF: Boolean;
{$IFDEF RICHVIEWCBDEF3}
bmp: TBitmap;
slw: Integer;
{$ENDIF}
picw, pich: Integer;
begin
if Image=nil then
exit;
RVFWrite(Stream,'{pict');
if (ImageWidth>0) and (Image.Width>0) then begin
if (Image is TMetafile) and (TMetafile(Image).MMWidth>0) and
(not TMetafile(Image).Enhanced or (rvrtfSaveEMFAsWMF in Options)) then
picw := Round(TMetafile(Image).MMWidth*72/(127*TwipsPerPixel))
else
picw := Image.Width;
RVFWrite(Stream,Format('picscalex%d', [Round(ImageWidth*100/picw)]));
end;
if (ImageHeight>0) and (Image.Height>0) then begin
if (Image is TMetafile) and (TMetafile(Image).MMHeight>0) and
(not TMetafile(Image).Enhanced or (rvrtfSaveEMFAsWMF in Options)) then
pich := Round(TMetafile(Image).MMHeight*72/(127*TwipsPerPixel))
else
pich := Image.Height;
RVFWrite(Stream,Format('picscaley%d', [Round(ImageHeight*100/pich)]));
end;
{$IFDEF RICHVIEWCBDEF3} // requires ScanLine property...
// Saving bitmaps ...
if Image is TBitmap then begin
s := RVFSavePicture(Image);
if TBitmap(Image).Height>1 then
slw := abs(PChar(TBitmap(Image).ScanLine[1])-PChar(TBitmap(Image).ScanLine[0]))
else
slw := Image.Width;
RVFWrite(Stream,
Format('dibitmap0wbmwidthbytes%dpicw%dpich%dpicwgoal%dpichgoal%d ',
[ slw, Image.Width, Image.Height, Image.Width*15, Image.Height*15]));
RVFWrite(Stream, PChar(s)+sizeof(TBitmapFileHeader)*2);
end
// Saving metafiles ...
else
{$ENDIF}
if Image is TMetafile then begin
if TMetafile(Image).Enhanced then
if not (rvrtfSaveEMFAsWMF in Options) then begin
s := RVFSavePicture(Image);
RVFWrite(Stream,Format('emfblippicw%dpich%d ',
[TMetafile(Image).MMWidth, TMetafile(Image).MMHeight]));
RVFWrite(Stream,PChar(s));
wmf := nil;
FreeWMF := False;
end
else begin
wmf := TMetafile.Create;
wmf.Assign(Image);
wmf.Enhanced := False;
FreeWMF := True;
end
else begin
wmf := TMetafile(Image);
FreeWMF := False;
end;
if wmf<>nil then begin
s := RVFSavePicture(wmf);
RVFWrite(Stream,Format('wmetafile8picw%dpich%d ',
[wmf.MMWidth, wmf.MMHeight]));
RVFWrite(Stream,PChar(s)+22*2); // sizeof(TMetafileHeader)=22
if FreeWMF then
wmf.Free;
end;
end
else
// Saving Jpegs ...
{$IFNDEF RVDONOTUSEJPEGIMAGE}
if (Image is TJpegImage) and (rvrtfSaveJpegAsJpeg in Options) then begin
s := RVFSavePicture(Image);
RVFWrite(Stream,Format('jpegblippicw%dpich%d ',
[Image.Width, Image.Height]));
RVFWrite(Stream,PChar(s));
end
else
{$ENDIF}
// Saving PNG...
if (RVPngGraphiClass<>nil) and (Image is RVPngGraphiClass) then begin
s := RVFSavePicture(Image);
RVFWrite(Stream,Format('pngblippicw%dpich%d ',
[Image.Width, Image.Height]));
RVFWrite(Stream,PChar(s));
end
else
{$IFDEF RICHVIEWCBDEF3}
if rvrtfSaveBitmapDefault in Options then begin
// Saving other image formats, such as icons, as bitmaps
bmp := TBitmap.Create;
try
bmp.Assign(Image);
except
bmp.Width := Image.Width;
bmp.Height := Image.Height;
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
bmp.Canvas.Draw(0,0,Image);
end;
s := RVFSavePicture(bmp);
if bmp.Height>1 then
slw := abs(PChar(bmp.ScanLine[1])-PChar(bmp.ScanLine[0]))
else
slw := bmp.Width;
RVFWrite(Stream,Format('dibitmap0wbmwidthbytes%dpicw%dpich%dpicwgoal%dpichgoal%d ',
[ slw, bmp.Width, bmp.Height, bmp.Width*15, bmp.Height*15]));
RVFWrite(Stream, PChar(s)+sizeof(TBitmapFileHeader)*2);
bmp.Free;
end
else
{$ENDIF}
begin
// Saving other image formats, such as icons, as metafiles
wmf := TMetafile.Create;
wmf.Enhanced := False;
wmf.Width := Image.Width;
wmf.Height := Image.Height;
with TMetafileCanvas.Create(wmf, 0) do begin
Draw(0,0, Image);
Free;
end;
if rvrtfSaveEMFDefault in Options then begin
wmf.Enhanced := True;
s := RVFSavePicture(wmf);
RVFWrite(Stream,Format('emfblippicw%dpich%d ',
[TMetafile(wmf).MMWidth, TMetafile(wmf).MMHeight]));
RVFWrite(Stream,PChar(s));
end
else begin
s := RVFSavePicture(wmf);
// Unfortunately, some RTF readers can read only wmetafile8 (for ex., WordPad).
// MS Word reads all correctly
// (there are some problems with picture size when saving wmetafile8)
// May be it will be better to store unknown formats as bitmaps,
// but it's not recommended, and some quality losing is possible.
RVFWrite(Stream,Format('wmetafile1picw%dpich%d ',
[wmf.Width, wmf.Height]));
RVFWrite(Stream,PChar(s)+22*2); // sizeof(TMetafileHeader)=22
end;
wmf.Free;
end;
RVFWrite(Stream,'}');
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
Level: Integer; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList);
begin
RVSaveImageToRTF(Stream, TwipsPerPixel, Image, ImageWidth, ImageHeight,
TCustomRVData(RVData).RTFOptions);
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.PrintToBitmap(Bkgnd: TBitmap; Preview: Boolean;
RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer;
ColorMode: TRVColorMode):Boolean;
var Top: Integer;
{$IFDEF RICHVIEWCBDEF3}
tmp: TBitmap;
{$ENDIF}
begin
Result := True;
if (dli is TRVMultiImagePrintInfo) and (Part>=0) then
Top := -TRVImagePrintPart(TRVMultiImagePrintInfo(dli).PartsList[Part]).ImgTop
else
Top := 0;
if (ImageWidth<=0) and (ImageHeight<=0) then
if Preview and (ImageCopy<>nil) then
Bkgnd.Canvas.Draw(0,Top, ImageCopy)
else
Bkgnd.Canvas.Draw(0,Top, Image)
else
if Preview and (ImageCopy<>nil) then
Bkgnd.Canvas.StretchDraw(Bounds(0,Top, Bkgnd.Width,Bkgnd.Height), ImageCopy)
else begin
if ((ImageWidth<=0) or (ImageWidth=Image.Width)) and ((ImageHeight<=0) or (ImageHeight=Image.Height)) then
Bkgnd.Canvas.StretchDraw(Bounds(0,Top, Bkgnd.Width,Bkgnd.Height), Image)
else begin
{$IFDEF RICHVIEWCBDEF3}
tmp := nil;
if Image.Transparent then begin
tmp := TBitmap.Create;
tmp.Assign(bkgnd);
end;
{$ENDIF}
bkgnd.Width := Image.Width;
if Part<0 then
bkgnd.Height := Image.Height;
{$IFDEF RICHVIEWCBDEF3}
if Image.Transparent then begin
bkgnd.Canvas.StretchDraw(Rect(0,0,bkgnd.Width,bkgnd.Height), tmp);
tmp.Free
end;
{$ENDIF}
Bkgnd.Canvas.Draw(0, Top, Image)
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVGraphicItemInfo.Print(Canvas: TCanvas; x, y, x2: Integer;
Preview, Correction: Boolean; const sad: TRVScreenAndDevice;
RichView: TRVScroller; dli: TRVDrawLineInfo;
Part: Integer; ColorMode: TRVColorMode; RVData: TPersistent);
var DCState: Integer;
R: TRect;
begin
// will be called only for metafiles
DCState := SaveDC(Canvas.Handle);
try
R := Bounds(x+MulDiv(Spacing, sad.ppixDevice, sad.ppixScreen),
y+MulDiv(Spacing, sad.ppiyDevice, sad.ppiyScreen),
MulDiv(GetImageWidth(TCustomRichView(RichView).Style), sad.ppixDevice, sad.ppixScreen),
MulDiv(GetImageHeight(TCustomRichView(RichView).Style), sad.ppiyDevice, sad.ppiyScreen));
with R do
IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
Canvas.StretchDraw(r, Image);
finally
RestoreDC(Canvas.Handle, DCState);
end;
end;
{------------------------------------------------------------------------------}
function TRVGraphicItemInfo.CreatePrintingDrawItem(RVData: TObject;
const sad: TRVScreenAndDevice): TRVDrawLineInfo;
begin
if not GetBoolValueEx(rvbpPrintToBMP, nil) or (MinHeightOnPage=0) or
((ImageHeight>0) and (ImageHeight<>Image.Height)) then begin
Result := TRVDrawLineInfo.Create;
exit;
end;
Result := TRVMultiImagePrintInfo.Create(Self);
Result.Width := MulDiv(GetWidth, sad.ppixDevice, sad.ppixScreen);
Result.Height := MulDiv(GetHeight, sad.ppiyDevice, sad.ppiyScreen);
TRVMultiImagePrintInfo(Result).sad := sad;
end;
{============================ TRVHotGraphicItemInfo ===========================}
constructor TRVHotGraphicItemInfo.CreateEx(RVData: TPersistent;
AImage: TGraphic; AVAlign: TRVVAlign);
begin
inherited CreateEx(RVData, AImage, AVAlign);
StyleNo := rvsHotPicture;
end;
{------------------------------------------------------------------------------}
function TRVHotGraphicItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpJump, rvbpAllowsFocus, rvbpXORFocus:
Result := True;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVHotGraphicItemInfo.Execute(RVData:TPersistent);
begin
if RVData is TCustomRVFormattedData then
TCustomRVFormattedData(RVData).DoJump(JumpID+
TCustomRVFormattedData(RVData).FirstJumpNo)
end;
{============================== TRVBulletItemInfo =============================}
constructor TRVBulletItemInfo.CreateEx(RVData: TPersistent; AImageIndex: Integer; AImageList: TCustomImageList; AVAlign: TRVVAlign);
begin
inherited Create(RVData);
StyleNo := rvsBullet;
ImageIndex := AImageIndex;
ImageList := AImageList;
VAlign := AVAlign;
end;
{------------------------------------------------------------------------------}
procedure TRVBulletItemInfo.Assign(Source: TCustomRVItemInfo);
begin
if Source is TRVBulletItemInfo then begin
ImageList := TRVBulletItemInfo(Source).ImageList;
ImageIndex := TRVBulletItemInfo(Source).ImageIndex;
NoHTMLImageSize := TRVBulletItemInfo(Source).NoHTMLImageSize;
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetHeight: Integer;
begin
Result := TImageList(ImageList).Height+Spacing*2;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetImageHeight(RVStyle: TRVStyle): Integer;
begin
Result := TImageList(ImageList).Height;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetWidth: Integer;
begin
Result := TImageList(ImageList).Width+Spacing*2;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetImageWidth(RVStyle: TRVStyle): Integer;
begin
Result := TImageList(ImageList).Width;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas;
RVData: TPersistent): Integer;
begin
Result := TImageList(ImageList).Width+Spacing*2;
if sad<>nil then
Result := MulDiv(Result, sad.ppixDevice, sad.ppixScreen);
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetImageIndex(Hot: Boolean): Integer;
begin
Result := ImageIndex;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpValid:
Result := ImageList<>nil;
rvbpDisplayActiveState:
Result := True;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetExtraIntProperty(Prop: TRVExtraItemProperty;
var Value: Integer): Boolean;
begin
case Prop of
rvepNoHTMLImageSize:
begin
Value := ord(NoHTMLImageSize);
Result := True;
end;
else
Result := inherited GetExtraIntProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.SetExtraIntProperty(Prop: TRVExtraItemProperty;
Value: Integer): Boolean;
begin
case Prop of
rvepNoHTMLImageSize:
begin
NoHTMLImageSize := Value<>0;
Result := True;
end;
else
Result := inherited SetExtraIntProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetExtraStrProperty(
Prop: TRVExtraItemStrProperty; var Value: String): Boolean;
begin
case Prop of
rvespAlt:
begin
Value := Alt;
Result := True;
end;
else
Result := inherited GetExtraStrProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.SetExtraStrProperty(
Prop: TRVExtraItemStrProperty; const Value: String): Boolean;
begin
case Prop of
rvespAlt:
begin
Alt := Value;
Result := True;
end;
else
Result := inherited SetExtraStrProperty(Prop, Value);
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.GetRVFExtraPropertyCount: Integer;
begin
Result := inherited GetRVFExtraPropertyCount;
if NoHTMLImageSize then
inc(Result);
if Alt<>'' then
inc(Result);
end;
{------------------------------------------------------------------------------}
procedure TRVBulletItemInfo.SaveRVFExtraProperties(Stream: TStream);
begin
inherited SaveRVFExtraProperties(Stream);
if NoHTMLImageSize then
WriteRVFExtraIntPropertyStr(Stream, rvepNoHTMLImageSize, 1);
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.PrintToBitmap(Bkgnd: TBitmap; Preview: Boolean;
RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer;
ColorMode: TRVColorMode): Boolean;
begin
Result := True;
ImageList.Draw(Bkgnd.Canvas,0,0, ImageIndex);
end;
{------------------------------------------------------------------------------}
procedure TRVBulletItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
var SelColor: TColor;
BlendColor: TColorRef;
ILDrawOptions: Integer;
begin
if (rvidsSelected in State) then begin
if rvidsControlFocused in State then
SelColor := Style.SelColor
else
SelColor := Style.InactiveSelColor;
end
else
SelColor := clNone;
if SelColor<clNone then begin
BlendColor := ColorToRGB(SelColor);
ILDrawOptions := ILD_TRANSPARENT or ILD_SELECTED;
end
else begin
BlendColor := CLR_NONE;
ILDrawOptions := ILD_TRANSPARENT;
end;
ImageList_DrawEx(ImageList.Handle, GetImageIndex(rvidsHover in State),
Canvas.Handle, x+Spacing, y+Spacing,
TImageList(ImageList).Width, TImageList(ImageList).Height,
CLR_NONE, BlendColor, ILDrawOptions);
if (rvidsCurrent in State) and (Style.CurrentItemColor<>clNone) then begin
Canvas.Pen.Color := Style.CurrentItemColor;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
Canvas.Rectangle(x,y, x+TImageList(ImageList).Width+Spacing*2, y+TImageList(ImageList).Height+Spacing*2);
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.ReadRVFHeader(var P: PChar; RVData: TPersistent): Boolean;
var ImageListNo: Integer;
begin
Result := (RVFReadInteger(P,ImageListNo) and
RVFReadInteger(P,ImageIndex));
if not Result then exit;
ImageList := TCustomRVData(RVData).RVFImageListNeeded(ImageListNo);
if ImageList<>nil then
if ImageList.Count<=ImageIndex then begin
TCustomRVData(RVData).RVFWarnings := TCustomRVData(RVData).RVFWarnings+[rvfwConvLargeImageIdx];
if rvfoConvLargeImageIdxToZero in TCustomRVData(RVData).RVFOptions then
ImageIndex := 0
else
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.ReadRVFLine(const s: String;
RVData: TPersistent;
ReadType, LineNo, LineCount: Integer;
var Name: String;
var ReadMode: TRVFReadMode;
var ReadState: TRVFReadState): Boolean;
begin
if (LineNo=0) then
Name := s
else
SetExtraPropertyFromRVFStr(s);
Result := True;
end;
{------------------------------------------------------------------------------}
function TRVBulletItemInfo.SaveRVFHeaderTail(RVData: TPersistent): String;
begin
Result := Format('%d %d', [ImageList.Tag, ImageIndex]);
end;
{------------------------------------------------------------------------------}
procedure TRVBulletItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
ItemNo,ParaNo: Integer; const Name: String;
Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
begin
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, 1+GetRVFExtraPropertyCount,
RVFItemSavePara(ParaNo,TCustomRVData(RVData), ForceSameAsPrev),
Byte(RVFGetItemOptions(ItemOptions, ForceSameAsPrev)) and RVItemOptionsMask,
0, RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options, Tag),
SaveRVFHeaderTail(RVData)]));
RVFWriteLine(Stream, Name);
SaveRVFExtraProperties(Stream);
end;
{------------------------------------------------------------------------------}
procedure RVSaveImageListImageToRTF(Stream: TStream;
TwipsPerPixel: Double;
ImageList: TCustomImageList;
ImageIndex: Integer;
RTFOptions: TRVRTFOptions);
var s: String;
wmf: TMetafile;
{$IFDEF RICHVIEWCBDEF3}
bmp: TBitmap;
slw: Integer;
{$ENDIF}
Canvas: TMetafileCanvas;
begin
if (ImageList=nil) or (ImageIndex<0) or
(ImageIndex>=ImageList.Count) then
exit;
RVFWrite(Stream,'{pict');
{$IFDEF RICHVIEWCBDEF3}
if rvrtfSaveBitmapDefault in RTFOptions then begin
bmp := TBitmap.Create;
ImageList.GetBitmap(ImageIndex, bmp);
s := RVFSavePicture(bmp);
if bmp.Height>1 then
slw := abs(PChar(bmp.ScanLine[1])-PChar(bmp.ScanLine[0]))
else
slw := bmp.Width;
RVFWrite(Stream,Format('dibitmap0wbmwidthbytes%dpicw%dpich%dpicwgoal%dpichgoal%d ',
[slw, bmp.Width, bmp.Height, bmp.Width*15, bmp.Height*15]));
RVFWrite(Stream, PChar(s)+sizeof(TBitmapFileHeader)*2);
bmp.Free;
end
else
{$ENDIF}
begin
wmf := TMetafile.Create;
wmf.Enhanced := False;
wmf.Width := TImageList(ImageList).Width;
wmf.Height := TImageList(ImageList).Height;
Canvas := TMetafileCanvas.Create(wmf, 0);
ImageList.Draw(Canvas, 0, 0, ImageIndex);
Canvas.Free;
s := RVFSavePicture(wmf);
RVFWrite(Stream,Format('wmetafile1picw%dpich%d ',
[wmf.Width, wmf.Height]));
RVFWrite(Stream,PChar(s)+22*2); // sizeof(TMetafileHeader)=22
wmf.Free;
end;
RVFWrite(Stream,'}');
end;
{------------------------------------------------------------------------------}
procedure TRVBulletItemInfo.SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
Level: Integer; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList);
begin
RVSaveImageListImageToRTF(Stream, TwipsPerPixel,
ImageList, ImageIndex, TCustomRVData(RVData).RTFOptions);
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
procedure RVSaveImageSharedImageInHTML(ImageList: TCustomImageList;
ImageIndex: Integer; Graphic: TGraphic;
var Location: String;
RVData: TPersistent; const Path,
imgSavePrefix: String; var imgSaveNo: Integer; CurrentFileColor: TColor;
SaveOptions: TRVSaveOptions;
Bullets: TRVList);
var j: Integer;
bmp: TBitmap;
bi : TRVHTMLBulletInfo;
begin
Location := '';
for j:=0 to Bullets.Count-1 do begin
bi := TRVHTMLBulletInfo(Bullets[j]);
if (ImageList = bi.ImageList) and
(ImageIndex = bi.ImageIndex) and
(Graphic = bi.Graphic) and
(CurrentFileColor = bi.BackColor) then begin
Location := bi.FileName;
break;
end;
end;
if Location='' then begin
bmp := TBitmap.Create;
try
if ImageList<>nil then begin
bmp.Width := TImageList(ImageList).Width;
bmp.Height := TImageList(ImageList).Height;
bmp.Canvas.Brush.Color := CurrentFileColor;
bmp.Canvas.Pen.Color := CurrentFileColor;
bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
ImageList.Draw(bmp.Canvas, 0, 0, ImageIndex);
end
else begin
bmp.Width := Graphic.Width;
bmp.Height := Graphic.Width;
bmp.Canvas.Brush.Color := CurrentFileColor;
bmp.Canvas.Pen.Color := CurrentFileColor;
bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height));
bmp.Canvas.Draw(0,0, Graphic);
end;
Location := TCustomRVData(RVData).DoSavePicture(rvsfHTML, imgSavePrefix, Path,
imgSaveNo, rvsoOverrideImages in SaveOptions,
CurrentFileColor, bmp);
Location := RV_GetHTMLPath(Location, SaveOptions, TCustomRVData(RVData).GetRVStyle.DefCodePage);
bi := TRVHTMLBulletInfo.Create;
bi.FileName := Location;
bi.BackColor := CurrentFileColor;
bi.ImageList := ImageList;
bi.ImageIndex := ImageIndex;
bi.Graphic := Graphic;
Bullets.Add(bi);
finally
bmp.Free;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVBulletItemInfo.SaveToHTML(Stream: TStream;
RVData: TPersistent; ItemNo: Integer; const Text, Path,
imgSavePrefix: String; var imgSaveNo: Integer; CurrentFileColor: TColor;
SaveOptions: TRVSaveOptions;
UseCSS: Boolean; Bullets: TRVList);
var
Location: String;
DoDefault: Boolean;
{....................................................}
function GetCSS: String;
var s: String;
begin
Result := '';
if UseCSS then begin
Result := GetVShiftCSS(TCustomRVData(RVData).GetRVStyle);
if Result<>'' then
RV_AddStr(Result, Format('style="{%s}"',[Result]));
end;
if (Alt<>'') or UseCSS then begin
if rvsoUTF8 in SaveOptions then
s := RVU_AnsiToUTF8(TCustomRVData(RVData).GetRVStyle.DefCodePage, Alt)
else
s := Alt;
RV_AddStr(Result, 'alt="'+s+'"');
end;
{$IFNDEF RVDONOTUSEITEMHINTS}
if Hint<>'' then begin
s := RV_GetHintStr(rvsfHTML, Hint);
if rvsoUTF8 in SaveOptions then
s := RVU_AnsiToUTF8(TCustomRVData(RVData).GetRVStyle.DefCodePage, s);
RV_AddStr(Result, s);
end;
{$ENDIF}
if Spacing>0 then
RV_AddStr(Result, Format('hspace=%s vspace=%s', [
RV_HTMLGetIntAttrVal(Spacing, SaveOptions),
RV_HTMLGetIntAttrVal(Spacing, SaveOptions)]));
if Result<>'' then
Result := ' '+Result+' ';
end;
{....................................................}
begin
TCustomRVData(RVData).HTMLSaveImage(TCustomRVData(RVData), ItemNo, Path, CurrentFileColor, Location, DoDefault);
if DoDefault then
RVSaveImageSharedImageInHTML(ImageList, ImageIndex, nil, Location, RVData, Path,
imgSavePrefix, imgSaveNo, CurrentFileColor, SaveOptions, Bullets);
RVWrite(Stream,Format('<img%s%ssrc="'+Location+'"%s>',
[RV_GetExtraIMGStr(SaveOptions, TImageList(ImageList).Width,
TImageList(ImageList).Height, NoHTMLImageSize), GetCSS,
RV_HTMLGetEndingSlash(SaveOptions)]));
end;
{$ENDIF}
{============================= TRVHotspotItemInfo =============================}
constructor TRVHotspotItemInfo.CreateEx(RVData: TPersistent; AImageIndex, AHotImageIndex: Integer;
AImageList: TCustomImageList; AVAlign: TRVVAlign);
begin
inherited CreateEx(RVData, AImageIndex, AImageList, AVAlign);
StyleNo := rvsHotspot;
HotImageIndex := AHotImageIndex;
end;
{------------------------------------------------------------------------------}
procedure TRVHotspotItemInfo.Assign(Source: TCustomRVItemInfo);
begin
if Source is TRVHotspotItemInfo then
HotImageIndex := TRVHotspotItemInfo(Source).HotImageIndex;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
function TRVHotspotItemInfo.GetImageIndex(Hot: Boolean): Integer;
begin
if Hot then
Result := HotImageIndex
else
Result := ImageIndex;
end;
{------------------------------------------------------------------------------}
function TRVHotspotItemInfo.ReadRVFHeader(var P: PChar;
RVData: TPersistent): Boolean;
begin
Result := (inherited ReadRVFHeader(P, RVData));
if not Result then
exit;
if not (P^ in [#0, #10, #13]) then begin
Result := RVFReadInteger(P,HotImageIndex);
if not Result then
exit;
end
else
HotImageIndex := ImageIndex;
if ImageList<>nil then
if ImageList.Count<=HotImageIndex then begin
TCustomRVData(RVData).RVFWarnings := TCustomRVData(RVData).RVFWarnings+[rvfwConvLargeImageIdx];
if rvfoConvLargeImageIdxToZero in TCustomRVData(RVData).RVFOptions then
HotImageIndex := 0
else
Result := False;
end;
end;
{------------------------------------------------------------------------------}
function TRVHotspotItemInfo.SaveRVFHeaderTail(RVData: TPersistent): String;
begin
Result := Format('%s %d', [inherited SaveRVFHeaderTail(RVData), HotImageIndex]);
end;
{------------------------------------------------------------------------------}
procedure TRVHotspotItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
ItemNo,ParaNo: Integer; const Name: String;
Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
begin
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, 1,
RVFItemSavePara(ParaNo,TCustomRVData(RVData),ForceSameAsPrev),
Byte(RVFGetItemOptions(ItemOptions,ForceSameAsPrev)) and RVItemOptionsMask,
0, RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options, Tag),
SaveRVFHeaderTail(RVData)]));
RVFWriteLine(Stream, Name);
end;
{------------------------------------------------------------------------------}
function TRVHotspotItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpJump, rvbpAllowsFocus,rvbpXORFocus:
Result := True;
rvbpHotColdJump:
Result := ImageIndex<>HotImageIndex;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVHotspotItemInfo.Execute(RVData: TPersistent);
begin
if RVData is TCustomRVFormattedData then
TCustomRVFormattedData(RVData).DoJump(JumpID+
TCustomRVFormattedData(RVData).FirstJumpNo)
end;
{============================ TRVBreakItemInfo ================================}
constructor TRVBreakItemInfo.CreateEx(RVData: TPersistent; ALineWidth: Byte; AStyle: TRVBreakStyle; AColor: TColor);
begin
inherited Create(RVData);
StyleNo := rvsBreak;
LineWidth := ALineWidth;
Style := AStyle;
Color := AColor;
end;
{------------------------------------------------------------------------------}
procedure TRVBreakItemInfo.Assign(Source: TCustomRVItemInfo);
begin
if Source is TRVBreakItemInfo then begin
LineWidth := TRVBreakItemInfo(Source).LineWidth;
Color := TRVBreakItemInfo(Source).Color;
Style := TRVBreakItemInfo(Source).Style;
end;
inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
{ Drawing 3d edge with colors TopLeftColor, BottomRightColor.
r - outer rectangle (right bottom coordinates inclusive).
LineWidth - width of edge. }
procedure DrawEdge(Canvas: TCanvas; r: TRect;
TopLeftColor, BottomRightColor: TColor; LineWidth: Integer);
var i: Integer;
DrawBottom: Boolean;
begin
if LineWidth<=0 then
LineWidth := 1;
DrawBottom := r.Bottom-r.Top>=LineWidth;
for i := LineWidth-1 downto 0 do begin
Canvas.Pen.Color := TopLeftColor;
Canvas.MoveTo(r.Left, r.Bottom);
Canvas.LineTo(r.Left, r.Top);
Canvas.LineTo(r.Right, r.Top);
if DrawBottom then begin
Canvas.Pen.Color := BottomRightColor;
Canvas.LineTo(r.Right, r.Bottom);
Canvas.LineTo(r.Left, r.Bottom);
InflateRect(r, -1, -1);
end
else
InflateRect(r, 0, -1);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVBreakItemInfo.PaintFullWidth(Left, Right, Top: Integer;
Canvas: TCanvas; State: TRVItemDrawStates; Style: TRVStyle;
const ClipRect: TRect; dli: TRVDrawLineInfo);
begin
inc(Left,5);
dec(Right,5);
inc(Top,5);
if Color = clNone then
Canvas.Pen.Color := Style.TextStyles[0].Color
else
Canvas.Pen.Color := Color;
Canvas.Pen.Style := psInsideFrame;
case Self.Style of
rvbsLine:
begin
Canvas.Pen.Width := LineWidth;
Canvas.MoveTo(Left, Top);
Canvas.LineTo(Right, Top);
end;
rvbsRectangle:
begin
Canvas.Pen.Width := 1;
Canvas.Rectangle(Left, Top-LineWidth div 2,
Right, Top-LineWidth div 2+LineWidth);
end;
rvbs3d:
begin
Canvas.Pen.Width := 1;
DrawEdge(Canvas,
Rect(Left, Top-LineWidth div 2, Right-1, Top-LineWidth div 2+LineWidth-1),
clBtnShadow, clBtnFace, 1);
end;
end;
if rvidsSelected in State then begin
if rvidsControlFocused in State then
Canvas.Pen.Color := Style.SelColor
else
Canvas.Pen.Color := Style.InactiveSelColor;
if Canvas.Pen.Color<>clNone then begin
Canvas.Pen.Width := LineWidth;
Canvas.MoveTo(Left, Top);
Canvas.LineTo(Right, Top);
end;
end;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
end;
{------------------------------------------------------------------------------}
procedure TRVBreakItemInfo.Print(Canvas: TCanvas; x, y, x2: Integer;
Preview, Correction: Boolean; const sad: TRVScreenAndDevice; RichView: TRVScroller;
dli: TRVDrawLineInfo;Part: Integer; ColorMode: TRVColorMode; RVData: TPersistent);
var x5, y5, w: Integer;
clr: TColor;
begin
Canvas.Pen.Style := psInsideFrame;
Canvas.Pen.Mode := pmCopy;
if Color = clNone then
clr := TCustomRichView(RichView).Style.TextStyles[0].Color
else
clr := Color;
Canvas.Pen.Color := RV_GetColor(clr, ColorMode);;
y5 := (5 * sad.ppiyDevice) div sad.ppiyScreen;
x5 := (5 * sad.ppixDevice) div sad.ppixScreen;
case Style of
rvbsLine:
begin
Canvas.Pen.Width := (LineWidth * sad.ppiyDevice) div sad.ppiyScreen;
Canvas.MoveTo(x+x5, y+y5);
Canvas.LineTo(x2-x5, y+y5);
end;
rvbsRectangle:
begin
w := (LineWidth * sad.ppiyDevice) div sad.ppiyScreen;
Canvas.Pen.Width := Round(sad.ppiyDevice/sad.ppiyScreen);
Canvas.Rectangle(x+x5, y+y5-(w div 2), x2-x5, y+y5-(w div 2)+w);
end;
rvbs3d:
begin
Canvas.Pen.Width := 1;
w := (LineWidth * sad.ppiyDevice) div sad.ppiyScreen;
DrawEdge(Canvas,
Rect(x+x5, y+y5-(w div 2), x2-x5-1, y+y5-(w div 2)+w-1),
RV_GetColor(clBtnShadow, ColorMode),
RV_GetColor(clBtnFace, ColorMode),
Round(sad.ppiyDevice/sad.ppiyScreen));
end;
end;
Canvas.Pen.Style := psSolid;
end;
{------------------------------------------------------------------------------}
function TRVBreakItemInfo.AsText(LineWidth: Integer; RVData: TPersistent;
const Text, Path: String; TextOnly,Unicode: Boolean): String;
var c: Char;
begin
if Self.LineWidth>1 then
c := '='
else
c := '-';
if LineWidth<1 then
LineWidth := 1;
SetLength(Result, LineWidth);
FillChar(PChar(Result)^, LineWidth, ord(c));
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
procedure TRVBreakItemInfo.SaveToHTML(Stream: TStream; RVData: TPersistent;
ItemNo: Integer; const Text, Path: String; const imgSavePrefix: String;
var imgSaveNo: Integer; CurrentFileColor: TColor;
SaveOptions: TRVSaveOptions; UseCSS: Boolean; Bullets: TRVList);
var title: String;
begin
if rvsoForceNonTextCSS in SaveOptions then
UseCSS := True;
title := '';
{$IFNDEF RVDONOTUSEITEMHINTS}
if Hint<>'' then begin
title := RV_GetHintStr(rvsfHTML, Hint)+' ';;
if rvsoUTF8 in SaveOptions then
title := RVU_AnsiToUTF8(TCustomRVData(RVData).GetRVStyle.DefCodePage, title);
end;
{$ENDIF}
if UseCSS and (Color<>clNone) then
RVWrite(Stream, Format('<hr %s size=%s %sstyle="{color : %s}"%s>',
[RV_HTMLGetNoValueAttribute('noshade', SaveOptions),
RV_HTMLGetIntAttrVal(LineWidth, SaveOptions),
title, RV_GetHTMLRGBStr(Color, False),
RV_HTMLGetEndingSlash(SaveOptions)]))
else if (Color<>clNone) then
RVWrite(Stream, Format('<hr %s size=%s color=%s %s%s>',
[RV_HTMLGetNoValueAttribute('noshade', SaveOptions),
RV_HTMLGetIntAttrVal(LineWidth, SaveOptions),
RV_GetHTMLRGBStr(Color, True), title,
RV_HTMLGetEndingSlash(SaveOptions)]))
else
RVWrite(Stream, Format('<hr %s size=%s %s%s>',
[RV_HTMLGetNoValueAttribute('noshade', SaveOptions),
RV_HTMLGetIntAttrVal(LineWidth, SaveOptions),
title, RV_HTMLGetEndingSlash(SaveOptions)]));
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVBreakItemInfo.ReadRVFHeader(var P: PChar;
RVData: TPersistent): Boolean;
var bc, bs,bw: Integer;
begin
if not (P^ in [#0, #10, #13]) then begin
Result := (RVFReadInteger(P,bc) and
RVFReadInteger(P,bs) and
RVFReadInteger(P,bw));
if Result then begin
LineWidth := Byte(bw);
Style := TRVBreakStyle(bs);
Color := bc;
end;
end
else begin
Color := clNone;
Style := rvbsLine;
LineWidth := 1;
Result := True;
end;
end;
{------------------------------------------------------------------------------}
function TRVBreakItemInfo.SaveRVFHeaderTail(RVData: TPersistent): String;
begin
Result := Format('%d %d %d', [Integer(Color), Integer(Style), Integer(LineWidth)]);
end;
{------------------------------------------------------------------------------}
procedure TRVBreakItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
ItemNo, ParaNo: Integer; const Name: String;
Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
begin
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, 0,
RVFItemSavePara(ParaNo, TCustomRVData(RVData), False),
Byte(ItemOptions) and RVItemOptionsMask,
0, RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options,Tag),
SaveRVFHeaderTail(RVData)]));
end;
{------------------------------------------------------------------------------}
procedure TRVBreakItemInfo.FillRTFTables(ColorList: TRVColorList;
ListOverrideCountList: TRVIntegerList; RVData: TPersistent);
begin
ColorList.AddUnique(Color);
end;
{------------------------------------------------------------------------------}
procedure TRVBreakItemInfo.SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
Level: Integer; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList);
var ColorIdx: Integer;
tbl: String;
begin
if Color = clNone then
ColorIdx := 0
else
ColorIdx := ColorList.IndexOf(Pointer(Color));
case Level of
0:
tbl := '';
1:
tbl := 'intblitap1';
else
tbl := Format('itap%d',[Level]);
end;
RVWrite(Stream, Format('pard%splainfs6brdrbbrdrsbrdrw%dbrdrcf%dparpard%s',
[tbl, Round(LineWidth*TwipsPerPixel), ColorIdx, tbl]));
end;
{------------------------------------------------------------------------------}
function TRVBreakItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpRequiresRVFLines:
Result := False;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
function TRVBreakItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpPrintToBMP:
Result := False;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{================================ TRVTextItemInfo =============================}
procedure TRVTextItemInfo.Execute(RVData: TPersistent);
begin
if RVData is TCustomRVFormattedData then begin
if GetBoolValueEx(rvbpJump, TCustomRVData(RVData).GetRVStyle) then
TCustomRVFormattedData(RVData).DoJump(JumpID+
TCustomRVFormattedData(RVData).FirstJumpNo)
end;
end;
{------------------------------------------------------------------------------}
function TRVTextItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpJump, rvbpAllowsFocus,rvbpXORFocus:
Result := RVStyle.TextStyles[GetActualStyleNo(RVStyle)].Jump;
rvbpHotColdJump:
Result := RVStyle.TextStyles[GetActualStyleNo(RVStyle)].Jump and
RVStyle.StyleHoverSensitive(GetActualStyleNo(RVStyle));
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTextItemInfo.MarkStylesInUse(Data: TRVDeleteUnusedStylesData);
begin
inherited MarkStylesInUse(Data);
if StyleNo<>rvsDefStyle then
Data.UsedTextStyles[StyleNo] := 1;
end;
{------------------------------------------------------------------------------}
function TRVTextItemInfo.ReadRVFHeader(var P: PChar;
RVData: TPersistent): Boolean;
begin
Result := True;
{$IFNDEF RVDONOTUSEITEMHINTS}
{$IFDEF RICHVIEWCBDEF3}
if P^<>#0 then
Hint := AnsiExtractQuotedStr(P, '"');
{$ENDIF}
{$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure TRVTextItemInfo.UpdateStyles(Data: TRVDeleteUnusedStylesData);
begin
inherited UpdateStyles(Data);
if StyleNo<>rvsDefStyle then
dec(StyleNo, Data.UsedTextStyles[StyleNo]-1);
end;
{=========================== TRVStoreSubRVData ================================}
{ Must be overriden to return a copy of itself. }
function TRVStoreSubRVData.Duplicate: TRVStoreSubRVData;
begin
Result := nil;
end;
{------------------------------------------------------------------------------}
{ Compares itself with StoreSub. Self and StoreSub must be of the same item.
Return value: 0 if the same subdocument, <0 if Self is before StoreSub,
> 0 if Self is after StoreSub. }
function TRVStoreSubRVData.Compare(StoreSub: TRVStoreSubRVData): Integer;
begin
Result := 0;
end;
{=========================== TRVMultiDrawItemPart =============================}
function TRVMultiDrawItemPart.GetSoftPageBreakInfo: Integer;
begin
Result := -1;
end;
{============================== TRVTabItemInfo ================================}
procedure TRVTabItemInfo.MarkStylesInUse(Data: TRVDeleteUnusedStylesData);
begin
inherited MarkStylesInUse(Data);
Data.UsedTextStyles[TextStyleNo] := 1;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.UpdateStyles(Data: TRVDeleteUnusedStylesData);
begin
inherited UpdateStyles(Data);
dec(TextStyleNo, Data.UsedTextStyles[TextStyleNo]-1)
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.ApplyStyleConversion(RVData: TPersistent;
ItemNo, UserData: Integer);
begin
TCustomRVFormattedData(RVData).DoCurrentTextStyleConversion(TextStyleNo, ParaNo,
ItemNo, UserData, False);
end;
{------------------------------------------------------------------------------}
function TRVTabItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpPrintToBMP:
Result := False;
rvbpActualPrintSize:
Result := True;
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{------------------------------------------------------------------------------}
function TRVTabItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpDrawingChangesFont, rvbpAlwaysInText, rvbpSwitchToAssStyleNo:
Result := True;
else
Result := inherited GetBoolValue(Prop);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.OnDocWidthChange(DocWidth: Integer;
dli: TRVDrawLineInfo; Printing: Boolean; Canvas: TCanvas;
RVData: TPersistent; sad: PRVScreenAndDevice; var HShift, Desc: Integer;
NoCaching, Reformatting: Boolean);
var TextMetric: TTextMetric;
begin
TCustomRVData(RVData).GetRVStyle.ApplyStyle(Canvas, TextStyleNo, rvbdUnspecified,
rvflCanUseCustomPPI in TCustomRVData(RVData).Flags);
FillChar(TextMetric, sizeof(TextMetric), 0);
GetTextMetrics(Canvas.Handle, TextMetric);
Desc := TextMetric.tmDescent;
dli.Height := TextMetric.tmHeight;
dli.Width := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent;
ItemNo, ParaNo: Integer; const Name: String; Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
begin
RVFWriteLine(Stream,
Format('%d %d %s %d %d %s %s',
[StyleNo, 0, RVFItemSavePara(ParaNo, TCustomRVData(RVData), False),
Byte(ItemOptions) and RVItemOptionsMask,
0, RVFSaveTag(rvoTagsArePChars in TCustomRVData(RVData).Options,Tag),
SaveRVFHeaderTail(RVData)]));
end;
{------------------------------------------------------------------------------}
function TRVTabItemInfo.SaveRVFHeaderTail(RVData: TPersistent): String;
begin
Result := IntToStr(TextStyleNo);
end;
{------------------------------------------------------------------------------}
function TRVTabItemInfo.ReadRVFHeader(var P: PChar;
RVData: TPersistent): Boolean;
begin
Result := True;
if not (P^ in [#0, #10, #13]) then begin
Result := RVFReadInteger(P, TextStyleNo);
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.DrawTab(Canvas: TCanvas; x, y: Integer;
dli: TRVDrawLineInfo; Style: TRVStyle; TextDrawState: TRVTextDrawStates;
CanUseCustomPPI, RTL, SpecialChars, Printing: Boolean;
ColorMode: TRVColorMode);
{.........................................}
procedure DrawArrow(const r: TRect);
var x,y,len: Integer;
begin
len := r.Right-r.Left;
if len<5 then
len := 5;
if len>10 then
len := 10;
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
x := (R.Right+R.Left+len) div 2;
y := (R.Top+R.Bottom) div 2;
Canvas.MoveTo(x,y);
Canvas.LineTo(x-len-1,y);
if RTL then begin
x := x-len+1;
Canvas.MoveTo(x,y-1);
Canvas.LineTo(x,y+2);
inc(x);
Canvas.MoveTo(x,y-2);
Canvas.LineTo(x,y+3);
inc(x);
Canvas.MoveTo(x,y-2);
Canvas.LineTo(x,y+3);
end
else begin
dec(x);
Canvas.MoveTo(x,y-1);
Canvas.LineTo(x,y+2);
dec(x);
Canvas.MoveTo(x,y-2);
Canvas.LineTo(x,y+3);
dec(x);
Canvas.MoveTo(x,y-2);
Canvas.LineTo(x,y+3);
end;
end;
{.........................................}
var w,r: Integer;
potm: POutlineTextMetric;
sz: Integer;
begin
Style.ApplyStyleColor(Canvas, TextStyleNo, TextDrawState, Printing, ColorMode);
Style.ApplyStyle(Canvas, TextStyleNo, rvbdUnspecified, CanUseCustomPPI);
{
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := clRed;
Canvas.Pen.Width := 1;
Canvas.Rectangle(x, y, x+dli.Width, y+dli.Height);
}
if Canvas.Brush.Color<>clNone then
Canvas.FillRect(Bounds(x, y, dli.Width, dli.Height));
if fsUnderline in Canvas.Font.Style then begin
sz := GetOutlineTextMetrics(Canvas.Handle,0,nil);
if sz>0 then begin
GetMem(potm, sz);
FillChar(potm^, sz, 0);
sz := GetOutlineTextMetrics(Canvas.Handle,sz,potm);
if sz>0 then begin
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.Pen.Width := potm.otmsUnderscoreSize;
Canvas.Pen.Style := psInsideFrame;
w := y-potm.otmsUnderscorePosition+potm.otmTextMetrics.tmAscent+
potm.otmsUnderscoreSize div 2;
Canvas.MoveTo(x-1, w);
Canvas.LineTo(x+dli.Width+1, w);
Canvas.Pen.Style := psSolid;
end;
end;
end;
if SpecialChars then
DrawArrow(Bounds(x, y, dli.Width, dli.Height));
if Leader<>'' then begin
Style.ApplyStyle(Canvas, TextStyleNo, rvbdUnspecified, CanUseCustomPPI);
w := Canvas.TextWidth(Leader);
if w=0 then
exit;
r := x+dli.Width-w;
inc(x, w);
while x+w<=r do begin
Canvas.TextOut(x, y, Leader);
inc(x, w);
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
var TextDrawState: TRVTextDrawStates;
begin
TextDrawState := [];
if rvidsSelected in State then
include(TextDrawState, rvtsSelected);
if rvidsControlFocused in State then
include(TextDrawState, rvtsControlFocused);
if rvidsHover in State then
include(TextDrawState, rvtsHover);
DrawTab(Canvas, x, y, dli, Style, TextDrawState, rvidsCanUseCustomPPI in State,
rvidsRTL in State, rvidsShowSpecialCharacters in State, False, rvcmColor);
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.Print(Canvas: TCanvas; x, y, x2: Integer; Preview,
Correction: Boolean; const sad: TRVScreenAndDevice;
RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer;
ColorMode: TRVColorMode; RVData: TPersistent);
begin
DrawTab(Canvas, x, y, dli, TCustomRVData(RVData).GetRVStyle, [],
rvflCanUseCustomPPI in TCustomRVData(RVData).Flags, False, False, True,
ColorMode);
end;
{------------------------------------------------------------------------------}
function TRVTabItemInfo.GetAssociatedTextStyleNo: Integer;
begin
Result := TextStyleNo;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.SetAssociatedTextStyleNo(Value: Integer);
begin
TextStyleNo := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVTabItemInfo.SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer; const Name: String; TwipsPerPixel: Double;
Level: Integer; ColorList: TRVColorList; StyleToFont,
ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList);
begin
RVWrite(Stream, 'tab ');
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
procedure TRVTabItemInfo.SaveToHTML(Stream: TStream; RVData: TPersistent;
ItemNo: Integer; const Text, Path, imgSavePrefix: String;
var imgSaveNo: Integer; CurrentFileColor: TColor;
SaveOptions: TRVSaveOptions; UseCSS: Boolean; Bullets: TRVList);
var SpacesInTab: Integer;
Filler: String;
Len: Integer;
begin
SpacesInTab := TCustomRVData(RVData).GetRVStyle.SpacesInTab;
if SpacesInTab<=0 then
SpacesInTab := 8;
if Leader='' then begin
Filler := '  ';
Len := 2;
end
else begin
Filler := RV_MakeHTMLStr(Leader, False);
Len := Length(Leader);
end;
SpacesInTab := (SpacesInTab+Len-1) div Len;
while SpacesInTab<>0 do begin
RVFWrite(Stream, Filler);
dec(SpacesInTab);
end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function TRVTabItemInfo.AsText(LineWidth: Integer; RVData: TPersistent;
const Text, Path: String; TextOnly, Unicode: Boolean): String;
begin
Result := #09;
end;
{==============================================================================}
initialization
RichView_InitializeList;
RichViewTextItemClass := TRVTextItemInfo;
finalization
RichView_FinalizeList;
end.