Eksi Universe UI

uvmain.pas

{ drawing code for ek$i universe - used in book poster - 2002 }

unit uvmain;

interface

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

type
  TTitle = class(TObject)
    Title : string;
    Id : integer;
    Referers:integer;
    X,Y:integer;
    SubTitles : TList;
    ShowCaption : boolean;
    R:integer;
    TW : integer;

    constructor Create;
    destructor Destroy;override;
  end;

  TfMain = class(TForm)
    bDoit: TButton;
    iMain: TImage;
    pb: TProgressBar;
    setupButton: TButton;
    printButton: TButton;
    printDialog: TPrinterSetupDialog;
    procedure FormCreate(Sender: TObject);
    procedure bDoitClick(Sender: TObject);
    procedure iMainMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure iMainMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure iMainMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; mX, mY: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure printButtonClick(Sender: TObject);
    procedure setupButtonClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  public
    // bmp:TBitmap;
    titles:TList;
    scrollx,scrolly : integer;
    dragging : boolean;
    dragx,dragy:integer;
    UniverseBounds:TRect;
    maxRef:integer;

    function getTitle(id:integer):TTitle;
    procedure drawUniverse(drawCanvas:TCanvas; drawWidth,drawHeight:integer);
    procedure drawScreen;
    procedure drawPrinter;
  end;

var
  fMain: TfMain;

implementation

uses

  Printers, Math, ADODB_TLB;

{$R *.dfm}

procedure TfMain.drawScreen;
begin
  with iMain.Picture.Bitmap do drawUniverse(Canvas,Width,Height);
end;

procedure TfMain.drawPrinter;
begin
  with Printer do drawUniverse(Canvas,PageWidth,PageHeight);
end;

constructor TTitle.Create;
begin
  inherited;
  SubTitles := TList.Create;
end;

destructor TTitle.Destroy;
begin
  SubTitles.Free;
  inherited;
end;

const

  connectionString : WideString =
    'Provider=SQLOLEDB;Server=SOURTIMES;Database=sozluk';

procedure TfMain.FormCreate(Sender: TObject);
var
  bmp:TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.Width := iMain.Width;
  bmp.Height := iMain.Height;
  iMain.Picture.Assign(bmp);
  titles := TList.Create;
end;

function mysort(item1,item2:pointer):integer;
begin
  Result := CompareValue(TTitle(item2).referers,TTitle(item1).referers); // en cok refer edilen
end;

procedure TfMain.drawUniverse(drawCanvas:TCanvas; drawWidth,drawHeight:integer);
var
  n:integer;
  t:TTitle;
  dx,dy,ox,oy:integer;
  subn:integer;
  subt:TTitle;
begin
  dx := (drawWidth div 2)-scrollx;
  dy := (drawHeight div 2)-scrolly;
  with drawCanvas do begin
    Brush.Color := clBlack;
    FillRect(ClipRect);
    Pen.Color := clGreen;
    for n:=0 to titles.Count-1 do begin
      t := TTitle(titles[n]);
      for subn := 0 to t.SubTitles.Count-1 do begin
        subt := t.SubTitles[subn];
        if (t.R > 1) then PolyLine([Point(t.x+dx,t.y+dy),Point(subt.x+dx,subt.y+dy)]);
      end;
    end;
    //Brush.Color := clWhite;
    Pen.Color := clBlack;
    Font.Height := 20;
    Font.Style := [fsBold];
    Font.Name := 'Arial';
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    for n:=0 to titles.Count-1 do begin
      t := TTitle(titles[n]);
      with t do Ellipse(x+dx-r,y+dy-r,x+dx+r,y+dy+r);
    end;
    Brush.Style := bsClear;
    for n:=0 to titles.Count-1 do begin
      t := TTitle(titles[n]);
      with t do begin
        if showCaption then begin
          if tw = 0 then tw := TextWidth(t.title);
          ox := (t.x+dx)-(tw div 2);
          oy := (t.y+dy)+r;
          Font.Color := clBlack;
          TextOut(ox+1,oy+1,t.title);
          TextOut(ox-1,oy-1,t.title);
          Font.Color := clYellow;
          TextOut(ox,oy,t.title);
        end;
      end; {with}
    end;
  end;
end;

procedure TfMain.bDoitClick(Sender: TObject);
var
  conn:Connection;
  rs:RecordSet;
  v:Variant;
  n,id:integer;
  maxLinks:integer;
  src,dst:TTitle;
  cmd:Command;
  globalAngle,angle:single;
  globaldivs:single;
  globalX,globalY:integer;
  bounds:TRect;
  distance:integer;
  params:OleVariant;

  procedure dofor(t:TTitle; x,y:integer);
  var
    n:integer;
    subt:TTitle;
    divs:single;
    range:integer;
    cnt:integer;
    hede:single;
  begin
    t.x := x;
    t.y := y;
    t.r := (t.referers div 2)+2;
    range := 100 + t.r;
//    inc(distance);
    hede := sqrt(abs(sqr(x)-sqr(y)));
    t.showCaption := (id=31782) or (t.r > 5) or ((hede > 1000) and (t.R > 2));

    if t.subTitles.Count > 0 then begin
      cnt := 0;
      for n:=0 to t.SubTitles.Count-1 do begin
        subt := t.SubTitles[n];
        if (subt.x = 0) and (subt.y = 0) then inc(cnt);
      end;
      if cnt > 0 then begin
        divs := PI/cnt;
        angle := random(360)*PI/180;
        inc(distance);
        for n:=0 to t.SubTitles.Count-1 do begin
          subt := t.SubTitles[n];
          if (subt.x = 0) and (subt.y = 0) then begin
            x := Trunc(((distance+range+Random(40)) * cos(angle)));
            y := Trunc(((distance+range+Random(40)) * sin(angle)));
            if x-t.r < Bounds.Left then Bounds.Left := x-t.r else
            if x+t.r > Bounds.Right then Bounds.Right := x+t.r;
            if y-t.r < Bounds.Top then Bounds.Top := y-t.r else
            if y+t.r > Bounds.Bottom then Bounds.Bottom := y+t.r;
            subt.x := x;
            subt.y := y;
            dofor(subt,x,y);
          end;
          angle := angle + divs;
        end;
      end;
    end;
  end;
begin
  Screen.Cursor := crHourGlass;
  angle := 0;
  distance := 1;
  maxRef := 0;
  globalAngle := 0;
  try
    conn := CoConnection.Create;
    conn.CursorLocation := adUseServer;
    conn.ConnectionTimeout := 0;
    conn.Open(connectionString,'','',0);

    cmd := CoCommand.Create;
    cmd.Set_ActiveConnection(conn);
    cmd.CommandType := adCmdStoredProc;
    cmd.CommandText := 'getLinks';
    cmd.CommandTimeout := 0;

    params := EmptyParam;
    rs := CoRecordSet.Create;
    rs.Open(cmd,EmptyParam,adOpenForwardOnly,adLockReadOnly,0);
    v := rs.GetRows(-1,EmptyParam,EmptyParam);
    rs.Close;

    cmd := CoCommand.Create;
    cmd.Set_ActiveConnection(conn);
    cmd.CommandType := adCmdStoredProc;
    cmd.CommandText := 'getTitleById';
    cmd.Prepared := true;
    cmd.Parameters.Append(cmd.CreateParameter('',adInteger,adParamInput,4,0));
    cmd.Parameters.Append(cmd.CreateParameter('',adVarChar,adParamOutput,50,''));

    maxLinks := VarArrayHighBound(v,2);
    // maxLinks := 20;

    pb.Max := maxLinks;
    for n:=0 to maxLinks do begin
      if n mod 1000 = 0 then pb.Position := n;
      id := v[0,n];
      src := getTitle(id);
      if src.title = '' then src.title := v[2,n];
      id := v[1,n];
      dst := getTitle(id);
      if dst.title = '' then dst.title := v[3,n];
      src.SubTitles.Add(dst);
      dst.referers := dst.Referers + 1;
      if dst.referers > maxRef then maxRef := dst.referers;
    end;
//    titles.Sort(mysort);
//    saveCache;
//    loadCache;

    Bounds := Rect(0,0,0,0);
    globalDivs := PI/50;
    for n:=0 to titles.Count-1 do
      with TTitle(titles[n]) do if (x=0) and (y=0) then begin
        globalX := Trunc(((n+Random(40)) * cos(globalAngle)));
        globalY := Trunc(((n+Random(40)) * sin(globalAngle)));
        dofor(titles[n],globalX,globalY);
        globalAngle := globalAngle + globalDivs;
      end;
//    dofor(titles[0],0,0);
(*
    bmp.Width := Bounds.Right-Bounds.Left;
    bmp.Height := Bounds.Bottom-Bounds.Top;
    *)
    UniverseBounds := Bounds;
    drawScreen;
  finally
    Screen.Cursor := crDefault;
  end;
end;

function TfMain.getTitle(id: integer): TTitle;
var
  n:integer;
begin
  for n:=0 to titles.Count-1 do begin
    Result := TTitle(titles[n]);
    if Result.id = id then exit;
  end;
  Result := TTitle.Create;
  Result.id := id;
  titles.Add(Result);
end;

procedure TfMain.iMainMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  dragging := true;
  dragx := X+scrollx;
  dragy := Y+scrolly;
end;

procedure TfMain.iMainMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if [ssLeft]=Shift then begin
    if dragging then begin
      scrollx := dragx-X;
      scrolly := dragy-Y;
    end;
  end else if [ssRight]=Shift then begin
    scrollx := 0;
    scrolly := 0;
    drawScreen;
  end;
end;

procedure TfMain.iMainMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; mX, mY: Integer);
var
  n:integer;
  t:TTitle;
  dx,dy,cx,cy:integer;
  P:TPoint;
begin
  dragging := false;
  Screen.Cursor := crHourGlass;
  dx := (iMain.Picture.Bitmap.Width div 2)-scrollx;
  dy := (iMain.Picture.Bitmap.Height div 2)-scrolly;
  try
    for n:=0 to Titles.Count-1 do begin
      t := Titles[n];
      cx := t.x+dx;
      cy := t.y+dy;
      P := Point(mX,mY);
      with P do begin
        if (X >= (cx-t.r)) and (X <= (cx+t.r)) and (Y >= cy-t.r) and (Y <= cy+t.r) then begin
          t.showCaption := not t.showCaption;
          break;
        end;
      end;
    end;
  finally
    drawScreen;
    Screen.Cursor := crDefault;
  end;
end;

procedure TfMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case char(Key) of
    'Q' :
    begin
      scrollx := UniverseBounds.Left;
      scrolly := UniverseBounds.Top;
    end;
    'W' :
    begin
      scrollx := 0;
      scrolly := UniverseBounds.Top;
    end;
    'E' :
    begin
      scrollx := UniverseBounds.Right;
      scrolly := UniverseBounds.Top;
    end;
    'A' :
    begin
      scrollx := UniverseBounds.Left;
      scrolly := 0;
    end;
    'S' :
    begin
      scrollx := 0;
      scrolly := 0;
    end;
    'D' :
    begin
      scrollx := UniverseBounds.Right;
      scrolly := 0;
    end;
    'Z' :
    begin
      scrollx := UniverseBounds.Left;
      scrolly := UniverseBounds.Bottom;
    end;
    'X' :
    begin
      scrollx := 0;
      scrolly := UniverseBounds.Bottom;
    end;
    'C' :
    begin
      scrollx := UniverseBounds.Right;
      scrolly := UniverseBounds.Bottom;
    end;
    else exit;
  end;
  drawScreen;
  Key := 0;
end;

procedure TfMain.printButtonClick(Sender: TObject);
begin
  Printer.BeginDoc;
  drawPrinter;
  Printer.EndDoc;
end;

procedure TfMain.setupButtonClick(Sender: TObject);
begin
  printDialog.Execute;
end;

procedure TfMain.FormResize(Sender: TObject);
begin
  iMain.Picture.Bitmap.Width := iMain.Width;
  iMain.Picture.Bitmap.Height := iMain.Height;
  drawScreen;
end;

end.