my problem custom control trying develop , cannot seem figure out how implement scroll bars correctly. highlight in key points trying make question easier understand.
- the control simple image viewer, image drawn in center of control.
- the control derives
tscrollingwincontrol. - i have published property called
fimagetpictureclass, allows loading image control. - there no child controls added painting
fimageonto control. - in constructor have written
autoscroll := false; - i have intercepted
wm_sizemessage , here determine offsets centeringfimagemiddle of control , try recalculate scroll ranges. - finally override paint method draw centered
fimageonto control.
so far good, image can loaded @ design or runtime , displayed in center of control. cannot understand how scrolling set properly.
here relevant code far:
unit uimageviewer; interface uses winapi.windows, winapi.messages, system.classes, vcl.controls, vcl.forms, vcl.graphics; type tmyimageviewer = class(tscrollingwincontrol) private fcanvas: tcanvas; fimage: tpicture; foffsetx: integer; // center position in control fimage foffsety: integer; // center position in control fimage procedure setimage(const value: tpicture); private procedure calculateoffsets; //recalculates center fimage procedure calculatescrollranges; protected procedure loaded; override; procedure paintcontrol; procedure paintwindow(dc: hdc); override; procedure wmerasebkgnd(var message: tmessage); message wm_erasebkgnd; procedure wmpaint(var message: twmpaint); message wm_paint; procedure wmsize(var message: tmessage); message wm_size; public constructor create(aowner: tcomponent); override; destructor destroy; override; property canvas: tcanvas read fcanvas; published property align; property color; property image: tpicture read fimage write setimage; end; procedure register; implementation procedure register; begin registercomponents('standard', [tmyimageviewer]); end; constructor tmyimageviewer.create(aowner: tcomponent); begin inherited create(aowner); fcanvas := tcontrolcanvas.create; tcontrolcanvas(fcanvas).control:=self; fimage := tpicture.create; self.autosize := false; //? autoscroll := false; controlstyle := controlstyle + [csopaque]; end; destructor tmyimageviewer.destroy; begin fcanvas.free; fimage.free; inherited destroy; end; procedure tmyimageviewer.loaded; begin inherited loaded; calculateoffsets; calculatescrollranges; end; procedure tmyimageviewer.paintcontrol; procedure drawclientbackground; // paints control color begin canvas.brush.color := color; canvas.brush.style := bssolid; canvas.fillrect(clientrect); end; begin // if not (csdesigning in componentstate) // begin drawclientbackground; // draw fimage if (fimage <> nil) , (fimage.graphic <> nil) begin canvas.draw(foffsetx, foffsety, fimage.graphic); end; // end; end; procedure tmyimageviewer.paintwindow(dc: hdc); begin fcanvas.handle := dc; try paintcontrol; fcanvas.handle := 0; end; end; procedure tmyimageviewer.setimage(const value: tpicture); begin if value <> fimage begin fimage.assign(value); calculateoffsets; calculatescrollranges; invalidate; end; end; procedure tmyimageviewer.calculateoffsets; begin // centering fimage in middle of control if fimage.graphic <> nil begin foffsetx := (width - fimage.width) div 2; foffsety := (height - fimage.height) div 2; end; end; procedure tmyimageviewer.calculatescrollranges; begin horzscrollbar.range:= foffsetx + fimage.width + foffsetx; vertscrollbar.range:= foffsety + fimage.height + foffsety; end; procedure tmyimageviewer.wmerasebkgnd(var message: tmessage); begin message.result := 1; end; procedure tmyimageviewer.wmpaint(var message: twmpaint); begin painthandler(message); end; procedure tmyimageviewer.wmsize(var message: tmessage); begin inherited; calculateoffsets; calculatescrollranges; invalidate; end; end. i started writing in lazarus use in delphi hence both tags have been added.
how should scrollbars calculated? bearing in mind there no children or auto scrolling enabled must manual calculations, drawing image in center of control , need know how calculate scrollbar ranges etc.
i have tried few different things no success , seems putting in , hoping best, guidance here please.
edit
so having tried running original code in delphi has made me realise how more different lazarus is, lots of things had changed run under delphi , right scrollbars disappearing.
as garth answered, should set scroll bar's range size of picture. not enough. must realize need 2 distinct kinds of placement behaviour of image: when scroll bar visible (1), able pan image uncentered position, when scroll bar not visible (2), image should automatically center. requires similar distinction in code.
also, making little hard wanting paint on tscrollingwincontrol. acquire canvas, easy way mimicking implementation of tcustomcontrol, kind of did in example shown below, , code like:
unit awimageviewer; interface uses winapi.windows, winapi.messages, system.classes, vcl.controls, vcl.forms, vcl.graphics; type tawimageviewer = class(tscrollingwincontrol) private fpicture: tpicture; procedure picturechanged(sender: tobject); procedure setpicture(value: tpicture); procedure wmpaint(var message: twmpaint); message wm_paint; protected procedure paintwindow(dc: hdc); override; procedure resize; override; public constructor create(aowner: tcomponent); override; destructor destroy; override; published property color; property picture: tpicture read fpicture write setpicture; end; implementation { tawimageviewer } constructor tawimageviewer.create(aowner: tcomponent); begin inherited create(aowner); fpicture := tpicture.create; fpicture.onchange := picturechanged; end; destructor tawimageviewer.destroy; begin fpicture.free; inherited destroy; end; procedure tawimageviewer.paintwindow(dc: hdc); var canvas: tcanvas; r: trect; begin if fpicture.graphic = nil inherited paintwindow(dc) else begin canvas := tcanvas.create; try canvas.lock; try canvas.handle := dc; try if clientwidth > fpicture.width r.left := (clientwidth - fpicture.width) div 2 else r.left := -horzscrollbar.position; if clientheight > fpicture.height r.top := (clientheight - fpicture.height) div 2 else r.top := -vertscrollbar.position; r.width := fpicture.width; r.height := fpicture.height; canvas.draw(r.left, r.top, fpicture.graphic); excludecliprect(dc, r.left, r.top, r.right, r.bottom); fillrect(dc, clientrect, brush.handle); canvas.handle := 0; end; canvas.unlock; end; canvas.free; end; end; end; procedure tawimageviewer.picturechanged(sender: tobject); begin horzscrollbar.range := fpicture.width; vertscrollbar.range := fpicture.height; invalidate; end; procedure tawimageviewer.resize; begin horzscrollbar.position := (fpicture.width - clientwidth) div 2; vertscrollbar.position := (fpicture.height - clientheight) div 2; if horzscrollbar.position * vertscrollbar.position = 0 invalidate; inherited resize; end; procedure tawimageviewer.setpicture(value: tpicture); begin fpicture.assign(value); end; procedure tawimageviewer.wmpaint(var message: twmpaint); begin controlstate := controlstate + [cscustompaint]; inherited; controlstate := controlstate - [cscustompaint]; end; end. and if prepare painting on temporary bitmap, not need canvas:
procedure tawimageviewer.paintwindow(dc: hdc); var bmp: tbitmap; r: trect; begin if fpicture.graphic = nil inherited paintwindow(dc) else begin bmp := tbitmap.create; try bmp.canvas.brush.assign(brush); bmp.setsize(clientwidth, clientheight); if clientrect.width > fpicture.width r.left := (clientwidth - fpicture.width) div 2 else r.left := -horzscrollbar.position; if clientheight > fpicture.height r.top := (clientheight - fpicture.height) div 2 else r.top := -vertscrollbar.position; r.width := fpicture.width; r.height := fpicture.height; bmp.canvas.draw(r.left, r.top, fpicture.graphic); bitblt(dc, 0, 0, clientwidth, clientheight, bmp.canvas.handle, 0, 0, srccopy); bmp.free; end; end; end; but if place timage component on control, becomes more simple:
unit awimageviewer2; interface uses system.classes, vcl.forms, vcl.graphics, vcl.extctrls; type tawimageviewer = class(tscrollingwincontrol) private fimage: timage; function getpicture: tpicture; procedure setpicture(value: tpicture); protected procedure resize; override; public constructor create(aowner: tcomponent); override; published property color; property picture: tpicture read getpicture write setpicture; end; implementation { tawimageviewer } constructor tawimageviewer.create(aowner: tcomponent); begin inherited create(aowner); autoscroll := true; fimage := timage.create(self); fimage.autosize := true; fimage.parent := self; end; function tawimageviewer.getpicture: tpicture; begin result := fimage.picture; end; procedure tawimageviewer.resize; begin if clientwidth > fimage.width fimage.left := (clientwidth - fimage.width) div 2 else horzscrollbar.position := (fimage.width - clientwidth) div 2; if clientheight > fimage.height fimage.top := (clientheight - fimage.height) div 2 else vertscrollbar.position := (fimage.height - clientheight) div 2; inherited resize; end; procedure tawimageviewer.setpicture(value: tpicture); begin fimage.picture := value; end; end. 
Comments
Post a Comment