Componentes.Terceros.TRichView/12.0.4/Demos/Addins/BlendBitmap/RVBlendBitmap.pas

unit RVBlendBitmap;

interface
{$I RV_Defs.inc}

uses
     {$IFDEF RICHVIEWDEF2009}AnsiStrings,{$ENDIF}
     SysUtils, Classes, Windows, Graphics,
     RVStyle, RVItem, RVFMisc, DLines, CRVFData, RVTypes;

const
  rvsBlendBitmap = -50;
  rvsHotBlendBitmap = -51;

type
  TRVBlendBitmapItemInfo = class(TRVGraphicItemInfo)
    protected
      Back: TBitmap;
      function SaveRVFHeaderTail(RVData: TPersistent): TRVRawByteString; override;
      function GetTransparency(State: TRVItemDrawStates): Byte; virtual;
    public
      Transparency: Byte;
      constructor CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign); override;
      destructor Destroy; override;
      procedure Paint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
                      Style: TRVStyle; dli: TRVDrawLineInfo); override;
      procedure AfterLoading(FileFormat: TRVLoadFormat); override;
      function ReadRVFHeaderTail(var P: PRVAnsiChar; RVData: TPersistent;
        UTF8Strings: Boolean; var AssStyleNameUsed: Boolean): Boolean; override;
      procedure Assign(Source: TCustomRVItemInfo); override;
  end;

  TRVHotBlendBitmapItemInfo = class(TRVBlendBitmapItemInfo)
    protected
      function GetTransparency(State: TRVItemDrawStates): Byte; override;
    public
      HotTransparency: Byte;
      function GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean; override;
      constructor CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign); override;
      procedure Execute(RVData:TPersistent); override;
      procedure Assign(Source: TCustomRVItemInfo); override;
  end;


implementation

{$R-}
procedure DrawTransparent(Canvas: TCanvas;
                          x,y: Integer;
                          Transparency: Byte;
                          Back: TBitmap;
                          Bitmap: TBitmap);
type
     RGBARR = array [0..0] of TRGBQUAD;
     PRGBARR = ^RGBARR;
var rgb1,rgb2: PRGBARR;
    i,j: Integer;
    op, tr: Integer;
begin
   tr := Transparency;
   op := 255-Transparency;
   Back.Canvas.CopyRect(Rect(0,0,Back.Width,Back.Height), Canvas,
                   Bounds(x,y,Back.Width,Back.Height));
   for i:=0 to Back.Height-1 do begin
     rgb1 := PRGBARR(Back.ScanLine[i]);
     rgb2 := PRGBARR(Bitmap.ScanLine[i]);
     for j:=0 to Back.Width-1 do
       if not CompareMem(@rgb1[j], @rgb2[j],3) then
         with rgb1[j] do begin
           rgbBlue  := (rgbBlue*tr  + rgb2[j].rgbBlue*op) div 255;
           rgbGreen := (rgbGreen*tr + rgb2[j].rgbGreen*op)div 255;
           rgbRed   := (rgbRed*tr   + rgb2[j].rgbRed*op) div 255;
         end;
   end;
   Canvas.Draw(x,y, Back);
end;

{======================= TRVBlendBitmapItemInfo ===============================}
constructor TRVBlendBitmapItemInfo.CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign);
begin
  inherited CreateEx(RVData, AImage as TBitmap, AValign);
  Transparency := 0;
  StyleNo := rvsBlendBitmap;
  AfterLoading(rvlfRVF);
end;
{------------------------------------------------------------------------------}
procedure TRVBlendBitmapItemInfo.AfterLoading(FileFormat: TRVLoadFormat);
begin
  inherited AfterLoading(FileFormat);
  TBitmap(Image).PixelFormat := pf32bit;
  Back := TBitmap.Create;
  Back.PixelFormat := pf32bit;
  Back.Width := TBitmap(Image).Width;
  Back.Height := TBitmap(Image).Height;
end;
{------------------------------------------------------------------------------}
destructor TRVBlendBitmapItemInfo.Destroy;
begin
  Back.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TRVBlendBitmapItemInfo.GetTransparency(State: TRVItemDrawStates): Byte;
begin
  Result := Transparency;
end;
{------------------------------------------------------------------------------}
procedure TRVBlendBitmapItemInfo.Paint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
                      Style: TRVStyle; dli: TRVDrawLineInfo);
begin
  if ImageCopy<>nil then
    inherited Paint(x, y, Canvas, State, Style, dli)
  else begin
     inc(x); inc(y);
     DrawTransparent(Canvas, x, y, GetTransparency(State), Back, TBitmap(Image));
     if (rvidsCurrent in State) and (Style.HoverColor<>clNone) then begin
       Canvas.Pen.Color := Style.HoverColor;
       Canvas.Pen.Style := psSolid;
       Canvas.Rectangle(x-2,y-2, x+Image.Width+2, y+Image.Height+2);
     end;
     if (rvidsSelected in State) then begin
       Canvas.Pen.Color := Style.SelColor;
       Canvas.Pen.Style := psSolid;
       Canvas.Rectangle(x-1,y-1, x+Image.Width+1, y+Image.Height+1);
     end
  end;
end;
{------------------------------------------------------------------------------}
function TRVBlendBitmapItemInfo.SaveRVFHeaderTail(RVData: TPersistent): TRVRawByteString;
begin
  Result := {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}Format('%s %d', [inherited SaveRVFHeaderTail(RVData), Integer(Transparency)]);
end;
{------------------------------------------------------------------------------}
function TRVBlendBitmapItemInfo.ReadRVFHeaderTail(var P: PRVAnsiChar;
  RVData: TPersistent; UTF8Strings: Boolean;
  var AssStyleNameUsed: Boolean): Boolean;
var tr: Integer;
begin
  Result := inherited ReadRVFHeaderTail(P, RVData, UTF8Strings, AssStyleNameUsed);
  if not Result then exit;
  if not (P^ in [#0, #10, #13]) then
    Result := RVFReadInteger(P,tr)
  else
    Result := False;
  if Result then
    Transparency := Byte(tr);
end;
{------------------------------------------------------------------------------}
procedure TRVBlendBitmapItemInfo.Assign(Source: TCustomRVItemInfo);
begin
  if (Source is TRVBlendBitmapItemInfo) then
    Transparency := TRVBlendBitmapItemInfo(Source).Transparency;
  inherited Assign(Source);
end;
{======================= TRVHotBlendBitmapItemInfo ============================}
constructor TRVHotBlendBitmapItemInfo.CreateEx(RVData: TPersistent;
  AImage: TGraphic; AVAlign: TRVVAlign);
begin
  inherited CreateEx(RVData, AImage, AVAlign);
  StyleNo := rvsHotBlendBitmap;
end;
{------------------------------------------------------------------------------}
function TRVHotBlendBitmapItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
  RVStyle: TRVStyle): Boolean;
begin
  case Prop of
    rvbpJump, rvbpAllowsFocus, rvbpXORFocus, rvbpHotColdJump:
      Result := True;
    else
      Result := inherited GetBoolValueEx(Prop, RVStyle);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVHotBlendBitmapItemInfo.Execute(RVData:TPersistent);
begin
  if RVData is TCustomRVFormattedData then
    TCustomRVFormattedData(RVData).DoJump(JumpID+
      TCustomRVFormattedData(RVData).FirstJumpNo)
end;
{------------------------------------------------------------------------------}
procedure TRVHotBlendBitmapItemInfo.Assign(Source: TCustomRVItemInfo);
begin
  if (Source is TRVHotBlendBitmapItemInfo) then
    HotTransparency := TRVHotBlendBitmapItemInfo(Source).HotTransparency;
  inherited Assign(Source);
end;
{------------------------------------------------------------------------------}
function TRVHotBlendBitmapItemInfo.GetTransparency(State: TRVItemDrawStates): Byte;
begin
  if rvidsHover in State then
    Result := HotTransparency
  else
    Result := Transparency;
end;
{==============================================================================}
initialization

  RegisterRichViewItemClass(rvsBlendBitmap, TRVBlendBitmapItemInfo);
  RegisterRichViewItemClass(rvsHotBlendBitmap, TRVHotBlendBitmapItemInfo);

end.