Редактор блок-схем

[wavebvg]

Перелазал большой количество сайтов, так и ненашёл ничего работающего.
Нажно API для создания блок схем, любой сложности - главное чтобы работало с LCL на LINUX...
Если, вдруг, кто находил, отпишитесь пожалуйста

[B4rr4cuda]

Canvas+[Rectangle,TextOut,MoveTo,LineTo,Draw]?
Я начинал писать что-то похожее, но потом забил.

Код: Выделить всё

unit Templates;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics;

type
     TTemplateProperties=record
                           Name:string;
                           OutDir:string;
                           Size:TRect;
                         end;

     TSuParent=class
                 Coord:TRect;
                 AutoSize:boolean;
               end;

     { Ttemplate }

     Ttemplate = class
                   Constructor Create(TemplateProperty:TTemplateProperties);
                   procedure Free;
                   BmpCanva:TBitmap;
                 private
                   Size:TRect;
                   OutDir:string;
                   Name:string;
                 public
                   function Save:TFilename;
                   Procedure PrintObj(Obj:TSuParent);
                 end;
                 
     TInfer = class(TSuParent)
               Text:String;
               Font:TFont;
              end;

implementation

{ Ttemplate }

constructor Ttemplate.Create(TemplateProperty:TTemplateProperties);
begin
inherited Create;
Name:=TemplateProperty.Name;
OutDir:=TemplateProperty.OutDir;
Size:=TemplateProperty.Size;

BmpCanva:=TBitMap.Create;
BmpCanva.Width:=size.Right-size.Left;
BmpCanva.Height:=size.Bottom-size.Top;
      BmpCanva.Canvas.Brush.Color:=clWhite;
      BmpCanva.Canvas.FillRect(size.Left,size.top,size.Right,size.Bottom);
end;

procedure Ttemplate.Free;
begin
  BmpCanva.Free;

  inherited Free;
end;

function Ttemplate.Save:TFilename;
begin
  if DirectoryExists(OutDir) then
    begin
      if LastDelimiter('\/',OutDir)<>length(OutDir) then
        begin
          {$IFDEF unix}
            OutDir:=OutDir+'/';
          {$ENDIF}
          {$IFDEF MSWINDOWS}
            OutDir:=OutDir+'\';
          {$ENDIF}
        end;
      Result:=OutDir+Name+'.bmp';
      BmpCanva.SaveToFile(OutDir+Name+'.bmp');
    end;
end;

procedure Ttemplate.PrintObj(Obj: TSuParent);
var wcoord:TRect; text:string;
begin
  if not assigned(Obj) then exit;
 
wcoord:=obj.Coord;

  if (Obj is TInfer) then
    begin
    text:=(Obj as TInfer).Text;
   
       if (obj.AutoSize) or ((wcoord.Right=0)or(wcoord.Bottom=0)) then
         begin
           wcoord.Right:=wcoord.Left+BmpCanva.Canvas.TextWidth(text)+8;
           wcoord.Bottom:=wcoord.Top+BmpCanva.Canvas.TextHeight(text)+8;
         end;
      BmpCanva.Canvas.Rectangle(wcoord);
     
      BmpCanva.Canvas.TextOut(wcoord.Left+4,wCoord.Top+4,Text);
    end;

end;

end.

И сэмпл:

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
var tp:TTemplateProperties; TT:Ttemplate;
    ts:TInfer;
begin
  {TEST}
   Tp.Size.Left:=0;
   Tp.Size.Right:=200;
   Tp.Size.Top:=0;
   Tp.Size.Bottom:=200;
   tp.OutDir:='/tmp/';
   tp.Name:='Template1';
   tt:=Ttemplate.Create(tp);

   ts:=TInfer.Create;
   ts.Text:='mmmmmmmmmm';
   ts.Coord.Left:=50;
   ts.Coord.Top:=50;
//   ts.AutoSize:=true;
   ts.Coord.Right:=100;
  ts.Coord.Bottom:=100;
   tt.PrintObj(ts);

Image1.Picture.Bitmap.Assign(tt.BmpCanva);

  {TEST}
   tt.Free;
   ts.free;
end;

[PublicJoke]

Насколька сильна надобность? Спрашиваю так потому, что есть кое-что под Delphi/CLX, но усилия по адаптации под LCL потребуются весьма серьезные, в том числе и с моей стороны, а мне "паровозом" работать особо некогда.

[wavebvg]

Ну надобность найти что-нить в течении 5 месяцев (или написать самому). Посмотрел, что есть под делфи - слишом заморочено, решил сам напишу по примеру B4rr4cuda.

[PublicJoke]

Если передумаете - дайте знать.

[Timid]

Посмотрите на delphikingdom.info, вроде есть проект такой. И даже на стандартных компонентах.