mirror of
https://github.com/moparisthebest/Simba
synced 2024-08-13 16:53:59 -04:00
950bf6cfa9
Fixed a bug in cts 0, made cst 1 20% faster. Only cts 2 left to optimise. (Can be optimised a lot!) git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@94 3f818213-9676-44b0-a9b4-5e4c4e03d09d
160 lines
3.5 KiB
ObjectPascal
160 lines
3.5 KiB
ObjectPascal
unit TestUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Menus, ComCtrls, ExtCtrls, SynEdit, SynHighlighterPas, SynMemo,
|
|
//Client,
|
|
MufasaTypes,
|
|
mmlpsthread,
|
|
mmlthread,
|
|
window, // for the comp picker and selector
|
|
colourpicker,
|
|
windowselector
|
|
;
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
Mufasa_Image_List: TImageList;
|
|
MainMenu1: TMainMenu;
|
|
Memo1: TMemo;
|
|
MenuItemScript: TMenuItem;
|
|
MenuItemRun: TMenuItem;
|
|
SynEdit1: TSynEdit;
|
|
SynFreePascalSyn1: TSynFreePascalSyn;
|
|
ToolBar1: TToolBar;
|
|
TB_Run: TToolButton;
|
|
TB_Pause: TToolButton;
|
|
TB_Stop: TToolButton;
|
|
ToolButton1: TToolButton;
|
|
TB_ReloadPlugins: TToolButton;
|
|
TB_Tray: TToolButton;
|
|
TB_NewTab: TToolButton;
|
|
TB_CloseTab: TToolButton;
|
|
ToolButton4: TToolButton;
|
|
TB_ClearDebug: TToolButton;
|
|
TB_PickColour: TToolButton;
|
|
TB_SelectClient: TToolButton;
|
|
ToolButton8: TToolButton;
|
|
TB_Convert: TToolButton;
|
|
MTrayIcon: TTrayIcon;
|
|
procedure Button1Click(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure MenuItemRunClick(Sender: TObject);
|
|
procedure PickColorEvent(Sender: TObject);
|
|
procedure Selector_DOWN(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure NoTray(Sender: TObject);
|
|
procedure ToTray(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
Window: TMWindow;
|
|
Picker: TMColorPicker;
|
|
Selector: TMWindowSelector;
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
|
|
implementation
|
|
uses
|
|
lclintf,plugins;
|
|
|
|
|
|
|
|
{ TForm1 }
|
|
procedure Run;
|
|
Var
|
|
MMLPSThread : TMMLPSThread;
|
|
|
|
begin
|
|
MMLPSThread := TMMLPSThread.Create(True);
|
|
MMLPSThread.SetPSScript(Form1.SynEdit1.Lines.Text);
|
|
MMLPSThread.SetDebug(Form1.Memo1);
|
|
|
|
// This doesn't actually set the Client's MWindow to the passed window, it
|
|
// only copies the current set window handle.
|
|
MMLPSThread.Client.MWindow.SetWindow(Form1.Window);
|
|
|
|
MMLPSThread.Resume;
|
|
|
|
// sleep(500);
|
|
// MMLPSThread.PSScript.Stop;
|
|
|
|
end;
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
begin;
|
|
Run;
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
Window := TMWindow.Create;
|
|
Picker := TMColorPicker.Create(Window);
|
|
Selector := TMWindowSelector.Create(Window);
|
|
|
|
MainDir:= ExtractFileDir(Application.ExeName);
|
|
PluginsGlob := TMPlugins.Create;
|
|
PluginsGlob.PluginDirs.Add(ExpandFileName(MainDir + DS + '..' + DS + '..'+ DS + 'Plugins'+ DS));
|
|
// SynMemo1.sc
|
|
end;
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
begin
|
|
Selector.Free;
|
|
Picker.Free;
|
|
Window.Free;
|
|
PluginsGlob.Free;
|
|
end;
|
|
|
|
procedure TForm1.MenuItemRunClick(Sender: TObject);
|
|
begin
|
|
Run;
|
|
end;
|
|
|
|
procedure TForm1.PickColorEvent(Sender: TObject);
|
|
var
|
|
c, x, y: Integer;
|
|
begin
|
|
Picker.Pick(c, x, y);
|
|
writeln('Picked colour: ' + inttostr(c) + ' at (' + inttostr(x) + ', ' + inttostr(y) + ')');
|
|
end;
|
|
|
|
procedure TForm1.Selector_DOWN(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
Window.SetTarget(Selector.Drag {$ifdef MSWINDOWS},w_window{$endif});
|
|
writeln('New window: ' + IntToStr(Window.{$ifdef MSWindows}TargetHandle{$else}CurWindow{$ENDIF}));
|
|
end;
|
|
|
|
procedure TForm1.NoTray(Sender: TObject);
|
|
begin
|
|
if Not Form1.IsVisible then
|
|
Form1.Show
|
|
else
|
|
Form1.Hide;
|
|
end;
|
|
|
|
procedure TForm1.ToTray(Sender: TObject);
|
|
begin
|
|
Form1.Hide;
|
|
end;
|
|
|
|
|
|
initialization
|
|
{$I testunit.lrs}
|
|
|
|
end.
|
|
|