Solved

Animation Loop

Posted on 2002-06-16
9
329 Views
Last Modified: 2010-04-04
Simple question. I want to create a loop suitable for animation and I want the loop to end when Done = true. I have tried using a TTimer component, but this does not work. The code at the moment is as follows:

AnimTimer.Enabled := true;

while Done = true do
begin
end;

AnimTimer.Enabled := false;
Done := false;

However the while loop causes the program to freeze so that nothing happens. At the moment, the animation routine is not looped, but is attached to AnimTimer's OnTimer event. It is important that the code after the line where the Animation routine is called is not executed until Done = true. Has anyone got any ideas?
0
Comment
Question by:nashing_nasher
  • 5
  • 4
9 Comments
 
LVL 33

Expert Comment

by:Slick812
ID: 7082340
there's a difference between doing a "Fade" of a bitmap on a Canvas (HDC) and doing a Fade of a Windowed control (TPanel), I gave you all you need to do a fade in the question

http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=delphi&qid=20308278

Using Direct X is a real task, more than just a few lines of code, much more, and you have to get the Direct X librarys to use it. What size of TPanels you talkin about? Less than 600X 400 ?
0
 
LVL 33

Expert Comment

by:Slick812
ID: 7084705
Here's some code that will move a TPanel with a bitmap Image on it. I had to Subclass the Panel so that I could make sure there was only ONE paint per move so there is no flicker. Moving a TImage will always have flicker. If you absolutely have to have a TImage then put it on the Panel and Hide it BEFORE the move and then Show it AFTER the move.


type
ThreadRec = record
    Interval: Cardinal;
    isTiming: Boolean;
    ID: Byte;
    Op: Byte;
    end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    sbut_MovePanel: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private
    { Private declarations }
    EndPos, StartPos, Mover: TPoint;
    Radian1: Extended;
    PixelMov: Word;
    procedure MoveIt;
    procedure MovePanel(X, Y: Integer);
    procedure DoThreadTimer;


var
  Form1: TForm1;
  TimerR: ThreadRec;
  PbBmp: TBitmap;
  PPanelProc: Pointer;

implementation

{$R *.DFM}

uses Math;

function ThreadFunc(Parameter: Pointer): Integer; stdcall;
begin
Result := 0;
while TimerR.isTiming do
  begin
  SleepEx(TimerR.Interval, False);

  if TimerR.isTiming then
    if TimerR.Op = 1 then
    Form1.MoveIt;

  end;
TimerR.ID := 0;
EndThread(Result);
end;

function PanelMFunc(hWnd: THandle; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): Cardinal; stdcall;
var
PaintS: TPaintStruct;
begin
{This SubClass functions was added so the Panel will only get ONE paint operation}
Result := 0;
case Msg of
WM_PAINT: begin
          BeginPaint(hWnd, PaintS);
          BitBlt(PaintS.hDC, 0, 0, PbBmp.Width, PbBmp.Height, PbBmp.Canvas.Handle, 0, 0, SRCCOPY);
          EndPaint(hWnd,PaintS);
          Exit;
          end;
WM_ERASEBKGND: begin
               Result := 1;
               Exit;
               end;
end;
Result := CallWindowProc(PPanelProc, hWnd, Msg, Wparam, Lparam);
end;

procedure TForm1.DoThreadTimer;
var
ThreadId: LongWord;
begin
{The interval should be MORE than 10 or alot of the processor
time cycles are used, if you need an interval less than 10 then
you may want to set the Thread Priority higher with
SetThreadPriority( )}
if (TimerR.ID <> 0) then Exit;
{TimerR.ID is set to 0 when the Thread ends, so check for 0
to make sure you don't start a thread if one is still running}
if TimerR.Interval < 10 then
TimerR.Interval := 10;
TimerR.ID := 1;
CloseHandle(hThread);
{since a thread may be created more than once,
you should Close the Handle}

hThread := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);
end;

procedure TForm1.MoveIt;
begin
MoveWindow(Panel1.Handle,Round(StartPos.x-Cos(Radian1)*(PixelMov*Mover.x)),
           Round(StartPos.y-Sin(Radian1)*(PixelMov*Mover.x)),Panel1.Width,Panel1.Height,True);
Inc(Mover.x);
if (Mover.x > Mover.y) or (Mover.x > 1000) then
  begin
  TimerR.IsTiming := False;
  MoveWindow(Panel1.Handle,EndPos.x,EndPos.y,Panel1.Width,Panel1.Height,True);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{I create a bitmap here to show on the panel, but you could load it
from resource}
PbBmp := TBitmap.Create;
PbBmp.Height := Panel1.Height;
PbBmp.Width := Panel1.Width;
PbBmp.Canvas.Brush.Color := clRed;
PbBmp.Canvas.FillRect(Panel1.ClientRect);
PbBmp.Canvas.TextOut(15,30,'Panel Bitmap');
{ SubClass Panel3 to control it's painting}
PPanelProc := Pointer(SetWindowLong(Panel1.Handle, GWL_WNDPROC, Integer(@PanelMFunc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(Panel1.Handle, GWL_WNDPROC, Integer(PPanelProc));
TimerR.isTiming := False;
CloseHandle(hThread);
end;

procedure TForm1.MovePanel(X, Y: Integer);
begin
{these tests of X and Y keep the panel visible on it's
Parent's Client Rect}
if X < 0 then X := 0;
if Y < 0 Then Y := 0;
if X > Panel1.Parent.ClientWidth - Panel1.Width then
X := Panel1.Parent.ClientWidth - Panel1.Width;
if Y > Panel1.Parent.ClientHeight - Panel1.Height then
Y := Panel1.Parent.ClientHeight - Panel1.Height;

Panel1.BringToFront;
{BringToFront gets the Panel To Paint over other Controls}
StartPos.x := Panel1.Left;
StartPos.y := Panel1.Top;
EndPos.x := X;
EndPos.y := Y;
PixelMov := 10;
{PixelMov is the amount of pixel movement per Timer interval}
Mover.y := Round(Sqrt(SumOfSquares([abs(EndPos.y-StartPos.y),abs(EndPos.x-StartPos.x)])));
{Sqrt(SumOfSquares get's the distance between the Start and End points}
if Mover.y < 2*PixelMov then
  begin
  {test to see if there's enough distance for a timer}
  MoveWindow(Panel1.Handle,X,Y,Panel1.Width,Panel1.Height, True);
  Exit;
  end;
Mover.x := 0;
Mover.y := Mover.y div PixelMov;
{Mover.y div PixelMov get's the amount of moves needed}
Radian1 := DegToRad(180 * (1 + ArcTan2(EndPos.y-StartPos.y, EndPos.x-StartPos.x) / Pi));
{Radian1 is the angle at which the panel will be moved}
TimerR.Interval := 38;
TimerR.isTiming := True;
TimerR.Op := 1;
DoThreadTimer;
end;

procedure TForm1.sbut_MovePanelClick(Sender: TObject);
begin
MovePanel(-40,890);
end;
0
 

Author Comment

by:nashing_nasher
ID: 7101490
By "Componentless" I mean without the need to use Delphi Components such as DelphiX Component Pack. I know you need to use the Component librarys.
0
 
LVL 33

Expert Comment

by:Slick812
ID: 7102270
I have tried to use the Direct X some time ago, and I could only do simple things, like initialize it, and I worked on it for a good while. So I can'r help you with that. If you want to use Direct X go to a Delphi X site and get the librarys and demo code there and spend some time learning it. But I would not think to use it for the operations you have described. I have showed you how to fade controls and move pictures on panels.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:nashing_nasher
ID: 7103122
OK. I've got it fading out, but I want to make the code reusable. This is how my program will work:

1) The program loads with a TPanel and some checkboxes on it.
2) A button is clicked and the TPanel fades out.
3) While the TPanel is not visible its dimensions and contents are changed.
4) The new TPanel fades in.

The problem I have occurs when fading it in. The old TPanel is faded in but because its dimensions have been changed and its contents have been changed, the TPanel is either tiled or cropped as it fades in. How do I fix this problem? (Sorry, I am a beginner programmer)
0
 
LVL 33

Expert Comment

by:Slick812
ID: 7104732
This can be a real problem, I have tried to get an image of a non visible control, and I have seen questions about that here at EE. I had no success in getting a hidden control (or Form) image, because there may not an image anywhere to get, since it is hidden and not drawing on an HDC. I did see an example where some controls were created that were visible when the program started, and an image was taken from those controls and used to draw a "Fake" panel to display. But I can't find the code for that if I still have it. You could also draw "Fake" controls on the "Fake" panel and fade that in. But that could take work if you used controls like a TMemo or TListBox, but buttons and checkboxes would be easy. I'll try and do a sizable Panel with a variable number checkboxes. Are the checkboxes created dynamicly at runtime? ?
0
 

Author Comment

by:nashing_nasher
ID: 7104838
Umm... not sure if they're created dynamically. I've never understood what that meant. But I create them from the source code like this:

var
  MyCheckBox: TCheckBox;
begin
  MyCheckBox := TCheckBox.Create(form1);
 blah blah blah
end;

One other option that i've only just come across is the use of transition effects. Do you know of any free component packs that could be used to do an alphablend transition effect on a TPanel?
0
 
LVL 33

Accepted Solution

by:
Slick812 earned 115 total points
ID: 7109502
Yes, creating controls at runtime is refered to as created dynamicly. I got this fake hidden panel thing to work, but there was more effort in it then I had thought it would be. In this Code there is a panel with 4 checkboxes on it. I fade out the Panel and then while it is hidden I add 2 checkBoxes to it and then fade it back to view. There is One TPanel with 4 checkboxes and 3 buttons on this form. These fake checksboxes do not like Large Fonts ot unusuall Fonts.


unit NewFade1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, Buttons;

type
  ThreadRec = record
    Interval: Cardinal;
    isTiming: Boolean;
    ID: Byte;
    end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    but_HidePan: TButton;
    but_ShowPan: TButton;
    sbut_FadePan1: TSpeedButton;
    procedure but_HidePanClick(Sender: TObject);
    procedure but_ShowPanClick(Sender: TObject);
    procedure sbut_FadePan1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    PanelOut: Boolean;
    PanelNum: Byte;
    hThread: THandle;
    PanelBmp: TBitmap;
    procedure DoThreadTimer;
    procedure PanelFade(Panel: TPanel);
    procedure MakeFakePanel(Panel: TPanel; var CBmp: TBitmap);
    procedure GetPanelBmp(Panel: TPanel; Fake: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  NewCheck1, NewCheck2: TCheckBox;
  TimerR: ThreadRec;
  Fading: Boolean;

implementation

{$R *.DFM}

function ThreadFunc(Parameter: Pointer): Integer; stdcall;
begin
Result := 0;
while TimerR.isTiming do
  begin
  {isTiming cuts this thread off, it uses a while loop with a
  SleepEx to get a timer interval effect}
  SleepEx(TimerR.Interval, False);

  if TimerR.isTiming then
    Form1.PanelFade(Form1.Panel1);

  end;
TimerR.ID := 0;
Fading := False;
EndThread(Result);
{no code below EndThread will be executed}
end;

procedure TForm1.DoThreadTimer;
var
ThreadId: LongWord;
begin
{The interval should be MORE than 10 or alot of the processor
time cycles are used, if you need an interval less than 10 then
you may want to set the Thread Priority higher with
SetThreadPriority( )}
if (TimerR.ID <> 0) or (not Assigned(PanelBmp)) then Exit;
{TimerR.ID is set to 0 when the Thread ends, so check for 0
to make sure you don't start a thread if one is still running}
if TimerR.Interval < 10 then
TimerR.Interval := 10;
TimerR.ID := 1;
CloseHandle(hThread);
hThread := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);
if hThread < 2 then
  begin
  TimerR.ID := 0;
  FreeAndNil(PanelBmp);
  Fading := False;
  end;
end;

procedure TForm1.PanelFade(Panel: TPanel);
var
PanelDC: HDC;
begin
{FadeOut determines if the Panel Fades In or Out}
if PanelOut then
  begin
  PanelDC := GetWindowDC(Panel.Handle);
  {I use GetWindowDC to avoid some child controls not showing}
  BitBlt(PanelDC, 0, 0, Panel.Width, Panel.Height, PanelBmp.Canvas.Handle, (14-PanelNum)*Panel.Width, 0, SRCCOPY);
  ReleaseDC(Panel.Handle,PanelDC);
  end else
  BitBlt(Canvas.Handle, Panel.Left, Panel.Top, Panel.Width, Panel.Height, PanelBmp.Canvas.Handle, PanelNum*Panel.Width, 0, SRCCOPY);

Inc(PanelNum);
if PanelNum > 14 then
  begin
  TimerR.isTiming := False;
  if PanelOut then
    begin
    Panel.Hide;
    FreeAndNil(PanelBmp);
    end else
    begin
    Panel.Show;
    FreeAndNil(PanelBmp);
    end;
  end;
end;

procedure TForm1.MakeFakePanel(Panel: TPanel; var CBmp: TBitmap);
{this MakeFakePanel procedure creates a Bitmap that Looks like
a TPanel with checkboxes on it, but it is totally created by
drawing everything on the panel, it has 2 parameters
Panel - the TPanel you want to fake and
CBmp - the TBitmap you want to be the Copy image
I could not get it to do all different Fonts and font
sizes, but the default font , Arial and Times new roman
do ok in sizes less than 18,
also I could not get a Focus Rect, since a control is
not listed as focused while it is hidden. And the checkbox
Z order is not considered for overlapping}
var
i, FontHeight: Integer;
ChkBoxBmp: TBitmap;
UnRect, CkRect, PRect, GRect: TRect;
DrwNum, DnNum, OffSet: Byte;
Bevel1: TPanelBevel;
TopColor, BottomColor: TColor;
Flags: Longint;

procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor;
  Width: Integer);

procedure DoRect;
var
TopRight, BottomLeft: TPoint;
begin
with Canvas, Rect do
  begin
  TopRight.X := Right;
  TopRight.Y := Top;
  BottomLeft.X := Left;
  BottomLeft.Y := Bottom;
  Pen.Color := TopColor;
  PolyLine([BottomLeft, TopLeft, TopRight]);
  Pen.Color := BottomColor;
  Dec(BottomLeft.X);
  PolyLine([TopRight, BottomRight, BottomLeft]);
  end;
end;

  begin
  Canvas.Pen.Width := 1;
  Dec(Rect.Bottom); Dec(Rect.Right);
  while Width > 0 do
  begin
    Dec(Width);
    DoRect;
    InflateRect(Rect, -1, -1);
  end;
  Inc(Rect.Bottom); Inc(Rect.Right);
end;

begin
if not Assigned(Panel) then
  begin
  FreeAndNil(CBmp);
  Exit;
  end;
ChkBoxBmp := TBitmap.Create;
ChkBoxBmp.Handle := LoadBitmap(0,MAKEINTRESOURCE(OBM_CHECKBOXES));
CkRect := Rect(0,0,ChkBoxBmp.Width div 4, ChkBoxBmp.Height div 3);
UnRect := Rect(CkRect.Right,0,CkRect.Right*2, CkRect.Bottom);
CBmp.Canvas.Brush.Color := Panel.Color;
CBmp.Width := Panel.Width;
CBmp.Height := Panel.Height;
CBmp.Canvas.FillRect(Panel.ClientRect);
if Length(Panel.Caption) > 0 then
with CBmp.Canvas do
  begin
    Brush.Style := bsClear;
    Font := Panel.Font;
    FontHeight := TextHeight('W');
    PRect := Panel.ClientRect;
    InflateRect(PRect,-Panel.BorderWidth,-Panel.BorderWidth);
    with PRect do
    begin
      Top := ((Bottom + Top) - FontHeight) div 2;
      Bottom := Top + FontHeight;
    end;
    Flags := DT_EXPANDTABS or DT_VCENTER or DT_CENTER;
    DrawText(Handle, PChar(Panel.Caption), -1, PRect, Flags);
  end;
if Panel.ControlCount > 0 then
  begin
  for i:= 0 to Panel.ControlCount -1 do
    begin
    DnNum := 0;
    if Panel.Controls[i] is TCheckBox then
      begin
      with CBmp.Canvas do
        begin
        Brush.Style := bsSolid;
        Brush.Color := Panel.Color;
        FillRect(Panel.Controls[i].BoundsRect);
        Brush.Style := bsClear;
        Font := TCheckBox(Panel.Controls[i]).Font;
        end;
      if TCheckBox(Panel.Controls[i]).Checked then
          drwNum := 1 else DrwNum := 0;
      if not TCheckBox(Panel.Controls[i]).Enabled then
        begin
        DrwNum := DrwNum+2;
        if DrwNum = 3 then DnNum := 2;
        end;
      if TCheckBox(Panel.Controls[i]).Height mod 2 = 0 then
      Flags := TCheckBox(Panel.Controls[i]).Top+(TCheckBox(Panel.Controls[i]).Height div 2)- (CkRect.Bottom div 2)-1
      else
      Flags := TCheckBox(Panel.Controls[i]).Top+((TCheckBox(Panel.Controls[i]).Height+1) div 2)- (CkRect.Bottom div 2)-1;
      BitBlt(CBmp.Canvas.Handle, TCheckBox(Panel.Controls[i]).Left, Flags,
            CkRect.Right, CkRect.Bottom, ChkBoxBmp.Canvas.Handle, CkRect.Right* DrwNum, DnNum*CkRect.Bottom, SRCCOPY);

if Length(TCheckBox(Panel.Controls[i]).Caption) > 0 then
with CBmp.Canvas do
  begin
    with PRect do
      begin
      if abs(Font.Size) < 7 then Offset := 1 else
      if (abs(Font.Size) > 6) and (abs(Font.Size) <11) then OffSet := 2 else
      if (abs(Font.Size) > 10) and (abs(Font.Size) <14) then OffSet := 3 else
      if (abs(Font.Size) > 13) and (abs(Font.Size) <17) then OffSet := 4 else
      OffSet := 5;
      Left := TCheckBox(Panel.Controls[i]).Left+ CkRect.Right+3+OffSet;
      Right := TCheckBox(Panel.Controls[i]).Left+TCheckBox(Panel.Controls[i]).Width;
      if TCheckBox(Panel.Controls[i]).Height mod 2 = 0 then
        begin
        Top := TCheckBox(Panel.Controls[i]).Top;
        Bottom := PRect.Top + TCheckBox(Panel.Controls[i]).Height-1;
        end else
        begin
        Top := TCheckBox(Panel.Controls[i]).Top-1;
        Bottom := PRect.Top + TCheckBox(Panel.Controls[i]).Height+1;
        end;

      end;
    if not TCheckBox(Panel.Controls[i]).Enabled then
        begin
        Font.Color := clBtnHighLight;
        GRect := Rect(PRect.Left+1,PRect.Top+1,PRect.Right+1,PRect.Bottom+1);;
        windows.DrawText(Handle, PChar(TCheckBox(Panel.Controls[i]).Caption) , -1, GRect, DT_VCENTER or DT_SINGLELINE or DT_LEFT);
        Font.Color := clGrayText;
        end;
    windows.DrawText(Handle, PChar(TCheckBox(Panel.Controls[i]).Caption) , -1, PRect, DT_VCENTER or DT_SINGLELINE or DT_LEFT);
  end;
      end;
    end;
  end; // ControlCount > 0
FreeAndNil(ChkBoxBmp);
PRect := Panel.ClientRect;
Bevel1 := Panel.BevelOuter;
if Bevel1 <> bvNone then
  begin
  AdjustColors(Bevel1);
  Frame3D(CBmp.Canvas, PRect, TopColor, BottomColor, Panel.BevelWidth);
  end;
Bevel1 := Panel.BevelInner;
if Bevel1 <> bvNone then
  begin
  AdjustColors(Bevel1);
  Frame3D(CBmp.Canvas, PRect, TopColor, BottomColor, Panel.BevelWidth);
  end;
end;

procedure TForm1.GetPanelBmp(Panel: TPanel; Fake: Boolean);
{this procedure gets the fade bitmap PanelBmp, it has been optimized some
from the last version, there are 2 parameters
Panel - the TPanel to get and
Fake, if true it gets a Fake Panel bitmap if false it gets a real one}
Type
  TpRGB = packed record
    b, g, r : Byte;
    end;
var
SoRGBPixel: ^TpRGB;
BlRGBPixel: ^TpRGB;
y, x, pic, BlendAmt, ResultAmt: Integer;
BlankBmp, SourceBmp: TBitmap;
PanelDC: HDC;
begin
BlendAmt := 82;
SourceBmp := TBitmap.Create;
SourceBmp.Width := Panel.Width;
SourceBmp.Height := Panel.Height;
SourceBmp.PixelFormat  := pf24Bit;
if Fake then
  MakeFakePanel(Panel,SourceBmp)
  else
  begin
  PanelDC := GetWindowDC(Panel.Handle);
  BitBlt(SourceBmp.Canvas.Handle,0,0,SourceBmp.Width,SourceBmp.Height,PanelDC,0,0, SRCCOPY);
  ReleaseDC(Panel.Handle,PanelDC);
  end;

BlankBmp := TBitmap.Create;
BlankBmp.PixelFormat := pf24bit;
BlankBmp.Canvas.Brush := Panel.Parent.Brush;
BlankBmp.Width := SourceBmp.Width;
BlankBmp.Height := SourceBmp.Height;

if Assigned(PanelBmp) then
FreeAndNil(PanelBmp);

PanelBmp := TBitmap.Create;
PanelBmp.Canvas.Brush := Panel.Parent.Brush;
PanelBmp.PixelFormat := pf24bit;
PanelBmp.Width := SourceBmp.Width*15;
PanelBmp.Height := SourceBmp.Height;
ResultAmt := 1000 - BlendAmt;

for pic := 0 to 14 do
  begin // 0 to 14

  For y := 0 to SourceBmp.Height -1 do
    begin // y to height
    SoRGBPixel := SourceBmp.ScanLine[y];
    BlRGBPixel := BlankBmp.ScanLine[y];
    For x := 0 to SourceBmp.Width -1 do
      Begin
      BlRGBPixel.r := (ResultAmt * BlRGBPixel.r + BlendAmt * SoRGBPixel.r) div 1000;
      BlRGBPixel.g := (ResultAmt * BlRGBPixel.g  + BlendAmt * SoRGBPixel.g) div 1000;
      BlRGBPixel.b := (ResultAmt * BlRGBPixel.b  + BlendAmt * SoRGBPixel.b) div 1000;
      Inc(SoRGBPixel);
      Inc(BlRGBPixel);
      End;
    end; //y to height
     BitBlt(PanelBmp.Canvas.Handle, pic*BlankBmp.Width, 0, BlankBmp.Width, BlankBmp.Height,
      BlankBmp.Canvas.Handle, 0, 0, SRCCOPY);

    end; // 0 to 14
BlankBmp.Free;
SourceBmp.Free;
end;

procedure TForm1.but_HidePanClick(Sender: TObject);
begin
Panel1.Hide;
Panel1.Color := clYellow;
CheckBox2.Enabled := False;
end;

procedure TForm1.but_ShowPanClick(Sender: TObject);
begin
Panel1.Show;
end;

procedure TForm1.sbut_FadePan1Click(Sender: TObject);
var
Oleft: Integer;
AutoS: Boolean;
begin
if Fading then Exit;
Application.ProcessMessages;
{if the panel is visible it fades out}
if Panel1.Visible then
  begin
  PanelOut := True;
  {set the Panel in GetPanelBmp( ) to the TPanel for
  fading, set Fake to False since it is visible.
  To Copy the real Panel}
  GetPanelBmp(Panel1, False);
  PanelNum := 0;
  TimerR.isTiming := True;
  TimerR.Interval := 108;
  DoThreadTimer;
  end else
  begin
  {this s for Panel not visible}
  Panel1.Height := Panel1.Height+18;
  Panel1.Width := Panel1.Width+14;
  {Here the Panel is changed to be wider and higher}
  if not Assigned(NewCheck1) then
  begin
  {2 new check boxes are added to the panel}
  NewCheck1 := TCheckBox.Create(Panel1);
  NewCheck1.Parent := Panel1;
  NewCheck1.Left := CheckBox3.Left;
  NewCheck1.Top := CheckBox3.Top+ CheckBox3.Height+10;
  NewCheck1.Font.Name := 'Arial';
  NewCheck1.Font.Size := 12;
  NewCheck1.Font.Color := clBlue;
  NewCheck1.Caption := 'New Check1';
  if not Assigned(NewCheck2) then
    begin
    NewCheck2 := TCheckBox.Create(Panel1);
    NewCheck2.Parent := Panel1;
    NewCheck2.Left := CheckBox4.Left;
    NewCheck2.Top := CheckBox4.Top+ CheckBox4.Height+10;
    NewCheck2.Caption := 'New Check2';
    NewCheck2.Checked := True;
    end;
{ ! ! ! ! ! ! ! ! ! ! !  IMPORTANT + + + + + + + + + +}
{if you change the Panel while it is not visible and run the timer
the NewCheck1 and 2 seem to lose their Owner, I can not understand this.
I also do not understand the fix. I could not fix this except
to make it visible and then hide it again, but I move the panel off the
visiible client area to show it and hide it and move it back, so
there is nothing to see}
  AutoS := Form1.AutoScroll;
  Form1.AutoScroll := False;
  Oleft := Panel1.Left;
  Panel1.Left := -Panel1.Width;
  Panel1.Show;
  Panel1.Hide;
  Panel1.Left := Oleft;
  Form1.AutoScroll := AutoS;
  end;
  GetPanelBmp(Panel1, True);
  Fading := True;
  PanelOut := False;
  PanelNum := 0;
  TimerR.isTiming := True;
  TimerR.Interval := 108;
  DoThreadTimer;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(hThread);
FreeAndNil(PanelBmp);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
hThread := 0;
Fading := False;
end;

end.





- - - - - - - - - - - - - - - - - - - - - - - - - -
you might look at torry delphi web site for components the
GetPanelBmp( ) procedure here is for Blending (transition) it just uses a "Blank" but you could use any bitmap to blend to
0
 

Author Comment

by:nashing_nasher
ID: 7110169
Cool. This is a completely smooth fade. HIGHLY RECOMMENDED
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now