rvback.pas

richview1.7 full.source

unit RVBack;

interface
uses SysUtils, Windows, Classes, Graphics, RVStyle, RVScroll, RVFuncs;

type
  TRVBackground = class
    private
      BitmapCopy: TBitmap;
    public
      Style: TBackgroundStyle;
      Bitmap: TBitmap;
      constructor Create;
      destructor Destroy; override;
      function ScrollRequiresFullRedraw: Boolean;
      procedure UpdatePaletted(PaletteAction: TRVPaletteAction;Palette: HPALETTE; LogPalette: PLogPalette);
      procedure Draw(DC: HDC; const Rect: TRect; HOffs, VOffs, Width,Height: Integer; Color: TColor);
  end;

implementation

{============================== TRVBackground =================================}
constructor TRVBackground.Create;
begin
  inherited Create;
  Bitmap := TBitmap.Create;
  Style  := bsNoBitmap;
end;
{------------------------------------------------------------------------------}
destructor TRVBackground.Destroy;
begin
  Bitmap.Free;
  BitmapCopy.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}
function TRVBackground.ScrollRequiresFullRedraw: Boolean;
begin
  if Bitmap.Empty then
    Result := False
  else begin
    case Style of
      bsNoBitmap, bsTiledAndScrolled:
        Result := False;
      //bsStretched, bsTiled, bsCentered:
      else
        Result := True;
    end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVBackground.UpdatePaletted(PaletteAction: TRVPaletteAction;
                             Palette: HPALETTE; LogPalette: PLogPalette);
begin
  BitmapCopy.Free;
  BitmapCopy := nil;
  case PaletteAction of
    rvpaAssignPallette:
      if (LogPalette<>nil) and not Bitmap.Empty then
        RV_SetPaletteToPicture(Bitmap,LogPalette);
    rvpaCreateCopies,rvpaCreateCopiesEx:
      if (LogPalette<>nil) and not Bitmap.Empty then begin
        BitmapCopy := TBitmap.Create;
        BitmapCopy.Assign(Bitmap);
        RV_SetPaletteToPicture(BitmapCopy,LogPalette);
        BitmapCopy.IgnorePalette := True;
      end;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVBackground.Draw(DC: HDC; const Rect: TRect;
                             HOffs, VOffs, Width, Height: Integer;
                             Color: TColor);
var i, j: Integer;
    hbr: HBRUSH;
    OffsRect: TRect;
    bmp: TBitmap;
begin
 if BitmapCopy=nil then
   bmp := Bitmap
 else
   bmp := BitmapCopy;
 if bmp.Empty or (Style in [bsNoBitmap, bsCentered]) then begin
   hbr := CreateSolidBrush(ColorToRGB(Color));
   OffsRect := Rect;
   OffsetRect(OffsRect, -Rect.Left, -Rect.Top);
   FillRect(DC, OffsRect, hbr);
   DeleteObject(hbr);
   if not bmp.Empty and (Style = bsCentered) then
     BitBlt(DC, -Rect.Left+(Width-bmp.Width) div 2,
                -Rect.Top+(Height-bmp.Height) div 2,
                bmp.Width, bmp.Height,
                bmp.Canvas.Handle, 0, 0, SRCCOPY);
  end
 else
   case Style of
     bsTiled:
      for i:= Rect.Top div bmp.Height to Rect.Bottom div bmp.Height do
        for j:= Rect.Left div bmp.Width to Rect.Right div bmp.Width do
          BitBlt(DC, j*bmp.Width-Rect.Left,i*bmp.Height-Rect.Top, bmp.Width,
                 bmp.Height, bmp.Canvas.Handle, 0, 0, SRCCOPY);
     bsStretched:
          StretchBlt(DC, -Rect.Left, -Rect.Top, Width, Height,
                     bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
                     SRCCOPY);
     bsTiledAndScrolled:
      for i:= (Rect.Top+VOffs) div bmp.Height to
              (Rect.Bottom+VOffs) div bmp.Height do
        for j:= (Rect.Left+HOffs) div bmp.Width to
                (Rect.Right+HOffs) div bmp.Width do
          BitBlt(DC, j*bmp.Width-HOffs-Rect.Left,i*bmp.Height-VOffs-Rect.Top, bmp.Width,
                 bmp.Height, bmp.Canvas.Handle, 0, 0, SRCCOPY);
   end
end;

end.