Scrolling Bitmaps

is there a good component out there that will scroll a Bitmap continuously.

I have one, but it will only scroll it across and then when it is done, start over again

I've checked out Torry's pages and the
Delphi Superpage and couldn't find one
that would do

so any help here would be appreciated.
LVL 3
ckanetaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

AttarSoftwareCommented:
If you have your image stored in a tBitmap, and you wish to scroll it (in a tPaintBox for example) then you _could_ just do something like:

Set up a timer (Timer1), or create a thread to run this code in (harder)...

procedure tForm1.Timer1Timer( sender : tObject ) ;
const
  scrollPos : longint = 0 ;
begin
  BitBlt( PaintBox1.Canvas.Handle, scrollPos, 0, Bitmap1.Width - scrollPos, PaintBox1.Height, Bitmap1.Canvas.Handle, 0, 0, SRCCOPY ) ;
  BitBlt( PaintBox1.Canvas.Handle, 0, 0, scrollPos, PaintBox1.Height, Bitmap1.Canvas.Handle, Bitmap1.Width - scrollPos, 0, SRCCOPY ) ;
  InvalidateRect( PaintBox1.Handle, nil, false ) ;
  inc( scrollPos, 5 ) ;
end ;

Or something ;O)

Good luck with your search,

Tim.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
aacrgCommented:
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.
0
ckanetaAuthor Commented:
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?
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

aacrgCommented:
Sorry, I didn't understand what your meaning?
0
doncovCommented:
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.
0
ptmcompCommented:
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.
0
AttarSoftwareCommented:
> 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...
0
ckanetaAuthor Commented:
scroll a Bitmap
not enlarge
0
ckanetaAuthor Commented:
Good enough for government work!!
I guess this'll have to do
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.