mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-04 16:35:15 -05:00
Something to do with crlf..
This commit is contained in:
unknown
parent
11406043f1
commit
419e801b8a
@ -1,357 +1,357 @@
|
||||
{
|
||||
This file is part of the Mufasa Macro Library (MML)
|
||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||
|
||||
MML is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
MML is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
See the file COPYING, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
framescript for the Mufasa Macro Library
|
||||
}
|
||||
unit framescript;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll,
|
||||
mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls;
|
||||
const
|
||||
ecCodeCompletion = ecUserFirst;
|
||||
type
|
||||
TScriptState = (ss_None,ss_Running,ss_Paused,ss_Stopping);
|
||||
{
|
||||
ss_None: Means the script either hasn't been run yet, or it has ended (Succesfully or terminated)
|
||||
ss_Running: Means the script is running as we speak :-)
|
||||
ss_Paused: Means the script is currently in pause modus.
|
||||
ss_Stopping: Means we've asked PS-Script politely to stop the script (next time we press the stop button we won't be that nice).
|
||||
}
|
||||
|
||||
{ TScriptFrame }
|
||||
|
||||
TScriptFrame = class(TFrame)
|
||||
SynEdit: TSynEdit;
|
||||
SynFreePascalSyn1: TSynFreePascalSyn;
|
||||
procedure SynEditChange(Sender: TObject);
|
||||
procedure SynEditDragDrop(Sender, Source: TObject; X, Y: Integer);
|
||||
procedure SynEditDragOver(Sender, Source: TObject; X, Y: Integer;
|
||||
State: TDragState; var Accept: Boolean);
|
||||
procedure SynEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
|
||||
);
|
||||
procedure SynEditProcessCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
procedure SynEditProcessUserCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
procedure SynEditSpecialLineColors(Sender: TObject; Line: integer;
|
||||
var Special: boolean; var FG, BG: TColor);
|
||||
procedure SynEditStatusChange(Sender: TObject; Changes: TSynStatusChanges);
|
||||
private
|
||||
OwnerPage : TPageControl;
|
||||
OwnerSheet : TTabSheet;//The owner TTabsheet -> For title setting
|
||||
public
|
||||
ErrorData : TErrorData; //For threadsafestuff
|
||||
ScriptErrorLine : integer; //Highlight the error line!
|
||||
ScriptFile : string;//The path to the saved/opened file currently in the SynEdit
|
||||
StartText : string;//The text synedit holds upon start/open/save
|
||||
ScriptName : string;//The name of the currently opened/saved file.
|
||||
ScriptDefault : string;//The default script e.g. program new; begin end.
|
||||
ScriptChanged : boolean;//We need this for that little * (edited star).
|
||||
ScriptThread : TMThread;//Just one thread for now..
|
||||
FScriptState : TScriptState;//Stores the ScriptState, if you want the Run/Pause/Start buttons to change accordingly, acces through Form1
|
||||
procedure undo;
|
||||
procedure redo;
|
||||
procedure HandleErrorData;
|
||||
procedure MakeActiveScriptFrame;
|
||||
procedure ScriptThreadTerminate(Sender: TObject);
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
TestUnit, SynEditTypes, LCLIntF, StrUtils,framefunctionlist;
|
||||
|
||||
{ TScriptFrame }
|
||||
|
||||
procedure TScriptFrame.SynEditChange(Sender: TObject);
|
||||
begin
|
||||
ScriptErrorLine:= -1;
|
||||
if not ScriptChanged then
|
||||
begin;
|
||||
ScriptChanged:= True;
|
||||
Form1.Caption:= Format(WindowTitle,[ScriptName + '*']);
|
||||
OwnerSheet.Caption:=ScriptName + '*';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditDragDrop(Sender, Source: TObject; X, Y: Integer);
|
||||
begin
|
||||
if Source is TFunctionListFrame then
|
||||
if TFunctionListFrame(Source).DraggingNode.Data <> nil then
|
||||
SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(TFunctionListFrame(Source).DraggingNode.Data)^.MethodStr,true));
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditDragOver(Sender, Source: TObject; X, Y: Integer;
|
||||
State: TDragState; var Accept: Boolean);
|
||||
begin
|
||||
Accept := Source = Form1.frmFunctionList;
|
||||
if(Accept)then
|
||||
begin
|
||||
SynEdit.CaretXY := SynEdit.PixelsToLogicalPos(point(x, y));
|
||||
if(not(Form1.Active))then Form1.BringToFront;
|
||||
if(Form1.ActiveControl <> SynEdit)then Form1.ActiveControl := SynEdit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if key = VK_F3 then
|
||||
begin;
|
||||
Form1.ActionFindNextExecute(Sender);
|
||||
key := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditProcessCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
begin
|
||||
case Command of
|
||||
ecUndo : begin
|
||||
Command:= ecNone;
|
||||
Self.Undo;
|
||||
end;
|
||||
ecRedo : begin
|
||||
Command := ecNone;
|
||||
self.Redo;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditProcessUserCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
var
|
||||
LineText,SearchText : string;
|
||||
Caret : TPoint;
|
||||
i,endI : integer;
|
||||
begin
|
||||
if Command = ecCodeCompletion then
|
||||
begin
|
||||
form1.FunctionListShown(True);
|
||||
with form1.frmFunctionList do
|
||||
if editSearchList.CanFocus then
|
||||
begin;
|
||||
editSearchList.SetFocus;
|
||||
LineText := SynEdit.LineText;
|
||||
Caret:=SynEdit.LogicalCaretXY;
|
||||
i := Caret.X - 1;
|
||||
endi := caret.x;
|
||||
if (i > length(LineText)) or ((i = 0) and (length(lineText) = 0)) then
|
||||
begin
|
||||
SearchText:= '';
|
||||
CompletionLine := PadRight(linetext,caret.x);
|
||||
end
|
||||
else begin
|
||||
while (i > 0) and (LineText[i] in ['a'..'z','A'..'Z','0'..'9','_']) do
|
||||
dec(i);
|
||||
while LineText[endi] in ['a'..'z','A'..'Z','0'..'9','_'] do
|
||||
inc(endi);
|
||||
SearchText := Trim(copy(LineText, i + 1, Caret.X - i - 1));
|
||||
CompletionLine := LineText;
|
||||
end;
|
||||
CompletionStart:= LineText;
|
||||
Delete(CompletionLine,i+1,endi - i - 1);
|
||||
Insert('%s',CompletionLine,i+1);
|
||||
CompletionCaret := Point(endi,Caret.y);
|
||||
StartWordCompletion:= Point(i+1,caret.y);
|
||||
mDebugLn(CompletionLine);
|
||||
mDebugLn(CompletionStart);
|
||||
InCodeCompletion := true;
|
||||
editSearchList.Text:= SearchText;
|
||||
editSearchList.SelStart:= Length(searchText);
|
||||
SynEdit.SelectedColor.Style:= [fsUnderline];
|
||||
SynEdit.SelectedColor.Foreground:= clBlack;
|
||||
SynEdit.SelectedColor.Background:= clWhite;
|
||||
Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditSpecialLineColors(Sender: TObject;
|
||||
Line: integer; var Special: boolean; var FG, BG: TColor);
|
||||
begin
|
||||
if line = ScriptErrorLine then
|
||||
begin;
|
||||
Special := true;
|
||||
BG := $50a0ff;
|
||||
FG := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditStatusChange(Sender: TObject;
|
||||
Changes: TSynStatusChanges);
|
||||
begin
|
||||
{$IFDEF UpdateEditButtons}
|
||||
if scSelection in changes then
|
||||
begin;
|
||||
Form1.TT_Cut.Enabled := SynEdit.SelAvail;
|
||||
form1.TT_Copy.Enabled:= Form1.TT_Cut.Enabled;
|
||||
form1.TT_Paste.Enabled:= SynEdit.CanPaste;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
procedure TScriptFrame.undo;
|
||||
begin
|
||||
SynEdit.Undo;
|
||||
if ScriptChanged then
|
||||
if SynEdit.Lines.Text = StartText then
|
||||
begin;
|
||||
Form1.Caption:= format(WindowTitle,[ScriptName]);
|
||||
OwnerSheet.Caption:= ScriptName;
|
||||
ScriptChanged := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.redo;
|
||||
begin
|
||||
SynEdit.Redo;
|
||||
if ScriptChanged then
|
||||
if SynEdit.Lines.Text = StartText then
|
||||
begin;
|
||||
Form1.Caption:= format(WindowTitle,[ScriptName]);
|
||||
OwnerSheet.Caption := ScriptName;
|
||||
ScriptChanged := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.HandleErrorData;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if ErrorData.Module <> '' then
|
||||
begin;
|
||||
if not FileExists(ErrorData.Module) then
|
||||
formWriteln(Format('ERROR comes from a non-existing file (%s)',[ErrorData.Module]))
|
||||
else
|
||||
begin
|
||||
ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-)
|
||||
for i := 0 to Form1.Tabs.Count - 1 do
|
||||
if lowercase(TMufasaTab(Form1.Tabs[i]).ScriptFrame.ScriptFile) = lowercase(ErrorData.Module) then
|
||||
begin;
|
||||
ErrorData.Module:= '';
|
||||
TMufasaTab(Form1.Tabs[i]).ScriptFrame.ErrorData := Self.ErrorData;
|
||||
TMufasaTab(Form1.Tabs[i]).ScriptFrame.HandleErrorData;
|
||||
Exit;
|
||||
end;
|
||||
Form1.LoadScriptFile(ErrorData.Module,true);
|
||||
ErrorData.Module:= '';
|
||||
Form1.CurrScript.ErrorData := Self.ErrorData;
|
||||
Form1.CurrScript.HandleErrorData;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
MakeActiveScriptFrame;
|
||||
ScriptErrorLine:= ErrorData.Row;
|
||||
SynEdit.Invalidate;
|
||||
if ErrorData.Col = -1 then
|
||||
SynEdit.SelStart:= ErrorData.Position
|
||||
else
|
||||
SynEdit.LogicalCaretXY := Point(ErrorData.Col,ErrorData.Row);
|
||||
if pos('error',lowercase(ErrorData.Error)) > 0 then
|
||||
formWriteln(Format('%s at line %d',[ErrorData.Error,ErrorData.Row]))
|
||||
else
|
||||
formWriteln(Format('Error: %s at line %d',[ErrorData.Error,ErrorData.Row]));
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.MakeActiveScriptFrame;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if Form1.Visible then
|
||||
for i := 0 to OwnerPage.PageCount - 1 do
|
||||
if OwnerPage.Pages[i] = OwnerSheet then
|
||||
begin;
|
||||
OwnerPage.TabIndex := i;
|
||||
if OwnerSheet.CanFocus then
|
||||
OwnerSheet.SetFocus;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.ScriptThreadTerminate(Sender: TObject);
|
||||
begin
|
||||
FScriptState:= ss_None;
|
||||
Form1.RefreshTab;
|
||||
end;
|
||||
procedure AddKey(const SynEdit : TSynEdit; const ACmd: TSynEditorCommand; const AKey: word;const AShift: TShiftState);
|
||||
begin
|
||||
with SynEdit.KeyStrokes.Add do
|
||||
begin
|
||||
Key := AKey;
|
||||
Shift := AShift;
|
||||
Command := ACmd;
|
||||
end;
|
||||
end;
|
||||
constructor TScriptFrame.Create(TheOwner: TComponent);
|
||||
var
|
||||
MarkCaret : TSynEditMarkupHighlightAllCaret;
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
OwnerSheet := TTabSheet(TheOwner);
|
||||
OwnerPage := TPageControl(OwnerSheet.Owner);
|
||||
StartText:= SynEdit.Lines.text;
|
||||
ScriptDefault:= StartText;
|
||||
ScriptName:= 'Untitled';
|
||||
ScriptChanged := false;
|
||||
FScriptState:= ss_None;
|
||||
ScriptErrorLine:= -1;
|
||||
OwnerSheet.Caption:= ScriptName;
|
||||
SynEdit.Options:= SynEdit.Options- [eoGroupUndo];
|
||||
SynEdit.Options:= SynEdit.Options+ [eoGroupUndo,eoPersistentCaret];
|
||||
SynEdit.IncrementColor.Background := $30D070;
|
||||
SynEdit.HighlightAllColor.Background:= clYellow;
|
||||
SynEdit.HighlightAllColor.Foreground:= clDefault;
|
||||
MarkCaret := TSynEditMarkupHighlightAllCaret(SynEdit.MarkupByClass[TSynEditMarkupHighlightAllCaret]);
|
||||
if assigned(MarkCaret) then
|
||||
begin
|
||||
with MarkCaret.MarkupInfo do
|
||||
begin;
|
||||
Background :=$E6E6E6;
|
||||
FrameColor := clGray;
|
||||
end;
|
||||
MarkCaret.Enabled := True;
|
||||
MarkCaret.FullWord:= True;
|
||||
MarkCaret.FullWordMaxLen:= 3;
|
||||
MarkCaret.WaitTime := 1500;
|
||||
MarkCaret.IgnoreKeywords := true;
|
||||
end;
|
||||
AddKey(SynEdit,ecCodeCompletion,VK_SPACE,[ssCtrl]);
|
||||
// TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :(
|
||||
end;
|
||||
|
||||
destructor TScriptFrame.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I framescript.lrs}
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
This file is part of the Mufasa Macro Library (MML)
|
||||
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
||||
|
||||
MML is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
MML is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
See the file COPYING, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
framescript for the Mufasa Macro Library
|
||||
}
|
||||
unit framescript;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll,
|
||||
mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls;
|
||||
const
|
||||
ecCodeCompletion = ecUserFirst;
|
||||
type
|
||||
TScriptState = (ss_None,ss_Running,ss_Paused,ss_Stopping);
|
||||
{
|
||||
ss_None: Means the script either hasn't been run yet, or it has ended (Succesfully or terminated)
|
||||
ss_Running: Means the script is running as we speak :-)
|
||||
ss_Paused: Means the script is currently in pause modus.
|
||||
ss_Stopping: Means we've asked PS-Script politely to stop the script (next time we press the stop button we won't be that nice).
|
||||
}
|
||||
|
||||
{ TScriptFrame }
|
||||
|
||||
TScriptFrame = class(TFrame)
|
||||
SynEdit: TSynEdit;
|
||||
SynFreePascalSyn1: TSynFreePascalSyn;
|
||||
procedure SynEditChange(Sender: TObject);
|
||||
procedure SynEditDragDrop(Sender, Source: TObject; X, Y: Integer);
|
||||
procedure SynEditDragOver(Sender, Source: TObject; X, Y: Integer;
|
||||
State: TDragState; var Accept: Boolean);
|
||||
procedure SynEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
|
||||
);
|
||||
procedure SynEditProcessCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
procedure SynEditProcessUserCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
procedure SynEditSpecialLineColors(Sender: TObject; Line: integer;
|
||||
var Special: boolean; var FG, BG: TColor);
|
||||
procedure SynEditStatusChange(Sender: TObject; Changes: TSynStatusChanges);
|
||||
private
|
||||
OwnerPage : TPageControl;
|
||||
OwnerSheet : TTabSheet;//The owner TTabsheet -> For title setting
|
||||
public
|
||||
ErrorData : TErrorData; //For threadsafestuff
|
||||
ScriptErrorLine : integer; //Highlight the error line!
|
||||
ScriptFile : string;//The path to the saved/opened file currently in the SynEdit
|
||||
StartText : string;//The text synedit holds upon start/open/save
|
||||
ScriptName : string;//The name of the currently opened/saved file.
|
||||
ScriptDefault : string;//The default script e.g. program new; begin end.
|
||||
ScriptChanged : boolean;//We need this for that little * (edited star).
|
||||
ScriptThread : TMThread;//Just one thread for now..
|
||||
FScriptState : TScriptState;//Stores the ScriptState, if you want the Run/Pause/Start buttons to change accordingly, acces through Form1
|
||||
procedure undo;
|
||||
procedure redo;
|
||||
procedure HandleErrorData;
|
||||
procedure MakeActiveScriptFrame;
|
||||
procedure ScriptThreadTerminate(Sender: TObject);
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
TestUnit, SynEditTypes, LCLIntF, StrUtils,framefunctionlist;
|
||||
|
||||
{ TScriptFrame }
|
||||
|
||||
procedure TScriptFrame.SynEditChange(Sender: TObject);
|
||||
begin
|
||||
ScriptErrorLine:= -1;
|
||||
if not ScriptChanged then
|
||||
begin;
|
||||
ScriptChanged:= True;
|
||||
Form1.Caption:= Format(WindowTitle,[ScriptName + '*']);
|
||||
OwnerSheet.Caption:=ScriptName + '*';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditDragDrop(Sender, Source: TObject; X, Y: Integer);
|
||||
begin
|
||||
if Source is TFunctionListFrame then
|
||||
if TFunctionListFrame(Source).DraggingNode.Data <> nil then
|
||||
SynEdit.InsertTextAtCaret( GetMethodName(PMethodInfo(TFunctionListFrame(Source).DraggingNode.Data)^.MethodStr,true));
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditDragOver(Sender, Source: TObject; X, Y: Integer;
|
||||
State: TDragState; var Accept: Boolean);
|
||||
begin
|
||||
Accept := Source = Form1.frmFunctionList;
|
||||
if(Accept)then
|
||||
begin
|
||||
SynEdit.CaretXY := SynEdit.PixelsToLogicalPos(point(x, y));
|
||||
if(not(Form1.Active))then Form1.BringToFront;
|
||||
if(Form1.ActiveControl <> SynEdit)then Form1.ActiveControl := SynEdit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if key = VK_F3 then
|
||||
begin;
|
||||
Form1.ActionFindNextExecute(Sender);
|
||||
key := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditProcessCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
begin
|
||||
case Command of
|
||||
ecUndo : begin
|
||||
Command:= ecNone;
|
||||
Self.Undo;
|
||||
end;
|
||||
ecRedo : begin
|
||||
Command := ecNone;
|
||||
self.Redo;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditProcessUserCommand(Sender: TObject;
|
||||
var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer);
|
||||
var
|
||||
LineText,SearchText : string;
|
||||
Caret : TPoint;
|
||||
i,endI : integer;
|
||||
begin
|
||||
if Command = ecCodeCompletion then
|
||||
begin
|
||||
form1.FunctionListShown(True);
|
||||
with form1.frmFunctionList do
|
||||
if editSearchList.CanFocus then
|
||||
begin;
|
||||
editSearchList.SetFocus;
|
||||
LineText := SynEdit.LineText;
|
||||
Caret:=SynEdit.LogicalCaretXY;
|
||||
i := Caret.X - 1;
|
||||
endi := caret.x;
|
||||
if (i > length(LineText)) or ((i = 0) and (length(lineText) = 0)) then
|
||||
begin
|
||||
SearchText:= '';
|
||||
CompletionLine := PadRight(linetext,caret.x);
|
||||
end
|
||||
else begin
|
||||
while (i > 0) and (LineText[i] in ['a'..'z','A'..'Z','0'..'9','_']) do
|
||||
dec(i);
|
||||
while LineText[endi] in ['a'..'z','A'..'Z','0'..'9','_'] do
|
||||
inc(endi);
|
||||
SearchText := Trim(copy(LineText, i + 1, Caret.X - i - 1));
|
||||
CompletionLine := LineText;
|
||||
end;
|
||||
CompletionStart:= LineText;
|
||||
Delete(CompletionLine,i+1,endi - i - 1);
|
||||
Insert('%s',CompletionLine,i+1);
|
||||
CompletionCaret := Point(endi,Caret.y);
|
||||
StartWordCompletion:= Point(i+1,caret.y);
|
||||
mDebugLn(CompletionLine);
|
||||
mDebugLn(CompletionStart);
|
||||
InCodeCompletion := true;
|
||||
editSearchList.Text:= SearchText;
|
||||
editSearchList.SelStart:= Length(searchText);
|
||||
SynEdit.SelectedColor.Style:= [fsUnderline];
|
||||
SynEdit.SelectedColor.Foreground:= clBlack;
|
||||
SynEdit.SelectedColor.Background:= clWhite;
|
||||
Synedit.MarkupByClass[TSynEditMarkupHighlightAllCaret].TempDisable;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditSpecialLineColors(Sender: TObject;
|
||||
Line: integer; var Special: boolean; var FG, BG: TColor);
|
||||
begin
|
||||
if line = ScriptErrorLine then
|
||||
begin;
|
||||
Special := true;
|
||||
BG := $50a0ff;
|
||||
FG := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.SynEditStatusChange(Sender: TObject;
|
||||
Changes: TSynStatusChanges);
|
||||
begin
|
||||
{$IFDEF UpdateEditButtons}
|
||||
if scSelection in changes then
|
||||
begin;
|
||||
Form1.TT_Cut.Enabled := SynEdit.SelAvail;
|
||||
form1.TT_Copy.Enabled:= Form1.TT_Cut.Enabled;
|
||||
form1.TT_Paste.Enabled:= SynEdit.CanPaste;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
procedure TScriptFrame.undo;
|
||||
begin
|
||||
SynEdit.Undo;
|
||||
if ScriptChanged then
|
||||
if SynEdit.Lines.Text = StartText then
|
||||
begin;
|
||||
Form1.Caption:= format(WindowTitle,[ScriptName]);
|
||||
OwnerSheet.Caption:= ScriptName;
|
||||
ScriptChanged := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.redo;
|
||||
begin
|
||||
SynEdit.Redo;
|
||||
if ScriptChanged then
|
||||
if SynEdit.Lines.Text = StartText then
|
||||
begin;
|
||||
Form1.Caption:= format(WindowTitle,[ScriptName]);
|
||||
OwnerSheet.Caption := ScriptName;
|
||||
ScriptChanged := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.HandleErrorData;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if ErrorData.Module <> '' then
|
||||
begin;
|
||||
if not FileExists(ErrorData.Module) then
|
||||
formWriteln(Format('ERROR comes from a non-existing file (%s)',[ErrorData.Module]))
|
||||
else
|
||||
begin
|
||||
ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-)
|
||||
for i := 0 to Form1.Tabs.Count - 1 do
|
||||
if lowercase(TMufasaTab(Form1.Tabs[i]).ScriptFrame.ScriptFile) = lowercase(ErrorData.Module) then
|
||||
begin;
|
||||
ErrorData.Module:= '';
|
||||
TMufasaTab(Form1.Tabs[i]).ScriptFrame.ErrorData := Self.ErrorData;
|
||||
TMufasaTab(Form1.Tabs[i]).ScriptFrame.HandleErrorData;
|
||||
Exit;
|
||||
end;
|
||||
Form1.LoadScriptFile(ErrorData.Module,true);
|
||||
ErrorData.Module:= '';
|
||||
Form1.CurrScript.ErrorData := Self.ErrorData;
|
||||
Form1.CurrScript.HandleErrorData;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
MakeActiveScriptFrame;
|
||||
ScriptErrorLine:= ErrorData.Row;
|
||||
SynEdit.Invalidate;
|
||||
if ErrorData.Col = -1 then
|
||||
SynEdit.SelStart:= ErrorData.Position
|
||||
else
|
||||
SynEdit.LogicalCaretXY := Point(ErrorData.Col,ErrorData.Row);
|
||||
if pos('error',lowercase(ErrorData.Error)) > 0 then
|
||||
formWriteln(Format('%s at line %d',[ErrorData.Error,ErrorData.Row]))
|
||||
else
|
||||
formWriteln(Format('Error: %s at line %d',[ErrorData.Error,ErrorData.Row]));
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.MakeActiveScriptFrame;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if Form1.Visible then
|
||||
for i := 0 to OwnerPage.PageCount - 1 do
|
||||
if OwnerPage.Pages[i] = OwnerSheet then
|
||||
begin;
|
||||
OwnerPage.TabIndex := i;
|
||||
if OwnerSheet.CanFocus then
|
||||
OwnerSheet.SetFocus;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScriptFrame.ScriptThreadTerminate(Sender: TObject);
|
||||
begin
|
||||
FScriptState:= ss_None;
|
||||
Form1.RefreshTab;
|
||||
end;
|
||||
procedure AddKey(const SynEdit : TSynEdit; const ACmd: TSynEditorCommand; const AKey: word;const AShift: TShiftState);
|
||||
begin
|
||||
with SynEdit.KeyStrokes.Add do
|
||||
begin
|
||||
Key := AKey;
|
||||
Shift := AShift;
|
||||
Command := ACmd;
|
||||
end;
|
||||
end;
|
||||
constructor TScriptFrame.Create(TheOwner: TComponent);
|
||||
var
|
||||
MarkCaret : TSynEditMarkupHighlightAllCaret;
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
OwnerSheet := TTabSheet(TheOwner);
|
||||
OwnerPage := TPageControl(OwnerSheet.Owner);
|
||||
StartText:= SynEdit.Lines.text;
|
||||
ScriptDefault:= StartText;
|
||||
ScriptName:= 'Untitled';
|
||||
ScriptChanged := false;
|
||||
FScriptState:= ss_None;
|
||||
ScriptErrorLine:= -1;
|
||||
OwnerSheet.Caption:= ScriptName;
|
||||
SynEdit.Options:= SynEdit.Options- [eoGroupUndo];
|
||||
SynEdit.Options:= SynEdit.Options+ [eoGroupUndo,eoPersistentCaret];
|
||||
SynEdit.IncrementColor.Background := $30D070;
|
||||
SynEdit.HighlightAllColor.Background:= clYellow;
|
||||
SynEdit.HighlightAllColor.Foreground:= clDefault;
|
||||
MarkCaret := TSynEditMarkupHighlightAllCaret(SynEdit.MarkupByClass[TSynEditMarkupHighlightAllCaret]);
|
||||
if assigned(MarkCaret) then
|
||||
begin
|
||||
with MarkCaret.MarkupInfo do
|
||||
begin;
|
||||
Background :=$E6E6E6;
|
||||
FrameColor := clGray;
|
||||
end;
|
||||
MarkCaret.Enabled := True;
|
||||
MarkCaret.FullWord:= True;
|
||||
MarkCaret.FullWordMaxLen:= 3;
|
||||
MarkCaret.WaitTime := 1500;
|
||||
MarkCaret.IgnoreKeywords := true;
|
||||
end;
|
||||
AddKey(SynEdit,ecCodeCompletion,VK_SPACE,[ssCtrl]);
|
||||
// TSynPasSyn(SynEdit.Highlighter).NestedComments:= false; Does not work :(
|
||||
end;
|
||||
|
||||
destructor TScriptFrame.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I framescript.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,381 +1,381 @@
|
||||
unit simpleanalyzer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, SynEdit, SynHighlighterPas,MufasaBase, Clipbrd;
|
||||
|
||||
type
|
||||
|
||||
TScriptVar = record
|
||||
VarName, VarType : string;
|
||||
end;
|
||||
|
||||
{ TScriptMethod }
|
||||
|
||||
TScriptMethod = class(TObject)
|
||||
BeginPos, EndPos : integer;
|
||||
isFunction : Boolean;
|
||||
Name : string;
|
||||
Parameters,Vars : array of TScriptVar;
|
||||
ParameterLen,VarLen : integer;
|
||||
Returns : String;
|
||||
Methods : Array of TScriptMethod;
|
||||
MethodLen : Integer;
|
||||
function AddMethod( iszehfunction : boolean; TheName : string): TScriptMethod;
|
||||
procedure AddVar( TheName, TheType : string);
|
||||
procedure AddParam( TheName : string);
|
||||
constructor create( iszehfunction : Boolean; TheName : string);
|
||||
function CreateMethodStr : string;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TScriptAnalyzer }
|
||||
|
||||
TScriptAnalyzer = class(TObject)
|
||||
ScriptToAnalyze : string;
|
||||
ScriptName : string;
|
||||
Methods : Array of TScriptMethod;
|
||||
MethodLen : Integer;
|
||||
Main : TScriptMethod;
|
||||
HasMain : boolean;
|
||||
Vars : Array of TScriptVar;
|
||||
VarLen : integer;
|
||||
Function AddMethod( iszehfunction : boolean; Name : string): TScriptMethod;
|
||||
procedure AddVar( TheName, TheType : string);
|
||||
procedure analyze;
|
||||
constructor create;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
mPasLex,strutils;
|
||||
|
||||
|
||||
|
||||
destructor TScriptAnalyzer.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin;
|
||||
for i := 0 to MethodLen - 1 do
|
||||
Self.Methods[i].Free;
|
||||
Main.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
destructor TScriptMethod.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin;
|
||||
for i := 0 to MethodLen - 1 do
|
||||
Self.Methods[i].Free;
|
||||
inherited;
|
||||
end;
|
||||
constructor TScriptMethod.create( iszehfunction : Boolean; TheName : string);
|
||||
begin;
|
||||
inherited Create;
|
||||
Self.isFunction := iszehfunction;
|
||||
Self.Name := TheName;
|
||||
end;
|
||||
|
||||
function TScriptMethod.CreateMethodStr: string;
|
||||
var
|
||||
i : integer;
|
||||
LastType : string;
|
||||
begin
|
||||
if isFunction then
|
||||
result := 'function ' + Name
|
||||
else
|
||||
result := 'procedure '+ name;
|
||||
if ParameterLen > 0 then
|
||||
begin;
|
||||
result := result + '(';
|
||||
LastType := '';
|
||||
for i := 0 to ParameterLen - 1 do
|
||||
begin;
|
||||
if lasttype <> '' then
|
||||
if lowercase(lasttype) <> lowercase(Parameters[i].VarType) then
|
||||
result := result + ' : ' + LastType + '; '
|
||||
else
|
||||
result := result + ', ';
|
||||
result := result + Parameters[i].VarName;
|
||||
lasttype := Parameters[i].VarType;
|
||||
end;
|
||||
Result := result + ' : ' + Parameters[ParameterLen - 1].VarType + ')';
|
||||
end;
|
||||
if isFunction then
|
||||
result := result + ' : ' + Returns
|
||||
else
|
||||
result := result + ';';
|
||||
end;
|
||||
|
||||
constructor TScriptAnalyzer.create;
|
||||
begin;
|
||||
inherited create;
|
||||
ScriptName := 'Default';
|
||||
Main := TScriptMethod.create(false,'!main');
|
||||
end;
|
||||
procedure TScriptMethod.addVar( TheName, TheType : string);
|
||||
begin;
|
||||
inc(Self.VarLen);
|
||||
SetLength(Self.Vars, self.varlen);
|
||||
Self.Vars[Self.VarLen - 1].VarName := TheName;
|
||||
Self.Vars[Self.VarLen - 1].VarType := TheType;
|
||||
end;
|
||||
procedure TScriptAnalyzer.AddVar( TheName, TheType : string);
|
||||
begin;
|
||||
inc(Self.VarLen);
|
||||
SetLength(Self.Vars, self.VarLen);
|
||||
Self.Vars[Self.VarLen - 1].VarName := TheName;
|
||||
Self.Vars[Self.VarLen - 1].VarType := TheType;
|
||||
end;
|
||||
function TScriptMethod.AddMethod( iszehfunction : boolean; TheName : string) : TScriptMethod;
|
||||
begin;
|
||||
inc(Self.MethodLen);
|
||||
SetLength(Self.Methods, Self.MethodLen);
|
||||
Self.Methods[Self.Methodlen - 1] := TScriptMethod.create(iszehfunction,TheName);
|
||||
Result :=Self.Methods[Self.Methodlen - 1];
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function TScriptAnalyzer.AddMethod( iszehfunction : boolean; Name : string) : TScriptMethod;
|
||||
begin;
|
||||
inc(Self.MethodLen);
|
||||
SetLength(Self.Methods, Self.MethodLen);
|
||||
Self.Methods[Self.Methodlen - 1] := TScriptMethod.create(iszehfunction,Name);
|
||||
Result :=Self.Methods[Self.Methodlen - 1];
|
||||
end;
|
||||
|
||||
|
||||
procedure TScriptMethod.AddParam(TheName: string);
|
||||
begin;
|
||||
inc(Self.ParameterLen);
|
||||
SetLength(Self.Parameters, self.ParameterLen);
|
||||
Self.Parameters[Self.ParameterLen - 1].VarName := TheName;
|
||||
end;
|
||||
|
||||
|
||||
procedure TScriptAnalyzer.analyze;
|
||||
var
|
||||
LastTk : TTokenKind;
|
||||
StartPos,LastPos: integer;
|
||||
|
||||
LastTkString : string;
|
||||
I : integer;
|
||||
TempInt : integer;
|
||||
InMethod : Boolean;
|
||||
ExpectingType : boolean; //Params and result
|
||||
WaitingForResult : boolean;
|
||||
StartParam : integer;
|
||||
StartVar : integer;
|
||||
Method : TScriptMethod;
|
||||
InTypes : Boolean;
|
||||
TempName : string;
|
||||
BeginCount : integer;
|
||||
InGlobal : boolean;
|
||||
InParams : boolean;
|
||||
InVarSection : Boolean;
|
||||
Lex : TmwPasLex;
|
||||
begin
|
||||
Lex := TmwPasLex.Create;
|
||||
Lex.Origin := PChar(Self.ScriptToAnalyze);
|
||||
InTypes := False;
|
||||
InMethod := False;
|
||||
InParams := False;
|
||||
Method := nil;
|
||||
BeginCount := 0;
|
||||
ExpectingType := False;
|
||||
WaitingForResult := False;
|
||||
StartParam := 0;
|
||||
InVarSection := False;
|
||||
while (Lex.TokenID <> tkNull) do
|
||||
begin;
|
||||
LastTk := Lex.TokenID;
|
||||
LastPos := Lex.RunPos;
|
||||
Lex.NextNoJunk;
|
||||
case LastTk of
|
||||
// tkInclude : ShowMessage(Lex.Token);
|
||||
// if (FParser.Token[Length(FParser.Token)] = '}') then
|
||||
// FIncludes.Add(StringReplace(LowerCase(Trim(Copy(FParser.Token, 11, Length(FParser.Token) - 11))), '/', '\', [rfReplaceAll]));
|
||||
tkProgram : if Lex.TokenID = tkIdentifier then
|
||||
Self.ScriptName := Lex.Token;
|
||||
tkRoundOpen: begin;
|
||||
LastTkString := Lex.Token;
|
||||
if InMethod and InParams then
|
||||
StartParam := 0;
|
||||
end;
|
||||
tkType : InVarSection := False;
|
||||
tkBegin : begin;
|
||||
|
||||
InVarSection := False;
|
||||
if InMethod then
|
||||
inc(BeginCount)
|
||||
else if BeginCount = 0 then
|
||||
begin;
|
||||
InVarSection := false;
|
||||
InMethod := true;
|
||||
HasMain := True;
|
||||
Method := Main;
|
||||
Main.BeginPos := LastPos - 4;
|
||||
Inc(BeginCount);
|
||||
end;
|
||||
end;
|
||||
tkCase : begin;
|
||||
if InMethod then
|
||||
inc(BeginCount);
|
||||
end;
|
||||
tkEnd : if InMethod then
|
||||
begin;
|
||||
Dec(BeginCount);
|
||||
if BeginCount = 0 then
|
||||
begin;
|
||||
Method.EndPos := LastPos;
|
||||
InMethod := False;
|
||||
end;
|
||||
end;
|
||||
tkIdentifier: begin;
|
||||
if (InMethod and InParams) or (InVarSection) then
|
||||
begin;
|
||||
|
||||
{ if ExpectingType then
|
||||
begin;
|
||||
FormAnalyzer.SynEdit1.Lines.add(copy( FormAnalyzer.SynEdit1.Lines.Text,StartPos, LastPos - StartPos));
|
||||
LastTKString := copy( FormAnalyzer.SynEdit1.Lines.GetText,StartPos, Lex.TokenPos - StartPos);
|
||||
for i := StartParam to Method.ParameterLen - 1 do
|
||||
Method.Parameters[i].VarType := LastTkString;
|
||||
end
|
||||
else
|
||||
Method.AddParam(LastTkString); }
|
||||
if not ExpectingType and InVarSection then
|
||||
Method.AddVar(LastTKString,'') else
|
||||
if not ExpectingType then
|
||||
Method.AddParam(LastTKString);
|
||||
end;
|
||||
end;
|
||||
tkVar : begin;
|
||||
if InMethod and Not InParams then
|
||||
InVarSection := True;
|
||||
if not InMethod then
|
||||
begin;
|
||||
Method := Main;
|
||||
InGlobal := True;
|
||||
InVarSection := True;
|
||||
|
||||
end;
|
||||
if InVarSection then
|
||||
StartVar := Method.VarLen;
|
||||
LastTKString := Lex.Token;
|
||||
end;
|
||||
tkConst : begin;
|
||||
if not InMethod then
|
||||
InVarSection := false;
|
||||
LastTKString := Lex.token;
|
||||
end;
|
||||
tkComma : begin;
|
||||
LastTKString := Lex.Token;
|
||||
end;
|
||||
tkColon : begin;
|
||||
LastTkString := Lex.Token;
|
||||
if (InMethod and InParams) or InVarSection then
|
||||
begin;
|
||||
ExpectingType := True;
|
||||
StartPos := LastPos;
|
||||
end
|
||||
else if InMethod and WaitingForresult then
|
||||
begin;
|
||||
Method.Returns := Lex.Token;
|
||||
WaitingForResult := False;
|
||||
end;
|
||||
end;
|
||||
tkSemiColon : begin;
|
||||
if (InMethod and InParams) or (InVarSection) then
|
||||
begin;
|
||||
if ExpectingType then
|
||||
begin;
|
||||
LastTKString := Trim(copy( ScriptToAnalyze,StartPos + 1, LastPos - StartPos - 1));
|
||||
if (InParams and InMethod) then
|
||||
for i := StartParam to Method.ParameterLen - 1 do
|
||||
Method.Parameters[i].VarType := LastTkString
|
||||
else
|
||||
for i := StartVar to Method.VarLen - 1 do
|
||||
Method.Vars[i].VarType := LastTKString;
|
||||
ExpectingType := False;
|
||||
end;
|
||||
LastTkString := Lex.Token;
|
||||
StartParam := Method.ParameterLen;
|
||||
StartVar := Method.VarLen;
|
||||
end;
|
||||
end;
|
||||
tkRoundClose: if InMethod and InParams then
|
||||
begin;
|
||||
if ExpectingType then
|
||||
begin;
|
||||
LastTKString := Trim(copy(ScriptToAnalyze,StartPos + 2, LastPos - StartPos - 2));
|
||||
for i := StartParam to Method.ParameterLen - 1 do
|
||||
Method.Parameters[i].VarType := LastTkString;
|
||||
ExpectingType := False;
|
||||
end;
|
||||
InParams := False;
|
||||
end;
|
||||
tkProcedure,
|
||||
tkFunction : begin;
|
||||
if (InVarSection or (InMethod and InParams)) and ExpectingType then
|
||||
begin;
|
||||
//Do nothing since the this procedure/function is a var ;-)
|
||||
end else
|
||||
begin;
|
||||
if not InMethod then
|
||||
InVarSection := False;
|
||||
if (not InTypes) and (not InVarSection) then
|
||||
begin;
|
||||
WaitingForResult := LastTK = tkFunction;
|
||||
if Lex.TokenID <> tkIdentifier then
|
||||
begin;
|
||||
mDebugLn('Analyzer: No method name -> exiting');
|
||||
exit;
|
||||
end;
|
||||
TempName := Lex.Token;
|
||||
TempInt := Lex.TokenPos;
|
||||
Lex.NextNoJunk;
|
||||
if Lex.TokenID = tkRoundOpen then
|
||||
InParams := True
|
||||
else if Lex.TokenID = tkPoint then
|
||||
begin;
|
||||
mDebugLn('Analyzer: In class definition?');
|
||||
// FormAnalyzer.SynEdit2.Lines.add('In class definition *cough*');
|
||||
Lex.NextNoJunk;
|
||||
TempName := Lex.Token;
|
||||
end else if ((Lex.TokenID = tkSemicolon) xor WaitingForResult) or ((Lex.TokenID = tkColon) xor WaitingForResult) then
|
||||
begin;
|
||||
InParams := False;
|
||||
end else
|
||||
begin;
|
||||
mDebugLn('Analyzer: You''re missing some stuff in the procedure declaration');
|
||||
Exit;
|
||||
end;
|
||||
if InMethod then
|
||||
Method := Method.AddMethod(WaitingForResult,TempName)
|
||||
else
|
||||
Method := Self.AddMethod(WaitingForResult,TempName);
|
||||
InMethod := true;
|
||||
Method.Beginpos := TempInt;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
// SynEdit2.Lines.Add(TokeToString(Lex.TokenID) + '-' + Lex.Token);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit simpleanalyzer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, SynEdit, SynHighlighterPas,MufasaBase, Clipbrd;
|
||||
|
||||
type
|
||||
|
||||
TScriptVar = record
|
||||
VarName, VarType : string;
|
||||
end;
|
||||
|
||||
{ TScriptMethod }
|
||||
|
||||
TScriptMethod = class(TObject)
|
||||
BeginPos, EndPos : integer;
|
||||
isFunction : Boolean;
|
||||
Name : string;
|
||||
Parameters,Vars : array of TScriptVar;
|
||||
ParameterLen,VarLen : integer;
|
||||
Returns : String;
|
||||
Methods : Array of TScriptMethod;
|
||||
MethodLen : Integer;
|
||||
function AddMethod( iszehfunction : boolean; TheName : string): TScriptMethod;
|
||||
procedure AddVar( TheName, TheType : string);
|
||||
procedure AddParam( TheName : string);
|
||||
constructor create( iszehfunction : Boolean; TheName : string);
|
||||
function CreateMethodStr : string;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TScriptAnalyzer }
|
||||
|
||||
TScriptAnalyzer = class(TObject)
|
||||
ScriptToAnalyze : string;
|
||||
ScriptName : string;
|
||||
Methods : Array of TScriptMethod;
|
||||
MethodLen : Integer;
|
||||
Main : TScriptMethod;
|
||||
HasMain : boolean;
|
||||
Vars : Array of TScriptVar;
|
||||
VarLen : integer;
|
||||
Function AddMethod( iszehfunction : boolean; Name : string): TScriptMethod;
|
||||
procedure AddVar( TheName, TheType : string);
|
||||
procedure analyze;
|
||||
constructor create;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
mPasLex,strutils;
|
||||
|
||||
|
||||
|
||||
destructor TScriptAnalyzer.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin;
|
||||
for i := 0 to MethodLen - 1 do
|
||||
Self.Methods[i].Free;
|
||||
Main.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
destructor TScriptMethod.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin;
|
||||
for i := 0 to MethodLen - 1 do
|
||||
Self.Methods[i].Free;
|
||||
inherited;
|
||||
end;
|
||||
constructor TScriptMethod.create( iszehfunction : Boolean; TheName : string);
|
||||
begin;
|
||||
inherited Create;
|
||||
Self.isFunction := iszehfunction;
|
||||
Self.Name := TheName;
|
||||
end;
|
||||
|
||||
function TScriptMethod.CreateMethodStr: string;
|
||||
var
|
||||
i : integer;
|
||||
LastType : string;
|
||||
begin
|
||||
if isFunction then
|
||||
result := 'function ' + Name
|
||||
else
|
||||
result := 'procedure '+ name;
|
||||
if ParameterLen > 0 then
|
||||
begin;
|
||||
result := result + '(';
|
||||
LastType := '';
|
||||
for i := 0 to ParameterLen - 1 do
|
||||
begin;
|
||||
if lasttype <> '' then
|
||||
if lowercase(lasttype) <> lowercase(Parameters[i].VarType) then
|
||||
result := result + ' : ' + LastType + '; '
|
||||
else
|
||||
result := result + ', ';
|
||||
result := result + Parameters[i].VarName;
|
||||
lasttype := Parameters[i].VarType;
|
||||
end;
|
||||
Result := result + ' : ' + Parameters[ParameterLen - 1].VarType + ')';
|
||||
end;
|
||||
if isFunction then
|
||||
result := result + ' : ' + Returns
|
||||
else
|
||||
result := result + ';';
|
||||
end;
|
||||
|
||||
constructor TScriptAnalyzer.create;
|
||||
begin;
|
||||
inherited create;
|
||||
ScriptName := 'Default';
|
||||
Main := TScriptMethod.create(false,'!main');
|
||||
end;
|
||||
procedure TScriptMethod.addVar( TheName, TheType : string);
|
||||
begin;
|
||||
inc(Self.VarLen);
|
||||
SetLength(Self.Vars, self.varlen);
|
||||
Self.Vars[Self.VarLen - 1].VarName := TheName;
|
||||
Self.Vars[Self.VarLen - 1].VarType := TheType;
|
||||
end;
|
||||
procedure TScriptAnalyzer.AddVar( TheName, TheType : string);
|
||||
begin;
|
||||
inc(Self.VarLen);
|
||||
SetLength(Self.Vars, self.VarLen);
|
||||
Self.Vars[Self.VarLen - 1].VarName := TheName;
|
||||
Self.Vars[Self.VarLen - 1].VarType := TheType;
|
||||
end;
|
||||
function TScriptMethod.AddMethod( iszehfunction : boolean; TheName : string) : TScriptMethod;
|
||||
begin;
|
||||
inc(Self.MethodLen);
|
||||
SetLength(Self.Methods, Self.MethodLen);
|
||||
Self.Methods[Self.Methodlen - 1] := TScriptMethod.create(iszehfunction,TheName);
|
||||
Result :=Self.Methods[Self.Methodlen - 1];
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function TScriptAnalyzer.AddMethod( iszehfunction : boolean; Name : string) : TScriptMethod;
|
||||
begin;
|
||||
inc(Self.MethodLen);
|
||||
SetLength(Self.Methods, Self.MethodLen);
|
||||
Self.Methods[Self.Methodlen - 1] := TScriptMethod.create(iszehfunction,Name);
|
||||
Result :=Self.Methods[Self.Methodlen - 1];
|
||||
end;
|
||||
|
||||
|
||||
procedure TScriptMethod.AddParam(TheName: string);
|
||||
begin;
|
||||
inc(Self.ParameterLen);
|
||||
SetLength(Self.Parameters, self.ParameterLen);
|
||||
Self.Parameters[Self.ParameterLen - 1].VarName := TheName;
|
||||
end;
|
||||
|
||||
|
||||
procedure TScriptAnalyzer.analyze;
|
||||
var
|
||||
LastTk : TTokenKind;
|
||||
StartPos,LastPos: integer;
|
||||
|
||||
LastTkString : string;
|
||||
I : integer;
|
||||
TempInt : integer;
|
||||
InMethod : Boolean;
|
||||
ExpectingType : boolean; //Params and result
|
||||
WaitingForResult : boolean;
|
||||
StartParam : integer;
|
||||
StartVar : integer;
|
||||
Method : TScriptMethod;
|
||||
InTypes : Boolean;
|
||||
TempName : string;
|
||||
BeginCount : integer;
|
||||
InGlobal : boolean;
|
||||
InParams : boolean;
|
||||
InVarSection : Boolean;
|
||||
Lex : TmwPasLex;
|
||||
begin
|
||||
Lex := TmwPasLex.Create;
|
||||
Lex.Origin := PChar(Self.ScriptToAnalyze);
|
||||
InTypes := False;
|
||||
InMethod := False;
|
||||
InParams := False;
|
||||
Method := nil;
|
||||
BeginCount := 0;
|
||||
ExpectingType := False;
|
||||
WaitingForResult := False;
|
||||
StartParam := 0;
|
||||
InVarSection := False;
|
||||
while (Lex.TokenID <> tkNull) do
|
||||
begin;
|
||||
LastTk := Lex.TokenID;
|
||||
LastPos := Lex.RunPos;
|
||||
Lex.NextNoJunk;
|
||||
case LastTk of
|
||||
// tkInclude : ShowMessage(Lex.Token);
|
||||
// if (FParser.Token[Length(FParser.Token)] = '}') then
|
||||
// FIncludes.Add(StringReplace(LowerCase(Trim(Copy(FParser.Token, 11, Length(FParser.Token) - 11))), '/', '\', [rfReplaceAll]));
|
||||
tkProgram : if Lex.TokenID = tkIdentifier then
|
||||
Self.ScriptName := Lex.Token;
|
||||
tkRoundOpen: begin;
|
||||
LastTkString := Lex.Token;
|
||||
if InMethod and InParams then
|
||||
StartParam := 0;
|
||||
end;
|
||||
tkType : InVarSection := False;
|
||||
tkBegin : begin;
|
||||
|
||||
InVarSection := False;
|
||||
if InMethod then
|
||||
inc(BeginCount)
|
||||
else if BeginCount = 0 then
|
||||
begin;
|
||||
InVarSection := false;
|
||||
InMethod := true;
|
||||
HasMain := True;
|
||||
Method := Main;
|
||||
Main.BeginPos := LastPos - 4;
|
||||
Inc(BeginCount);
|
||||
end;
|
||||
end;
|
||||
tkCase : begin;
|
||||
if InMethod then
|
||||
inc(BeginCount);
|
||||
end;
|
||||
tkEnd : if InMethod then
|
||||
begin;
|
||||
Dec(BeginCount);
|
||||
if BeginCount = 0 then
|
||||
begin;
|
||||
Method.EndPos := LastPos;
|
||||
InMethod := False;
|
||||
end;
|
||||
end;
|
||||
tkIdentifier: begin;
|
||||
if (InMethod and InParams) or (InVarSection) then
|
||||
begin;
|
||||
|
||||
{ if ExpectingType then
|
||||
begin;
|
||||
FormAnalyzer.SynEdit1.Lines.add(copy( FormAnalyzer.SynEdit1.Lines.Text,StartPos, LastPos - StartPos));
|
||||
LastTKString := copy( FormAnalyzer.SynEdit1.Lines.GetText,StartPos, Lex.TokenPos - StartPos);
|
||||
for i := StartParam to Method.ParameterLen - 1 do
|
||||
Method.Parameters[i].VarType := LastTkString;
|
||||
end
|
||||
else
|
||||
Method.AddParam(LastTkString); }
|
||||
if not ExpectingType and InVarSection then
|
||||
Method.AddVar(LastTKString,'') else
|
||||
if not ExpectingType then
|
||||
Method.AddParam(LastTKString);
|
||||
end;
|
||||
end;
|
||||
tkVar : begin;
|
||||
if InMethod and Not InParams then
|
||||
InVarSection := True;
|
||||
if not InMethod then
|
||||
begin;
|
||||
Method := Main;
|
||||
InGlobal := True;
|
||||
InVarSection := True;
|
||||
|
||||
end;
|
||||
if InVarSection then
|
||||
StartVar := Method.VarLen;
|
||||
LastTKString := Lex.Token;
|
||||
end;
|
||||
tkConst : begin;
|
||||
if not InMethod then
|
||||
InVarSection := false;
|
||||
LastTKString := Lex.token;
|
||||
end;
|
||||
tkComma : begin;
|
||||
LastTKString := Lex.Token;
|
||||
end;
|
||||
tkColon : begin;
|
||||
LastTkString := Lex.Token;
|
||||
if (InMethod and InParams) or InVarSection then
|
||||
begin;
|
||||
ExpectingType := True;
|
||||
StartPos := LastPos;
|
||||
end
|
||||
else if InMethod and WaitingForresult then
|
||||
begin;
|
||||
Method.Returns := Lex.Token;
|
||||
WaitingForResult := False;
|
||||
end;
|
||||
end;
|
||||
tkSemiColon : begin;
|
||||
if (InMethod and InParams) or (InVarSection) then
|
||||
begin;
|
||||
if ExpectingType then
|
||||
begin;
|
||||
LastTKString := Trim(copy( ScriptToAnalyze,StartPos + 1, LastPos - StartPos - 1));
|
||||
if (InParams and InMethod) then
|
||||
for i := StartParam to Method.ParameterLen - 1 do
|
||||
Method.Parameters[i].VarType := LastTkString
|
||||
else
|
||||
for i := StartVar to Method.VarLen - 1 do
|
||||
Method.Vars[i].VarType := LastTKString;
|
||||
ExpectingType := False;
|
||||
end;
|
||||
LastTkString := Lex.Token;
|
||||
StartParam := Method.ParameterLen;
|
||||
StartVar := Method.VarLen;
|
||||
end;
|
||||
end;
|
||||
tkRoundClose: if InMethod and InParams then
|
||||
begin;
|
||||
if ExpectingType then
|
||||
begin;
|
||||
LastTKString := Trim(copy(ScriptToAnalyze,StartPos + 2, LastPos - StartPos - 2));
|
||||
for i := StartParam to Method.ParameterLen - 1 do
|
||||
Method.Parameters[i].VarType := LastTkString;
|
||||
ExpectingType := False;
|
||||
end;
|
||||
InParams := False;
|
||||
end;
|
||||
tkProcedure,
|
||||
tkFunction : begin;
|
||||
if (InVarSection or (InMethod and InParams)) and ExpectingType then
|
||||
begin;
|
||||
//Do nothing since the this procedure/function is a var ;-)
|
||||
end else
|
||||
begin;
|
||||
if not InMethod then
|
||||
InVarSection := False;
|
||||
if (not InTypes) and (not InVarSection) then
|
||||
begin;
|
||||
WaitingForResult := LastTK = tkFunction;
|
||||
if Lex.TokenID <> tkIdentifier then
|
||||
begin;
|
||||
mDebugLn('Analyzer: No method name -> exiting');
|
||||
exit;
|
||||
end;
|
||||
TempName := Lex.Token;
|
||||
TempInt := Lex.TokenPos;
|
||||
Lex.NextNoJunk;
|
||||
if Lex.TokenID = tkRoundOpen then
|
||||
InParams := True
|
||||
else if Lex.TokenID = tkPoint then
|
||||
begin;
|
||||
mDebugLn('Analyzer: In class definition?');
|
||||
// FormAnalyzer.SynEdit2.Lines.add('In class definition *cough*');
|
||||
Lex.NextNoJunk;
|
||||
TempName := Lex.Token;
|
||||
end else if ((Lex.TokenID = tkSemicolon) xor WaitingForResult) or ((Lex.TokenID = tkColon) xor WaitingForResult) then
|
||||
begin;
|
||||
InParams := False;
|
||||
end else
|
||||
begin;
|
||||
mDebugLn('Analyzer: You''re missing some stuff in the procedure declaration');
|
||||
Exit;
|
||||
end;
|
||||
if InMethod then
|
||||
Method := Method.AddMethod(WaitingForResult,TempName)
|
||||
else
|
||||
Method := Self.AddMethod(WaitingForResult,TempName);
|
||||
InMethod := true;
|
||||
Method.Beginpos := TempInt;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
// SynEdit2.Lines.Add(TokeToString(Lex.TokenID) + '-' + Lex.Token);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,22 +1,22 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TSimbaUpdateForm','FORMDATA',[
|
||||
'TPF0'#16'TSimbaUpdateForm'#15'SimbaUpdateForm'#4'Left'#3#6#1#6'Height'#3'K'#1
|
||||
+#3'Top'#3#219#0#5'Width'#3#217#1#13'ActiveControl'#7#12'UpdateButton'#11'Bor'
|
||||
+'derIcons'#11#12'biSystemMenu'#10'biMinimize'#0#7'Caption'#6#12'Update Simba'
|
||||
+#12'ClientHeight'#3'K'#1#11'ClientWidth'#3#217#1#8'OnCreate'#7#10'FormCreate'
|
||||
+#6'OnShow'#7#15'CleanUpdateForm'#10'LCLVersion'#6#6'0.9.29'#0#12'TProgressBa'
|
||||
+'r'#16'DownloadProgress'#4'Left'#2#8#6'Height'#2#29#3'Top'#3#12#1#5'Width'#3
|
||||
+#198#1#7'Anchors'#11#6'akLeft'#7'akRight'#8'akBottom'#0#6'Smooth'#9#8'TabOrd'
|
||||
+'er'#2#0#0#0#7'TButton'#12'UpdateButton'#4'Left'#3#131#1#6'Height'#2#25#3'To'
|
||||
+'p'#3','#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6
|
||||
+#7'Update!'#7'OnClick'#7#17'UpdateButtonClick'#8'TabOrder'#2#1#0#0#7'TButton'
|
||||
+#11'CloseButton'#4'Left'#2#8#6'Height'#2#25#3'Top'#3','#1#5'Width'#2'K'#7'An'
|
||||
+'chors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#5'Close'#7'OnClick'#7#16'Clo'
|
||||
+'seButtonClick'#8'TabOrder'#2#2#0#0#5'TMemo'#9'UpdateLog'#4'Left'#2#8#6'Heig'
|
||||
+'ht'#3#253#0#3'Top'#2#8#5'Width'#3#198#1#7'Anchors'#11#5'akTop'#6'akLeft'#7
|
||||
+'akRight'#8'akBottom'#0#8'TabOrder'#2#3#0#0#6'TLabel'#13'DownloadSpeed'#4'Le'
|
||||
+'ft'#2'`'#6'Height'#2#14#3'Top'#3'2'#1#5'Width'#2'N'#7'Anchors'#11#6'akLeft'
|
||||
+#8'akBottom'#0#7'Caption'#6#13'DownloadSpeed'#11'ParentColor'#8#7'Visible'#8
|
||||
+#0#0#0
|
||||
]);
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
LazarusResources.Add('TSimbaUpdateForm','FORMDATA',[
|
||||
'TPF0'#16'TSimbaUpdateForm'#15'SimbaUpdateForm'#4'Left'#3#6#1#6'Height'#3'K'#1
|
||||
+#3'Top'#3#219#0#5'Width'#3#217#1#13'ActiveControl'#7#12'UpdateButton'#11'Bor'
|
||||
+'derIcons'#11#12'biSystemMenu'#10'biMinimize'#0#7'Caption'#6#12'Update Simba'
|
||||
+#12'ClientHeight'#3'K'#1#11'ClientWidth'#3#217#1#8'OnCreate'#7#10'FormCreate'
|
||||
+#6'OnShow'#7#15'CleanUpdateForm'#10'LCLVersion'#6#6'0.9.29'#0#12'TProgressBa'
|
||||
+'r'#16'DownloadProgress'#4'Left'#2#8#6'Height'#2#29#3'Top'#3#12#1#5'Width'#3
|
||||
+#198#1#7'Anchors'#11#6'akLeft'#7'akRight'#8'akBottom'#0#6'Smooth'#9#8'TabOrd'
|
||||
+'er'#2#0#0#0#7'TButton'#12'UpdateButton'#4'Left'#3#131#1#6'Height'#2#25#3'To'
|
||||
+'p'#3','#1#5'Width'#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6
|
||||
+#7'Update!'#7'OnClick'#7#17'UpdateButtonClick'#8'TabOrder'#2#1#0#0#7'TButton'
|
||||
+#11'CloseButton'#4'Left'#2#8#6'Height'#2#25#3'Top'#3','#1#5'Width'#2'K'#7'An'
|
||||
+'chors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#5'Close'#7'OnClick'#7#16'Clo'
|
||||
+'seButtonClick'#8'TabOrder'#2#2#0#0#5'TMemo'#9'UpdateLog'#4'Left'#2#8#6'Heig'
|
||||
+'ht'#3#253#0#3'Top'#2#8#5'Width'#3#198#1#7'Anchors'#11#5'akTop'#6'akLeft'#7
|
||||
+'akRight'#8'akBottom'#0#8'TabOrder'#2#3#0#0#6'TLabel'#13'DownloadSpeed'#4'Le'
|
||||
+'ft'#2'`'#6'Height'#2#14#3'Top'#3'2'#1#5'Width'#2'N'#7'Anchors'#11#6'akLeft'
|
||||
+#8'akBottom'#0#7'Caption'#6#13'DownloadSpeed'#11'ParentColor'#8#7'Visible'#8
|
||||
+#0#0#0
|
||||
]);
|
||||
|
||||
@ -1,64 +1,64 @@
|
||||
program new;
|
||||
{$LoadDLL libsmart}
|
||||
function IsKeyDown(C:Char): Boolean;
|
||||
begin
|
||||
Result := SmartIsKeyDown(ord(c));
|
||||
end;
|
||||
|
||||
procedure MoveMouse(x, y: Integer);
|
||||
begin
|
||||
SmartMoveMouse(x, y);
|
||||
end;
|
||||
|
||||
procedure HoldMouse(x, y: Integer; left: Boolean);
|
||||
begin
|
||||
SmartHoldMouse(x, y, left);
|
||||
end;
|
||||
|
||||
procedure ReleaseMouse(x, y: Integer; left: Boolean);
|
||||
begin
|
||||
SmartReleaseMouse(x, y, left);
|
||||
end;
|
||||
|
||||
procedure KeyUp(key: byte);
|
||||
begin
|
||||
If Key = 13 Then
|
||||
Key := 10;
|
||||
SmartReleaseKey(key);
|
||||
end;
|
||||
|
||||
procedure KeyDown(key: byte);
|
||||
begin
|
||||
If Key = 13 Then
|
||||
Key := 10;
|
||||
SmartHoldKey(key);
|
||||
end;
|
||||
|
||||
procedure SendKeys(S: String);
|
||||
begin
|
||||
SmartSendKeys(S);
|
||||
end;
|
||||
|
||||
procedure GetMousePos(var x, y: Integer);
|
||||
begin
|
||||
SmartGetMousePos(x, y);
|
||||
end;
|
||||
|
||||
function GetColor(x, y: Integer): Integer;
|
||||
begin
|
||||
result:= SmartGetColor(x, y);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
w,h:integer;
|
||||
begin
|
||||
SmartSetup('http://world19.runescape.com/', 'plugin.js?param=o0,a1,m0', 765, 503);
|
||||
SetTargetArray(SmartImageArray(), 765,503);
|
||||
getclientdimensions(w,h);
|
||||
writeln(inttostr(w) + ' , ' + inttostr(h));
|
||||
if findcolortolerance(w,h,00000,0,0,764,502,300) then
|
||||
smartmovemouse(w,h);
|
||||
savescreenshot('/tmp/smart.bmp');
|
||||
//Wait(5000);
|
||||
end.
|
||||
program new;
|
||||
{$LoadDLL libsmart}
|
||||
function IsKeyDown(C:Char): Boolean;
|
||||
begin
|
||||
Result := SmartIsKeyDown(ord(c));
|
||||
end;
|
||||
|
||||
procedure MoveMouse(x, y: Integer);
|
||||
begin
|
||||
SmartMoveMouse(x, y);
|
||||
end;
|
||||
|
||||
procedure HoldMouse(x, y: Integer; left: Boolean);
|
||||
begin
|
||||
SmartHoldMouse(x, y, left);
|
||||
end;
|
||||
|
||||
procedure ReleaseMouse(x, y: Integer; left: Boolean);
|
||||
begin
|
||||
SmartReleaseMouse(x, y, left);
|
||||
end;
|
||||
|
||||
procedure KeyUp(key: byte);
|
||||
begin
|
||||
If Key = 13 Then
|
||||
Key := 10;
|
||||
SmartReleaseKey(key);
|
||||
end;
|
||||
|
||||
procedure KeyDown(key: byte);
|
||||
begin
|
||||
If Key = 13 Then
|
||||
Key := 10;
|
||||
SmartHoldKey(key);
|
||||
end;
|
||||
|
||||
procedure SendKeys(S: String);
|
||||
begin
|
||||
SmartSendKeys(S);
|
||||
end;
|
||||
|
||||
procedure GetMousePos(var x, y: Integer);
|
||||
begin
|
||||
SmartGetMousePos(x, y);
|
||||
end;
|
||||
|
||||
function GetColor(x, y: Integer): Integer;
|
||||
begin
|
||||
result:= SmartGetColor(x, y);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
w,h:integer;
|
||||
begin
|
||||
SmartSetup('http://world19.runescape.com/', 'plugin.js?param=o0,a1,m0', 765, 503);
|
||||
SetTargetArray(SmartImageArray(), 765,503);
|
||||
getclientdimensions(w,h);
|
||||
writeln(inttostr(w) + ' , ' + inttostr(h));
|
||||
if findcolortolerance(w,h,00000,0,0,764,502,300) then
|
||||
smartmovemouse(w,h);
|
||||
savescreenshot('/tmp/smart.bmp');
|
||||
//Wait(5000);
|
||||
end.
|
||||
|
||||
@ -1,142 +1,142 @@
|
||||
program new;
|
||||
var
|
||||
Bmpz : integer;
|
||||
w,h : integer;
|
||||
begin
|
||||
Bmpz := BitmapFromString(166, 73, 'beNq9Xf2PVeURtv+Jv' +
|
||||
'zeKSYvZaNlc2/S4N22tmtoYE0NsLdYQQoiClpgNQaSUUpRSpFhC/a' +
|
||||
'yIX0QCVaOtxn/MYWd39rnPM/Pecz/OJm82994958z7vjPvfM+c1ZW' +
|
||||
'f/+RHOtZWd9vwD/T7eLT7Fz+9z/7G17g+LrYfbdC99ks3mvil2/jF' +
|
||||
'nxDP8YfbX/8Q/8WB/wro9KM/wQbOKmau42f33W0Dv6aXLTgcCu6Dz' +
|
||||
'6cbreDqYi3+tRttbm8nk9/YwxVcFG07ogORopitNieQjo/y22/jdH' +
|
||||
'XF1+W/2GSqDcSlxTPxK2IWf8Tf/bE+W7rXL/NpBDbjXzGlWMsD994' +
|
||||
'V0/av9//4h36N345LCFKfSjb+1bYlZuJoInTE8mPgj3qmcA8JOym+' +
|
||||
'cN8aBKm3IyycA36mVeMpUyaAvCJWFxfghPHk4i/+nDjODiKwr8tJ9' +
|
||||
'6RappMBnan2EdYdwPXG79Vp8pl3gKBuch+QVXZbn4OQKozjw5Gpxv' +
|
||||
'Lj7LR5VEp46XEYC1U7cnFRSNXdJBuvzjiNlAD0PBIx0PRo2ElvnIV' +
|
||||
'YqX2wK20YkTxw7z1KKr5efxohTlGGHM9/jzl3k1JVT73OdvuYrK7E' +
|
||||
'mcJjiA8h5l8h/Y47fmCD7rVV2MLxmUFIKrDiAJIUoyuJ//sHh07iA' +
|
||||
'DnG2mgXbmyAQ25PqCGCj4MWk4wHOnRfrKNbBRnugBODajWpyDOx6J' +
|
||||
'cFxG5LsvtjHXqba5HqNZWZ00FG3NlwiKdOrR879kKAjusd41MB4ZT' +
|
||||
'wCJNAJ+lmHwh6XB+U01OhQloidpTO3KEo9IrPK08IZQznidgkVkAs' +
|
||||
'vRPoJAdRhCknVElHaNVrgrYN4jvvXPzyy+sXLpw+ePCZOOmhHaWaD' +
|
||||
'G0mcuyYACIa9Rn/VwVdNZlNGhjtIgVMgdq9D3d7/GuwZeWcSOcE3f' +
|
||||
'l2KgiC49FRIu0F7QvcBNyTCnolvGg/U2VeMY57hRA//+/H3377+Xf' +
|
||||
'ffXn16uX19cP2+z133tlHB8DT5PMhso+FE1fvAx0nEIBQptB+kgqR' +
|
||||
'2hf+wD7Qg7E7n9c9JLUccYpfSbchXDfWTuoiYbzi2+lAiLduffjVV' +
|
||||
'5/Z+PrrG///381vvrl1/vypI0cOOKn31PqQqvGr/+Kma0y1P/SKtF' +
|
||||
'SDVbQaN0AaS+m8J3RHcSA9JHhqgqH8IuwTrvuvvc3SKzmOS3aIN25' +
|
||||
'cNaA2jMy++OITG8ZbbALvvXfppZeec2JDo6yN9MAv2dG+XWt77o4l' +
|
||||
'94eOoGMP8bA7OBSyZDlun7UNrW8m6JW2bBhfXbmLbEy1xJEe4mjPC' +
|
||||
'h3lAunGwTYrBIXINoifffafTz99+/r1d+2DDZvAzZsf4Bxee/WVo0' +
|
||||
'cPuTwNPKZKqdJe5WSYA/oYLFbaPdTYyX2UOvfmgI4ycbylaSvoCtG' +
|
||||
'I8bmhI64R47jViPRwfgZEA2fj2rUrNj766N+ffPyW/+JzsAn4HOxK' +
|
||||
'IzanNxLHhE3yppJvFsXWfNBRSJHninQGPBQdCL5FoJPrQP0D8TWsM' +
|
||||
'BJqC6499VeoDwcXHhANhA37YMO4x/vvv2HDtAWfQMzBJuBzOHv2Zb' +
|
||||
'cXnLfn7q8NXk2uP7xsKdDJzEdHRzdpCZJqscS1q+O0Kyy+IIDl7nx' +
|
||||
'YNx2gm7huQHS6+tcbr16+fO7Klb/beGXXbhs4B5tAzMFneODwkePH' +
|
||||
'/2TDFQn1/boGizo5mttLhK6OtdQ1gadvudDVxVTpS0Rpi0NPfZUUf' +
|
||||
'kJc+9NMAzRbz8bFi2cuXTrrQG3YBN588x8xB5tAzMGneubM8RMnjj' +
|
||||
'qxdVtUTa5vFWRDQEcfMvJS1ZqGgI4SLXWhK09bInSV0Rh+cgKLh9i' +
|
||||
'NxiJsmD5w7tyfbfgcAjQOm8Pbb71uI8jv2UOHTp58yYa7H9EJluqi' +
|
||||
'vuQhoFO4p+K0A0FXp184xPAIDAS98rc7xh2oDyMSu8XMARunTx+jO' +
|
||||
'QQ4Jz8byHxiDnv37bN7bYTHm8LWqNcNCj3s4hTjOwBdRQmy1qF3Hu' +
|
||||
'0RhG7/dRqzsb5+2BQAlwg+BxtKYEiBNgefhs3Br7fZGr0dXl8P/kZ' +
|
||||
'RLeKog0IPdI8zt97Q0FMHMmpNQ0OnUGwosXaBa4N2r1l2NkzV9znY' +
|
||||
'SLmKE6FRoBOhT9V+2f/c8w7RgaLqqBGTQPpw0MO9iV591G0GhZ4eM' +
|
||||
'Tz7Q0Mn5QGJzdUGG4cOPfv88/uPHDnw4osHbcQcfBoI2lmQz82gm7' +
|
||||
'ponxCiA628THHwh4OuerIGZAeFHhDJVAxKGA56GoQlu8wNPeMYBw7' +
|
||||
'84eDBZ2zEHHwaPocgQvtg1GVkdvCFF43O0t1Gnx5yVEqjWjr0Kl8L' +
|
||||
'GU4Y5kuHHgycdiDNxxgCuqoQGkG2W9yyMwVg3769z/7xKRv79//e5' +
|
||||
'uDT8DkEEZqssRmmEOPJqCbpVzTTlgg9dR1TbGLbEbfhDlru2impEv' +
|
||||
'eZYuVB7cuCjjZ4h9HJjQQYNR/sXnfimaTYu/fx3z31xNNPP2lz8Gn' +
|
||||
'YHGwYUNMQTG0w9fLoiRPpelU51yNGF7ijb0HolE6gpzvNiY2DtiD0' +
|
||||
'cebKU1YTkfrlQsdMNs18IKU9uI09wcTD9evvmhbx+OOPPPHEb5588' +
|
||||
'rc2fA5GXSY7TDm8Haw5efKVV19TLqrqGaGbfFCktM8NHcP65N9Io5' +
|
||||
'ORTbcU6EjGGmkNvdH4iY34TI7lRdautJ3mMqW/2KNu3LhqWoSxjkc' +
|
||||
'f/aWNxx77tQkRM/HMCjCV0iZm5gESWJpVRYnllM6kccnY9lmh0wKR' +
|
||||
'e7cx7nyP/H6zQg8nj1r6uNjKXojb/bjNCl19p2H9UYSUQqXE2I2Eb' +
|
||||
't78wCSF8RPTEIzPGOHdzrU4derU+fMqNOkJGqTT0LPvCbm/5oBOt6' +
|
||||
'fqGQ7PqKfUGqS3WdeeUhpJzMCIJ0VgGgYZibNCxwRmzLdHesPT3Y3' +
|
||||
'y42CPvXXrQ9MizMS7fPnctWtXjv3ldAqRTlA7kYZQkIp1l2h9oKf+' +
|
||||
'0tSxpnRVJaL0XztVu9A+B1ePCpRANGluIWEjkNR/5wODaTIPBoUpT' +
|
||||
'o3UGKs++89LpkWYvXD8r2dOX7igKoqWC6FnqZH3opusGJ8KPTXt0z' +
|
||||
'QDPEQVaMqPbUNHnoZZTMRh0LUb2lrci7FyrKroAx1v75q55WmeiZY' +
|
||||
'PhEx5+W9nz7x+MT1Zmp+GG6tFTMptiGBClQqSa0BXNSke8nC355Hx' +
|
||||
'A9XpJlyTQ2brXKy0oWMOW0U8eITTah3aQPJ4p9ArS7MT0Um+DlKck' +
|
||||
'C9R5Ut/Hk6qoLpZCAQhOjbK8EXhS1JH48mE1niUPeHhtdU+GCdNng' +
|
||||
'6s4lp1YBLcPqWGVYgVeXg61I6reBqKg6hfIH2JHqhphEo2iEdcL6p' +
|
||||
'eeCOlYaep11WBoWoUOBz6r9buj+sp+1cTpRqCW8tbSOugu9CZQzdq' +
|
||||
'9qljHOkQVaOHuhH63PrkkNO5rlCGWLv9qNWVdm1gNxnTSRWwqlI1K' +
|
||||
'q282MqzNBu1qFpnpL+0NS63ZO1z0EBsYJUH3lbVdA406KTEKm4jcW' +
|
||||
'20uaWjXepONNTjoaZAkobsqzyooPPIvyVDTG1D4iHtKtFxpto1hqM' +
|
||||
'bzUycQ2od49ywiLKBcdITHN1YVY1ZgvHfNvHgw1NrWmM9qTmApwYL' +
|
||||
'WyiP0Y4eMoo0ESjVMVTPp0ic0uTm07bql1OMt4vO+pfDp7o3kXHVD' +
|
||||
'aCqQ0n9dQ2FXOuVGuhO3QI53je4JZWfO7r9A1Wya8uFVMdrgE6rBq' +
|
||||
'I4tJLIOmftMDB3uwNlMunGqozQPdGVpkzYU3zxOIeShviNY94Q7lM' +
|
||||
'NdtQP0RAj9QmtUdTE1LOtx7mVi7W6knLaiVOwFRmZOrRItiofSOtq' +
|
||||
'kyK+1U1fZapBYeFzGpuumHn8yzGo/MGGYTxkejcZEdMz1ZPP096Se' +
|
||||
'kxSspJBMWfc5MYR3jQ0HhxRHLkS1rMOtc6matpUBalOvAYGlQ9oYm' +
|
||||
'3IvoYGFdjvpFTcy4V6FnrQZcT8FeOoFronraF7pPUI0R0l9Hb1tKe' +
|
||||
'hTNRSGiyLOnVUZYxVMxPtylI1WplaOYX71okKRLen8i69nm40Mpjp' +
|
||||
'CCjG00YEVKRDJwLVM53zVA+/lu5WTYd6HvCUTpTOUWmsdIxGgLub5' +
|
||||
'GzjQvHGE03KEpFTpYegOUZtARr0pn1j4smuAFSIJiJUryntiSJdu1' +
|
||||
'XgcGrRKmMvPDc7VyvNMRJEa0T5i9XxarWRzw0/NwRBVQZL6lk36cf' +
|
||||
'WoAmFzmPa1amJM9XgLUo/xk4rvR1X1HDRR3yqUrQqNSy2VC82evPl' +
|
||||
'uPbVqGKgxzYal5E3jEhOufpUjHegf3Yjflr0gdHyzCotQbNQsDdUm' +
|
||||
'4kRb4k+MKm20MiTJ7OlYdapCa/QdaXsZlzdluboT1aFJwwx9Rt4oz' +
|
||||
'Cs7PBSiLQ/W7rnVVw17bcThqdW8UcvFFTkqFdDugT1SaKWgh4VNdL' +
|
||||
'TXihpjpOmU2p8x2HhrMw6I9Tg8xU6hVdiK1wJ3+o3ck/KdV2jS/MD' +
|
||||
'cVZBNgSd1OzKWK5ccIjTShtvdCNpkFyFi4pRV2GRNvSGF6tyOaItH' +
|
||||
'Dc+tDYibzkWJCr0EKM0W7Tr0T9J14R1lnKkuL7RAwePUlAIAaq6Em' +
|
||||
'lmi3ZYqrqRbJ7u0a7UzQJF09tGdFpHTy5TLGlvQE+tsKl9tCq3Hkb' +
|
||||
'E+nRioVCgE4w/BHlXJWsq1bFnFxoNEum5a3QiDWRhUnffPjBbaXtu' +
|
||||
'iqLTG/NhUmHhe6Ue8p7QSY9Now8N46JSXHtCD19QPCeQbvwKsZ/6u' +
|
||||
'NSon2nnNa6hXru00SJtTqTX9u9GMs76laW9lVI/z6YqO5mMNFMXGt' +
|
||||
'KiQ13pad7S9GZdOybKBsZxYAkYCtNKhM269j7xODrXaWV3/24k5Fq' +
|
||||
'MNstkTWv6dOio2jOhP3SyONIOimgXd/UBn68LDfIQ5O2EdMqWIeXB' +
|
||||
'xnwdeHRv04586KsJ4lykGwlG4dXQrhLmqbB6kU4sbZeUhryrrjtz9' +
|
||||
'8BRzWSbw4MJoLNacOfbqgsVyChtL9iJBZuIVm4QZTtLgZ6mHERqAd' +
|
||||
'YXo58Hd3vBTixVP4qGKr6stVNCGmGcxOgSu5F0PXzmWhSzxC405NX' +
|
||||
'R7isVD18cugaMXGZNuEwhQW650DVomyaWD9GNZDt8LIYhGWsDQU/D' +
|
||||
'lBjhJTpfLvR2ly2sNByiC00aQQsaGK4bSdWAhbwKA3ViodBP6O3Yh' +
|
||||
'XXQLjSaP4wN9ofrA9NO8hy6G0kjpBvoHgg6RTAxjukm/86vHcXZzq' +
|
||||
'xdc/Z2oA8MURpVTw8KHeNumsOzA2tHc4wy7Xdy51VpGboPTDBS8rA' +
|
||||
'NDT38OZpNFCQ36No1IuM/uum9YzuPPgcDPVw3EordY5tcrHQbFDrl' +
|
||||
'wpEjaAegN/Jmh4PuvIX81T6H8PAsvRuJpuph50AKvC4XejtHCDmMH' +
|
||||
'cAdgJ6i25n8ENAb9XeI8WV1IyF/KeUeaHGrq6xL7MQSaa601eFZ1Y' +
|
||||
'O23D4wtOGVzbL0ne+Z7BeqxVK6kWhRDKGbCiswGriULjSNw4Up7lo' +
|
||||
'5viB0xDJ+Jsc+7bkT4RLX3o1miBMt2I2ky7I605qItBB1QeiNMiKK' +
|
||||
'yqVVUYtAx0hoO72qiowv3oWm6rmU1sLQwhfvA6MZsFVlBCV0zd0Lh' +
|
||||
'bIKVYVo1J7E8Z+vC02Fa1xa9YKYyHdyTWa+HjhVonvF7jRiNV8nlr' +
|
||||
'RYhmIZ8T7T9P0vc3RiqXKoFG5Dc0N6mxV6zx4FE+9mgoowN5QC4zN' +
|
||||
'BD7iaAtEI2aTJCTP1QtHsxKpUaqIbxlbxo6ag9O+FUlUjpmmQyNJV' +
|
||||
'l4vY9ExdaG43KNgY6bkeQ1JEo04ZWUR/6A0JUq0O31yjpN7uRlLle' +
|
||||
'NP7NOnh6TvsNP11KvR2Sc7UKjNtKzHr2isjSys+MAhLMfGwi2+nr2' +
|
||||
'/pk1Ohk/tOMz/7hGW12r3RiSUqpjVhjN615P/VupUgRX29whhex1l' +
|
||||
'B71n/m7YG1d4jlftxahcafCYx9mpXKfulwlobOuXL+WfNuW0jXfM0' +
|
||||
'MPtd22/qi+bbZeZpvZKmK5BKk0qQIBgV2VXWgdKb/kvvTbmobqkTv' +
|
||||
'/6L3ihtw9SzFOOb7tYt5Q2Dp7rzrubFc+yzj3imf527htpMSNWOcL' +
|
||||
'ejGx51C0lFuRbU42O1pCs6sYQzp9FGoErtbltqVfEIdqEhaev8AbO' +
|
||||
'R22+lRJUS0U32hStvSAPbmuGDo+rwOnIDxRW625Xm2lWyLSMmurRJ' +
|
||||
'U4LIc4voSVrUGRjfPBRb1VjY7gwba2hrDnrlaFqzlpYcTrTNaa4un' +
|
||||
'rOdgbznbsxWavQ/ieNJF2DxC0pn/7xJYw+OpoqhqTWnU7Pi1UEUOl' +
|
||||
'gIHX+Nr7duoP7h1DRsgsNPqrLaZU5zk+IlZZqSN5YCh9QUjWhpN6l' +
|
||||
'm9FFyQuWIWhU84FUOdspksM4okml9bq4J+EmnE61lUI0J69vEdNUq' +
|
||||
'Q4lZpZG+tLhS++s2ClLUXE21Aqzg7ia7J6X1renO0Bmvuv8lGs5W3' +
|
||||
'xXcE6wyaNQKRduHgE6sW/fWSSLdbfWcTFXPsNJ5LO9wTAveUxcxvf' +
|
||||
'WV6psUv423Syd8dbLrO/HqwPu2RiQSilKMegawti01UJtJ3w4iIe2' +
|
||||
'ry1KUA7kh/QmPgetGv8Ew37Q1Qa9uRUUfsEZibUP/SZ1saRd9dbv1' +
|
||||
'gZVSTtuVpMt0PkzqE5VETZWA9ORAYtxORWo4HJuqd6EyhpGdBsanM' +
|
||||
'pM+fH7qXVRxSZ6WbsS9QJMebtBVLH1PqzZk07pdJOxutBsNn0huof' +
|
||||
'6H6avb2+2V0KYgqUdS1VFABNOoOkm3FI98BHDT0ADJgrLZi5G3j3a' +
|
||||
'Po+8BCV1cWQ==');
|
||||
GetBitmapSize(bmpz,w,h);
|
||||
Writeln(inttostr(w) + '-' + inttostr(h));
|
||||
SetBitmapSize(Bmpz,w div 2, h div 2);
|
||||
SaveBitmap(Bmpz,'/tmp/test.bmp');
|
||||
//FreeBitmap(Bmpz);
|
||||
Bmpz := LoadBitmap('/tmp/test.bmp');
|
||||
SetBitmapSize(bmpz,w,h);
|
||||
SaveBitmap(Bmpz,'/tmp/test2.bmp');
|
||||
program new;
|
||||
var
|
||||
Bmpz : integer;
|
||||
w,h : integer;
|
||||
begin
|
||||
Bmpz := BitmapFromString(166, 73, 'beNq9Xf2PVeURtv+Jv' +
|
||||
'zeKSYvZaNlc2/S4N22tmtoYE0NsLdYQQoiClpgNQaSUUpRSpFhC/a' +
|
||||
'yIX0QCVaOtxn/MYWd39rnPM/Pecz/OJm82994958z7vjPvfM+c1ZW' +
|
||||
'f/+RHOtZWd9vwD/T7eLT7Fz+9z/7G17g+LrYfbdC99ks3mvil2/jF' +
|
||||
'nxDP8YfbX/8Q/8WB/wro9KM/wQbOKmau42f33W0Dv6aXLTgcCu6Dz' +
|
||||
'6cbreDqYi3+tRttbm8nk9/YwxVcFG07ogORopitNieQjo/y22/jdH' +
|
||||
'XF1+W/2GSqDcSlxTPxK2IWf8Tf/bE+W7rXL/NpBDbjXzGlWMsD994' +
|
||||
'V0/av9//4h36N345LCFKfSjb+1bYlZuJoInTE8mPgj3qmcA8JOym+' +
|
||||
'cN8aBKm3IyycA36mVeMpUyaAvCJWFxfghPHk4i/+nDjODiKwr8tJ9' +
|
||||
'6RappMBnan2EdYdwPXG79Vp8pl3gKBuch+QVXZbn4OQKozjw5Gpxv' +
|
||||
'Lj7LR5VEp46XEYC1U7cnFRSNXdJBuvzjiNlAD0PBIx0PRo2ElvnIV' +
|
||||
'YqX2wK20YkTxw7z1KKr5efxohTlGGHM9/jzl3k1JVT73OdvuYrK7E' +
|
||||
'mcJjiA8h5l8h/Y47fmCD7rVV2MLxmUFIKrDiAJIUoyuJ//sHh07iA' +
|
||||
'DnG2mgXbmyAQ25PqCGCj4MWk4wHOnRfrKNbBRnugBODajWpyDOx6J' +
|
||||
'cFxG5LsvtjHXqba5HqNZWZ00FG3NlwiKdOrR879kKAjusd41MB4ZT' +
|
||||
'wCJNAJ+lmHwh6XB+U01OhQloidpTO3KEo9IrPK08IZQznidgkVkAs' +
|
||||
'vRPoJAdRhCknVElHaNVrgrYN4jvvXPzyy+sXLpw+ePCZOOmhHaWaD' +
|
||||
'G0mcuyYACIa9Rn/VwVdNZlNGhjtIgVMgdq9D3d7/GuwZeWcSOcE3f' +
|
||||
'l2KgiC49FRIu0F7QvcBNyTCnolvGg/U2VeMY57hRA//+/H3377+Xf' +
|
||||
'ffXn16uX19cP2+z133tlHB8DT5PMhso+FE1fvAx0nEIBQptB+kgqR' +
|
||||
'2hf+wD7Qg7E7n9c9JLUccYpfSbchXDfWTuoiYbzi2+lAiLduffjVV' +
|
||||
'5/Z+PrrG///381vvrl1/vypI0cOOKn31PqQqvGr/+Kma0y1P/SKtF' +
|
||||
'SDVbQaN0AaS+m8J3RHcSA9JHhqgqH8IuwTrvuvvc3SKzmOS3aIN25' +
|
||||
'cNaA2jMy++OITG8ZbbALvvXfppZeec2JDo6yN9MAv2dG+XWt77o4l' +
|
||||
'94eOoGMP8bA7OBSyZDlun7UNrW8m6JW2bBhfXbmLbEy1xJEe4mjPC' +
|
||||
'h3lAunGwTYrBIXINoifffafTz99+/r1d+2DDZvAzZsf4Bxee/WVo0' +
|
||||
'cPuTwNPKZKqdJe5WSYA/oYLFbaPdTYyX2UOvfmgI4ycbylaSvoCtG' +
|
||||
'I8bmhI64R47jViPRwfgZEA2fj2rUrNj766N+ffPyW/+JzsAn4HOxK' +
|
||||
'IzanNxLHhE3yppJvFsXWfNBRSJHninQGPBQdCL5FoJPrQP0D8TWsM' +
|
||||
'BJqC6499VeoDwcXHhANhA37YMO4x/vvv2HDtAWfQMzBJuBzOHv2Zb' +
|
||||
'cXnLfn7q8NXk2uP7xsKdDJzEdHRzdpCZJqscS1q+O0Kyy+IIDl7nx' +
|
||||
'YNx2gm7huQHS6+tcbr16+fO7Klb/beGXXbhs4B5tAzMFneODwkePH' +
|
||||
'/2TDFQn1/boGizo5mttLhK6OtdQ1gadvudDVxVTpS0Rpi0NPfZUUf' +
|
||||
'kJc+9NMAzRbz8bFi2cuXTrrQG3YBN588x8xB5tAzMGneubM8RMnjj' +
|
||||
'qxdVtUTa5vFWRDQEcfMvJS1ZqGgI4SLXWhK09bInSV0Rh+cgKLh9i' +
|
||||
'NxiJsmD5w7tyfbfgcAjQOm8Pbb71uI8jv2UOHTp58yYa7H9EJluqi' +
|
||||
'vuQhoFO4p+K0A0FXp184xPAIDAS98rc7xh2oDyMSu8XMARunTx+jO' +
|
||||
'QQ4Jz8byHxiDnv37bN7bYTHm8LWqNcNCj3s4hTjOwBdRQmy1qF3Hu' +
|
||||
'0RhG7/dRqzsb5+2BQAlwg+BxtKYEiBNgefhs3Br7fZGr0dXl8P/kZ' +
|
||||
'RLeKog0IPdI8zt97Q0FMHMmpNQ0OnUGwosXaBa4N2r1l2NkzV9znY' +
|
||||
'SLmKE6FRoBOhT9V+2f/c8w7RgaLqqBGTQPpw0MO9iV591G0GhZ4eM' +
|
||||
'Tz7Q0Mn5QGJzdUGG4cOPfv88/uPHDnw4osHbcQcfBoI2lmQz82gm7' +
|
||||
'ponxCiA628THHwh4OuerIGZAeFHhDJVAxKGA56GoQlu8wNPeMYBw7' +
|
||||
'84eDBZ2zEHHwaPocgQvtg1GVkdvCFF43O0t1Gnx5yVEqjWjr0Kl8L' +
|
||||
'GU4Y5kuHHgycdiDNxxgCuqoQGkG2W9yyMwVg3769z/7xKRv79//e5' +
|
||||
'uDT8DkEEZqssRmmEOPJqCbpVzTTlgg9dR1TbGLbEbfhDlru2impEv' +
|
||||
'eZYuVB7cuCjjZ4h9HJjQQYNR/sXnfimaTYu/fx3z31xNNPP2lz8Gn' +
|
||||
'YHGwYUNMQTG0w9fLoiRPpelU51yNGF7ijb0HolE6gpzvNiY2DtiD0' +
|
||||
'cebKU1YTkfrlQsdMNs18IKU9uI09wcTD9evvmhbx+OOPPPHEb5588' +
|
||||
'rc2fA5GXSY7TDm8Haw5efKVV19TLqrqGaGbfFCktM8NHcP65N9Io5' +
|
||||
'ORTbcU6EjGGmkNvdH4iY34TI7lRdautJ3mMqW/2KNu3LhqWoSxjkc' +
|
||||
'f/aWNxx77tQkRM/HMCjCV0iZm5gESWJpVRYnllM6kccnY9lmh0wKR' +
|
||||
'e7cx7nyP/H6zQg8nj1r6uNjKXojb/bjNCl19p2H9UYSUQqXE2I2Eb' +
|
||||
't78wCSF8RPTEIzPGOHdzrU4derU+fMqNOkJGqTT0LPvCbm/5oBOt6' +
|
||||
'fqGQ7PqKfUGqS3WdeeUhpJzMCIJ0VgGgYZibNCxwRmzLdHesPT3Y3' +
|
||||
'y42CPvXXrQ9MizMS7fPnctWtXjv3ldAqRTlA7kYZQkIp1l2h9oKf+' +
|
||||
'0tSxpnRVJaL0XztVu9A+B1ePCpRANGluIWEjkNR/5wODaTIPBoUpT' +
|
||||
'o3UGKs++89LpkWYvXD8r2dOX7igKoqWC6FnqZH3opusGJ8KPTXt0z' +
|
||||
'QDPEQVaMqPbUNHnoZZTMRh0LUb2lrci7FyrKroAx1v75q55WmeiZY' +
|
||||
'PhEx5+W9nz7x+MT1Zmp+GG6tFTMptiGBClQqSa0BXNSke8nC355Hx' +
|
||||
'A9XpJlyTQ2brXKy0oWMOW0U8eITTah3aQPJ4p9ArS7MT0Um+DlKck' +
|
||||
'C9R5Ut/Hk6qoLpZCAQhOjbK8EXhS1JH48mE1niUPeHhtdU+GCdNng' +
|
||||
'6s4lp1YBLcPqWGVYgVeXg61I6reBqKg6hfIH2JHqhphEo2iEdcL6p' +
|
||||
'eeCOlYaep11WBoWoUOBz6r9buj+sp+1cTpRqCW8tbSOugu9CZQzdq' +
|
||||
'9qljHOkQVaOHuhH63PrkkNO5rlCGWLv9qNWVdm1gNxnTSRWwqlI1K' +
|
||||
'q282MqzNBu1qFpnpL+0NS63ZO1z0EBsYJUH3lbVdA406KTEKm4jcW' +
|
||||
'20uaWjXepONNTjoaZAkobsqzyooPPIvyVDTG1D4iHtKtFxpto1hqM' +
|
||||
'bzUycQ2od49ywiLKBcdITHN1YVY1ZgvHfNvHgw1NrWmM9qTmApwYL' +
|
||||
'WyiP0Y4eMoo0ESjVMVTPp0ic0uTm07bql1OMt4vO+pfDp7o3kXHVD' +
|
||||
'aCqQ0n9dQ2FXOuVGuhO3QI53je4JZWfO7r9A1Wya8uFVMdrgE6rBq' +
|
||||
'I4tJLIOmftMDB3uwNlMunGqozQPdGVpkzYU3zxOIeShviNY94Q7lM' +
|
||||
'NdtQP0RAj9QmtUdTE1LOtx7mVi7W6knLaiVOwFRmZOrRItiofSOtq' +
|
||||
'kyK+1U1fZapBYeFzGpuumHn8yzGo/MGGYTxkejcZEdMz1ZPP096Se' +
|
||||
'kxSspJBMWfc5MYR3jQ0HhxRHLkS1rMOtc6matpUBalOvAYGlQ9oYm' +
|
||||
'3IvoYGFdjvpFTcy4V6FnrQZcT8FeOoFronraF7pPUI0R0l9Hb1tKe' +
|
||||
'hTNRSGiyLOnVUZYxVMxPtylI1WplaOYX71okKRLen8i69nm40Mpjp' +
|
||||
'CCjG00YEVKRDJwLVM53zVA+/lu5WTYd6HvCUTpTOUWmsdIxGgLub5' +
|
||||
'GzjQvHGE03KEpFTpYegOUZtARr0pn1j4smuAFSIJiJUryntiSJdu1' +
|
||||
'XgcGrRKmMvPDc7VyvNMRJEa0T5i9XxarWRzw0/NwRBVQZL6lk36cf' +
|
||||
'WoAmFzmPa1amJM9XgLUo/xk4rvR1X1HDRR3yqUrQqNSy2VC82evPl' +
|
||||
'uPbVqGKgxzYal5E3jEhOufpUjHegf3Yjflr0gdHyzCotQbNQsDdUm' +
|
||||
'4kRb4k+MKm20MiTJ7OlYdapCa/QdaXsZlzdluboT1aFJwwx9Rt4oz' +
|
||||
'Cs7PBSiLQ/W7rnVVw17bcThqdW8UcvFFTkqFdDugT1SaKWgh4VNdL' +
|
||||
'TXihpjpOmU2p8x2HhrMw6I9Tg8xU6hVdiK1wJ3+o3ck/KdV2jS/MD' +
|
||||
'cVZBNgSd1OzKWK5ccIjTShtvdCNpkFyFi4pRV2GRNvSGF6tyOaItH' +
|
||||
'Dc+tDYibzkWJCr0EKM0W7Tr0T9J14R1lnKkuL7RAwePUlAIAaq6Em' +
|
||||
'lmi3ZYqrqRbJ7u0a7UzQJF09tGdFpHTy5TLGlvQE+tsKl9tCq3Hkb' +
|
||||
'E+nRioVCgE4w/BHlXJWsq1bFnFxoNEum5a3QiDWRhUnffPjBbaXtu' +
|
||||
'iqLTG/NhUmHhe6Ue8p7QSY9Now8N46JSXHtCD19QPCeQbvwKsZ/6u' +
|
||||
'NSon2nnNa6hXru00SJtTqTX9u9GMs76laW9lVI/z6YqO5mMNFMXGt' +
|
||||
'KiQ13pad7S9GZdOybKBsZxYAkYCtNKhM269j7xODrXaWV3/24k5Fq' +
|
||||
'MNstkTWv6dOio2jOhP3SyONIOimgXd/UBn68LDfIQ5O2EdMqWIeXB' +
|
||||
'xnwdeHRv04586KsJ4lykGwlG4dXQrhLmqbB6kU4sbZeUhryrrjtz9' +
|
||||
'8BRzWSbw4MJoLNacOfbqgsVyChtL9iJBZuIVm4QZTtLgZ6mHERqAd' +
|
||||
'YXo58Hd3vBTixVP4qGKr6stVNCGmGcxOgSu5F0PXzmWhSzxC405NX' +
|
||||
'R7isVD18cugaMXGZNuEwhQW650DVomyaWD9GNZDt8LIYhGWsDQU/D' +
|
||||
'lBjhJTpfLvR2ly2sNByiC00aQQsaGK4bSdWAhbwKA3ViodBP6O3Yh' +
|
||||
'XXQLjSaP4wN9ofrA9NO8hy6G0kjpBvoHgg6RTAxjukm/86vHcXZzq' +
|
||||
'xdc/Z2oA8MURpVTw8KHeNumsOzA2tHc4wy7Xdy51VpGboPTDBS8rA' +
|
||||
'NDT38OZpNFCQ36No1IuM/uum9YzuPPgcDPVw3EordY5tcrHQbFDrl' +
|
||||
'wpEjaAegN/Jmh4PuvIX81T6H8PAsvRuJpuph50AKvC4XejtHCDmMH' +
|
||||
'cAdgJ6i25n8ENAb9XeI8WV1IyF/KeUeaHGrq6xL7MQSaa601eFZ1Y' +
|
||||
'O23D4wtOGVzbL0ne+Z7BeqxVK6kWhRDKGbCiswGriULjSNw4Up7lo' +
|
||||
'5viB0xDJ+Jsc+7bkT4RLX3o1miBMt2I2ky7I605qItBB1QeiNMiKK' +
|
||||
'yqVVUYtAx0hoO72qiowv3oWm6rmU1sLQwhfvA6MZsFVlBCV0zd0Lh' +
|
||||
'bIKVYVo1J7E8Z+vC02Fa1xa9YKYyHdyTWa+HjhVonvF7jRiNV8nlr' +
|
||||
'RYhmIZ8T7T9P0vc3RiqXKoFG5Dc0N6mxV6zx4FE+9mgoowN5QC4zN' +
|
||||
'BD7iaAtEI2aTJCTP1QtHsxKpUaqIbxlbxo6ag9O+FUlUjpmmQyNJV' +
|
||||
'l4vY9ExdaG43KNgY6bkeQ1JEo04ZWUR/6A0JUq0O31yjpN7uRlLle' +
|
||||
'NP7NOnh6TvsNP11KvR2Sc7UKjNtKzHr2isjSys+MAhLMfGwi2+nr2' +
|
||||
'/pk1Ohk/tOMz/7hGW12r3RiSUqpjVhjN615P/VupUgRX29whhex1l' +
|
||||
'B71n/m7YG1d4jlftxahcafCYx9mpXKfulwlobOuXL+WfNuW0jXfM0' +
|
||||
'MPtd22/qi+bbZeZpvZKmK5BKk0qQIBgV2VXWgdKb/kvvTbmobqkTv' +
|
||||
'/6L3ihtw9SzFOOb7tYt5Q2Dp7rzrubFc+yzj3imf527htpMSNWOcL' +
|
||||
'ejGx51C0lFuRbU42O1pCs6sYQzp9FGoErtbltqVfEIdqEhaev8AbO' +
|
||||
'R22+lRJUS0U32hStvSAPbmuGDo+rwOnIDxRW625Xm2lWyLSMmurRJ' +
|
||||
'U4LIc4voSVrUGRjfPBRb1VjY7gwba2hrDnrlaFqzlpYcTrTNaa4un' +
|
||||
'rOdgbznbsxWavQ/ieNJF2DxC0pn/7xJYw+OpoqhqTWnU7Pi1UEUOl' +
|
||||
'gIHX+Nr7duoP7h1DRsgsNPqrLaZU5zk+IlZZqSN5YCh9QUjWhpN6l' +
|
||||
'm9FFyQuWIWhU84FUOdspksM4okml9bq4J+EmnE61lUI0J69vEdNUq' +
|
||||
'Q4lZpZG+tLhS++s2ClLUXE21Aqzg7ia7J6X1renO0Bmvuv8lGs5W3' +
|
||||
'xXcE6wyaNQKRduHgE6sW/fWSSLdbfWcTFXPsNJ5LO9wTAveUxcxvf' +
|
||||
'WV6psUv423Syd8dbLrO/HqwPu2RiQSilKMegawti01UJtJ3w4iIe2' +
|
||||
'ry1KUA7kh/QmPgetGv8Ew37Q1Qa9uRUUfsEZibUP/SZ1saRd9dbv1' +
|
||||
'gZVSTtuVpMt0PkzqE5VETZWA9ORAYtxORWo4HJuqd6EyhpGdBsanM' +
|
||||
'pM+fH7qXVRxSZ6WbsS9QJMebtBVLH1PqzZk07pdJOxutBsNn0huof' +
|
||||
'6H6avb2+2V0KYgqUdS1VFABNOoOkm3FI98BHDT0ADJgrLZi5G3j3a' +
|
||||
'Po+8BCV1cWQ==');
|
||||
GetBitmapSize(bmpz,w,h);
|
||||
Writeln(inttostr(w) + '-' + inttostr(h));
|
||||
SetBitmapSize(Bmpz,w div 2, h div 2);
|
||||
SaveBitmap(Bmpz,'/tmp/test.bmp');
|
||||
//FreeBitmap(Bmpz);
|
||||
Bmpz := LoadBitmap('/tmp/test.bmp');
|
||||
SetBitmapSize(bmpz,w,h);
|
||||
SaveBitmap(Bmpz,'/tmp/test2.bmp');
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user