I did used the one of your component to create my, i did copy it and made some changes to my needs.
Code: Select all
unit ChartRV;
interface
Uses Classes, Windows, Graphics, Controls, SysUtils, RVItem, DB, RVClasses,
RVStyle, RVScroll, DLines, RVTypes, RVFuncs, Jpeg, Dialogs, FMTBcd,
Uni, InfoDB;
{$I EnerConst.pas}
Const
rvsChart = -13;
Type
THackRVRectItemInfo = class(TRVRectItemInfo);
TRVChartItemInfo = class(TRVRectItemInfo)
Protected
{$IFNDEF RVDONOTUSEANIMATION}
FAnimator: TObject;
{$ENDIF}
FResizable: Boolean;
FNoChart : Integer;
function GetHeight: Integer; override;
function GetWidth: Integer; override;
function GetRVFExtraPropertyCount: Integer; override;
procedure SaveRVFExtraProperties(Stream: TStream); override;
Function GetChartImage(NoChart:Integer):TMetaFile;
Public
Image,ImageCopy : TGraphic;
ImageWidth, ImageHeight, Interval : Integer;
NoHTMLImageSize: Boolean;
Alt, ImageFileName: String;
Constructor CreateEx(RVData: TPersistent; NoChart:Integer; AVAlign: TRVVAlign); virtual;
Constructor Create(RVData: TPersistent); override;
Function PrintToBitmap(Bkgnd: TBitmap; Preview: Boolean; RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer; ColorMode: TRVColorMode):Boolean;override;
Procedure Print(Canvas: TCanvas; x,y,x2: Integer; Preview, Correction: Boolean; const sad: TRVScreenAndDevice; RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer; ColorMode: TRVColorMode; RVData: TPersistent); override;
procedure Assign(Source: TCustomRVItemInfo); override;
procedure TransferProperties(Source: TCustomRVItemInfo; RVData: TPersistent); override;
function SetExtraIntProperty(Prop: TRVExtraItemProperty; Value: Integer): Boolean; override;
function GetExtraIntProperty(Prop: TRVExtraItemProperty; var Value: Integer): Boolean; override;
function SetExtraStrProperty(Prop: TRVExtraItemStrProperty; const Value: String): Boolean; override;
function GetExtraStrProperty(Prop: TRVExtraItemStrProperty; var Value: String): Boolean; override;
procedure UpdatePaletteInfo(PaletteAction: TRVPaletteAction; ForceRecreateCopy: Boolean; Palette: HPALETTE; LogPalette: PLogPalette); override;
function GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas; RVData: TPersistent): Integer; override;
destructor Destroy; override;
function AsImage: TGraphic; override;
procedure Paint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo); override;
function GetBoolValue(Prop: TRVItemBoolProperty): Boolean; override;
function GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean; override;
{$IFNDEF RVDONOTUSEHTML}
procedure SaveToHTML(Stream: TStream; RVData: TPersistent; ItemNo: Integer; const Text: TRVRawByteString; const Path: String; const imgSavePrefix: String; var imgSaveNo: Integer; CurrentFileColor: TColor; SaveOptions: TRVSaveOptions; UseCSS: Boolean; Bullets: TRVList); override;
{$ENDIF}
function ReadRVFLine(const s: TRVRawByteString; RVData: TPersistent; ReadType, LineNo, LineCount: Integer; var Name: TRVRawByteString; var ReadMode: TRVFReadMode; var ReadState: TRVFReadState; UTF8Strings: Boolean; var AssStyleNameUsed: Boolean): Boolean; override;
procedure SaveRVF(Stream: TStream; RVData: TPersistent; ItemNo, ParaNo: Integer; const Name: TRVRawByteString; Part: TRVMultiDrawItemPart; ForceSameAsPrev: Boolean); override;
procedure SaveRTF(Stream: TStream; const Path: String; RVData: TPersistent; ItemNo: Integer; TwipsPerPixel: Double; Level: Integer; ColorList: TRVColorList; StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList; FontTable: TRVList); override;
function GetImageHeight(RVStyle: TRVStyle): Integer; override;
function GetImageWidth(RVStyle: TRVStyle): Integer; override;
procedure MovingToUndoList(ItemNo: Integer; RVData, AContainerUndoItem: TObject); override;
function CreatePrintingDrawItem(RVData: TObject; const sad: TRVScreenAndDevice): TRVDrawLineInfo; override;
{$IFNDEF RVDONOTUSEANIMATION}
procedure UpdateAnimator(RVData: TObject); override;
{$ENDIF}
property MinHeightOnPage: Integer read FMinHeightOnPage write FMinHeightOnPage;
End;
implementation
uses RVFMisc,RichView, PtblRV, PtRVData, CRVData, CRVFData, RVUni, RVStr, CtrlImg,
RVAnimate
{$IFNDEF RVDONOTUSELISTS}
, RVMarker
{$ENDIF}
;
{========================= TRVImagePrintPart ==================================}
type
TRVImagePrintPart = class (TRVMultiDrawItemPart)
public
ImgTop, ImgHeight: Integer;
function GetSoftPageBreakInfo: Integer; override;
function GetImageHeight: Integer; override;
end;
function TRVImagePrintPart.GetSoftPageBreakInfo: Integer;
begin
Result := ImgTop;
end;
{------------------------------------------------------------------------------}
function TRVImagePrintPart.GetImageHeight: Integer;
begin
Result := ImgHeight;
end;
{========================= TRVMultiImagePrintInfo =============================}
type
TRVMultiImagePrintInfo = class (TRVMultiDrawItemInfo)
private
FItem: THackRVRectItemInfo;
public
constructor Create(AItem: TRVRectItemInfo);
procedure SetSize(AWidth, AHeight: Integer); override;
function InitSplit(const Sad: TRVScreenAndDevice): Boolean; override;
function CanSplitFirst(Y: Integer; const Sad: TRVScreenAndDevice;
FirstOnPage, PageHasFootnotes, FootnotesChangeHeight: Boolean): Boolean; override;
function SplitAt(Y: Integer; const Sad: TRVScreenAndDevice;
FirstOnPage: Boolean; var FootnoteRVDataList: TList;
var MaxHeight: Integer; FootnotesChangeHeight: Boolean): Boolean; override;
end;
{------------------------------------------------------------------------------}
{$IFNDEF RVDONOTUSEHTML}
function GetHTMLImageAlign(Align: TRVVAlign; SaveOptions: TRVSaveOptions;
CSSVersion: Boolean): TRVAnsiString;
begin
case Align of
rvvaMiddle:
Result := 'middle';
rvvaAbsTop:
Result := 'abstop';
rvvaAbsBottom:
Result := 'absbottom';
rvvaAbsMiddle:
Result := 'absmiddle';
else
begin
Result := '';
exit;
end;
end;
if (rvsoXHTML in SaveOptions) then
Result := '"'+Result+'"';
Result := ' align='+Result;
end;
{$ENDIF}
constructor TRVMultiImagePrintInfo.Create(AItem: TRVRectItemInfo);
begin
inherited Create;
FItem := THackRVRectItemInfo(AItem);
end;
{------------------------------------------------------------------------------}
function TRVMultiImagePrintInfo.CanSplitFirst(Y: Integer;
const Sad: TRVScreenAndDevice; FirstOnPage, PageHasFootnotes,
FootnotesChangeHeight: Boolean): Boolean;
begin
Y := RV_YToScreen(Y, sad);
Result :=
(Y>0) and
FItem.GetBoolValueEx(rvbpPrintToBMP, nil) and
(FItem.FMinHeightOnPage>0) and
(Y>=FItem.FMinHeightOnPage+FItem.GetBorderHeight*2) and
((FItem.GetImageHeight(nil)-Y >= FItem.FMinHeightOnPage) or
(Y>FItem.GetImageHeight(nil)+FItem.GetBorderHeight*2));
end;
{------------------------------------------------------------------------------}
function TRVMultiImagePrintInfo.InitSplit(const Sad: TRVScreenAndDevice): Boolean;
var part: TRVImagePrintPart;
begin
Result := FItem.FMinHeightOnPage<>0;
if not Result then
exit;
part := TRVImagePrintPart.Create;
part.ImgTop := 0;
part.ImgHeight := FItem.GetImageHeight(nil);
part.Height := RV_YToDevice(part.ImgHeight+FItem.GetBorderHeight*2, sad);
PartsList.Add(part);
end;
{------------------------------------------------------------------------------}
function TRVMultiImagePrintInfo.SplitAt(Y: Integer;
const Sad: TRVScreenAndDevice; FirstOnPage: Boolean;
var FootnoteRVDataList: TList; var MaxHeight: Integer;
FootnotesChangeHeight: Boolean): Boolean;
var PrevHeight, NewHeight, PrevTop: Integer;
part: TRVImagePrintPart;
begin
if FItem.FMinHeightOnPage<=0 then begin
Result := False;
exit;
end;
if PartsList.Count=0 then
raise ERichViewError.Create(errRVPrint);
part := TRVImagePrintPart(PartsList[PartsList.Count-1]);
if (part.ImgHeight<=FItem.FMinHeightOnPage) then begin
Result := False;
exit;
end;
PrevHeight := RV_YToScreen(Y, sad)-FItem.GetBorderHeight*2;
NewHeight := part.ImgHeight-PrevHeight;
if (NewHeight<FItem.FMinHeightOnPage) or (PrevHeight<FItem.FMinHeightOnPage) then begin
Result := False;
exit;
end;
part.ImgHeight := PrevHeight;
part.Height := RV_YToDevice(part.ImgHeight+FItem.GetBorderHeight*2, sad);
PrevTop := part.ImgTop;
part := TRVImagePrintPart.Create;
part.ImgTop := PrevTop+PrevHeight;
part.ImgHeight := NewHeight;
part.Height := RV_YToDevice(part.ImgHeight+FItem.GetBorderHeight*2, sad);
PartsList.Add(part);
Result := True;
end;
{------------------------------------------------------------------------------}
procedure TRVMultiImagePrintInfo.SetSize(AWidth, AHeight: Integer);
begin
// do nothing
end;
Function TRVChartItemInfo.GetHeight: Integer;
Begin
If (Image is TIcon)
Then TIcon(Image).Handle;
If (ImageHeight>0)
Then Result := ImageHeight
Else Result := Image.Height;
Inc(Result,Spacing*2);
End;
Function TRVChartItemInfo.GetWidth: Integer;
Begin
If (Image is TIcon)
Then TIcon(Image).Handle;
If (ImageWidth>0)
Then Result := ImageWidth
Else Result := Image.Width;
Inc(Result, Spacing*2);
End;
Function TRVChartItemInfo.GetRVFExtraPropertyCount: Integer;
Begin
Result := inherited GetRVFExtraPropertyCount;
If (not FResizable)
Then Inc(Result);
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 TRVChartItemInfo.SaveRVFExtraProperties(Stream: TStream);
begin
inherited SaveRVFExtraProperties(Stream);
if not FResizable then
WriteRVFExtraIntPropertyStr(Stream, rvepResizable, ord(FResizable));
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 TRVChartItemInfo.GetChartImage(NoChart:Integer):TMetaFile;
Var
Query : TUniQuery;
memStream : TMemoryStream;
Begin
Result := TMetaFile.Create;
Query := TUniQuery.Create(Nil);
Query.Connection := TInfoDB.GetInstance.Connection;
//Query.DatabaseName := DATABASE_NAME;
Query.SQL.Clear;
Query.SQL.Add('SELECT * FROM Graphiques WHERE No_Graph = '+IntToStr(NoChart));
Query.Open;
memStream := TMemoryStream.Create;
TBlobField(Query.FieldByName('Sample_Graph')).SaveToStream(memStream);
memStream.Position := 0;
Result.LoadFromStream(memStream);
memStream.Free;
Query.Close;
Query.Free;
End;
Constructor TRVChartItemInfo.CreateEx(RVData: TPersistent; NoChart:Integer; AVAlign: TRVVAlign);
Begin
inherited Create(RVData);
FNoChart := NoChart;
StyleNo := rvsChart;
Image := GetChartImage(NoChart);
VAlign := AVAlign;
FResizable := True;
End;
Constructor TRVChartItemInfo.Create(RVData: TPersistent);
Begin
inherited Create(RVData);
FNoChart := 0;
StyleNo := rvsChart;
FResizable := True;
End;
function TRVChartItemInfo.PrintToBitmap(Bkgnd: TBitmap; Preview: Boolean;
RichView: TRVScroller; dli: TRVDrawLineInfo; Part: Integer;
ColorMode: TRVColorMode):Boolean;
var Top, Height: Integer;
SourceImage: TGraphic;
{$IFDEF RICHVIEWCBDEF3}
TmpBackground: TBitmap;
{$ENDIF}
begin
Result := True;
if Preview and (ImageCopy<>nil) then
SourceImage := ImageCopy
else
SourceImage := Image;
// If the source picture is increased in at least one
// dimension, resizing background image (for providing higher quality).
// Images printed on several pages (Part>=0) cannot be resized in height,
// so height is checked only if Part<0.
// If the source image is transparent, background is stretched; otherwise
// the content of bkgnd does not matter
if (bkgnd.Width<SourceImage.Width) or
((Part<0) and (bkgnd.Height<SourceImage.Height)) then begin
{$IFDEF RICHVIEWCBDEF3}
if SourceImage.Transparent then begin
TmpBackground := TBitmap.Create;
TmpBackground.Assign(bkgnd);
end
else
TmpBackground := nil;
try
{$ENDIF}
if bkgnd.Width<SourceImage.Width then
bkgnd.Width := SourceImage.Width;
if (Part<0) and (bkgnd.Height<SourceImage.Height) then
bkgnd.Height := SourceImage.Height;
{$IFDEF RICHVIEWCBDEF3}
if TmpBackground<>nil then
bkgnd.Canvas.StretchDraw(Rect(0,0,bkgnd.Width,bkgnd.Height), TmpBackground);
finally
TmpBackground.Free;
end;
{$ENDIF}
end;
if (dli is TRVMultiImagePrintInfo) and (Part>=0) then begin
// Drawing the image part. Multipage images cannot be scaled in height,
// so we use SourceImage.Height
Top := -TRVImagePrintPart(TRVMultiImagePrintInfo(dli).PartsList[Part]).ImgTop;
Height := SourceImage.Height;
end
else begin
// Drawing the whole image
Top := 0;
Height := bkgnd.Height;
end;
bkgnd.Canvas.StretchDraw(Bounds(0,Top,bkgnd.Width,Height), SourceImage);
end;
Procedure TRVChartItemInfo.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;
procedure TRVChartItemInfo.Assign(Source: TCustomRVItemInfo);
var grclass: TGraphicClass;
begin
if Source is TRVChartItemInfo then begin
Alt := TRVChartItemInfo(Source).Alt;
FResizable := TRVChartItemInfo(Source).FResizable;
ImageFileName := TRVChartItemInfo(Source).ImageFileName;
ImageWidth := TRVChartItemInfo(Source).ImageWidth;
ImageHeight := TRVChartItemInfo(Source).ImageHeight;
NoHTMLImageSize := TRVChartItemInfo(Source).NoHTMLImageSize;
Image.Free;
ImageCopy.Free;
grclass := TGraphicClass(TRVChartItemInfo(Source).Image.ClassType);
Image := RV_CreateGraphics(grclass);
Image.Assign(TRVChartItemInfo(Source).Image);
if TRVChartItemInfo(Source).ImageCopy<>nil then begin
grclass := TGraphicClass(TRVChartItemInfo(Source).ImageCopy.ClassType);
ImageCopy := RV_CreateGraphics(grclass);
ImageCopy.Assign(TRVChartItemInfo(Source).ImageCopy);
end
else
ImageCopy := nil;
end;
inherited Assign(Source);
end;
procedure TRVChartItemInfo.TransferProperties(Source: TCustomRVItemInfo;
RVData: TPersistent);
begin
{$IFNDEF RVDONOTUSEANIMATION}
if (FAnimator=nil) and (Source is TRVChartItemInfo) then begin
FAnimator := TRVChartItemInfo(Source).FAnimator;
TRVChartItemInfo(Source).FAnimator := nil;
if FAnimator<>nil then
TRVAnimator(FAnimator).Update(nil, Self);
UpdateAnimator(RVData);
end;
{$ENDIF}
end;
function TRVChartItemInfo.SetExtraIntProperty(Prop: TRVExtraItemProperty;
Value: Integer): Boolean;
begin
Result := False;
case Prop of
rvepResizable:
begin
FResizable := Value<>0;
Result := True;
end;
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 TRVChartItemInfo.GetExtraIntProperty(Prop: TRVExtraItemProperty;
var Value: Integer): Boolean;
begin
Result := False;
case Prop of
rvepResizable:
begin
Value := ord(FResizable);
Result := True;
end;
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 TRVChartItemInfo.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;
function TRVChartItemInfo.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;
procedure TRVChartItemInfo.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 TRVChartItemInfo.GetMinWidth(sad: PRVScreenAndDevice; Canvas: TCanvas;
RVData: TPersistent): Integer;
begin
if Image is TIcon then
TIcon(Image).Handle;
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;
destructor TRVChartItemInfo.Destroy;
begin
Image.Free;
ImageCopy.Free;
{$IFNDEF RVDONOTUSEANIMATION}
FAnimator.Free;
{$ENDIF}
inherited Destroy;
end;
function TRVChartItemInfo.AsImage: TGraphic;
begin
Result := Image;
end;
procedure TRVChartItemInfo.Paint(x, y: Integer; Canvas: TCanvas;
State: TRVItemDrawStates; Style: TRVStyle; dli: TRVDrawLineInfo);
var w,h: Integer;
SelColor: TColor;
{...............................................}
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);
if not RVNT then
Canvas.Refresh;
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 (rvidsSelected in State) then begin
if rvidsControlFocused in State then
SelColor := Style.SelColor
else
SelColor := Style.InactiveSelColor;
{$IFDEF RVSHADESELECTION}
ShadeRectangle(Canvas, Bounds(x,y,w,h), SelColor);
{$ELSE}
Canvas.Pen.Color := SelColor;
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;
{$ENDIF}
end;
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;
end;
function TRVChartItemInfo.GetBoolValue(Prop: TRVItemBoolProperty): Boolean;
begin
case Prop of
rvbpResizable:
Result := (Image<>nil) and not (Image is TIcon) and FResizable;
rvbpValid:
Result := Image<>nil;
rvbpResizeHandlesOutside:
{$IFNDEF RVDONOTUSEANIMATION}
Result := FAnimator<>nil;
{$ELSE}
Result := False;
{$ENDIF}
rvbpDrawingChangesFont:
Result := True;
else
Result := inherited GetBoolValue(Prop);
end;
end;
function TRVChartItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean;
begin
case Prop of
rvbpDisplayActiveState:
Result := True;
rvbpPrintToBMP:
Result := not (Image is TMetafile);
else
Result := inherited GetBoolValueEx(Prop, RVStyle);
end;
end;
{$IFNDEF RVDONOTUSEHTML}
procedure TRVChartItemInfo.SaveToHTML(Stream: TStream; RVData: TPersistent;
ItemNo: Integer; const Text: TRVRawByteString; const Path: String;
const imgSavePrefix: String; var imgSaveNo: Integer; CurrentFileColor: TColor;
SaveOptions: TRVSaveOptions; UseCSS: Boolean; Bullets: TRVList);
{.................................................................}
function GetExtraIMGStr: TRVAnsiString;
var s: TRVAnsiString;
RVStyle: TRVStyle;
begin
Result := '';
if rvsoNoHypertextImageBorders in SaveOptions then
RV_AddStrA(Result, {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}
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_AddStrA(Result, {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}
Format('width=%s height=%s', [
RV_HTMLGetIntAttrVal(GetImageWidth(RVStyle), SaveOptions),
RV_HTMLGetIntAttrVal(GetImageHeight(RVStyle), SaveOptions)]));
if (Alt<>'') or UseCSS then begin
s := StringToHTMLString(Alt, SaveOptions, RVStyle);
RV_AddStrA(Result, 'alt="'+s+'"');
end;
if Spacing>0 then
RV_AddStrA(Result, {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}
Format('hspace=%s vspace=%s', [
RV_HTMLGetIntAttrVal(Spacing, SaveOptions),
RV_HTMLGetIntAttrVal(Spacing, SaveOptions)]));
{$IFNDEF RVDONOTUSEITEMHINTS}
if Hint<>'' then begin
s := StringToHTMLString(RV_GetHintStr(rvsfHTML, Hint), SaveOptions, RVStyle);
RV_AddStrA(Result, s);
end;
{$ENDIF}
if UseCSS then begin
s := GetVShiftCSS(RVStyle);
if s<>'' then
RV_AddStrA(Result, {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}
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, {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}Format('<img%s%ssrc="%s"%s>',
[GetHTMLImageAlign(VAlign, SaveOptions, UseCSS), GetExtraIMGStr,
StringToHTMLString(RV_GetHTMLPath(Location), SaveOptions, TCustomRVData(RVData).GetRVStyle),
RV_HTMLGetEndingSlash(SaveOptions)]));
end;
{$ENDIF}
Function TRVChartItemInfo.ReadRVFLine(const s: TRVRawByteString; RVData: TPersistent; ReadType, LineNo, LineCount: Integer; var Name: TRVRawByteString; var ReadMode: TRVFReadMode; var ReadState: TRVFReadState; UTF8Strings: Boolean; var AssStyleNameUsed: Boolean): Boolean;
Var
ifn: String;
GraphicClassName: String;
Begin
Result := True;
If (LineNo = 1)
Then Begin
FNoChart := StrToInt(s);
Image := GetChartImage(FNoChart);
End;
SetExtraPropertyFromRVFStr(s, UTF8Strings);
end;
(*
function TRVChartItemInfo.ReadRVFLine(const s: TRVRawByteString; RVData: TPersistent;
ReadType, LineNo, LineCount: Integer; var Name: TRVRawByteString;
var ReadMode: TRVFReadMode; var ReadState: TRVFReadState;
UTF8Strings: Boolean; var AssStyleNameUsed: Boolean): Boolean;
var grcls : TGraphicClass;
ifn: String;
GraphicClassName: String;
begin
Result := True;
case ReadType of
1: // ask user
begin
case LineNo of
0:
begin
Image := TCustomRVData(RVData).RVFPictureNeeded(
{$IFDEF RVUNICODESTR}String(TRVAnsiString(s)),{$ELSE}s,{$ENDIF}
Tag);
Name := s;
end;
else
begin
ifn := ImageFileName;
SetExtraPropertyFromRVFStr(s, UTF8Strings);
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
{$IFDEF RVUNICODESTR}
GraphicClassName := String(s);
{$ELSE}
GraphicClassName := s; // workaround for Delphi 3-6 bug
{$ENDIF}
grcls := TGraphicClass(GetClass(GraphicClassName));
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, UTF8Strings);
if (ReadType=2) and (LineNo=LineCount-2) then
ReadMode := rmBeforeBinary;
end;
end;
end;
procedure TRVChartItemInfo.SaveRVF(Stream: TStream;
RVData: TPersistent; ItemNo, ParaNo: Integer;
const Name: TRVRawByteString; Part: TRVMultiDrawItemPart;
ForceSameAsPrev: Boolean);
var SaveType, LineCount, Pos: Integer;
InvalidGraphic: TGraphic;
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,
{$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}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
Pos := Stream.Position;
try
RVFWriteLine(Stream, TRVAnsiString(Image.ClassName));
SaveRVFExtraProperties(Stream);
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
RVFSavePictureBinary(Stream, Image)
else
RVFWriteLine(Stream, RVFSavePicture(Image));
except
if Stream.Size=Stream.Position then
Stream.Size := Pos;
Stream.Position := Pos;
InvalidGraphic := TCustomRVData(RVData).GetRVStyle.InvalidPicture.Graphic;
RVFWriteLine(Stream, TRVAnsiString(InvalidGraphic.ClassName));
SaveRVFExtraProperties(Stream);
if rvfoSaveBinary in TCustomRVData(RVData).RVFOptions then
RVFSavePictureBinary(Stream, InvalidGraphic)
else
RVFWriteLine(Stream, RVFSavePicture(InvalidGraphic));
end;
end
else
SaveRVFExtraProperties(Stream);
end;
*)
Procedure TRVChartItemInfo.SaveRVF(Stream: TStream; RVData: TPersistent; ItemNo, ParaNo: Integer; const Name: TRVRawByteString; Part: TRVMultiDrawItemPart; ForceSameAsPrev: Boolean);
var
SaveType, LineCount, Pos: Integer;
InvalidGraphic: TGraphic;
Begin
SaveType := 0;
LineCount := 2+GetRVFExtraPropertyCount;
RVFWriteLine(Stream,{$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}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);
RVFWriteLine(Stream,Format('%d',[FNoChart]));
SaveRVFExtraProperties(Stream);
end;
procedure TRVChartItemInfo.SaveRTF(Stream: TStream; const Path: String;
RVData: TPersistent; ItemNo: Integer; TwipsPerPixel: Double;
Level: Integer; ColorList: TRVColorList;
StyleToFont, ListOverrideOffsetsList1, ListOverrideOffsetsList2: TRVIntegerList;
FontTable: TRVList);
begin
RVSaveImageToRTF(Stream, TwipsPerPixel, Image, ImageWidth, ImageHeight,
TCustomRVData(RVData).RTFOptions,
{$IFNDEF RVDONOTUSEANIMATION}FAnimator{$ELSE}nil{$ENDIF});
end;
function TRVChartItemInfo.GetImageHeight(RVStyle: TRVStyle): Integer;
begin
if Image is TIcon then
TIcon(Image).Handle;
if (ImageHeight>0) then
Result := ImageHeight
else
Result := Image.Height;
end;
function TRVChartItemInfo.GetImageWidth(RVStyle: TRVStyle): Integer;
begin
if Image is TIcon then
TIcon(Image).Handle;
if (ImageWidth>0) then
Result := ImageWidth
else
Result := Image.Width;
end;
procedure TRVChartItemInfo.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;
function TRVChartItemInfo.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 := RV_XToDevice(GetWidth, sad);
Result.Height := RV_YToDevice(GetHeight, sad);
end;
procedure TRVChartItemInfo.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;
end.
hehheehe