[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 453
  • Last Modified:

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.
0
ckaneta
Asked:
ckaneta
  • 3
  • 2
  • 2
  • +2
1 Solution
 
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
 
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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
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

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 3
  • 2
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now