unit UStructogramForm;

Windows,

Classes,

Controls,

ExtCtrls,

Forms,

Graphics,

ComCtrls,

Menus,

StdCtrls,

System.ImageList,

Vcl.ImgList,

Vcl.ToolWin,

Vcl.BaseImageCollection,

Vcl.VirtualImageList,

Vcl.VirtualImage,

SVGIconImageCollection,

TB2Item,

SpTBXItem,

UTypes,

UBaseForm;

TFStructogram = class(TFForm)

ScrollBox: TScrollBox;

PanelLeft: TPanel;

ToolBarStructogram: TToolBar;

TBClose: TToolButton;

TBStatement: TToolButton;

TBIf: TToolButton;

TBSwitch: TToolButton;

TBwhile: TToolButton;

TBDoWhile: TToolButton;

TBFor: TToolButton;

TBSubProgram: TToolButton;

TBBreak: TToolButton;

TBAlgorithm: TToolButton;

TBGenerateJava: TToolButton;

TBZoomOut: TToolButton;

TBZoomIn: TToolButton;

TBPuzzleMode: TToolButton;

icStructogram: TSVGIconImageCollection;

vilToolbarLight: TVirtualImageList;

vilToolbarDark: TVirtualImageList;

TrashImage: TVirtualImage;

vilPopupMenuLight: TVirtualImageList;

vilPopupMenuDark: TVirtualImageList;

StructoPopupMenu: TSpTBXPopupMenu;

MIAddCase: TSpTBXItem;

MISwitchWithCaseLine: TSpTBXItem;

MICopy: TSpTBXItem;

MIDelete: TSpTBXItem;

MIDeleteCase: TSpTBXItem;

SpTBXSeparatorItem1: TSpTBXSeparatorItem;

MIGenerateMethod: TSpTBXItem;

MIGenerateProgram: TSpTBXItem;

MIDataType: TSpTBXSubmenuItem;

SpTBXSeparatorItem2: TSpTBXSeparatorItem;

MICopyAsPicture: TSpTBXItem;

MIPuzzleMode: TSpTBXItem;

MIFont: TSpTBXItem;

MIConfiguration: TSpTBXItem;

MIBoolean: TSpTBXItem;

MIString: TSpTBXItem;

MIInt: TSpTBXItem;

MIFloat: TSpTBXItem;

MIDouble: TSpTBXItem;

MIChar: TSpTBXItem;

procedure FormCreate(Sender: TObject);

procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

procedure FormKeyPress(Sender: TObject; var Key: Char);

procedure FormClose(Sender: TObject; var Action: TCloseAction); override;

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

// used by buttons

procedure StrElementMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ImageDblClick(Sender: TObject);

procedure ImageMouseMove(Sender: TObject; Shift: TShiftState;

XPos, YPos: Integer);

procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; XPos, YPos: Integer);

procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; XPos, YPos: Integer);

procedure ScrollBoxClick(Sender: TObject);

procedure ScrollBoxMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

procedure MICopyAsPictureClick(Sender: TObject);

procedure MIDatatypeClick(Sender: TObject);

procedure StructoPopupMenuPopup(Sender: TObject);

procedure EditMemoChange(Sender: TObject);

procedure MIGenerateMethodClick(Sender: TObject);

procedure MIGenerateProgramClick(Sender: TObject);

procedure MIFontClick(Sender: TObject);

procedure MISwitchWithCaseLineClick(Sender: TObject);

procedure MIAddCaseClick(Sender: TObject);

procedure MIDeleteCaseClick(Sender: TObject);

procedure MIDeleteClick(Sender: TObject);

procedure MIPuzzleClick(Sender: TObject);

procedure MICopyClick(Sender: TObject);

procedure BBGenerateJavaClick(Sender: TObject);

procedure BBCloseClick(Sender: TObject);

procedure BBZoomOutClick(Sender: TObject);

procedure BBZoomInClick(Sender: TObject);

procedure BBPuzzleClick(Sender: TObject);

procedure MIConfigurationClick(Sender: TObject);

private

FEditMemo: TMemo;

FOldShape: TRect;

FOldCanvas: TCanvas;

FCurElement: TStrElement;

FCurList: TStrList;

FEditMemoElement: TStrElement;

FEditMemoBeginText: string;

FCurInsert: Integer;

FIsMoving: Boolean;

FReadOnly: Boolean;

FMousePos: TPoint;

FScreenMousePos: TPoint;

FDataType: string;

FVariables: string;

FIgnoreNextMouseDown: Boolean;

FIgnoreNextMouseUp: Boolean;

FSeparating: Integer;

FPuzzleMode: Integer;

FSolution: string;

FVersion: Byte;

procedure ShowShape;

procedure HideShape;

procedure AddParameter(List: TStrList; ParamList: TStringList);

procedure AddVariable(AText: string; List: TStringList);

procedure StrElementToJava(Element: TStrElement;

PList, VariablesList: TStringList; const Indent: string);

function FindElement(Current: TStrElement; X, Y: Integer): TStrElement;

function FindVisibleElement(Current: TStrElement; X, Y: Integer)

: TStrElement;

function BeforeOrAfter(Current: TStrElement): Boolean;

function GetParentElement(Element: TStrElement): TStrElement;

function GetToken(var Str: string; var Token: string): Integer;

procedure CalculateInsertionShape(DestList, InsertList: TStrList;

YPos: Integer);

procedure InsertElement(DestList, InsertList: TStrList;

ACurElement: TStrElement);

procedure SetEvents(Image: TListImage);

procedure DoEdit(StrElement: TStrElement; const Str: string);

procedure CloseEdit;

procedure SetLeftBorderForEditMemo;

function GetAlgorithmParameter(ParamList: TStringList): string;

procedure JavaProgram(List: TStrList; ProgList: TStringList;

const AName: string);

function GetAlgorithm: TStrAlgorithm;

function GetList: TStrList;

function GetListAtScreenPos(Point: TPoint): TStrList;

function GetCurList: Boolean;

function GetCurListAndCurElement: Boolean;

function GetStructogramAsBitmap: TBitmap;

function GetName(StrList: TStrList): string;

procedure PaintAll;

function FitsIn(ACurList: TStrList; ACurElement: TStrElement): Boolean;

procedure SetPuzzleMode(Mode: Integer);

procedure MakeVeryHard;

function StringFromStream(Stream: TStream): string;

function IntegerFromStream(Stream: TStream): Integer;

protected

function LoadFromFile(const FileName: string): Boolean;

function LoadFromFileOld(const FileName: string): Boolean;

procedure SaveToFile(const FileName: string);

procedure UpdateState; override;

public

constructor Create(AOwner: TComponent); override;

procedure New;

function Open(const Pathname: string): Boolean;

procedure Save(WithBackup: Boolean); override;

procedure Print; override;

procedure GenerateFromText(const Text: string);

procedure RenewFromText(const Text: string);

function GetFormType: string; override;

function GetSaveAsName: string; override;

procedure SetOptions; override;

procedure CutToClipboard; override;

procedure CopyToClipboard; override;

procedure PasteFromClipboard; override;

procedure SetFont(AFont: TFont); override;

procedure Enter(Sender: TObject); override;

procedure DoExport; override;

procedure ChangeStyle; override;

procedure DPIChanged; override;

end;

Messages,

Buttons,

SysUtils,

Math,

Clipbrd,

Dialogs,

Themes,

Types,

UITypes,

IOUtils,

StrUtils,

JvGnugettext,

UStringRessources,

UJava,

UConfiguration,

UUtils,

UGenerateStructogram,

UTemplates;

constructor TFStructogram.Create(AOwner: TComponent);

inherited;

FormTag := 11;

end;

procedure TFStructogram.FormCreate(Sender: TObject);

TranslateComponent(Self);

ToMainPanel;

FOldShape := Rect(-1, -1, -1, -1);

FEditMemo := TMemo.Create(Self);

FEditMemo.Parent := Self;

FEditMemo.SetBounds(136, 156, 99, 37);

FEditMemo.Color := StyleServices.GetSystemColor(clSkyBlue);

FEditMemo.OnChange := EditMemoChange;

FEditMemo.Visible := False;

FEditMemo.WordWrap := False;

FEditMemo.BevelInner := bvNone;

OnMouseActivate := FormMouseActivate;

Font.Assign(FConfiguration.StructogramFont);

ScrollBox.DoubleBuffered := True;

FSeparating := 0;

FPuzzleMode := 0;

TBPuzzleMode.Visible := False;

ToolBarStructogram.Height := 308 - 22;

FVersion := $0E;

FCurList := nil;

FCurElement := nil;

UpdateState;

SetOptions;

end;

procedure TFStructogram.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

if Modified and not AlreadySavedAs then

begin

FJava.DoSave(Self, True);

AlreadySavedAs := True;

end;

CanClose := True;

end;

procedure TFStructogram.FormClose(Sender: TObject; var Action: TCloseAction);

inherited;

for var I := ScrollBox.ControlCount - 1 downto 0 do

TListImage(ScrollBox.Controls[I]).StrList.Destroy;

Action := caFree;

end;

procedure TFStructogram.New;

var Elem: TStrElement; StrList: TStrAlgorithm;

if Pathname = '' then

Pathname := FJava.GetFilename('.jsg');

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font);

StrList.Text := FConfiguration.Algorithm + ' ' +

ChangeFileExt(ExtractFileName(Pathname), '');

Elem := TStrStatement.Create(StrList);

StrList.Insert(StrList, Elem);

SetEvents(StrList.ListImage);

StrList.ResizeAll;

StrList.Paint;

Modified := False;

Enter(Self); // must stay!

if CanFocus then

SetFocus;

Caption := Pathname;

FJava.AddToWindowMenuAndTabBar(Number, OpenWindow, Self);

end;

procedure TFStructogram.GenerateFromText(const Text: string);

var Generator: TGenerateStructogram; StrList: TStrAlgorithm;

if Pathname = '' then

Pathname := FJava.GetFilename('.jsg');

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font);

StrList.Text := FConfiguration.Algorithm + ' ';

Generator := TGenerateStructogram.Create(True);

Generator.GenerateStructogram(Text, StrList);

FreeAndNil(Generator);

SetEvents(StrList.ListImage);

StrList.ResizeAll;

StrList.Paint;

Save(False);

Enter(Self); // must stay!

if CanFocus then

SetFocus;

Caption := Pathname;

FJava.AddToWindowMenuAndTabBar(Number, OpenWindow, Self);

end;

procedure TFStructogram.RenewFromText(const Text: string);

var Generator: TGenerateStructogram; StrList: TStrList; Algorithm: string;

for var I := ScrollBox.ControlCount - 1 downto 0 do

begin

StrList := TListImage(ScrollBox.Controls[I]).StrList;

if StrList is TStrAlgorithm then

Algorithm := StrList.Text;

FreeAndNil(StrList);

end;

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font);

StrList.Text := Algorithm;

SetEvents(StrList.ListImage);

StrList.Text := FConfiguration.Algorithm + ' ';

Generator := TGenerateStructogram.Create(True);

Generator.GenerateStructogram(Text, StrList);

FreeAndNil(Generator);

StrList.ResizeAll;

StrList.Paint;

Save(False);

Enter(Self); // must stay!

if CanFocus then

SetFocus;

end;

function TFStructogram.Open(const Pathname: string): Boolean;

CloseEdit;

Result := LoadFromFile(Pathname);

if Result then

begin

Self.Pathname := Pathname;

Caption := Pathname;

FJava.AddToWindowMenuAndTabBar(Number, OpenWindow, Self);

Modified := False;

Enter(Self); // must stay!

if CanFocus then

SetFocus;

FReadOnly := IsWriteProtected(Pathname);

UpdateState;

end;

end;

procedure TFStructogram.Enter(Sender: TObject);

inherited;

if ToolBarStructogram.Visible and ToolBarStructogram.CanFocus then

ToolBarStructogram.SetFocus;

end;

function TFStructogram.LoadFromFile(const FileName: string): Boolean;

var StrList: TStrList; SwitchWithCaseLine: Boolean; Reader: TStringListReader;

procedure Init(List: TStrList);

begin

List.SwitchWithCaseLine := SwitchWithCaseLine;

List.SetPuzzleMode(FPuzzleMode);

List.SetFont(Font);

List.SetLineHeight;

SetEvents(List.ListImage);

List.ResizeAll;

List.Paint;

end;

Result := True;

Reader := TStringListReader.Create(FileName);

try

try

if Reader.HasOldFormat then

Result:= LoadFromFileOld(FileName)

else

begin

repeat

Reader.ReadLine;

if Reader.Key = 'FontName' then

Font.Name := Reader.Val

else if Reader.Key = 'FontSize' then

Font.Size := PPIScale(StrToInt(Reader.Val))

else if Reader.Key = 'FontColor' then

Font.Color := StrToInt(Reader.Val)

else if Reader.Key = 'FontBold' then

if Reader.Val = 'true' then

Font.Style := Font.Style + [fsBold]

else

Font.Style := Font.Style - [fsBold]

else if Reader.Key = 'FontItalic' then

if Reader.Val = 'true' then

Font.Style := Font.Style + [fsItalic]

else

Font.Style := Font.Style - [fsItalic]

else if Reader.Key = 'PuzzleMode' then

FPuzzleMode := StrToInt(Reader.Val)

else if Reader.Key = 'Solution' then

FSolution := UnHideCrLf(Reader.Val);

until (Reader.Key = '- Kind') or (Reader.Key = '');

while (Reader.Key = '- Kind') and Result do

begin

if Reader.Val = 'Algorithm' then

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font)

else

StrList := TStrList.Create(ScrollBox, FPuzzleMode, Font);

Reader.ReadLine;

if Reader.Key = 'SwitchWithCaseLine' then

SwitchWithCaseLine := (Reader.Val = 'true')

else

Reader.LineBack;

StrList.LoadFromReader(Reader);

Init(StrList);

Result := Result and not StrList.LoadError;

Reader.ReadLine;

end;

Result := True;

end;

except

on E: Exception do

ErrorMsg(E.Message);

end;

finally

FreeAndNil(Reader);

end;

FVersion := $0F;

end;

function TFStructogram.LoadFromFileOld(const FileName: string): Boolean;

var SigName: ShortString; FontName: ShortString; Style: Byte;

Stream: TFileStream; LeftMargin, TopMargin, Zoomfactor: SmallInt; Kind: Byte;

StrList: TStrList; StructogramAligned: Boolean; SwitchWithCaseLine: Boolean;

procedure Init(List: TStrList);

begin

List.SwitchWithCaseLine := SwitchWithCaseLine;

List.ListImage.Left := LeftMargin;

List.ListImage.Top := TopMargin;

List.SetPuzzleMode(FPuzzleMode);

List.SetFont(Font);

List.SetLineHeight;

SetEvents(List.ListImage);

List.ResizeAll;

List.Paint;

end;

Result := False;

Stream := TFileStream.Create(FileName, fmOpenRead);

try

try

Stream.Read(SigName, 4); { read signature }

if not((SigName = 'JSG') or (SigName = 'NSD')) then

ErrorMsg(_('Invalid file format!'))

else

begin

Stream.Read(FVersion, 1); { read FVersion }

if $0E <= FVersion then

begin

Stream.Read(FPuzzleMode, 1);

SetPuzzleMode(FPuzzleMode);

FSolution := StringFromStream(Stream);

Font.Name := StringFromStream(Stream);

if Font.Name = 'Arial' then

Font.Name := 'Segoe UI';

end;

if $0C = FVersion then

begin

Stream.Read(StructogramAligned, 1);

Stream.Read(SwitchWithCaseLine, 1);

end;

if ($0B <= FVersion) and (FVersion <= $0C) then

begin

Stream.Read(LeftMargin, 2); { read left margin }

Stream.Read(TopMargin, 2); { read top margin }

Stream.Read(Zoomfactor, 2); { read zoom factor }

end;

if ($0A <= FVersion) and (FVersion < $0E) then

begin

Stream.Read(FontName[0], 1);

Stream.Read(FontName[1], Ord(FontName[0])); { read font name }

Font.Name := string(FontName);

if Font.Name = 'Arial' then

Font.Name := 'Segoe UI';

end;

if ($0A <= FVersion) then

begin

Font.Size := IntegerFromStream(Stream);

Stream.Read(Style, 1);

Font.Style := [];

if (Style and $01) > 0 then

Font.Style := Font.Style + [fsBold];

if (Style and $02) > 0 then

Font.Style := Font.Style + [fsItalic];

Font.Color := IntegerFromStream(Stream);

if FVersion < $0D then

begin

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font);

StrList.LoadFromStream(Stream, FVersion);

Init(StrList);

Result := Result and not StrList.LoadError;

end

else

while (Stream.Read(Kind, 1) = 1) and Result do

begin

if Kind = Byte(nsAlgorithm) then

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font)

else

StrList := TStrList.Create(ScrollBox, FPuzzleMode, Font);

Stream.Read(SwitchWithCaseLine, 1);

Stream.Read(LeftMargin, 2);

Stream.Read(TopMargin, 2);

StrList.LoadFromStream(Stream, FVersion);

Init(StrList);

Result := Result and not StrList.LoadError;

end;

end;

Result := True;

end;

except

on E: Exception do

ErrorMsg(E.Message);

end;

finally

FreeAndNil(Stream);

end;

FVersion := $0E;

end;

procedure TFStructogram.SaveToFile(const FileName: string);

var Lines: TStringList; AList: TStrList;

Lines := TStringList.Create;

try

try

Lines.Add('JSG: true');

if Font.Name = 'Arial' then

Font.Name := 'Segoe UI';

Lines.Add('FontName: ' + Font.Name);

Lines.Add('FontSize: ' + IntToStr(PPIUnScale(Font.Size)));

if fsBold in Font.Style then

Lines.Add('FontBold: true');

if fsItalic in Font.Style then

Lines.Add('FontItalic: true');

Lines.Add('FontColor: ' + IntToStr(Font.Color));

if FPuzzleMode > 0 then

begin

Lines.Add('PuzzleMode: ' + IntToStr(FPuzzleMode));

Lines.Add('Solution: ' + HideCrLf(FSolution));

end;

for var I := 0 to ScrollBox.ControlCount - 1 do

begin

AList := TListImage(ScrollBox.Controls[I]).StrList;

Lines.Add('- Kind: ' + AList.GetKind);

Lines.Add(' SwitchWithCaseLine: ' +

BoolToStr(AList.SwitchWithCaseLine, True));

Lines.Add(' RectPos' + AList.GetRectPos);

Lines.Add(AList.GetText(' '));

end;

Lines.SaveToFile(FileName, TEncoding.UTF8);

except

on E: Exception do

ErrorMsg(E.Message);

end;

finally

Lines.Free;

end;

end;

function TFStructogram.StringFromStream(Stream: TStream): string;

var Size: LongInt;

Stream.Read(Size, SizeOf(Size));

SetLength(Result, Size div SizeOf(Char));

Stream.Read(Pointer(Result)^, Size);

end;

function TFStructogram.IntegerFromStream(Stream: TStream): Integer;

Stream.Read(Result, SizeOf(Integer));

end;

procedure TFStructogram.ShowShape;

with FOldShape do

begin

FOldCanvas.Pen.Color := clRed;

if Top = Bottom then

begin

FOldCanvas.MoveTo(Left + 1, Top - 2);

FOldCanvas.LineTo(Right, Top - 2);

FOldCanvas.MoveTo(Left + 1, Top - 1);

FOldCanvas.LineTo(Right, Top - 1);

FOldCanvas.MoveTo(Left + 1, Top + 1);

FOldCanvas.LineTo(Right, Top + 1);

FOldCanvas.MoveTo(Left + 1, Top + 2);

FOldCanvas.LineTo(Right, Top + 2);

end

else

begin

FOldCanvas.MoveTo(Left, Top);

FOldCanvas.LineTo(Right, Top);

FOldCanvas.LineTo(Right, Bottom);

FOldCanvas.LineTo(Left, Bottom);

FOldCanvas.LineTo(Left, Top);

FOldCanvas.MoveTo(Left + 1, Top + 1);

FOldCanvas.LineTo(Right - 1, Top + 1);

FOldCanvas.LineTo(Right - 1, Bottom - 1);

FOldCanvas.LineTo(Left + 1, Bottom - 1);

FOldCanvas.LineTo(Left + 1, Top + 1);

end;

end;

end;

procedure TFStructogram.HideShape;

if FOldShape.Top > -1 then

begin

with FOldShape do

begin

FOldCanvas.Pen.Color := StyleServices.GetStyleColor(scPanel);

if Top = Bottom then

begin

FOldCanvas.MoveTo(Left + 1, Top - 2);

FOldCanvas.LineTo(Right, Top - 2);

FOldCanvas.MoveTo(Left + 1, Top - 1);

FOldCanvas.LineTo(Right, Top - 1);

FOldCanvas.MoveTo(Left + 1, Top + 1);

FOldCanvas.LineTo(Right, Top + 1);

FOldCanvas.MoveTo(Left + 1, Top + 2);

FOldCanvas.LineTo(Right, Top + 2);

end

else

begin

FOldCanvas.MoveTo(Left, Top);

FOldCanvas.LineTo(Right, Top);

FOldCanvas.LineTo(Right, Bottom);

FOldCanvas.LineTo(Left, Bottom);

FOldCanvas.LineTo(Left, Top);

FOldCanvas.MoveTo(Left + 1, Top + 1);

FOldCanvas.LineTo(Right - 1, Top + 1);

FOldCanvas.LineTo(Right - 1, Bottom - 1);

FOldCanvas.LineTo(Left + 1, Bottom - 1);

FOldCanvas.LineTo(Left + 1, Top + 1);

end;

end;

FOldShape := Rect(-1, -1, -1, -1);

PaintAll;

end;

end;

procedure TFStructogram.StrElementMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var StrList: TStrList; Element: TStrElement; PtScreen, PtClient: TPoint;

if Button = mbLeft then

begin

CloseEdit;

if TSpeedButton(Sender).Tag = 0 then

StrList := TStrAlgorithm.Create(ScrollBox, FPuzzleMode, Font)

else

StrList := TStrList.Create(ScrollBox, FPuzzleMode, Font);

Element := nil;

case TSpeedButton(Sender).Tag of

Ord(nsAlgorithm):

begin

Element := TStrStatement.Create(StrList);

StrList.Text := FConfiguration.Algorithm + ' ';

end;

Ord(nsStatement):

Element := TStrStatement.Create(StrList);

Ord(nsIf):

Element := TStrIf.Create(StrList);

Ord(nsWhile):

begin

Element := TStrWhile.Create(StrList);

Element.Text := FConfiguration._While + ' ';

end;

Ord(nsDoWhile):

begin

Element := TStrDoWhile.Create(StrList);

Element.Text := FConfiguration.DoWhile + ' ';

end;

Ord(nsFor):

begin

Element := TStrFor.Create(StrList);

Element.Text := ReplaceStr(ReplaceStr(FConfiguration._For, '[', ''),

']', '') + ' ';

end;

Ord(nsSwitch):

Element := TStrSwitch.Create(StrList);

Ord(nsSubProgram):

Element := TStrSubprogram.Create(StrList);

Ord(nsBreak):

Element := TStrBreak.Create(StrList);

end;

StrList.Insert(StrList, Element);

StrList.SetFont(Font);

StrList.ResizeAll;

PtScreen := TToolButton(Sender).ClientToScreen(Point(X, Y));

PtClient := ToolBarStructogram.ScreenToClient(PtScreen);

StrList.ListImage.SetBounds(PtClient.X - StrList.RctList.Width div 2,

PtClient.Y - StrList.LineHeight div 2, StrList.RctList.Width,

StrList.RctList.Height);

SetEvents(StrList.ListImage);

StrList.Paint;

mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);

if TSpeedButton(Sender).Tag = Ord(nsDoWhile) then

SetCursorPos(Mouse.CursorPos.X + 30, Mouse.CursorPos.Y +

StrList.LineHeight)

else

SetCursorPos(Mouse.CursorPos.X + 30, Mouse.CursorPos.Y);

mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);

end;

end;

procedure TFStructogram.ImageDblClick(Sender: TObject);

FCurList := TListImage(Sender).StrList;

FCurElement := FindVisibleElement(FCurList, FMousePos.X, FMousePos.Y);

DoEdit(FCurElement, '');

FIgnoreNextMouseDown := True;

end;

procedure TFStructogram.ImageMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; XPos, YPos: Integer);

if FIgnoreNextMouseDown then

begin

FIgnoreNextMouseDown := False;

Exit;

end;

if FIsMoving then

Exit;

var

Image := TListImage(Sender);

Image.BringToFront;

FCurList := Image.StrList;

FMousePos := Point(XPos, YPos);

FScreenMousePos := Image.ClientToScreen(Point(XPos, YPos));

if FEditMemo.Visible then

CloseEdit;

FCurElement := FindVisibleElement(FCurList, FMousePos.X, FMousePos.Y);

if (FSeparating = 0) and Assigned(FCurElement) and Assigned(FCurElement.Prev)

then

if (FCurElement.Prev is TStrAlgorithm) or

not((FCurElement.Prev is TStrList) or (FCurElement is TStrCase)) then

FSeparating := 1;

UpdateState;

end;

procedure TFStructogram.ImageMouseMove(Sender: TObject; Shift: TShiftState;

XPos, YPos: Integer);

var ScrollBoxPt, Image2Pt, ScreenPt: TPoint;

DeltaX, DeltaY, DeltaX1, DeltaY1: Integer; Image, Image2: TListImage;

StrList: TStrList; StrStatement: TStrStatement; ARect: TRect;

HideShape;

if FEditMemo.Visible then

Exit;

if ssLeft in Shift then

begin

Image := TListImage(Sender);

FCurList := Image.StrList;

// start moving

ScreenPt := Image.ClientToScreen(Point(XPos, YPos));

ScrollBoxPt := ScrollBox.ScreenToClient(ScreenPt);

DeltaX := ScreenPt.X - FScreenMousePos.X;

DeltaY := ScreenPt.Y - FScreenMousePos.Y;

if (DeltaX = 0) and (DeltaY = 0) then

Exit;

if (Abs(DeltaX) + Abs(DeltaY) > 5) or FIsMoving then

begin // move Image

FIsMoving := True;

Modified := True;

FScreenMousePos := ScreenPt;

FCurElement := FindVisibleElement(FCurList, XPos - DeltaX, YPos - DeltaY);

if Assigned(FCurElement) and (FSeparating = 1) then

begin

DeltaX1 := XPos - FCurElement.Rct.Left;

DeltaY1 := YPos - FCurElement.Rct.Top;

if FCurElement.Prev = nil then

Exit;

ARect := FCurElement.Rct;

if (FCurElement.Prev is TStrListHead) or (FCurElement.Prev is TStrCase)

or (FPuzzleMode = 1) then

begin

StrStatement := TStrStatement.Create(FCurList);

StrStatement.Rct := FCurElement.Rct;

FCurList.Insert(FCurElement.Prev, StrStatement);

end;

if FPuzzleMode = 1 then

begin // handle single statements, no lists

FCurElement.Prev.Next := FCurElement.Next;

if Assigned(FCurElement.Next) then

FCurElement.Next.Prev := FCurElement.Prev;

FCurElement.Prev := nil;

FCurElement.Next := nil;

end

else

begin

FCurElement.Prev.Next := nil;

FCurElement.Prev := nil;

end;

FCurList.ResizeAll;

FCurList.Paint;

// create new List

StrList := TStrList.Create(ScrollBox, FPuzzleMode, Font);

StrList.SetFont(Font);

StrList.Insert(StrList, FCurElement);

StrList.SetList(StrList);

SetEvents(StrList.ListImage);

StrList.ResizeAll;

var

Rect := StrList.RctList;

Rect.Right := Max(ARect.Right - ARect.Left, StrList.RctList.Right);

Rect.Bottom := Max(ARect.Bottom - ARect.Top, StrList.RctList.Bottom);

StrList.RctList := Rect;

StrList.Rct := StrList.RctList;

StrList.ListImage.Left := Image.Left + ARect.Left + DeltaY;

StrList.ListImage.Top := Image.Top + ARect.Top + DeltaX;

StrList.Paint;

FSeparating := 2;

FCurList.DontMove := True;

FIgnoreNextMouseUp := True;

FIsMoving := False;

ScreenPt := StrList.ListImage.ClientToScreen(Point(DeltaX1, DeltaY1));

SetCursorPos(ScreenPt.X, ScreenPt.Y);

mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);

mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);

FCurList := StrList;

end

else

begin

// crucial for switching mouse to new image

Image.SetBounds(Image.Left + DeltaX, Image.Top + DeltaY, Image.Width,

Image.Height);

if FCurList.DontMove then

begin

Image.SetBounds(Image.Left - DeltaX, Image.Top - DeltaY, Image.Width,

Image.Height);

FCurList.DontMove := False;

end;

if FCurList.Kind <> Byte(nsAlgorithm) then

begin

for var I := ScrollBox.ControlCount - 1 downto 0 do

begin

Image2 := TListImage(ScrollBox.Controls[I]);

if Image2 <> Image then

begin

ARect := Image2.BoundsRect;

ARect.Inflate(20, 20);

if ARect.Contains(ScrollBoxPt) then

begin

Image2Pt := Image2.ScreenToClient(ScreenPt);

FCurElement := FindElement(Image2.StrList, Image2Pt.X,

Image2Pt.Y);

CalculateInsertionShape(Image2.StrList, FCurList, Image2Pt.Y);

end;

end;

end;

end;

end;

end;

end;

end;

procedure TFStructogram.CalculateInsertionShape(DestList, InsertList: TStrList;

YPos: Integer);

// FCurElement.debug()

if not Assigned(FCurElement) then

Exit;

with FCurElement do

if not EqualRect(FOldShape, Rect(Rct.Bottom, Rct.Left, Rct.Bottom,

Rct.Right)) then

begin

if BeforeOrAfter(FCurElement) then

begin

if YPos < FCurElement.Rct.Top + FCurElement.GetMaxDelta then

begin

FOldShape := Rect(Rct.Left, Rct.Top, Rct.Right, Rct.Top);

FCurInsert := -1; // Insert before

end

else if YPos > FCurElement.Rct.Bottom - FCurElement.GetMaxDelta then

begin

if FCurElement = List then

FOldShape := Rect(Rct.Left, Rct.Bottom, List.RctList.Right,

Rct.Bottom)

else

FOldShape := Rect(Rct.Left, Rct.Bottom, Rct.Right, Rct.Bottom);

FCurInsert := +1; // Insert after

end;

end

else

begin

var

DeltaY := (FCurElement.Rct.Bottom - FCurElement.Rct.Top) div 4;

if YPos < FCurElement.Rct.Top + DeltaY then

begin

FOldShape := Rect(Rct.Left, Rct.Top, Rct.Right, Rct.Top);

FCurInsert := -1;

end

else if YPos < FCurElement.Rct.Bottom - DeltaY then

begin

FOldShape := Rect(Rct.Left + 1, Rct.Top + 1, Rct.Right - 1,

Rct.Bottom - 1);

FCurInsert := 0;

end

else

begin

FOldShape := Rect(Rct.Left, Rct.Bottom, Rct.Right, Rct.Bottom);

FCurInsert := +1;

end;

end;

FOldCanvas := DestList.ListImage.Canvas;

if FitsIn(InsertList, FCurElement) then

begin

ShowShape;

DestList.Dirty := True;

end;

end;

end;

procedure TFStructogram.ImageMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; XPos, YPos: Integer);

var ScreenPt, QPoint, ScrollBoxPt, Image2Pt: TPoint; Image, Image2: TListImage;

StrList: TStrList; ARect: TRect;

FIsMoving := False;

Image := TListImage(Sender);

StrList := Image.StrList;

if FIgnoreNextMouseUp then

begin

FIgnoreNextMouseUp := False;

Exit;

end;

ARect := StrList.RctList;

StrList.ResizeAll;

if ARect <> StrList.RctList then

StrList.Paint;

if StrList.Kind in [Byte(nsAlgorithm), Byte(nsList)] then

begin

ScreenPt := Image.ClientToScreen(Point(XPos, YPos));

QPoint := Self.ScreenToClient(ScreenPt);

if QPoint.X < ScrollBox.Left then

begin

FreeAndNil(StrList);

Exit;

end;

if QPoint.Y < ScrollBox.Top then

Image.Top := 0;

end;

if StrList.Kind = Byte(nsList) then

begin

ScrollBoxPt := ScrollBox.ScreenToClient(ScreenPt);

for var I := ScrollBox.ControlCount - 1 downto 0 do

begin

Image2 := TListImage(ScrollBox.Controls[I]);

ARect := Image2.BoundsRect;

ARect.Inflate(30, 30);

if (Image2 <> Image) and ARect.Contains(ScrollBoxPt) then

begin

Image2Pt := Image2.ScreenToClient(ScreenPt);

FCurElement := FindElement(Image2.StrList, Image2Pt.X, Image2Pt.Y);

if Assigned(FCurElement) and FitsIn(StrList, FCurElement) then

InsertElement(Image2.StrList, StrList, FCurElement);