unit GvBitmap;

{ Graphics Vision Bitmap Controls,
  Copr. 1995,1999 Matthias K"oppe

  $Id$
}

{$ifndef FPK}
{$A+,B-,F+,G+,I-,O+,P-,Q-,R-,S-,T-,V+,X+}
{$endif}

interface

{$ifdef Windows}
uses Objects, Drivers, WinGr, Views, WinRes, GvViews, GvDialog, GvApp;
{$else}
uses Objects, Drivers, Views, WinRes, GvViews, GvDialog, GvApp;
{$endif}

type
  PImageScroller = ^TImageScroller;
  TImageScroller = object(TScroller)
    Image: pointer;
    constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
      AnImage: pointer);
    destructor Done; virtual;
    procedure Draw; virtual;
  end;

  PBmpScroller = ^TBmpScroller;
  TBmpScroller = object(TImageScroller)
    constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
      Path: string);
  end;

const
{ TBmpView flags
}
  bmfTiled      = 1;
  bmfAdjustSize = 2;

type
{ TBmpView object
}
  PBmpView = ^TBmpView;
  TBmpView = object(TBackground)
    Image: PImage;
    Flags: Word;
    constructor InitByImages(var Bounds: TRect;
      AnImage: PImage; AFlags: Word);
    constructor InitByFile(var Bounds: TRect; Path: string; AFlags: Word);
    constructor Init(var Bounds: TRect; Resource: PStream;
      BitmapName: PChar; AFlags: Word);
    destructor Done; virtual;
    procedure Draw; virtual;
  end;

{ TIconLabel object
}
  PIconLabel = ^TIconLabel;
  TIconLabel = object(TLabel)
    XorMask: PImage;
    AndMask: PImage;
    constructor InitByImages(var Bounds: TRect;
      AXorMask, AnAndMask: PImage; ALink: PGView);
    constructor Init(var Bounds: TRect;
      Resource: PStream; IconName: PChar; ALink: PGView);
    destructor Done; virtual;
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
  end;

{ TImageButton object
}
  PImageButton = ^TImageButton;
  TImageButton = object(TButton)
    UpImage, DownImage, FocImage, DisImage: PImage;
    constructor InitByImages(var Bounds: TRect; ATitle: TTitleStr;
      AnUpImage, ADownImage, AFocImage, ADisImage: PImage;
      ACommand: Word; AFlags: Byte);
    constructor InitByBWCC(var Bounds: TRect; ATitle: TTitleStr;
      BWCC: PStream; idCommand: Integer; ACommand: Word; AFlags: Byte);
    destructor Done; virtual;
    procedure DrawState(Down: Boolean); virtual;
  end;

type
{ TNewDesktop object
}
  PNewDesktop = ^TNewDesktop;
  TNewDesktop = object(TDesktop)
    constructor Init(var Bounds: TRect; Bitmap: string);
    procedure NewBitmap(Bitmap: string);
  end;

implementation

{$ifdef FPK}
uses Bgi, GvBwcc;
{$else}
{$ifdef Windows}
uses VgaMem, Bitmap, GvBwcc;
{$else}
uses Gr, VgaMem, MetaGr, Bitmap, GvBwcc;
{$endif Windows}
{$endif}

{ TImageScroller object
}

constructor TImageScroller.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
      AnImage: pointer);
var
  Extent: TPoint;
begin
  inherited Init(Bounds, AHScrollBar, AVScrollBar);
  with TextSize do
  begin
    X := 1;
    Y := 1
  end;
  GrowMode := gfGrowHiX + gfGrowHiY;
  GetImageExtent(AnImage, Extent);
  SetLimit(Extent.x, Extent.y);
  Image := AnImage
end;

destructor TImageScroller.Done;
begin
  FreeImage(Image);
  inherited Done
end;

procedure TImageScroller.Draw;
begin
  SetFillStyle(SolidFill, GetColor(3));
  Bar(0, 0, Size.X - 1, Size.Y - 1);
  If Image <> nil
  then PasteImage(-Delta.X, -Delta.Y, Image, NormalPut);
end;

{ TBmpScroller object
}

constructor TBmpScroller.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
      Path: string);
var
  S: PStream;
begin
  S := New(PDosStream, Init(Path, stOpenRead));
  inherited Init(Bounds, AHScrollBar, AVScrollBar, LoadBitmapFileImg(S^));
  Dispose(S, Done);
end;

{ TBmpView object
}

constructor TBmpView.InitByImages(var Bounds: TRect;
  AnImage: PImage; AFlags: Word);
begin
  If (AFlags and bmfAdjustSize <> 0) and (AnImage <> nil)
  then begin
    GetImageExtent(AnImage, Bounds.B);
    Inc(Bounds.B.x, Bounds.A.x);
    Inc(Bounds.B.y, Bounds.A.y)
  end;
  TGView.Init(Bounds);
  Image := AnImage;
  If AFlags and bmfAdjustSize <> 0
  then GrowMode := 0
  else GrowMode := gfGrowHiX + gfGrowHiY;
  Flags := AFlags
end;

constructor TBmpView.Init(var Bounds: TRect; Resource: PStream;
  BitmapName: PChar; AFlags: Word);
begin
  InitByImages(Bounds, LoadBitmapImg(Resource^, BitmapName), AFlags)
end;

constructor TBmpView.InitByFile(var Bounds: TRect; Path: string; AFlags: Word);
var
  S: TBufStream;
begin
  S.Init(Path, stOpenRead, 2048);
  InitByImages(Bounds, LoadBitmapFileImg(S), AFlags);
  S.Done;
end;

destructor TBmpView.Done;
begin
  FreeImage(Image);
  TGView.Done
end;

procedure TBmpView.Draw;
var
  Extent: TPoint;
  x, y: Integer;
begin
  if Image = nil
  then begin
    inherited Draw;
    Exit
  end;
  GetImageExtent(Image, Extent);
  If Flags and bmfTiled <> 0
  then begin
    y := 0;
    while y < Size.y do
    begin
      x := 0;
      while x < Size.x do
      begin
	PasteImage(x, y, Image, NormalPut);
	Inc(x, Extent.x)
      end;
      Inc(y, Extent.y)
    end
  end
  else begin
    SetFillStyle(SolidFill, GetColor(1));
    x := (Size.x - Extent.x) div 2;
    y := (Size.y - Extent.y) div 2;
    If x > 0
    then begin
      Bar(0, 0, x - 1, Size.y - 1);
      Bar(x + Extent.x, 0, Size.x - 1, Size.y - 1)
    end;
    If y > 0
    then begin
      Bar(x, 0, x + Extent.x - 1, y - 1);
      Bar(x, y + Extent.y, x + Extent.x - 1, Size.y - 1)
    end;
    PasteImage(x, y, Image, NormalPut)
  end;
end;

{ TIconLabel object
}

constructor TIconLabel.InitByImages(var Bounds: TRect;
  AXorMask, AnAndMask: PImage; ALink: PGView);
begin
  inherited Init(Bounds, '', ALink);
  XorMask := AXorMask;
  AndMask := AnAndMask
end;

constructor TIconLabel.Init(var Bounds: TRect;
  Resource: PStream; IconName: PChar; ALink: PGView);
var
  AXorMask, AnAndMask: PImage;
begin
  { Set up monochrome-bitmap conversion colors
  }
  {$ifndef FPK}
  Bitmap.Color := 0;
  Bitmap.BkColor := 15;
  {$endif}
  If Resource = nil
  then begin
    AXorMask := nil;
    AnAndMask := nil
  end else
    LoadIconImg(Resource^, IconName,
      Bounds.B.X - Bounds.A.X, Bounds.B.Y - Bounds.A.Y, GetMaxColor + 1,
      pointer(AXorMask), pointer(AnAndMask));
  TIconLabel.InitByImages(Bounds, AXorMask, AnAndMask, ALink);
end;

destructor TIconLabel.Done;
begin
  FreeImage(XorMask);
  FreeImage(AndMask);
  inherited Done
end;

procedure TIconLabel.Draw;
var
  s: TPoint;
begin
  TGView.Draw;
  If AndMask <> nil
  then begin
    GetImageExtent(AndMask, s);
    PasteImage((Size.x - s.x) div 2, (Size.y - s.y) div 2, AndMask, AndPut)
  end;
  If XorMask <> nil
  then begin
    GetImageExtent(XorMask, s);
    PasteImage((Size.x - s.x) div 2, (Size.y - s.y) div 2, XorMask, XorPut);
  end
end;

function TIconLabel.GetPalette: PPalette;
begin
  GetPalette := nil
end;

{ TImageButton object
}
constructor TImageButton.InitByImages(var Bounds: TRect; ATitle: TTitleStr;
  AnUpImage, ADownImage, AFocImage, ADisImage: PImage;
  ACommand: Word; AFlags: Byte);
begin
  inherited Init(Bounds, ATitle, ACommand, AFlags);
  UpImage := AnUpImage;
  DownImage := ADownImage;
  FocImage := AFocImage;
  DisImage := ADisImage
end;

constructor TImageButton.InitByBWCC(var Bounds: TRect; ATitle: TTitleStr;
  BWCC: PStream; idCommand: Integer; ACommand: Word; AFlags: Byte);
var
{$ifndef FPK} 
{$ifndef Windows}
  UpBmp: PBitmap;
  ColorMap: array[0..255] of Byte;
{$endif !Windows}
{$endif !FPK}
  AnUpImage, ADownImage, AFocImage, ADisImage: PImage;
begin
{$ifdef FPK}
  AnUpImage := LoadBitmapImg(BWCC^, PChar(bwcc_button_normal) + idCommand);
  ADisImage := LoadBitmapImg(BWCC^, PChar(bwcc_button_normal) + idCommand);
{$else}
{$ifdef Windows}
  AnUpImage := LoadBitmapImg(BWCC^, bwcc_button_normal + idCommand);
  ADisImage := LoadBitmapImg(BWCC^, bwcc_button_normal + idCommand);
{$else}
  UpBmp := LoadBitmap(BWCC^, bwcc_button_normal + idCommand);
  FillChar(ColorMap, SizeOf(ColorMap), 8);
  ColorMap[8] := 7; ColorMap[15] := 7;
  AnUpImage := BitmapToImage(UpBmp);
  ADisImage := BitmapToImageWithUserPalette(UpBmp, @ColorMap);
  DeleteBitmap(UpBmp);
{$endif Windows}
{$endif}
  ADownImage := LoadBitmapImg(BWCC^, PChar(bwcc_button_down) + idCommand);
  AFocImage := LoadBitmapImg(BWCC^, PChar(bwcc_button_focused) + idCommand);
  TImageButton.InitByImages(Bounds, ATitle,
    AnUpImage, ADownImage, AFocImage, ADisImage, ACommand, AFlags)
end;

destructor TImageButton.Done;
begin
  FreeImage(UpImage);
  FreeImage(DownImage);
  FreeImage(FocImage);
  FreeImage(DisImage);
  inherited Done
end;

procedure TImageButton.DrawState(Down: Boolean);

	procedure Put(Img: PImage);
	begin
	  If Img <> nil
	  then PasteImage(1, 1, Img, NormalPut)
	end;

begin
  SetViewport;
  TGView.Draw;
  If AmDefault
  then SetColor(GetColor(10))
  else If GOwner <> nil then SetColor(GOwner^.GetColor(1));
  Rectangle(0, 0, Size.x - 1, Size.y - 1);
  If Down then Put(DownImage) else
  if GetState(sfSelected) then Put(FocImage) else
  if GetState(sfDisabled) then Put(DisImage) else
  Put(UpImage);
  RestoreViewport
end;

{ TNewDesktop object
}

constructor TNewDesktop.Init(var Bounds: TRect; Bitmap: string);
begin
  inherited Init(Bounds);
  NewBitmap(Bitmap)
end;

procedure TNewDesktop.NewBitmap(Bitmap: string);
var
  OldBack: PBackground;
  Bounds: TRect;
begin
  OldBack := Background;
  OldBack^.GetBounds(Bounds);
  Background := New(PBmpView, InitByFile(Bounds, Bitmap, bmfTiled));
  InsertBefore(Background, OldBack);
  Dispose(OldBack, Done)
end;

end.
