moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-28 12:02:15 -05:00
Code Issues Releases Wiki Activity

Simba: Fix double-colour picking crash.

Browse Source
This commit is contained in:
Merlijn Wajer 2011-07-22 13:54:19 +02:00
parent 34eb23ba24
commit 297ea2abd8
2 changed files with 24 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Projects/Simba/simbaunit.pas
View File

@ -411,6 +411,7 @@ type
OpenFileData : TOpenFileData; OpenFileData : TOpenFileData;
WriteFileData : TWriteFileData; WriteFileData : TWriteFileData;
ScriptStartData : TScriptStartData; ScriptStartData : TScriptStartData;
procedure UpdateInterpreter; procedure UpdateInterpreter;
procedure HandleConnectionData; procedure HandleConnectionData;
procedure HandleOpenFileData; procedure HandleOpenFileData;
@ -2871,6 +2872,11 @@ var
c, x, y: Integer; c, x, y: Integer;
cobj: TColourPickerObject; cobj: TColourPickerObject;
begin begin
if Picker.Picking then
begin
formWriteln('Error: Already picking a colour');
exit;
end;
Picker.Pick(c, x, y); Picker.Pick(c, x, y);
cobj := TColourPickerObject.Create(c, Classes.Point(x,y), ''); cobj := TColourPickerObject.Create(c, Classes.Point(x,y), '');

21
Units/MMLAddon/colourpicker.pas
View File

@ -51,7 +51,12 @@ type
procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
private
{ Are we currently picking? }
FPicking: Boolean;
public public
manager: TIOManager; manager: TIOManager;
{ Form components } { Form components }
@ -68,7 +73,9 @@ type
{ Handles } { Handles }
InfoHandle, ImageHandle : HDC; InfoHandle, ImageHandle : HDC;
public public
property Picking: Boolean read FPicking;
property OnPick: TColourPickEvent read FPickEvent write FPickEvent; property OnPick: TColourPickEvent read FPickEvent write FPickEvent;
end; end;
@ -80,7 +87,8 @@ constructor TMColorPicker.Create(manager: TIOManager);
begin begin
inherited Create; inherited Create;
self.manager := manager; Self.manager := manager;
Self.FPicking := False;
end; end;
destructor TMColorPicker.Destroy; destructor TMColorPicker.Destroy;
@ -103,12 +111,17 @@ var
begin begin
if self.FPicking then
raise Exception.Create('Pick() has not yet returned, but has been called'
+ 'again');
Self.FPicking := True;
{ Disable both of the color pick buttons } { Disable both of the color pick buttons }
w := 0; w := 0;
h := 0; h := 0;
{ If the target window isn't valid (closed etc), make the destkop the new window} { If the target window isn't valid (closed etc), make the destkop the new window}
if not Self.Manager.TargetValid then if not Self.Manager.TargetValid then
self.Manager.SetDesktop; Self.Manager.SetDesktop;
{Desktop is needed for the whole picture} {Desktop is needed for the whole picture}
Desktop := TIOManager.Create; Desktop := TIOManager.Create;
@ -214,6 +227,8 @@ begin
Desktop.free; Desktop.free;
self.FPicking := False;
{ Re-enable the color pick buttons } { Re-enable the color pick buttons }
// Application.MainForm.Enabled := True; // Application.MainForm.Enabled := True;
// ColourHistoryForm.Enabled := True; // ColourHistoryForm.Enabled := True;