Scrolling Bitmaps

Hi ckaneta
I agree with AttarSoftware but to make this faster you can use ScrollWindowEx so only the scrolled in regions are invalidated the rest has not to be repainted.

Regards, aacrg.

I already had this going with canvas.copyrect ,what I was looking
for was a way to scroll the bitmap
continuously, i.e.
bitmap is 4 chars long(for simplicity)
[     a]
[    ab]
[   abc]
[  abcd]
[ abcd ]
[abcd a]
[bcd ab]
....
instead of
[     a]
[    ab]
[   abc]
[  abcd]
[ abcd ]
[abcd  ]
[bcd   ]
[cd    ]
[d     ]
[      ]
[     a]
[    ab]
[   abc]
[  abcd]
[ abcd ]
do you see what I mean?

Sorry, I didn't understand what your meaning?

Example:
unit hugeviewunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls, Menus, ImgList, ToolWin;
type
 TViewMode = (vm1x1, vmZoom, vmStretch);

  pbmi = ^TBmi;
  TBMI  = record
    bminfo : TBitmapInfo;
    colors : array[0..255] of TRGBQuad;
  end;
type
  TMainForm = class(TForm)
    OpenDialog1: TOpenDialog;
    ScrollBox1: TScrollBox;
    PaintBox: TPaintBox;
    MainMenu1: TMainMenu;
    OpenItem: TMenuItem;
    N1: TMenuItem;
    ExitItem: TMenuItem;
    FileMenu: TMenuItem;
    ToolBar1: TToolBar;
    WholeToolButton: TToolButton;
    V1x1ToolButton: TToolButton;
    ZoomToolButton: TToolButton;
    ToolButton4: TToolButton;
    ScaleComboBox: TComboBox;
    ImageList1: TImageList;
    procedure PaintMe(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure WholeButtonClick(Sender: TObject);
    procedure V1x1ButtonClick(Sender: TObject);
    procedure ZoomButtonClick(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure ExitItemClick(Sender: TObject);
    procedure ScaleComboBoxChange(Sender: TObject);
  private
    { Private declarations }
    procedure CloseFileMapping;
  public
    { Public declarations }
  ViewMode : TViewMode;
  bmi : TBmI;
 end;

var
  MainForm: TMainForm;
  Palette : hPalette;
  wDC : hDC;

implementation

{$R *.DFM}

const scales: array[0..4] of single = (0.25,0.5,1,2,4);

var ec : Integer;

    hf, hm : THandle;
    Bits : pointer;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 ScaleComboBox.ItemIndex := 2;
 Palette := CreateHalftonePalette(PaintBox.Canvas.Handle);
 Bits := nil;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
 if palette <> 0 then DeleteObject(Palette);
 CloseFileMapping;
end;

procedure TMainForm.Open1Click(Sender: TObject);
var
 pb: pByteArray;
 bmFile : pBitmapFileHeader;
begin
 CloseFileMapping;

 if not OpenDialog1.execute then Exit;
 try
 hf := CreateFile(pChar(OpenDialog1.FileName), GENERIC_READ or GENERIC_WRITE,
  FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
 if hf=INVALID_HANDLE_VALUE then
  raise EAbort.CreateFmt('Îøèáêà îòêðûòèÿ ôàéëà %d',[GetLastError]);


 hm := CreateFileMapping(hf, nil, PAGE_READWRITE, 0,0,nil);
 if hm=0 then
   raise EAbort.CreateFmt('Îøèáêà ñîçäàíèÿ îáúåêòà îòîáðàæåíèÿ %d',[GetLastError]);

 pb := MapViewOfFile(hm, FILE_MAP_ALL_ACCESS, 0,0,0);
 if pb=nil then
  raise EAbort.CreateFmt('Îøèáêà îòîáðàæåíèÿ â ïàìÿòü %d',[GetLastError]);

 bmFile := pBitmapFileHeader(pb);
 if (bmFile^.bfType<>$4D42) then BEGIN Exit; END;

 bits := pointer(@pByteArray(bmFile)^[bmFile^.bfOffBits]);
 bmi := pBmi(@pb^[SizeOf(TBitmapFileHeader)])^;
 except
  on E:EAbort do
   begin
    CloseFileMapping;
    ShowMessage(E.Message);
   end;
 end;

 MainForm.Caption := OpenDialog1.FileName;
 V1x1ToolButton.Click;
 V1x1ToolButton.Down := True;
end;

procedure TMainForm.CloseFileMapping;
var ec: Integer;
begin
  if (Bits <> nil) and
  not UnMapViewOfFile(Bits) then
   begin
     ec:=GetLastError;
     ShowMessage('Îøèáêà çàêðûòèÿ îòîáðàæàåìîãî ôàéëà '+IntToStr(ec));
   end;
  if (hm<>0) and (hm<>INVALID_HANDLE_VALUE) then  CloseHandle(hm);
  if (hf<>0) and (hf<>INVALID_HANDLE_VALUE) then  CloseHandle(hf);
end;

procedure TMainForm.PaintMe(Sender: TObject);
 var OldP : hPalette;i : integer;
begin
 if not Assigned(Bits) then Exit;
 OldP := SelectPalette(PaintBox.Canvas.Handle, Palette, False);
 RealizePalette(PaintBox.Canvas.Handle);
 SetStretchBltMode(PaintBox.Canvas.Handle, STRETCH_DELETESCANS);
 case ViewMode of
 vmStretch:
 with bmi.bminfo.bmiHeader  do
 i := StretchDIBits(PaintBox.Canvas.Handle,0,0,PaintBox.Height,PaintBox.Width,
  0,0,biWidth,Abs(biHeight),
  Bits, pBitmapInfo(@bmi.bminfo)^, DIB_RGB_COLORS,
  PaintBox.Canvas.CopyMode);
 vm1x1:
 with bmi.bminfo.bmiHeader,PaintBox.ClientRect  do
 i := SetDIBitsToDevice(PaintBox.Canvas.Handle,Left,Top,Right-Left,Bottom-Top,
  Left,Top,Top,Bottom-top,
  Bits, pBitmapInfo(@bmi.bminfo)^, DIB_RGB_COLORS);

 vmZoom:
  with bmi.bminfo.bmiHeader,PaintBox.ClientRect do
  i := StretchDIBits(PaintBox.Canvas.Handle,Left,Top,Right-Left,Bottom-Top,
  0,0,biWidth,Abs(biHeight),
  Bits, pBitmapInfo(@bmi.bminfo)^, DIB_RGB_COLORS,
  PaintBox.Canvas.CopyMode);

end;

if (i=0) or (i=GDI_ERROR) then
   begin
   ec :=GetLastError;
   MainForm.Caption := 'Îøèáêà '+IntToStr(ec);
   end;

SelectPalette(PaintBox.Canvas.Handle, OldP, False);
end;

procedure TMainForm.WholeButtonClick(Sender: TObject);
var px,py, sx,sy : Integer;
 kx, ky : single;
begin
 if not Assigned(Bits) then Exit;
 ViewMode := vmStretch;
 px := PaintBox.Parent.ClientWidth - 1;
 py := PaintBox.Parent.ClientHeight - 1;
 sx := bmi.bminfo.bmiHeader.biWidth;
 sy := Abs(bmi.bminfo.bmiHeader.biHeight);
 kx := px / sx; ky := py / sy;
 if kx > ky then
  begin
  PaintBox.Width := Round ( sx * ky );
  PaintBox.Height := py;
  end
 else
  begin
  PaintBox.Width := px;
  PaintBox.Height := Round ( sy * kx );
  end;
end;

procedure TMainForm.V1x1ButtonClick(Sender: TObject);
begin
 if not Assigned(Bits) then Exit;
 ViewMode := vm1x1;
 PaintBox.Width := bmi.bminfo.bmiHeader.biWidth;
 PaintBox.Height := Abs(bmi.bminfo.bmiHeader.biHeight);
end;

procedure TMainForm.ZoomButtonClick(Sender: TObject);
var x : single;
begin
 if not Assigned(Bits) then Exit;
 ViewMode := vmZoom;
 x := Scales[ScaleComboBox.ItemIndex];
 PaintBox.Width := Round(Integer(bmi.bminfo.bmiHeader.biWidth)*x);
 PaintBox.Height := Round(Integer(Abs(bmi.bminfo.bmiHeader.biHeight))*x);
end;

procedure TMainForm.ExitItemClick(Sender: TObject);
begin
 Close;
end;

procedure TMainForm.ScaleComboBoxChange(Sender: TObject);
begin
 if ZoomToolButton.Down then ZoomButtonClick(Sender);
end;

end.

If you want to scroll fast you should'nt use such things as DIBs and stretch functions. Use only DDBs and functions like BitBlt and ScrollWindow. The DIBs are device independent and your CPU has to calculate a lot to make it device dependend so it can display it...
Regards, ptm.

> i.e. bitmap is 4 chars long(for simplicity)
> [     a]
> [    ab]
> [   abc]
> [  abcd]
> [ abcd ]
> [abcd a]
> [bcd ab]

Doesnt my code wrap around like you want?

Tim...

scroll a Bitmap
not enlarge

Good enough for government work!!
I guess this'll have to do