Solved

qow 16: mystify (all solutions wil be graded)

Posted on 2002-04-22
48
221 Views
Last Modified: 2010-04-04
hi experts,

i am starting a new quest: qow = question of the week :-)
each week i will introduce a new simple? question.

now qow 16

ALL working solutions will get 25 points (a graded).

sorry, top 15 experts, you are not allowed to solve this
q, only other can solve this question :-(

hope, every knows the screensaver mystify,
which comes with windows

now the question is:
i want a app (no screensaver),
which does similar (must not exact) this
on the entire form.
keep in mind, that the canavas get cleared,
if the form is min-/maximized, if you want to draw
on the form-canavas->this is not wanted.
the count of lines should be adjustable at runtime,


ATTENTION:
ALL working solutions will get 25 points (a graded).
(except doubled solutions)

let see

meikl ;-)
0
Comment
Question by:kretzschmar
  • 23
  • 6
  • 5
  • +7
48 Comments
 
LVL 7

Expert Comment

by:God_Ares
ID: 6959231
sorry I don't know mystify, could you provide some sort of screenshot?
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959243
no window-os, god_ares?
if you have a window-os, go into
-system-preferences
-display
-screensaver-tab
-select mystify from the combobox (is available per default)

well, don't know if it is availabel on xp

meikl ;-)
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6959250
Sorry no English Windows... all is in dutch.. :(
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959277
maybe you find it, if i explain in german
go

-start
-einstellungen
-systemsteuerung
-anzeige
-bildschirmschoner-tab
-in combobox "bildschirmschoner" mystify suchen

or in short
colored lines moving across the screen

meikl ;-)
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6959294
Mein Deutche Sprache ist nicht so gut, tut mir leight,
are the lines straight or curved?
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959316
:-))
>Mein Deutche Sprache ist nicht so gut, tut mir leight
correction:
Meine deutsche Sprache ist nicht so gut, tut mir leid.

as you see, near correct, therefore
your german is better than my dutch,
(knowing no word in dutch) ;-)

as you will,
variations are welcome
0
 
LVL 3

Expert Comment

by:tongalite
ID: 6959551
Hi Meikl,

Mein deutsch ist auch schrecklich..und ich hab' keine blaße Ahnung wie man 'Mystify' machen kann.
Es versuche mit! ;)
t.
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959580
puu, no one knows the mystify-screensaver :-(

hi tongalite,
dein deutsch ist doch gar nicht so übel ;-)
your german isn't so bad ;-)

well, next try
- search with the explorer in the windowsdir/system[32] for the file:
ssmyst.scr
- doubleclick on the file

similar is needed,
variations are welcome

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959605
found one on web
something like this:

http://www.xs4all.nl/~rutgervd/screen/mystify.zip

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959613
btw. tongalite,
from where are you?

god_ares,
i guess you are from the netherlands, or?
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6959761
hi meikl :-)
another good one Q.

Igor.
0
 
LVL 3

Expert Comment

by:tongalite
ID: 6959776
Meikl,
...bin englander
Und du? Von voher kommst du? (..Welcher Gegenteil Deutschland... das heisst)

I have Mystify on my system.. in fact it's my current screensaver... as of 2 days ago. I also saw a Delphi demo recently that does sort of the same thing. I can't cheat and import the unit because I don't know where I saw it :)

This calls for some experimentation....
Man braucht eben für alles was schwierig ist... viel Geduld!

Später!
t.
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6959840
Yes, i'm form NL. It's not allowd to draw on the form?
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959884
tongalite
ah, ein engländer :-))

well,
i'm from germany,
and there i live in bavaria
and there i live in franconia near nuremberg (nürnberg).
but here are no jobs for delphi-coders,
thats why i earn my money primary as oracle-developer

and at least, this qow is no question which may fast answered, there is one week time

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959894
>It's not allowd to draw on the form?

yes its allowed, but if you move another window over the form, the lines shouldn't not be (partially) cleared, if you move the other to another side window.

use a tpaintbox for example
instead to draw on the form-canvas

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959903
instead of lines are also circles,
triangles, bitmaps,
whatever you have in mind allowed
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6959941
>oracle-developer
oracle forms??? please tell me the made an object orientated language I HATE pl/sql
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959968
atleast oracle has a bit done with objects, but not with forms and the objects are not so relyable and good as in other oo-languages.

well, but with the version 9 or 10
forms will be replaced with java.

so i'm coding pl/sql and i don't like it much

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6959992
igor, you like this q?
would you sponsor 25 pts. for the nicest?
0
 
LVL 45

Expert Comment

by:aikimark
ID: 6960251
I thought you said no entries from the q15 people.
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6960391
a sponsor is one, who gives somewhat,
i asked igor, if he want to spent 25 pts.
for the nicest app additional

if there comes one

no points for top15
no solution wanted from top15,
except the question is closed or i allow it explicit

a bit kickoff, in 1998 i played a bit with threads

unit PThreaU;
{ zeichnet auf PaintAreal }
{ Bug : Lvscht Linie nicht wenn Anzahl verkleinert wird }
interface

uses
  Classes,windows,sysutils,graphics,ppaper,ptoolu;

Type
  TALine = Record
             Start : TPoint;
             Ende  : TPoint;
             IsPainted : Integer;
             IsDeleted : Boolean;
           End;
type
  ThrPaint = class(TThread)
  private
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    Procedure do_One_Step;
    Constructor Create;
  end;

Var
  StepX1,StepY1,StepX2,StepY2,Anzahl,
  MaxX, MaxY : Longint;


implementation

var
  ALines : Array[0..200] of TALine;
  X1Neg, X2Neg, Y1Neg, Y2Neg,
  Z,P : Longint;


Procedure Init_Array;
Var I : Integer;
Begin
  for i := 0 to 200 do
  Begin
    With ALines[I] do
    Begin
      Start.X := 100;
      Start.y := 100;
      Ende.X := 100;
      Ende.y := 100;
      IsPainted := 0;
      IsDeleted := True;
    End;
  end;
End;

Constructor ThrPaint.Create;
begin
  inherited create(False);
  MaxX := PaintAreal.ClientWidth;
  MaxY := PaintAreal.ClientHeight;
  StepX1 := ToolWindow.STX1.Position;
  StepY1 := ToolWindow.STY1.Position;
  StepX2 := ToolWindow.STX2.Position;
  StepY2 := ToolWindow.STY2.Position;
  Anzahl := ToolWindow.Counter.Position;
  Z := 1;
  X1Neg := 1;
  Y1Neg := 1;
  X2Neg := -1;
  Y2Neg := -1;
  Init_Array;
  PaintAreal.Canvas.Pen.Width := 1;
  FreeOnTerminate := True;
End;

Procedure DeleteALine(OneLine : TALine);
Begin
  With OneLine do
  begin
    PaintAreal.Canvas.Pen.Color := PaintAreal.Color;

    PaintAreal.Canvas.MoveTo(Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,Ende.Y);

    IsPainted := 0;
    IsDeleted := True;
  End;
end;

Procedure DrawALine(OneLine : TALine);
Begin
  With OneLine do
  begin
    If Not(isDeleted) then DeleteALine(OneLine);
    PaintAreal.Canvas.Pen.Color := ClBlack;

    PaintAreal.Canvas.MoveTo(Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(Start.X,MaxY-Start.Y);
    PaintAreal.Canvas.LineTo(Ende.X,MaxY-Ende.Y);

    PaintAreal.Canvas.MoveTo(MaxX-Start.X,Start.Y);
    PaintAreal.Canvas.LineTo(MaxX-Ende.X,Ende.Y);

    IsPainted := 1;
    Isdeleted := False;
  end;
end;



Procedure ThrPaint.do_One_Step;
Begin
  With ALines[Z] do
  begin
    { check if koordinates leave paintareal }
    if (ALines[Z-1].Start.x+(stepx1*X1Neg) > MaxX) or
       (ALines[Z-1].Start.x+(stepx1*X1Neg) < 0) Then X1Neg := -X1Neg;
    if (ALines[Z-1].Start.y+(stepy1*y1Neg) > MaxY) or
       (ALines[Z-1].Start.Y+(stepy1*Y1Neg) < 0) Then Y1Neg := -Y1Neg;
    if (ALines[Z-1].Ende.x+(stepx2*X2Neg) > MaxX) or
       (ALines[Z-1].Ende.x+(stepx2*X2Neg) < 0) Then X2Neg := -X2Neg;
    if (ALines[Z-1].Ende.y+(stepy2*y2Neg) > MaxY) or
       (ALines[Z-1].Ende.y+(stepy2*y2Neg) < 0) Then Y2Neg := -Y2Neg;

   { Set the new coordinates, recognize resize event }

    If Start.X - MaxX > Abs(StepX1) then
      Start.X := MaxX+(stepx1*X1Neg)
    Else
      Start.X := ALines[Z-1].Start.x+(stepx1*X1Neg);
    If Start.Y - MaxY > Abs(StepY1) then
      Start.Y := MaxY+(stepx1*Y1Neg)
    else
      Start.Y := ALines[Z-1].Start.Y+(stepy1*Y1Neg);
    If Ende.X - MaxX > Abs(StepX2) then
      Ende.X := MaxX+(stepX2*X2Neg)
    else
      Ende.X := ALines[Z-1].Ende.x+(stepx2*X2Neg);
    If Ende.Y - MaxY > Abs(StepX1) then
      Ende.Y := MaxY+(stepY2*Y2Neg)
    else
      Ende.Y := ALines[Z-1].Ende.y+(stepy2*y2Neg);
    DrawALine(ALines[Z]);
  End;
  If Z < Anzahl Then P := 200 + Z - Anzahl else P := Z - Anzahl;
  DeleteALine(ALines[P]);
  Inc(Z);
  If Z > 200 Then
  begin
    { round over }
    ALines[0] := ALines[200];
    Z := 1;
  End;
end;

procedure ThrPaint.Execute;
begin
  while True do
  begin
    if Terminated then Terminate;
    Synchronize(Do_One_Step);
  end;
end;

end.

paints one line, does paint mirrored, paint rotated,
just not perfect

meikl ;-)
0
 
LVL 45

Expert Comment

by:aikimark
ID: 6960419
meikl,

You could have made two questions out of this problem.  First, paint small balls bounding around inside the borders of a form or picturebox canvas.  Secondly, change the balls to endpoints of line segments connected to each other.

Just being helpful. :-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6960434
aikimark,
implement it
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 6960936
kretzschmar , the saver is still available under XP .
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 14

Accepted Solution

by:
AvonWyss earned 50 total points
ID: 6961181
Okay, here is a possible solution. It features complete runtime customization ability (change the count of edges, the count of shapes, the size of the window, the speed) and does always redraw properly. In addition to that, it's build on a very solid fundamet that could easily be used to add more shape queues that are displayed at once or to add other kinds of shapes. Enjoy!

DFM:

object FormMain: TFormMain
  Left = 1
  Top = 0
  Width = 1020
  Height = 713
  BorderStyle = bsSizeToolWin
  Caption = 'FormMain'
  Color = clBlack
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 0
    Top = 0
    Width = 1012
    Height = 655
    Align = alClient
    OnPaint = PaintBox1Paint
  end
  object Panel1: TPanel
    Left = 0
    Top = 655
    Width = 1012
    Height = 31
    Align = alBottom
    BevelInner = bvRaised
    BevelOuter = bvLowered
    TabOrder = 0
    object Label1: TLabel
      Left = 8
      Top = 8
      Width = 50
      Height = 13
      Caption = 'Complexity'
    end
    object Label2: TLabel
      Left = 160
      Top = 8
      Width = 36
      Height = 13
      Caption = 'Shapes'
    end
    object Label3: TLabel
      Left = 304
      Top = 8
      Width = 27
      Height = 13
      Caption = 'Delay'
    end
    object Edit1: TEdit
      Left = 64
      Top = 5
      Width = 49
      Height = 21
      TabOrder = 0
      Text = '4'
      OnChange = Edit1Change
    end
    object UpDown1: TUpDown
      Left = 113
      Top = 5
      Width = 15
      Height = 21
      Associate = Edit1
      Min = 2
      Position = 4
      TabOrder = 1
      Wrap = False
    end
    object Edit2: TEdit
      Left = 200
      Top = 5
      Width = 49
      Height = 21
      TabOrder = 2
      Text = '4'
      OnChange = Edit2Change
    end
    object UpDown2: TUpDown
      Left = 249
      Top = 5
      Width = 15
      Height = 21
      Associate = Edit2
      Min = 1
      Max = 1000
      Position = 4
      TabOrder = 3
      Wrap = False
    end
    object Edit3: TEdit
      Left = 336
      Top = 5
      Width = 49
      Height = 21
      TabOrder = 4
      Text = '40'
      OnChange = Edit3Change
    end
    object UpDown3: TUpDown
      Left = 385
      Top = 5
      Width = 15
      Height = 21
      Associate = Edit3
      Min = 20
      Max = 1000
      Increment = 20
      Position = 40
      TabOrder = 5
      Wrap = False
    end
  end
  object TimerDraw: TTimer
    Interval = 20
    OnTimer = TimerDrawTimer
    Left = 11
    Top = 8
  end
end

Source:

unit UnitFormMain;

interface

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

type
  TShape=class
    procedure Draw(Canvas: TCanvas; Erase: Boolean); virtual; abstract;
    procedure EraseAndFree(Canvas: TCanvas);
  end;

  TShapeArray=array of TShape;
  TShapeQueue=class
  private
    FItems: TShapeArray;
    FCanvas: TCanvas;
    FHead, FTail: Integer;
    function GetCapacty: Integer;
    procedure SetCanvas(const Value: TCanvas);
    procedure SetCapacity(const Value: Integer);
    function GetCount: Integer;
  protected
    function Remove: TShape;
    function Empty: Boolean;
  public
    procedure Add(AShape: TShape);
    procedure Redraw;
    property Canvas: TCanvas read FCanvas write SetCanvas;
    property Count: Integer read GetCount;
    property Capacity: Integer read GetCapacty write SetCapacity;
  end;

  TPointArray=array of TPoint;
  TEdgeShape=class(TShape)
  private
    FPoints: TPointArray;
    FColor: TColor;
  public
    constructor Create(Width, Height, Count: Integer; Color: TColor; var Change: TPointArray); overload;
    constructor Create(Width, Height: Integer; Previous: TEdgeShape; Change: TPointArray); overload;
    procedure Draw(Canvas: TCanvas; Erase: Boolean); override;
  end;
  TEdgeQueue=class(TShapeQueue)
  private
    FLast: TEdgeShape;
    FChange: TPointArray;
    function GetComplexity: Integer;
    procedure SetComplexity(const Value: Integer);
  public
    constructor Create;
    procedure Add(Width, Height: Integer);
    property Complexity: Integer read GetComplexity write SetComplexity;
  end;

  TFormMain=class(TForm)
    Panel1: TPanel;
    PaintBox1: TPaintBox;
    TimerDraw: TTimer;
    Label1: TLabel;
    Edit1: TEdit;
    UpDown1: TUpDown;
    Label2: TLabel;
    Edit2: TEdit;
    UpDown2: TUpDown;
    Label3: TLabel;
    Edit3: TEdit;
    UpDown3: TUpDown;
    procedure TimerDrawTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
  private
    Queue: TEdgeQueue;
  public

  end;

var
  FormMain: TFormMain;

implementation

{$R *.DFM}

{ Generic }

function RandomChange: Integer;
const
  Min=5;
  Max=30;
begin
  Result:=(Random(2)*2-1)*(Random(Max-Min)+Min); // results in -max..-min or min..max
end;

function RandomColor: TCOlor;
begin
  Result:=Random(256)*65536+Random(256)*256+Random(256);
end;

{ TShapeQueue }

procedure TShapeQueue.Add(AShape: TShape);
begin
  if Count>=High(FItems) then
    Remove.EraseAndFree(FCanvas);
  FItems[FHead]:=AShape;
  if Assigned(Canvas) then
    AShape.Draw(Canvas, False);
  FHead:=(FHead+1) mod Length(FItems);
end;

function TShapeQueue.Empty: Boolean;
begin
  Result:=FHead=FTail;
end;

function TShapeQueue.GetCapacty: Integer;
begin
  Result:=High(FItems);
end;

function TShapeQueue.GetCount: Integer;
begin
  Result:=FHead-FTail;
  if Result<0 then
    Inc(Result, Length(FItems));
end;

procedure TShapeQueue.Redraw;
var
  I: Integer;
begin
  I:=FTail;
  while I<>FHead do begin
    FItems[I].Draw(FCanvas, False);
    I:=(I+1) mod Length(FItems);
  end;
end;

function TShapeQueue.Remove: TShape;
begin
  if not Empty then begin
    Result:=FItems[FTail];
    FItems[FTail]:=nil;
    FTail:=(FTail+1) mod Length(FItems);
  end else
    Result:=nil;
end;

procedure TShapeQueue.SetCanvas(const Value: TCanvas);
begin
  FCanvas:=Value;
  Redraw;
end;

procedure TShapeQueue.SetCapacity(const Value: Integer);
var
  Temp: TShapeArray;
  I,T: Integer;
begin
  if Value<1 then
    raise Exception.Create('Invalid argument. Capacity must be 1 or more.');
  if Value=Capacity then
    Exit;
  while Value<Count do
    Remove.EraseAndFree(FCanvas);
  SetLength(Temp, Value+1);
  T:=0;
  I:=FTail;
  while I<>FHead do begin
    Temp[T]:=FItems[I];
    I:=(I+1) mod Length(FItems);
    T:=(T+1) mod Length(Temp);
  end;
  FHead:=Count;
  FTail:=0;
  FItems:=Temp;
end;

{ TShape }

procedure TShape.EraseAndFree(Canvas: TCanvas);
begin
  Draw(Canvas, True);
  Free;
end;

{ TEdgeShape }

constructor TEdgeShape.Create(Width, Height, Count: Integer; Color: TColor; var Change: TPointArray);
var
  I: Integer;
begin
  FColor:=Color;
  SetLength(FPoints, Count);
  for I:=Low(FPoints) to High(FPoints) do
    with FPoints[I] do begin
      X:=Random(Width);
      Y:=Random(Height);
    end;
  SetLength(Change, Count);
  for I:=Low(Change) to High(Change) do
    with Change[I] do begin
      X:=RandomChange;
      Y:=RandomChange;
    end;
end;

constructor TEdgeShape.Create(Width, Height: Integer; Previous: TEdgeShape; Change: TPointArray);
var
  I: Integer;
begin
  FColor:=Previous.FColor;
  FPoints:=Copy(Change);
  for I:=Low(Change) to High(Change) do begin
    with Change[I] do
      if (X=0) or (Y=0) then begin
        X:=RandomChange;
        Y:=RandomChange;
      end;
    with FPoints[I] do
      if I<Length(Previous.FPoints) then begin
        Inc(X,Previous.FPoints[I].X);
        if X<0 then begin
          X:=-X;
          Change[I].X:=-Change[I].X;
        end else if X>=Width then begin
          Dec(X,X-Width);
          Change[I].X:=-Change[I].X;
        end;
        Inc(Y,Previous.FPoints[I].Y);
        if Y<0 then begin
          Y:=-Y;
          Change[I].Y:=-Change[I].Y;
        end else if Y>=Height then begin
          Dec(Y,Y-Height);
          Change[I].Y:=-Change[I].Y;
        end;
      end else begin
        X:=Random(Width);
        Y:=Random(Height);
      end;
  end;
end;

procedure TEdgeShape.Draw(Canvas: TCanvas; Erase: Boolean);
var
  I: Integer;
begin
  with FPoints[High(FPoints)] do
    Canvas.MoveTo(X,Y);
  if Erase then
    Canvas.Pen.Color:=clBlack
  else
    Canvas.Pen.Color:=FColor;
  for I:=Low(FPoints) to High(FPoints) do
    with FPoints[I] do
      Canvas.LineTo(X,Y);
end;

{ TEdgeQueue }

procedure TEdgeQueue.Add(Width, Height: Integer);
begin
  FLast:=TEdgeShape.Create(Width, Height, FLast, FChange);
  inherited Add(FLast);
end;

constructor TEdgeQueue.Create;
begin
  inherited Create;
  FLast:=TEdgeShape.Create(1000, 1000, 20, RandomColor, FChange);
  Capacity:=30;
  inherited Add(FLast);
end;

function TEdgeQueue.GetComplexity: Integer;
begin
  Result:=Length(FChange);
end;

procedure TEdgeQueue.SetComplexity(const Value: Integer);
begin
  SetLength(FChange, Value);
end;

{ TFormMain }

procedure TFormMain.TimerDrawTimer(Sender: TObject);
begin
  Queue.Add(PaintBox1.Width, PaintBox1.Height);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Queue:=TEdgeQueue.Create;
  Queue.Canvas:=PaintBox1.Canvas;
end;

procedure TFormMain.PaintBox1Paint(Sender: TObject);
begin
  Queue.Redraw;
end;

procedure TFormMain.Edit1Change(Sender: TObject);
begin
  Queue.Complexity:=UpDown1.Position;
end;

procedure TFormMain.Edit2Change(Sender: TObject);
begin
  Queue.Capacity:=UpDown2.Position;
end;

procedure TFormMain.Edit3Change(Sender: TObject);
begin
  TimerDraw.Interval:=UpDown3.Position;
end;

end.
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6961191
The compiled executable can be downloaded here:
http://web.bsn.ch/avonwyss/MystifyClone.exe (371kb)
0
 
LVL 1

Expert Comment

by:MBo
ID: 6961855
PaintBox with Align=alClient

var
  Form1: TForm1;
  a,olda,aa,oldaa:array[0..3] of tpoint;
  b,oldb,bb,oldbb:array[0..3] of tpoint;
  va,vb:array[0..3] of tpoint;
  first:boolean;

implementation
{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
procedure checkborder(var q,vq:integer;const brd:integer);
begin
  if q>=brd then begin
    q:=2*brd-q;  vq:=-vq;  end;
  if q<0 then begin
    q:=-q;    vq:=-vq;   end;
end;

begin
with paintbox1 do begin
for i:=0 to 3 do begin
  a[i].x:=a[i].x+va[i].x;
  checkborder(a[i].x,va[i].x,clientwidth);
  a[i].y:=a[i].y+va[i].y;
  checkborder(a[i].y,va[i].y,clientheight);
  aa[i].x:=aa[i].x+va[i].x;
  checkborder(aa[i].x,va[i].x,clientwidth);
  aa[i].y:=aa[i].y+va[i].y;
  checkborder(aa[i].y,va[i].y,clientheight);
  b[i].x:=b[i].x+vb[i].x;
  checkborder(b[i].x,vb[i].x,clientwidth);
  b[i].y:=b[i].y+vb[i].y;
  checkborder(b[i].y,vb[i].y,clientheight);
  bb[i].x:=bb[i].x+vb[i].x;
  checkborder(bb[i].x,vb[i].x,clientwidth);
  bb[i].y:=bb[i].y+vb[i].y;
  checkborder(bb[i].y,vb[i].y,clientheight);
end;
canvas.pen.color:=clLime;
if not first then begin canvas.Polygon(olda); canvas.Polygon(oldaa); end;
canvas.Polygon(a);   canvas.Polygon(aa);
olda:=a;    oldaa:=aa;
canvas.pen.color:=clRed;
if not first then begin canvas.Polygon(oldb); canvas.Polygon(oldbb); end;
canvas.Polygon(b);   canvas.Polygon(bb);
oldb:=b;    oldbb:=bb;
first:=false;
end;
end;

procedure TForm1.PaintBox1Click(Sender: TObject);
var i:integer;
begin
with paintbox1 do begin
if not Timer1.Enabled then begin
randomize;
for i:=0 to 3 do begin
  a[i].x:=random(clientwidth-5);
  a[i].y:=random(clientheight-5);
  aa[i].x:=a[i].x+5;
  aa[i].y:=a[i].y+5;
  va[i].x:=(1+random(5))*(2*random(2)-1);
  va[i].y:=(1+random(5))*(2*random(2)-1);
  b[i].x:=random(clientwidth-5);
  b[i].y:=random(clientheight-5);
  bb[i].x:=b[i].x+5;
  bb[i].y:=b[i].y+5;
  vb[i].x:=(1+random(5))*(2*random(2)-1);
  vb[i].y:=(1+random(5))*(2*random(2)-1);
end;
canvas.Brush.color:=clBlack;
canvas.brush.style:=bsSolid;
canvas.fillrect(getclientrect);
canvas.brush.style:=bsClear;
canvas.Pen.Mode:=pmXor;
first:=true;
end;
Timer1.Enabled:=not Timer1.Enabled;
end;
end;
0
 
LVL 1

Expert Comment

by:MBo
ID: 6961859
PaintBox with Align=alClient

var
  Form1: TForm1;
  a,olda,aa,oldaa:array[0..3] of tpoint;
  b,oldb,bb,oldbb:array[0..3] of tpoint;
  va,vb:array[0..3] of tpoint;
  first:boolean;

implementation
{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
procedure checkborder(var q,vq:integer;const brd:integer);
begin
  if q>=brd then begin
    q:=2*brd-q;  vq:=-vq;  end;
  if q<0 then begin
    q:=-q;    vq:=-vq;   end;
end;

begin
with paintbox1 do begin
for i:=0 to 3 do begin
  a[i].x:=a[i].x+va[i].x;
  checkborder(a[i].x,va[i].x,clientwidth);
  a[i].y:=a[i].y+va[i].y;
  checkborder(a[i].y,va[i].y,clientheight);
  aa[i].x:=aa[i].x+va[i].x;
  checkborder(aa[i].x,va[i].x,clientwidth);
  aa[i].y:=aa[i].y+va[i].y;
  checkborder(aa[i].y,va[i].y,clientheight);
  b[i].x:=b[i].x+vb[i].x;
  checkborder(b[i].x,vb[i].x,clientwidth);
  b[i].y:=b[i].y+vb[i].y;
  checkborder(b[i].y,vb[i].y,clientheight);
  bb[i].x:=bb[i].x+vb[i].x;
  checkborder(bb[i].x,vb[i].x,clientwidth);
  bb[i].y:=bb[i].y+vb[i].y;
  checkborder(bb[i].y,vb[i].y,clientheight);
end;
canvas.pen.color:=clLime;
if not first then begin canvas.Polygon(olda); canvas.Polygon(oldaa); end;
canvas.Polygon(a);   canvas.Polygon(aa);
olda:=a;    oldaa:=aa;
canvas.pen.color:=clRed;
if not first then begin canvas.Polygon(oldb); canvas.Polygon(oldbb); end;
canvas.Polygon(b);   canvas.Polygon(bb);
oldb:=b;    oldbb:=bb;
first:=false;
end;
end;

procedure TForm1.PaintBox1Click(Sender: TObject);
var i:integer;
begin
with paintbox1 do begin
if not Timer1.Enabled then begin
randomize;
for i:=0 to 3 do begin
  a[i].x:=random(clientwidth-5);
  a[i].y:=random(clientheight-5);
  aa[i].x:=a[i].x+5;
  aa[i].y:=a[i].y+5;
  va[i].x:=(1+random(5))*(2*random(2)-1);
  va[i].y:=(1+random(5))*(2*random(2)-1);
  b[i].x:=random(clientwidth-5);
  b[i].y:=random(clientheight-5);
  bb[i].x:=b[i].x+5;
  bb[i].y:=b[i].y+5;
  vb[i].x:=(1+random(5))*(2*random(2)-1);
  vb[i].y:=(1+random(5))*(2*random(2)-1);
end;
canvas.Brush.color:=clBlack;
canvas.brush.style:=bsSolid;
canvas.fillrect(getclientrect);
canvas.brush.style:=bsClear;
canvas.Pen.Mode:=pmXor;
first:=true;
end;
Timer1.Enabled:=not Timer1.Enabled;
end;
end;
0
 
LVL 1

Expert Comment

by:MBo
ID: 6961867
sorry for double post
0
 
LVL 4

Expert Comment

by:nestorua
ID: 6962219
HI, meikl,
As for this next qow: you want to have a form on which
those lines appears and dissappears as in the "mistery",
and in the same time forbid to paint on the Canvas of the form?
Am I right?
Sincerely,
Nestorua.
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6962464
>in the same time forbid to paint on the Canvas

no, i just say, you must ensure,
that if a repaint-event of the form
appears the lines are also drawn

meikl ;-)
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6962666
meikl, have you had the time to look at any of these?
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6962681
avonwyss,
i have already shown yours
this morning -> cool :-))
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6964643
hi all,

meikl :-)
I'm here. Yes, I will. Just tell me who deserve it.
Also I will provide my own solution of the task.

-----
Igor
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6964743
0
 

Expert Comment

by:lottol
ID: 6964978
Tried to make it simple :))

object MainForm: TMainForm
  Left = 237
  Top = 103
  Width = 696
  Height = 480
  Caption = 'MainForm'
  Color = clBlack
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnPaint = FormPaint
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object Timer1: TTimer
    Interval = 60
    OnTimer = Timer1Timer
    Left = 70
    Top = 112
  end
end

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TFigCoord = class
   Place :TPoint;
   xDir  :short;
   yDir  :short;
  public
   constructor CreateBounded(FigCoord: TFigCoord); virtual;
   procedure StepIt;
  end;

  TFigure = class
   Coords :TList;
  public
   constructor Create(Figure: TFigure; CoordsCount: integer); virtual;
   destructor Destroy; override;
   procedure StepIt;
  end;

  TDancer = class
   Color   :TColor;
   Figures :TList;
  public
   constructor Create(FiguresCount: integer; CoordsCount: integer); virtual;
   destructor Destroy; override;
   procedure StepIt; virtual;
  end;

  TMainForm = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SetDrawBounds;
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
 MainForm: TMainForm;
 Dancers: TList;
 DrawBounds: TPoint;
 Space: integer;

implementation

{$R *.DFM}

{ TFigureCoord }
constructor TFigCoord.CreateBounded(FigCoord: TFigCoord);
begin
 inherited create;
 if FigCoord = nil then
  begin
   Place := Point(Trunc(random(DrawBounds.x)),Trunc(random(DrawBounds.y)));
   xDir  := Trunc(random(2))-1;
   if xDir > -1 then xDir := 1;
   yDir  := Trunc(random(2))-1;
   if yDir > -1 then yDir := 1;
  end
 else
  begin
   Place := FigCoord.Place;
   xDir  := FigCoord.xDir;
   yDir  := FigCoord.yDir;
   StepIt;
  end;
end;

procedure TFigCoord.StepIt;
begin
 Place := Point(Place.x + xDir * Space, Place.y + yDir * Space);
 if not((Place.x > 0) and (Place.x < DrawBounds.x)) then
  begin
   xDir := -xDir;
   if Place.x < 0 then Place.x := abs(Place.x);
   if Place.x > DrawBounds.x then Place.x := 2 * DrawBounds.x - Place.x;
  end;
 if not((Place.y > 0) and (Place.y < DrawBounds.y)) then
  begin
   yDir := -yDir;
   if Place.y < 0 then Place.y := abs(Place.y);
   if Place.y > DrawBounds.y then Place.y := 2 * DrawBounds.y - Place.y;
  end;
end;

{ TFigure }

constructor TFigure.Create(Figure: TFigure;CoordsCount: integer);
var
 i: integer;
begin
 inherited create;
 Coords := TList.Create;
 for i := 0 to CoordsCount-1 do
  if Figure = nil
   then Coords.add(TFigCoord.CreateBounded(nil))
   else Coords.add(TFigCoord.CreateBounded(TFigCoord(Figure.Coords.Items[i])));
end;

destructor TFigure.Destroy;
begin
 Coords.free;
 inherited;
end;

procedure TFigure.StepIt;
var
 i: integer;
begin
 for i := 0 to Coords.Count-1 do
  TFigCoord(Coords.Items[i]).StepIt;
end;

{ TDancer }

constructor TDancer.Create(FiguresCount: integer; CoordsCount: integer);
var
 i      :integer;
 Figure :TFigure;
begin
 if FiguresCount < 1 then raise Exception.create('Dancer must have at least 1 figure!');
 inherited Create;
 color := Trunc(random(65534)+1);
 Figures := TList.Create;
 Figure := TFigure.Create(nil, CoordsCount);
 Figures.Add(Figure);
 for i := 2 to FiguresCount do
  begin
   Figure := TFigure.Create(Figure, CoordsCount);
   Figures.Add(Figure);
  end;
end;

destructor TDancer.Destroy;
begin
 while Figures.Count > 0 do
  begin
   TFigure(Figures.Items[0]).Free;
   Figures.Delete(0);
  end;
 Figures.free;
 inherited;
end;

procedure TDancer.StepIt;
var
 i: integer;
begin
 for i := 0 to Figures.Count-1 do
  TFigure(Figures.Items[i]).StepIt;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 Space   := 5;
 SetDrawBounds;
 Dancers := TList.Create;
 Dancers.Add(TDancer.Create(2,3));
 Dancers.Add(TDancer.Create(1,4));
 Dancers.Add(TDancer.Create(4,2));
 Dancers.Add(TDancer.Create(10,5));
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
 while Dancers.Count > 0 do
  begin
   TDancer(Dancers.Items[0]).free;
   Dancers.Delete(0);
  end;
 Dancers.free;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
 SetDrawBounds
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
 i: integer;
begin
 for i := 0 to Dancers.Count-1 do
  TDancer(Dancers.Items[i]).StepIt;
 Invalidate;
end;

procedure TMainForm.SetDrawBounds;
begin
 DrawBounds := Point(ClientWidth, ClientHeight);
end;

procedure TMainForm.FormPaint(Sender: TObject);
var
 i,j,k: integer;
begin
 Canvas.brush.Color := clBlack;
// Canvas.FillRect(ClientRect);
 for i := 0 to Dancers.Count-1 do
  begin
   Canvas.Pen.Color := TDancer(Dancers.items[i]).Color;
   for j := 0 to TDancer(Dancers.items[i]).Figures.Count-1 do
    with TFigure(TDancer(Dancers.items[i]).Figures.Items[j]) do
     begin
      Canvas.PenPos := TFigCoord(Coords.items[0]).Place;
      for k := Coords.Count-1 downto 0 do
       Canvas.LineTo(TFigCoord(Coords.items[k]).Place.x, TFigCoord(Coords.items[k]).Place.y);
     end;
  end;
end;

initialization
 Randomize;

end.
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6965359
Fade effect added, the same link (source and executable)
http://i-g-o-r.virtualave.net/zip/Mystery.zip
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6965396
wow, igor, very nice,
but, you know you will get no points,
because you're a top15 member,
but it may be a suggestion to all others

meikl ;-)

evaluating now MBo and lottol
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6965430
thanx meikl,
I know about "no points". I just provide an example to illustrate your question.
It takes all of my yerstaday coffee breaks  :-)
----
Igor.
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6970702
>It takes all of my yerstaday coffee breaks  
hope you run not out of coffee :-))
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6972964
I converted my code to screensaver and added settings form:
http://i-g-o-r.virtualave.net/zip/MysterySpline.zip
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6976653
gradings and next qow comes tomorrow
(no time today)

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6977954
well,
avonwyss code was the nicest
and includes also adjustments,

therefore i raised the points up to 50
(igor you do not need to grade the nicest,
i've already done it now, have enough points,
maybe next time)

mbo,
i got you code not to work with me,
maybe i'm too stupid for copy and paste
(watch out for your 25 points,
because i guess you've tested your code and
it works for you)

lottol,
i got your code work, but its really not so nice as this from avonwyss.
(watch out for your 25 points)

well,
perfect was igor, many thanks to you

thanks to all for participating on this quest

next qow will be a quicky
(first solution will get the points)

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6977984
lottol, MBo

sorry you must wait,
can't nevermore post 25 pts questions :-(
(ex-ex may changed something)


asking at community support now . . .
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6978022
i'm also unable to post qow 17 :-(
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6978040
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6978767
meikl, thanks a lot for the doubled amount of points! Looking forward to the next QOW when you will be able to post it.
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6986929
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
This video discusses moving either the default database or any database to a new volume.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

706 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

17 Experts available now in Live!

Get 1:1 Help Now