[DUG] Friday giveaway - Form Effects
John Bird
johnkbird at paradise.net.nz
Fri Nov 9 17:02:49 NZDT 2007
Here is the code.
Notes:
1 - I looked at Jeremy's example quickly (to see what he did better than me
of course!) - this example is a lot simpler as it does not create and use
its own form, you pass it a form to which it applies these effects. In fact
you could use the same routine for several different forms, at the same time
(I have tested it with two).
2 - I designed it to accept a lot of parameters rather than have a lot of
properties to set, so using it requires one line of code which can be an
advantage.
3 - The main thing I had to work out with a non-form unit was how to
instantiate a timer and the timer event - I did this by having the passed
form to be the owner of the timer, but the ontimer event class is removed
locally. I figured that this is probably cleaner if it is going to be
called many times, as the timer is then created only once, and free'd when
the form closes. The on timer event class is however created and destroyed
locally. This is the main part I would welcome feedback on in case I have
done something naughty here.
4 - I did a bit of thinking of how to have this work also for modal form
show, and how to have most of the setup code execute outside of the timer
for efficiency.
5 - You can put these effects on lots of parts of the screen - I used the
clock hour hand positions to specify 12 positions, plus none (ie forms
original position) and 13 (centre of the screen).
Any feedback welcome.
I have a full test program to drive it if anyone wants it as well.
John
You should be just able to copy and paste the unit - save as
jFormEffects.pas and add to your uses clause.
If it loses its formatting in the email, let me know and I will email it as
ZIP file.
unit JFormEffects;
(*
Form Effects
Freeware from JBCL - John Bird
A function unit - code only (no form attached) that can be called
to provide some pretty form effects.
If you like it/use it/have suggested improvments let me know.
kindly at least leave some reference to me in the source if you alter it!
Call by function
jFormEffect(
aForm TForm or descendent
aShowfl one of jfeShow jfeShowModal jfeHide jfeClose
//from here to simplify parameters are in alphabetic order
Note you can call using numbers, or if you prefer using the
constant values defined below, as they are in scope -
eg for aShowfl can be 1 (show) or you can use jfeShow
Hide form can be 3 or jfeHide
aBorderfl Borderstyle of form
0=no change
jfeStd (bsSizeable)
jfeToolwin (bsToolWin)
jfeNone
NOTE! only change this when form is not visible
acolorfl 0=no set color of form
1=set to aColorval folowing
aColorval if set sets color of form.
aFadefl 0=None
1=Fade in/out
Form becomes gradually less transparent as shows,
and more transparent as hidden, (fades out gradually).
aPosfl 0=No Move - use form position
1=Position at point on screen, no movement
2=Moveout/Hide into border
aPosVal 0=none (ie as defined)
rest correspond to clock hour positions
eg 1= 1 O'Clock is top border, on right side
2=right border, at top up to 12=middle top border
13=Centre
for Show, this is where form ends up
for Hide, this is where form will disappear to
eg aPosFl=2 and aPosVal=1 means Form slides down when shown
or slides up into on Hide to or from 1 O'Clock position on
screen
in the case of 1 O'Clock slides down from top right hand
corner of screen to occupy top right hand corner of screen.
and so on for the other 12 clock positions
eg 2 O'Clock is same position, but slides in from
the right screen border on show,
and off to the right on hide.
aRollfl 0=None
1=Roll down/Roll up
that is the form drops down from the title bar as shown, and
rolls up into the title bar as hidden.
Can be used along with the position function as well.
aSmoothfl one of jfeLow jfeMed jfeHigh how many iterations done
aTimeval time in Milliseconds to take - default 1000
Notes:
1 - form show ends at transparency,pos and height of form as set when
called.
after disappears, set to original values so that show and hide do valid
things...
2 - to avoid windows UI bugs, do not change forms border type while the
form is visible, only when not visible (does not repaint correctly).
3 - If using fade effects, better to set Alphablend on for the passed form -
the
hide method gives a smoother transition. This routine restores the original
alphablend value of the form, and if off, when the form is finished fading
out
it is likely to flash as alphablend value is set back to false.
4 - I designed it to accept a lot of parameters rather than have a lot of
properties to set, so using it requires one line of code which can be
an advantage.
5 - The main thing I had to work out with a non-form unit was how to
instantiate
a timer and the timer event - I did this by having the passed form
to be the owner of the timer, but the ontimer event class is removed
locally.
I figured that this is probably cleaner if it is going to be called many
times, as the timer is then created only once, and free'd when the form
closes. The on timer event class is however created and destroyed locally.
This is the main part I would welcome feedback on in case I have done
something naughty here.
6 - I did a bit of thinking of how to have this work also for modal form
show,
and how to have most of the setup code execute
outside of the timer for efficiency.
*)
interface
uses Sysutils,Forms, extctrls,classes,Windows,Graphics;
type
TTimerHelper = class
public
procedure TimerTick(sender: TObject);
end;
procedure jfeFormEffect(
aForm:TForm;
aShowfl:integer;
aBorderfl:integer;
aColorfl:Integer;
aColorval:TColor;
aFadefl:integer;
aPosfl:integer;
aPosVal:integer;
aRollfl:integer;
aSmooth:integer;
aTimeval:integer
);
const
//functions
jfeShow=1;
jfeShowModal=2;
jfeHide=3;
jfeClose=4;
//Positions for Beg and End 0=none
jfePosTopCentre=12;
jfePosTopRight=1;
jfeFrmCentre=13;
//Effect
jfeFadein=1;
jfeFadeOut=2;
jfeRollDown=3;
jfeRollUp=4;
//Smoothness
jfeLow=1;
jfeMed=2;
jfeHigh=3;
//numbers these translate to
jfeLownum=10;
jfeMednum=25;
jfeHighnum=100;
var
jfeTimer:TTimer;
jfeTimerHelper:TTimerHelper;
jfeForm:TForm;
jfetotloopcounter:integer;
implementation
//procedure onjfeTimer(sender:TObject);
//private vbls
var
Savetransparency,BegTransparency,EndTransparency:integer;
colorfunc:Boolean;
ShowFunc:Boolean;
HideFunc:Boolean;
RollFunc:Boolean;
TransFunc:Boolean;
MoveFunc:Boolean;
msgFunc:Boolean;
SaveLeft,SaveTop,SaveHeight,BegLeft,EndLeft,BegTop,EndTop:integer;
SaveAlphablend:Boolean;
BegHeight,EndHeight:integer;
ShowTop,ShowLeft:integer;
HideTop,HideLeft:integer;
ltime:integer;
loopmax:integer;
interval:integer;
loopptr:integer;
jfeashow:integer;
testval:integer;
hRect : TRect;
DesktopTop,DesktopLeft,DesktopRight,DesktopBottom:integer;
formOrigTop,formOrigLeft,formOrigHeight:integer;
formlastTop,formlastLeft,formlastHeight:integer;
procedure jfeFormEffect(
aForm:TForm;
aShowfl:integer;
aBorderfl:integer;
aColorfl:Integer;
aColorval:TColor;
aFadefl:integer;
aPosfl:integer;
aPosVal:integer;
aRollfl:integer;
aSmooth:integer;
aTimeval:integer
);
begin
if(aShowfl<1) then exit; //do nothing....
//note later this could be called for existing visible forms
Colorfunc:=false;
ShowFunc:=false;
HideFunc:=false;
Transfunc:=false;
Rollfunc:=false;
MoveFunc:=false;
//set up initial conditions
SaveTop:=aform.top;
SaveLeft:=aform.Left;
SaveHeight:=aform.Height;
SaveTransparency:=aform.AlphaBlendValue; //take current value
SaveAlphaBlend:=aform.AlphaBlend; //take current value
//save very first values, these should be valid fall back positions
formLastTop:=aform.Top;
formLastLeft:=aform.Left;
formLastHeight:=aform.Height;
if formOrigTop<=0 then formOrigTop:=aform.Top;
if formOrigLeft<=0 then formOrigLeft:=aform.Left;
if formOrigHeight<=0 then formOrigHeight:=aform.Height;
//last values should be last sensible ones
if (formLastLeft<DesktopLeft) or (formlastLeft>=DesktopRight)
or (formlastTop<DesktopTop) or (formlastTop>=DesktopBottom) then
begin
formlastLeft:=FormOrigLeft;
formlastTop:=FormOrigTop;
end;
//desktop size
SystemParametersInfo(SPI_GETWORKAREA,0, at hRect, 0);
DesktopTop:=hRect.Top;
DesktopLeft:=hRect.Left;
DesktopRight:=hRect.Right;
DesktopBottom:=hRect.Bottom;
//Show variables
ShowFunc:=false;
HideFunc:=false;
if aShowfl in [jfeShow,jfeShowModal] then ShowFunc:=true;
if aShowfl in [jfeHide,jfeClose] then HideFunc:=true;
//Set start values for form
if aborderfl>0 then
begin
if aborderfl=1 then aform.BorderStyle:=bsSizeable;
if aborderfl=2 then aform.BorderStyle:=bsToolwindow;
if aborderfl=3 then aform.BorderStyle:=bsNone;
end;
if (acolorfl>0) then
begin
aform.color:=acolorval;
end;
//transparency variables
BegTransparency:=SaveTransparency;
EndTransparency:=SaveTransparency;
if ShowFunc then
begin
if aFadefl > 0 then
begin
TransFunc:=true;
BegTransparency:=0;
EndTransparency:=SaveTransparency;
if EndTransparency <= 10 then EndTransparency:=255;
end;
if aRollfl > 0 then
begin
RollFunc:=true;
BegHeight:=0;
EndHeight:=SaveHeight;
end;
end;
if HideFunc then
begin
if aFadefl > 0 then
begin
TransFunc:=true;
BegTransparency:=SaveTransparency;
EndTransparency:=0;
if BegTransparency <= 10 then BegTransparency:=255;
end;
if aRollfl > 0 then
begin
RollFunc:=true;
BegHeight:=SaveHeight;
EndHeight:=0;
end;
end;
//positions - set ShowLeft Showtop HideLeft HideTop
case aPosval of
0: Begin
Showleft:=formlastLeft;
ShowTop:=formlasttop;
if (showLeft<DesktopLeft) or (ShowLeft>=DesktopRight)
or (ShowTop<DesktopTop) or (ShowTop>=DesktopBottom) then
begin
ShowLeft:=FormOrigLeft;
ShowTop:=FormOrigTop;
end;
End;
1,2: Begin
ShowLeft:=DesktopRight - aform.Width;
ShowTop:=DesktopTop;
End;
3: Begin
ShowLeft:=DesktopRight-aform.width;
ShowTop:=DesktopTop + (DeskTopBottom - DesktopTop -
aform.Height) div 2;
End;
4,5: Begin
ShowLeft:=DesktopRight - aform.Width;
ShowTop:=DeskTopBottom - aform.Height;
End;
6: Begin
ShowLeft:=DeskTopLeft + (DesktopRight -DeskTopLeft -
aform.Width) div 2;
ShowTop:=DeskTopBottom - aform.Height;
End;
7,8: Begin
ShowLeft:=DesktopLeft;
ShowTop:=DeskTopBottom - aform.Height;
End;
9: Begin
ShowLeft:=DesktopLeft;
ShowTop:=DesktopTop + (DeskTopBottom - DesktopTop -
aform.Height) div 2;
End;
10,11: Begin
ShowLeft:=DesktopLeft;
ShowTop:=DesktopTop;
End;
12: Begin
ShowLeft:=DeskTopLeft + (DeskTopRight - DeskTopLeft -
aform.Width) div 2;
ShowTop:=DesktopTop;
End;
13: Begin
ShowLeft:=DesktopLeft + (DesktopRight - DesktopLeft -
aform.Width) div 2;
ShowTop:=(DesktopBottom - DesktopTop - aform.Height) div 2;
End;
end;
//use Posval to set both hide and show positions - sensible and simple
case aPosVal of
0: Begin
Hideleft:=formlastLeft;
HideTop:=formlasttop;
if (HideLeft<DesktopLeft) or (HideLeft>=DesktopRight)
or (HideTop<DesktopTop) or (HideTop>=DesktopBottom) then
begin
HideLeft:=FormOrigLeft;
HideTop:=FormOrigTop;
end;
End;
1: Begin
HideLeft:=DesktopRight - aform.Width;
HideTop:=DesktopTop-aform.Height;
End;
2: Begin
HideLeft:=DesktopRight;
HideTop:=DesktopTop;
End;
3: Begin
HideLeft:=DesktopRight;
HideTop:=DesktopTop + (DeskTopBottom - DesktopTop -
aform.Height) div 2;
End;
4: Begin
HideLeft:=DesktopRight;
HideTop:=DesktopBottom - aform.Height;
End;
5: Begin
HideLeft:=DesktopRight - aform.Width;
HideTop:=DesktopBottom;
End;
6: Begin
HideLeft:=DeskTopLeft + (DesktopRight - DeskTopLeft -
aform.Width) div 2;
HideTop:=DesktopBottom;
End;
7: Begin
HideLeft:=DesktopLeft;
HideTop:=DesktopBottom;
End;
8: Begin
HideLeft:=DesktopLeft-aform.width;
HideTop:=DesktopBottom-aform.Height;
End;
9: Begin
HideLeft:=DesktopLeft-aform.width;
HideTop:=DesktopTop + (DeskTopBottom - DesktopTop -
aform.Height) div 2;
End;
10: Begin
HideLeft:=DesktopLeft-aform.width;
HideTop:=DesktopTop;
End;
11: Begin
HideLeft:=DesktopLeft;
HideTop:=DesktopTop-aform.Height;
End;
12: Begin
HideLeft:=DeskTopLeft + (DesktopRight - DeskTopLeft -
aform.Width) div 2;
HideTop:=DesktopTop-aform.Height;
End;
13: Begin
HideLeft:=(DesktopRight - aform.Width) div 2;
HideTop:=(DesktopBottom - aform.Height) div 2;
End;
end;
//set moving positions
movefunc:=false;
case aposfl of
0: begin
//use form position
ShowLeft:=formlastleft;
ShowTop:=formlastTop;
HideLeft:=ShowLeft;
HideTop:=ShowTop;
end;
1: begin
//just postion on that part of screen
HideLeft:=ShowLeft;
HideTop:=ShowTop;
end;
2: begin
//keep moving values set above
end;
end;
if ShowFunc then
begin
begleft:=HideLeft;
BegTop:=HideTop;
EndLeft:=ShowLeft;
EndTop:=ShowTop;
end;
if HideFunc then
begin
BegLeft:=ShowLeft;
BegTop:=ShowTop;
EndLeft:=HideLeft;
EndTop:=HideTop;
end;
if (begLeft<>endleft) or (begtop<>endTop) then movefunc:=true;
ltime:=atimeval;
if ltime<=0 then ltime:=1000;
loopmax:=50;
case asmooth of
jfeLow: loopmax:=jfeLownum;
jfeMed: loopmax:=jfeMednum;
jfeHigh: loopmax:=jfeHighNum;
end;
interval:=ltime div loopmax;
//set up loop
// jfeTimer:=TTimer.create(nil); //will destroy it myself
if not assigned(jfeTimer) then jfeTimer:=TTimer.create(aform); //form
will destroy it
if not assigned(jfeTimerHelper) then jfeTimerHelper:=TTimerHelper.create;
jfetimer.enabled:=false;
jfeTimer.Interval:=interval;
jfeTimer.OnTimer:=jfeTimerHelper.TimerTick; //set event
jfeForm:=aform;
msgFunc:=false;
jfeashow:=aShowfl;
if MoveFunc or Transfunc or Rollfunc then msgFunc:=true;
//set start values if form being shown
if ShowFunc then
begin
if transfunc then
begin
aform.AlphaBlend:=true;
aform.AlphaBlendValue:=begTransparency;
testval:=EndTransparency; //for debugger
end;
if (movefunc) then
begin
aform.Left:=begleft;
aform.Top:=Begtop;
end;
if (rollfunc) then
begin
aform.Height:=begHeight;
end;
end;
if HideFunc then
begin
if transfunc then
begin
aform.AlphaBlend:=true;
aform.AlphaBlendValue:=BegTransparency;
testval:=EndTransparency; //for debugger
end;
end;
//main loop
loopptr:=0;
jfeTimer.enabled:=true;
if ShowFunc then
begin
if jfeaShow=jfeShow then jfeform.Show;
if jfeaShow=jfeShowModal then jfeform.Showmodal;
//note for showmodal, form has to be shown after timer, otherwise
//timer never starts
if aposfl>0 then
begin
aform.Left:=begLeft;
aform.top:=begTop;
end;
end;
end;
procedure TTimerHelper.TimerTick(sender:TObject);
begin
//in case timer goes before form is starting to show...
if (jfeForm.visible=false) and (loopptr < loopmax) then exit;
//process form visibility
inc(loopptr);
if loopptr<loopmax then
begin
if moveFunc then
begin
jfeform.Left:=begleft + (((EndLeft-BegLeft) * loopptr) div loopmax);
jfeform.top:=begTop + (((EndTop-BegTop) * loopptr) div loopmax);
end;
if transfunc then
begin
jfeform.Alphablendvalue:=begtransparency +
(((Endtransparency-Begtransparency) * loopptr) div loopmax);
end;
if rollfunc then
begin
jfeform.height:=begheight + (((EndHeight-BegHeight) * loopptr) div
loopmax);
end;
if msgFunc then Application.processmessages;
end; //timer
//end stages
if loopptr > loopmax then
begin
jfeTimer.enabled:=false; //disable timer
//set final values if form hidden - set back to sensible values on
screen
if ShowFunc then
begin
if savetransparency<10 then savetransparency:=255; //valid for show
if (savetransparency>=0) and (savetransparency<=255) then
jfeform.AlphaBlendvalue:=savetransparency;
jfeform.AlphaBlend:=saveAlphablend;
end;
if HideFunc then
begin
if jfeaShow=jfeHide then jfeform.hide;
if jfeaShow=jfeClose then jfeform.close;
if savetransparency<10 then savetransparency:=255; //valid for show
if (savetransparency>=0) and (savetransparency<=255) then
jfeform.AlphaBlendvalue:=savetransparency;
if (saveLeft>=1) and (saveLeft<=DesktopRight) then
jfeform.Left:=saveleft;
if (saveTop>=1) and (saveTop<=DesktopBottom) then
jfeform.Top:=savetop;
Application.processMessages;
jfeform.AlphaBlend:=saveAlphablend; //do this last to avoid flash?
end;
if movefunc then
begin
//last iteration not done yet....
jfeForm.Left:=EndLeft;
jfeForm.Top:=EndTop;
end;
if RollFunc then
begin
jfeForm.Height:=formOrigHeight; //restore full height
//from 0 if hiding, and last bit if showing
end;
//finish
//freed by form now owning it
// jfeTimer.free;
// jfeTimer:=nil;
//http://delphi.about.com/od/kbcurt/a/dynamiccreation.htm
freeandnil(jfeTimerHelper); //do have to free this one
jfetotloopcounter:=jfetotloopcounter+loopptr;
Application.ProcessMessages;
end;
end;
end.
More information about the Delphi
mailing list