kota kota wrote:
> ok here is an example,
> (look the red letters)
> 

As an alternative, I quickly converted the triangle painting into a
component, which produces an OnProgress event. I then added a
ProgressBar to the main form which indicates the progress of the
calculation before the next paint occurs.

Here is a screenshot, showing the previous paint and it's busy
calculating the new triangles.

http://opensoft.homeip.net/~graemeg/generate_triangles.png

I also attached the new code for you.


Regards,
  - Graeme -

_______________________________________________________
fpGUI - a cross-platform GUI toolkit using Free Pascal
http://opensoft.homeip.net/fpgui/

program drawtest;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  fpg_main,
  fpg_base,
  fpg_widget,
  fpg_form,
  fpg_progressbar,
  fpg_button,
  fpg_label,
  fpg_edit,
  Math;


type
  // progress event for TGraphComponent
  TProgressEvent = procedure(Sender: TObject; const ACount: integer) of object;


  TGraphComponent = class(TfpgWidget)
  private
    R: real;
    n: integer;
    m: integer;
//    i: longint;
    x2, y2: integer;
    results: array of integer;
    intS: array of array of integer;
    FOnProgress: TProgressEvent;
    procedure   PreCalculations;
    function    logos(c, b: integer): integer;
    procedure   DoOnProgress(const ACount: integer);
  protected
    procedure   HandlePaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure   DrawGraph(const ACount: integer);
    property    OnProgress: TProgressEvent read FOnProgress write FOnProgress;
  end;


  TMainForm = class(TfpgForm)
  private
    {...@vfd_head_begin: MainForm}
    ProgressBar1: TfpgProgressBar;
    btnStart: TfpgButton;
    Custom1: TGraphComponent;
    EditInteger1: TfpgEditInteger;
    Label1: TfpgLabel;
    {...@vfd_head_end: MainForm}
    procedure btnStartClicked(Sender: TObject);
    procedure Custom1Progress(Sender: TObject; const ACount: integer);
  public
    procedure AfterCreate; override;
  end;


{ TGraphComponent }

procedure TGraphComponent.PreCalculations;
begin
  m := 0;
  n := 3;
  R := intpower(380, n);
end;

function TGraphComponent.logos(c, b: integer): integer;
begin
  Result := (1 * c + 1 * b) div 2;
end;

procedure TGraphComponent.DoOnProgress(const ACount: integer);
begin
  if Assigned(FOnProgress) and ((ACount mod 1000) = 0) then
    FOnProgress(self, ACount);
end;

procedure TGraphComponent.HandlePaint;
var
  x, y, u: real;
  k: integer;
  i: integer;
begin
//    inherited HandlePaint;

  { We are doing all the painting, so no need to call inherited }
  Canvas.Clear(clWhite);

  // Only paint when we called DrawGraph - all other times it will blank component.
  if Tag = 0 then
    Exit;

  k := 0;
  u := pi / 2;
  for i := 1 to n do
  begin
    x := power(R, (1 / n)) * cos(((2 * k * pi + u) / n)) + 512;
    y := power(R, (1 / n)) * sin(((2 * k * pi + u) / n)) + 384;
    ints[i, 1] := trunc(x);
    ints[i, 2] := trunc(y);
    k := k + 1;

  end;{For-loop}
  Canvas.SetColor(clBlack);
  Canvas.DrawLine(intS[1, 1], intS[1, 2], intS[n, 1], intS[n, 2]);
  for i := 2 to n do
    Canvas.DrawLine(intS[i - 1, 1], intS[i - 1, 2], ints[i, 1], intS[i, 2]);

  { if m is very big (e.g 1000000) the user gets a black screen until
    all the points are drawn }
  X2 := 500;
  y2 := 500;
  for i := 1 to m do
  begin
    results[i] := random(n) + 1;
    x2 := logos(x2, intS[results[i], 1]);
    y2 := logos(y2, intS[results[i], 2]);
    Canvas.Pixels[x2, y2] := clBlack;
    DoOnProgress(i);
  end;{For-loop}
end;

constructor TGraphComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  PreCalculations;
end;

procedure TGraphComponent.DrawGraph(const ACount: integer);
begin
  Tag := 1;
  m := ACount;
//    results: array [1..m] of integer;
//    intS:    array[1..m, 1..2] of integer;
  SetLength(results, m+1);
  Setlength(intS, m+1, 3);

  Invalidate;
  Tag := 0;
end;

{ TMainForm }

procedure TMainForm.btnStartClicked(Sender: TObject);
begin
  ProgressBar1.Position := 0;
  fpgApplication.ProcessMessages;
  Custom1.DrawGraph(EditInteger1.Value);
end;

procedure TMainForm.Custom1Progress(Sender: TObject; const ACount: integer);
var
  p: integer;
begin
  // calculate percentage complete.
  p := Trunc((ACount / EditInteger1.Value) * 100);
  ProgressBar1.Position := p;
end;

procedure TMainForm.AfterCreate;
begin
  {%region 'Auto-generated GUI code' -fold}
  {...@vfd_body_begin: MainForm}
  Name := 'MainForm';
  SetPosition(10, 25, 1024, 768);
  WindowTitle := 'Ελληνικά γράμματα ';
  Sizeable := False;

  ProgressBar1 := TfpgProgressBar.Create(self);
  with ProgressBar1 do
  begin
    Name := 'ProgressBar1';
    SetPosition(292, 724, 466, 22);
    Max := 100;
  end;

  btnStart := TfpgButton.Create(self);
  with btnStart do
  begin
    Name := 'btnStart';
    SetPosition(12, 24, 80, 24);
    Text := 'Start';
    FontDesc := '#Label1';
    Hint := '';
    ImageName := '';
    TabOrder := 1;
    OnClick := @btnStartClicked;
  end;

  Custom1 := TGraphComponent.Create(self);
  with Custom1 do
  begin
    Name := 'Custom1';
    SetPosition(108, 0, 916, 704);
    OnProgress  := @Custom1Progress;
  end;

  EditInteger1 := TfpgEditInteger.Create(self);
  with EditInteger1 do
  begin
    Name := 'EditInteger1';
    SetPosition(12, 80, 80, 24);
    TabOrder := 3;
    FontDesc := '#Edit1';
    Value := 10000;
  end;

  Label1 := TfpgLabel.Create(self);
  with Label1 do
  begin
    Name := 'Label1';
    SetPosition(8, 60, 80, 16);
    FontDesc := '#Label1';
    Hint := '';
    Text := 'Loop count:';
  end;

  {...@vfd_body_end: MainForm}
  {%endregion}
end;



// -----------------------------------------
procedure MainProc;
var
  frm: TMainForm;
begin
  fpgApplication.Initialize;
  frm := TMainForm.Create(nil);
  try
    frm.Show;
    fpgApplication.Run;
  finally
    frm.Free;
  end;
end;


begin
  Randomize;
  MainProc;
end.


_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal

Reply via email to