mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-11 03:45:06 -05:00
076f12e2c8
Edited the way Errors are shown (thread-safe now), When error occurs in an include Simba will open the tab(if not yet open) and go to the error, Added Writeln that accepts chars,strings and all kind of integers.. (not sure whether to keep it) Added format! git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@423 3f818213-9676-44b0-a9b4-5e4c4e03d09d
299 lines
8.0 KiB
ObjectPascal
299 lines
8.0 KiB
ObjectPascal
{
|
|
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.
|
|
|
|
Colourpicker for the Mufasa Macro Library
|
|
}
|
|
|
|
unit colourpicker;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
|
|
Graphics,
|
|
Window,MufasaTypes, colourhistory,bitmaps,input
|
|
|
|
{$IFNDEF PICKER_CLIENT}
|
|
{$IFDEF LINUX}
|
|
,x
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
;
|
|
|
|
|
|
type
|
|
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
|
|
|
|
TMColorPicker = class(TObject)
|
|
constructor Create(aWindow: TMWindow);
|
|
destructor Destroy; override;
|
|
|
|
procedure Pick(Out C, X, Y: Integer);
|
|
|
|
procedure ImageMainMouseMove(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);
|
|
public
|
|
// Will give us CopyClientToBitmap
|
|
Window: TMWindow;
|
|
|
|
// Created and freed in Pick.
|
|
Input: TMInput;
|
|
|
|
{ Form components }
|
|
ScreenForm, InfoForm : TForm;
|
|
ImageMain, ImageInfo: TImage;
|
|
Text : string;
|
|
FPickEvent : TPickEvent;
|
|
|
|
{ Some temp vars }
|
|
oldx, oldy, Color, colorx, colory: Integer;
|
|
// targetleft,targettop : integer;
|
|
|
|
TheChangedEvent,TheChangingEvent : TNotifyEvent;
|
|
|
|
{ Handles }
|
|
InfoHandle, ImageHandle : HDC;
|
|
public
|
|
property OnPick: TPickEvent read FPickEvent write FPickEvent;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
constructor TMColorPicker.Create(aWindow: TMWindow);
|
|
|
|
begin
|
|
inherited Create;
|
|
|
|
Self.Window := aWindow;
|
|
end;
|
|
|
|
destructor TMColorPicker.Destroy;
|
|
begin
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
var
|
|
closed: Boolean;
|
|
|
|
procedure TMColorPicker.Pick(Out C, X, Y: Integer);
|
|
var
|
|
w, h: integer;
|
|
SS : TShiftState;
|
|
p : TPoint;
|
|
|
|
bmp: TMufasaBitmap;
|
|
Desktop : TMWindow;
|
|
|
|
|
|
begin
|
|
{ Disable both of the color pick buttons }
|
|
w := 0;
|
|
h := 0;
|
|
{ If the target window isn't valid (closed etc), make the destkop the new window}
|
|
if not Self.Window.TargetValid then
|
|
self.Window.SetDesktop;
|
|
Input := TMInput.Create(Self.Window);//For the correct x,y values
|
|
|
|
{Desktop is needed for the whole picture}
|
|
Desktop := TMWindow.Create;
|
|
Desktop.SetDesktop;
|
|
Desktop.GetDimensions(w, h);
|
|
|
|
Application.MainForm.Enabled := False;
|
|
ColourHistoryForm.Enabled := False;
|
|
|
|
{ Create a form that will hold the client image and a form that will show cursor and color data }
|
|
ScreenForm := TForm.Create(Application.MainForm);
|
|
InfoForm := TForm.Create(ScreenForm);
|
|
|
|
{ Initialize the form that will hold the client image }
|
|
ScreenForm.Caption := 'SimbaColourPicker';
|
|
{ Set the form's dimensions to match that of the screen }
|
|
ScreenForm.Width := w;
|
|
ScreenForm.Height := h;
|
|
ScreenForm.Top := 0;
|
|
ScreenForm.left := 0;
|
|
ScreenForm.WindowState := wsmaximized;
|
|
ScreenForm.BorderStyle:= bsNone;
|
|
ScreenForm.FormStyle := fsStayOnTop;
|
|
|
|
{ Initialize the form that will hold the cursor and color info }
|
|
InfoForm.Width := 173;
|
|
InfoForm.Height := 33;
|
|
InfoForm.BorderStyle := bsNone;
|
|
InfoForm.FormStyle := fsStayOnTop;
|
|
InfoForm.Left := Mouse.CursorPos.X + 5;
|
|
InfoForm.Top := Mouse.CursorPos.Y - 15;
|
|
|
|
{ Initialize the image that will hold the cursor and color info }
|
|
ImageInfo := TImage.Create(InfoForm);
|
|
ImageInfo.Parent := InfoForm;
|
|
ImageInfo.Left := 0;
|
|
ImageInfo.Top := 0;
|
|
ImageInfo.Width := 173;
|
|
ImageInfo.Height := 33;
|
|
ImageInfo.Cursor := crCross;
|
|
ImageInfo.OnMouseMove := @ImageInfoMouseMove;
|
|
ImageInfo.Canvas.Brush.Color := 14811135;
|
|
ImageInfo.Canvas.Rectangle(0, 0, 173, 33);
|
|
ImageInfo.Canvas.Rectangle(114, 3, 140, 29);
|
|
ImageInfo.Canvas.Rectangle(142, 3, 168, 29);
|
|
ImageInfo.Canvas.Pen.Style := psClear;
|
|
|
|
{ Initialize the image that will hold the client image }
|
|
ImageMain := TImage.Create(ScreenForm);
|
|
ImageMain.Parent := ScreenForm;
|
|
ImageMain.left := 0;
|
|
ImageMain.top := 0;
|
|
ImageMain.width := ScreenForm.Width;
|
|
ImageMain.Height := ScreenForm.Height;
|
|
ImageMain.Cursor:= crCross;
|
|
ImageMain.OnMouseUp:= @ColorPickUp;
|
|
ImageMain.OnMouseMove:=@ImageMainMouseMove;
|
|
|
|
{ Copy the client to ImageMain }
|
|
bmp:=TMufasaBitmap.Create;
|
|
bmp.CopyClientToBitmap(Desktop, true, 0, 0, w-1, h-1);
|
|
ImageMain.Picture.Bitmap.Free;
|
|
ImageMain.Picture.Bitmap := bmp.ToTBitmap;
|
|
bmp.Free;
|
|
|
|
{ Set up handles and events }
|
|
ImageHandle:= ImageMain.Canvas.Handle;
|
|
InfoHandle:= ImageInfo.Canvas.Handle;
|
|
TheChangedEvent := ImageMain.Canvas.OnChange;
|
|
TheChangingEvent := ImageMain.Canvas.OnChanging;
|
|
{ Show the forms }
|
|
ScreenForm.Show;
|
|
InfoForm.Show;
|
|
|
|
{ Display the data on the info form }
|
|
p := ImageMain.ScreenToClient(Mouse.CursorPos);
|
|
ImageMainMouseMove(nil, SS, p.x, p.y);
|
|
|
|
closed := False;
|
|
|
|
{ Wait while the forms are still open }
|
|
while not Closed do
|
|
begin
|
|
sleep(1);
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
// add x to history here.
|
|
c := Color;
|
|
x := Colorx;
|
|
y := Colory;
|
|
|
|
{ Free forms and images }
|
|
ImageMain.Free;
|
|
ImageInfo.Free;
|
|
InfoForm.Free;
|
|
ScreenForm.Free;
|
|
|
|
Input.Free;
|
|
Desktop.free;
|
|
|
|
{ Re-enable the color pick buttons }
|
|
Application.MainForm.Enabled := True;
|
|
ColourHistoryForm.Enabled := True;
|
|
end;
|
|
|
|
procedure TMColorPicker.ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
var
|
|
TempPoint : TPoint;
|
|
R : TRect;
|
|
px, py : Integer;
|
|
MouseX, MouseY: Integer;
|
|
begin
|
|
{ Move the info form }
|
|
Input.GetMousePos(MouseX, MouseY);
|
|
InfoForm.Left := Mouse.CursorPos.X + 5;
|
|
InfoForm.Top := Mouse.CursorPos.Y - 15;
|
|
|
|
TempPoint := Point(x, y);
|
|
|
|
{ If a form cannot be fully set to 0,0 }
|
|
TempPoint.X := TempPoint.X - ScreenForm.Left;
|
|
TempPoint.Y := TempPoint.Y - ScreenForm.Top;
|
|
|
|
{ Get the pixel that the cursor is currently on }
|
|
Color := WidgetSet.DCGetPixel(ImageHandle, X, Y);
|
|
|
|
{ Draw the current pixel to the right color box }
|
|
ImageInfo.Canvas.Brush.Color := Color;
|
|
ImageInfo.Canvas.Rectangle(143, 4, 168, 29);
|
|
|
|
{ Draw the cursor and color info }
|
|
SetBkColor(InfoHandle, 14811135);
|
|
Text := Format('Pos: %d, %d', [MouseX, MouseY]);
|
|
R := Rect(5, 6, 114, 18);
|
|
ExtTextOut(InfoHandle, 5, 3, ETO_OPAQUE, @R, pchar(text), length(text), nil);
|
|
Text := Format('Color: %d', [Color]);
|
|
R := Rect(5, 18, 114, 28);
|
|
ExtTextOut(InfoHandle, 5, 15, ETO_OPAQUE, @R, pchar(text), length(text), nil);
|
|
|
|
{ Draw the left, slightly zoomed out, color box }
|
|
for px := -1 to 1 do
|
|
for py := -1 to 1 do
|
|
begin
|
|
ImageInfo.Canvas.Brush.Color := WidgetSet.DCGetPixel(ImageHandle, x + px, y + py);
|
|
ImageInfo.Canvas.Rectangle((px + 1) * 8 + 115, (py + 1) * 8 + 4, (px + 1) * 8 + 124, (py + 1) * 8 + 13);
|
|
end;
|
|
|
|
Oldx := TempPoint.x;
|
|
Oldy := TempPoint.y;
|
|
end;
|
|
|
|
procedure TMColorPicker.ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
{ Move the info form }
|
|
InfoForm.Top := Mouse.CursorPos.Y - 15;
|
|
InfoForm.Left := Mouse.CursorPos.X + 5;
|
|
end;
|
|
|
|
procedure TMColorPicker.ColorPickUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin;
|
|
{ Set the coordinates and color that the user cliked on }
|
|
Color:= WidgetSet.DCGetPixel(ImageMain.Canvas.Handle,x,y);
|
|
Input.GetMousePos(ColorX, ColorY);
|
|
|
|
if OnPick <> nil then
|
|
Onpick(Sender,Color,Colorx,Colory);
|
|
|
|
{ Close the forms }
|
|
InfoForm.Close;
|
|
ScreenForm.Close;
|
|
|
|
{ Tell Pick() that we are done }
|
|
closed := True;
|
|
end;
|
|
|
|
end.
|
|
|