RVBlendBitmap.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:7k
- unit RVBlendBitmap;
- interface
- uses SysUtils, Classes, Windows, Graphics,
- RVStyle, RVItem, RVFMisc, DLines, CRVFData;
- const
- rvsBlendBitmap = -50;
- rvsHotBlendBitmap = -51;
- type
- TRVBlendBitmapItemInfo = class(TRVGraphicItemInfo)
- protected
- Back: TBitmap;
- function SaveRVFHeaderTail(RVData: TPersistent): String; 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 ReadRVFHeader(var P: PChar; RVData: TPersistent): 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): String;
- begin
- Result := Format('%s %d', [inherited SaveRVFHeaderTail(RVData), Integer(Transparency)]);
- end;
- {------------------------------------------------------------------------------}
- function TRVBlendBitmapItemInfo.ReadRVFHeader(var P: PChar; RVData: TPersistent): Boolean;
- var tr: Integer;
- begin
- Result := inherited ReadRVFHeader(P, RVData);
- 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.