419_archimedes_spiral2.txt

PROGRAM Archimedes_Spiral2;

//////////////////////////////////////////////////////////////////////
//  #sign: Max: MAXBOX10: 17/05/2016 22:25:20 
//  Purpose: Grabs outlook contacts out of,  more items see below   //
//  #path>C:\Program Files (x86)\maxbox3\Import\IPC\maxbox4\maxbox4\examples\
//  Lines of Code #locs:196
//////////////////////////////////////////////////////////////////////

Const TEXTOUT = 'hi world of code coverage with cover age';

//############################################################################
// Archimedes Spiral Architect
//############################################################################
//TODO: Button with wait/stop event, change color and save bitmap as png

 procedure TApplication_PaintView(Canvas: TCanvas); forward;


  var aform: TForm;
      FWait, FStop, switch: Boolean;
      FValueA: Float;
      FValueB: Float;


//<FUNCTION>
//<PROCEDURE> 
procedure OpenIEURL(aURL:string);
var sz: string;
   //asr: TResolver;
   //ahead: TIPHeader;
begin
  Application.ProcessMessages;
  aURL:= trim(aURL);
  if aURL='' then Exit;
  with TRegistry.Create do try
     rootkey:= HKey_Classes_Root;
     OpenKey('\htmlfile\shell\open\command',false);
     try 
       sz:= ReadString('');
       writeln('test of IE readkey '+sz) 
     except
       sz:= ''; 
     end;
     CloseKey;
  finally
      Free;
  end;
  if sz='' then Exit;
  sz:= copy(sz, pos('"',sz)+1, length(sz));
  sz:= copy(sz, 1, pos('"',sz)-1);
  if pos('http://',aURL)<>1 then aURL:='http://'+aURL;
  //ShellExecute(0,'open',PChar(z), PChar(aURL), nil, sw_ShowNormal); 
  //ShellExecute(0,'open', PChar(aURL), nil, nil, sw_Show);
end;

procedure stopclick(sender: TObject);
begin
  writeln('archimedes demo stopped');
  FStop:= true;
end;  

procedure waitclick(sender: TObject);
begin
  FWait:= NOT Fwait;
  writeln('archimedes demo wait');
  if Not FWait then begin
    writeln('archimedes demo go');
    repeat
     TApplication_PaintView(aform.canvas);
     switch:= NOT switch;
     Sleep(20);
   until FWait; 
  end;
end;  

procedure CreateAForm;
 //diaform:= CreateMessageDialog('my fast form perform',mtconfirmation, []);
begin
   FValueA:= 3.0;
   FValueB:= 1.4;
   FWait:= false;
   aform:= CreateMessageDialog('Archimedes Spiral - Click to Stop or KeyPress',mtwarning,
                                        [mball, mbyes, mbhelp, mbok]);
   with aform do begin
     caption:= 'Archimedes Spiral Architect Demo';
     setBounds(50,50,800,850)
     Formstyle:= fsStayontop;
     Color:= clRed; //1266;
     Canvas.Brush.Color:= clBlack; //clBlue;
     Canvas.Brush.Style:= bsSolid;
     Canvas.Pen.Color:= clWhite;
     onclick:= @waitclick;
     ondblclick:= @stopclick;
   end;  
   with TLabel.Create(self) do begin
     parent:= aform;
     SetBounds(330,30,400,70)
     font.size:= 34;
     font.style:= [fsItalic]
     font.color:= clyellow;
     caption:= 'Archimedes Spiral ';
   end;  
   aform.show; 
end;



procedure TApplication_PaintView(Canvas: TCanvas);
var
  cx, cy, i: Integer;
  angle,x,y: Float;

begin
  if FWait then Exit;
   
   FValueB:= FValueB + 0.001;
   // Clear background
   //Canvas.FillStyle := 'rgba(0,0,99,0.08)';
   if switch then
     Canvas.FillRect(rect(0,90, aForm.Width, aForm.Height));
   //Draw our framerate on the screen
    cx:= aForm.width div 2;
    cy:= aForm.Height div 2;

  // Canvas.BeginPath;
  for i:= 42 downto 0 do begin
    angle:= FValueB * i;
    x:= cx + (FValueA + FValueB * angle) * Cos(angle);
    y:= cy + (FValueA + FValueB * angle) * Sin(angle);
    if i = 42 then Canvas.MoveTo(round(x), round(y)) 
      else Canvas.LineTo(round(x),round(y));
  end;
  //Canvas.StrokeStyle := '#FFF';
  //Canvas.Stroke;
end;


function CheckIEStartCommand: string;
begin
  Application.ProcessMessages;
  with TRegistry.Create do try
     rootkey:= HKey_Classes_Root;
     OpenKey('\htmlfile\shell\open\command',false);
     try 
       result:= ReadString('');
     except
       result:= ''; 
     end;
     CloseKey;
  finally
     Free;
  end;
end;

function SplitToken(const Text: string; SplitChar: Char;
    var First, Last: string): Boolean;
var  SplitPos: Integer;
begin
  Result:= False;
  SplitPos:= Pos(SplitChar, Text);
  if SplitPos = 0 then Exit;
  First:= Trim(Copy(Text, 1, SplitPos -1));
  Last:= Trim(Copy(Text, SplitPos +1, Length(Text) -SplitPos));
  Result:= (First <>'') and (Last <>'');
end;


Begin  //Main
//<Executable statements>
  //TOutlookExport_Spy;
  Writeln('');
  Writeln('Start Command of IE: '+CheckIEStartCommand);  
//<Definitions>  

  //ares:= TResolver.create;
 { with TResolver.create do begin
   //writeln(inttostr(GetHostByName(gethostname)));
    Free;
   end;  }
   
   CreateAForm;
   repeat 
     TApplication_PaintView(aform.canvas);
     switch:= NOT switch;
     Sleep(20);
   until isKeyPressed or FStop;
   writeln('archimedes demo stopped now!');
    
   {with TledForm.create(self) do begin
    showmodal;
    free;
   end;} 
 // function GetMacAddresses(const Machine: string; const Addresses: TStrings):Integer;
    
END. 


//############################################################################
// Archimedes Spiral App
//############################################################################

unit ArchSpiralMain;

interface

uses
  w3system, w3components, w3ctrls, w3application, w3game, w3gameapp,
  w3polygons, w3inet, w3graphics;

type
  TApplication = class(TW3CustomGameApplication)
  private
    FValueA: Float;
    FValueB: Float;
    FWait: Boolean;
    procedure HandleClick(Sender:TObject);
  protected
    procedure ApplicationStarting; override;
    procedure ApplicationClosing; override;
    procedure PaintView(Canvas: TW3Canvas); override;
  end;

implementation

//############################################################################
// TApplication
//############################################################################

procedure TApplication.ApplicationStarting;
begin
  inherited;

  FValueA := 3.0;
  FValueB := 1.4;

  GameView.OnClick := Self.HandleClick;

  // Initialize refresh interval, set this to 1 for optimal speed
  GameView.Delay := 10;
 
  // Start the redraw-cycle with framecounter active
  // Note: the framecounter impacts rendering speed. Disable
  // the framerate for maximum speed (false)
  GameView.StartSession(true);
end;

procedure TApplication.ApplicationClosing;
begin
  GameView.EndSession;
  inherited;
end;

procedure TApplication.HandleClick(Sender: TObject);
begin
  FWait := not FWait;
end;

// Note: In a real live game you would try to cache as much
// info as you can. Typical tricks are: 
//   1: Only get the width/height when resized
//   2: Pre-calculate strings, especially RGB/RGBA values
//   3: Only redraw what has changed, avoid a full repaint
// The code below is just to get you started

procedure TApplication.PaintView(Canvas: TW3Canvas);
var
  cx, cy: Integer;
  i: Integer;
  angle: Float;
  x, y: Float;
begin
  if FWait then
    exit;

  FValueB := FValueB + 0.001;

  // Clear background
  Canvas.FillStyle := 'rgba(0,0,99,0.08)';
  Canvas.FillRectF(0, 0, GameView.Width, GameView.Height);

  // Draw our framerate on the screen
//  Canvas.font := '10pt verdana';
//  Canvas.FillStyle := 'rgb(255,255,255)';
//  Canvas.FillTextF('FPS:' + IntToStr(GameView.FrameRate) + ' / ' + floatToStr(FbValue) ,10,20,MAX_INT);

  cx := GameView.width div 2;
  cy := GameView.Height div 2;
  Canvas.BeginPath;

  for i := 42 downto 0 do
  begin
    angle := FValueB * i;
    x := cx + (FValueA + FValueB * angle) * cos(angle);
    y := cy + (FValueA + FValueB * angle) * sin(angle);
    if i = 42 then Canvas.MoveToF(x, y) else Canvas.LineToF(x,y);
  end;

  Canvas.StrokeStyle := '#FFF';
  Canvas.Stroke;
end;


end.



More Items:

       aContactItem.Categories:='Kunde'; // neu
       aContactItem.FirstName:=KundeName1.AsString;
       aContactItem.LastName:=KundeName2.AsString;
       aContactItem.FileAs:=KundeSuchbegriff.AsString;
       aContactItem.CompanyName:=KundeSuchbegriff.AsString;
       aContactItem.CustomerID:=KundeKundenNr.AsString;
       aContactItem.Account:=KundeFibuNr.AsString; // neu
       aContactItem.Body:=KundeAnsprechpartner.AsString;
       aContactItem.BusinessAddressStreet:=KundeStrasse.AsString;
       aContactItem.BusinessAddressPostalCode:=KundePLZ.AsString;
       aContactItem.BusinessAddressPostOfficeBox:=KundePostfach.AsString;
       aContactItem.BusinessAddressCity:=KundeOrt.AsString;
//         aContactItem.BusinessAddressCountry:=KundeLand.AsString; // neu
       aContactItem.OrganizationalIDNumber:=KundeUStIdNr.AsString; // neu
//         aContactItem.GovernmentIDNumber:=''
       aContactItem.BusinessTelephoneNumber:=KundeTelefon1.AsString;
       aContactItem.BusinessFaxNumber:=KundeFax.AsString;
       aContactItem.MobileTelephoneNumber:=KundeTelefon2.AsString;
       aContactItem.Email1Address:=KundeEMail.AsString;
       aContactItem.WebPage:=KundeHomepage.AsString;
       aContactItem.Save;
 
  http://i1-win.softpedia-static.com/screenshots/maXbox_5.png?1381322021
  
    RegisterMethod('Constructor Create(AOwner: TComponent)');
    RegisterConstructor(@TJvMail.Create, 'Create');
  
  
   RegisterMethod('Procedure Free');
   RegisterMethod(@TJvMail.Destroy, 'Free');
   


----app_template_loaded_code----