RVBlendBitmap.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:7k
源码类别:

RichEdit

开发平台:

Delphi

  1. unit RVBlendBitmap;
  2. interface
  3. uses SysUtils, Classes, Windows, Graphics,
  4.      RVStyle, RVItem, RVFMisc, DLines, CRVFData;
  5. const
  6.   rvsBlendBitmap = -50;
  7.   rvsHotBlendBitmap = -51;
  8. type
  9.   TRVBlendBitmapItemInfo = class(TRVGraphicItemInfo)
  10.     protected
  11.       Back: TBitmap;
  12.       function SaveRVFHeaderTail(RVData: TPersistent): String; override;
  13.       function GetTransparency(State: TRVItemDrawStates): Byte; virtual;
  14.     public
  15.       Transparency: Byte;
  16.       constructor CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign); override;
  17.       destructor Destroy; override;
  18.       procedure Paint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
  19.                       Style: TRVStyle; dli: TRVDrawLineInfo); override;
  20.       procedure AfterLoading(FileFormat: TRVLoadFormat); override;
  21.       function ReadRVFHeader(var P: PChar; RVData: TPersistent): Boolean; override;
  22.       procedure Assign(Source: TCustomRVItemInfo); override;
  23.   end;
  24.   TRVHotBlendBitmapItemInfo = class(TRVBlendBitmapItemInfo)
  25.     protected
  26.       function GetTransparency(State: TRVItemDrawStates): Byte; override;
  27.     public
  28.       HotTransparency: Byte;
  29.       function GetBoolValueEx(Prop: TRVItemBoolPropertyEx; RVStyle: TRVStyle): Boolean; override;
  30.       constructor CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign); override;
  31.       procedure Execute(RVData:TPersistent); override;
  32.       procedure Assign(Source: TCustomRVItemInfo); override;
  33.   end;
  34. implementation
  35. {$R-}
  36. procedure DrawTransparent(Canvas: TCanvas;
  37.                           x,y: Integer;
  38.                           Transparency: Byte;
  39.                           Back: TBitmap;
  40.                           Bitmap: TBitmap);
  41. type
  42.      RGBARR = array [0..0] of TRGBQUAD;
  43.      PRGBARR = ^RGBARR;
  44. var rgb1,rgb2: PRGBARR;
  45.     i,j: Integer;
  46.     op, tr: Integer;
  47. begin
  48.    tr := Transparency;
  49.    op := 255-Transparency;
  50.    Back.Canvas.CopyRect(Rect(0,0,Back.Width,Back.Height), Canvas,
  51.                    Bounds(x,y,Back.Width,Back.Height));
  52.    for i:=0 to Back.Height-1 do begin
  53.      rgb1 := PRGBARR(Back.ScanLine[i]);
  54.      rgb2 := PRGBARR(Bitmap.ScanLine[i]);
  55.      for j:=0 to Back.Width-1 do
  56.        if not CompareMem(@rgb1[j], @rgb2[j],3) then
  57.          with rgb1[j] do begin
  58.            rgbBlue  := (rgbBlue*tr  + rgb2[j].rgbBlue*op) div 255;
  59.            rgbGreen := (rgbGreen*tr + rgb2[j].rgbGreen*op)div 255;
  60.            rgbRed   := (rgbRed*tr   + rgb2[j].rgbRed*op) div 255;
  61.          end;
  62.    end;
  63.    Canvas.Draw(x,y, Back);
  64. end;
  65. {======================= TRVBlendBitmapItemInfo ===============================}
  66. constructor TRVBlendBitmapItemInfo.CreateEx(RVData: TPersistent; AImage: TGraphic; AVAlign: TRVVAlign);
  67. begin
  68.   inherited CreateEx(RVData, AImage as TBitmap, AValign);
  69.   Transparency := 0;
  70.   StyleNo := rvsBlendBitmap;
  71.   AfterLoading(rvlfRVF);
  72. end;
  73. {------------------------------------------------------------------------------}
  74. procedure TRVBlendBitmapItemInfo.AfterLoading(FileFormat: TRVLoadFormat);
  75. begin
  76.   inherited AfterLoading(FileFormat);
  77.   TBitmap(Image).PixelFormat := pf32bit;
  78.   Back := TBitmap.Create;
  79.   Back.PixelFormat := pf32bit;
  80.   Back.Width := TBitmap(Image).Width;
  81.   Back.Height := TBitmap(Image).Height;
  82. end;
  83. {------------------------------------------------------------------------------}
  84. destructor TRVBlendBitmapItemInfo.Destroy;
  85. begin
  86.   Back.Free;
  87.   inherited Destroy;
  88. end;
  89. {------------------------------------------------------------------------------}
  90. function TRVBlendBitmapItemInfo.GetTransparency(State: TRVItemDrawStates): Byte;
  91. begin
  92.   Result := Transparency;
  93. end;
  94. {------------------------------------------------------------------------------}
  95. procedure TRVBlendBitmapItemInfo.Paint(x,y: Integer; Canvas: TCanvas; State: TRVItemDrawStates;
  96.                       Style: TRVStyle; dli: TRVDrawLineInfo);
  97. begin
  98.   if ImageCopy<>nil then
  99.     inherited Paint(x, y, Canvas, State, Style, dli)
  100.   else begin
  101.      inc(x); inc(y);
  102.      DrawTransparent(Canvas, x, y, GetTransparency(State), Back, TBitmap(Image));
  103.      if (rvidsCurrent in State) and (Style.HoverColor<>clNone) then begin
  104.        Canvas.Pen.Color := Style.HoverColor;
  105.        Canvas.Pen.Style := psSolid;
  106.        Canvas.Rectangle(x-2,y-2, x+Image.Width+2, y+Image.Height+2);
  107.      end;
  108.      if (rvidsSelected in State) then begin
  109.        Canvas.Pen.Color := Style.SelColor;
  110.        Canvas.Pen.Style := psSolid;
  111.        Canvas.Rectangle(x-1,y-1, x+Image.Width+1, y+Image.Height+1);
  112.      end
  113.   end;
  114. end;
  115. {------------------------------------------------------------------------------}
  116. function TRVBlendBitmapItemInfo.SaveRVFHeaderTail(RVData: TPersistent): String;
  117. begin
  118.   Result := Format('%s %d', [inherited SaveRVFHeaderTail(RVData), Integer(Transparency)]);
  119. end;
  120. {------------------------------------------------------------------------------}
  121. function TRVBlendBitmapItemInfo.ReadRVFHeader(var P: PChar; RVData: TPersistent): Boolean;
  122. var tr: Integer;
  123. begin
  124.   Result := inherited ReadRVFHeader(P, RVData);
  125.   if not Result then exit;
  126.   if not (P^ in [#0, #10, #13]) then
  127.     Result := RVFReadInteger(P,tr)
  128.   else
  129.     Result := False;
  130.   if Result then
  131.     Transparency := Byte(tr);
  132. end;
  133. {------------------------------------------------------------------------------}
  134. procedure TRVBlendBitmapItemInfo.Assign(Source: TCustomRVItemInfo);
  135. begin
  136.   if (Source is TRVBlendBitmapItemInfo) then
  137.     Transparency := TRVBlendBitmapItemInfo(Source).Transparency;
  138.   inherited Assign(Source);
  139. end;
  140. {======================= TRVHotBlendBitmapItemInfo ============================}
  141. constructor TRVHotBlendBitmapItemInfo.CreateEx(RVData: TPersistent;
  142.   AImage: TGraphic; AVAlign: TRVVAlign);
  143. begin
  144.   inherited CreateEx(RVData, AImage, AVAlign);
  145.   StyleNo := rvsHotBlendBitmap;
  146. end;
  147. {------------------------------------------------------------------------------}
  148. function TRVHotBlendBitmapItemInfo.GetBoolValueEx(Prop: TRVItemBoolPropertyEx;
  149.   RVStyle: TRVStyle): Boolean;
  150. begin
  151.   case Prop of
  152.     rvbpJump, rvbpAllowsFocus, rvbpXORFocus, rvbpHotColdJump:
  153.       Result := True;
  154.     else
  155.       Result := inherited GetBoolValueEx(Prop, RVStyle);
  156.   end;
  157. end;
  158. {------------------------------------------------------------------------------}
  159. procedure TRVHotBlendBitmapItemInfo.Execute(RVData:TPersistent);
  160. begin
  161.   if RVData is TCustomRVFormattedData then
  162.     TCustomRVFormattedData(RVData).DoJump(JumpID+
  163.       TCustomRVFormattedData(RVData).FirstJumpNo)
  164. end;
  165. {------------------------------------------------------------------------------}
  166. procedure TRVHotBlendBitmapItemInfo.Assign(Source: TCustomRVItemInfo);
  167. begin
  168.   if (Source is TRVHotBlendBitmapItemInfo) then
  169.     HotTransparency := TRVHotBlendBitmapItemInfo(Source).HotTransparency;
  170.   inherited Assign(Source);
  171. end;
  172. {------------------------------------------------------------------------------}
  173. function TRVHotBlendBitmapItemInfo.GetTransparency(State: TRVItemDrawStates): Byte;
  174. begin
  175.   if rvidsHover in State then
  176.     Result := HotTransparency
  177.   else
  178.     Result := Transparency;
  179. end;
  180. {==============================================================================}
  181. initialization
  182.   RegisterRichViewItemClass(rvsBlendBitmap, TRVBlendBitmapItemInfo);
  183.   RegisterRichViewItemClass(rvsHotBlendBitmap, TRVHotBlendBitmapItemInfo);
  184. end.