Simba/Units/MMLAddon/colourpicker.pas

unit colourpicker;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LCLIntf,LCLType,InterfaceBase,Forms,Controls,ExtCtrls,
  Graphics,
  Window
  ;

type
  TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);

  TMColorPicker = class(TObject)
        constructor Create(aWindow: TMWindow);
        destructor Destroy; override;

        procedure Pick(Var C, X, Y: Integer);

        procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer );
       procedure TimorTimer(Sender: TObject);
       Procedure ColorPickDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  public
        // Will give us CopyClientToBitmap
        Window: TMWindow;
        ColourHistory: TList; // for colour history

        Form : TForm;
        Image: TImage;
        Timor : TTimer;
        Bitmap : Graphics.TBitmap;
        Note : Graphics.TBitmap;
        Brush : TBrush;
        Text : string;
        FPickEvent : TPickEvent;

        oldx, oldy, Color, colorx, colory: Integer;

        TheChangedEvent,TheChangingEvent : TNotifyEvent;
        NoteHandle, BitmapHandle, ImageHandle : HDC;
  public
    property OnPick: TPickEvent read FPickEvent write FPickEvent;
  end;


implementation

constructor TMColorPicker.Create(aWindow: TMWindow);
begin
  Self.Window := aWindow;

end;

destructor TMColorPicker.Destroy;
begin

end;

procedure TMColorPicker.Pick(Var C, X, Y: Integer);
var
   w, h: integer;
   bmp: TBitmap;
begin
  Form := TForm.Create(Application.MainForm);
  Window.GetDimensions(w, h);

  Form.Width := w;
  Form.Height := h;
  Form.Top := 0;
  Form.left := 0;
  Form.WindowState := wsmaximized;
  Form.BorderStyle:= bsNone;

  Image := TImage.Create(Form);
  Image.Parent := Form;
  Image.left := 0;
  image.Width := 0;
  Image.width := Form.Width - 1;
  Image.Height := Form.Height - 1;
  Image.Cursor:= crCross;
  Image.OnMouseDown:= @ColorPickDown;
  Image.OnMouseMove:=@ImageMouseMove;
  Image.Canvas.Brush.Color := 14811135;
  Bitmap := Graphics.TBitmap.create;
  Bitmap.width := Form.Width;
  Bitmap.Height := Form.Height;
  Note := Graphics.TBitmap.create;
  Note.Canvas.Brush.Color := 14811135;
  Note.Width := 148;
  Note.Height := 33;
  Note.Canvas.Rectangle(0, 0, 147, 33);
  Note.Canvas.Rectangle(89, 3, 115, 29);
  Note.Canvas.Pen.Style:= psClear;

  bmp := Window.CopyClientToBitmap(0, 0, w, h);
  BitBlt(Image.Canvas.Handle, 0,0,w,h, bmp.Canvas.Handle,0,0,SRCCOPY);
  BitBlt(Bitmap.Canvas.Handle, 0,0,w,h, bmp.Canvas.Handle,0,0,SRCCOPY);
  bmp.Free;

  ImageHandle:= Image.Canvas.Handle;
  BitmapHandle:= Bitmap.Canvas.Handle;
  NoteHandle:= Note.Canvas.Handle;
  TheChangedEvent := Image.Canvas.OnChange;
  TheChangingEvent := Image.Canvas.OnChanging;

  Brush := Image.Canvas.Brush;
  Timor := TTimer.Create(Form);

  Timor.OnTimer:= @TimorTimer;
  Timor.Interval:= 50;
  Timor.Enabled:= False;

  Form.ShowModal;

  // add x to history here.
  c := Color;
  x := Colorx;
  y := Colory;

  Note.Free;
  Bitmap.Free;
  Timor.Free;
  Image.Free;
  Form.Free;
end;

procedure TMColorPicker.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Timor.Enabled:= True;
end;

procedure TMColorPicker.TimorTimer(Sender: TObject);
var
  TempPoint : TPoint;
begin
//  GetCursorPos(TempPoint);
  TempPoint := Mouse.CursorPos;

  { If a form cannot be fully set to 0,0 }
  TempPoint.X := TempPoint.X - Form.Left;
  TempPoint.Y := TempPoint.Y - Form.Top;

  BitBlt(ImageHandle, oldx + 5, oldy + 5,147,33,BitmapHandle,oldx + 5,oldy + 5,SRCCOPY);
  Color := WidgetSet.DCGetPixel(ImageHandle, TempPoint.X, TempPoint.Y);
  Rectangle(NoteHandle,1,1,85,32);
//  Text:='Pos: ' + inttostr(TempPoint.x - Client.Rect.Left) + ','  + inttostr(TempPoint.y - Client.Rect.Bottom);
  Text:='Pos: ' + inttostr(TempPoint.x) + ','  + inttostr(TempPoint.y);
  ExtTextOut(NoteHandle, 5, 3,0,nil,pchar(text),length(text),nil);
  Text := 'Color: ' +  inttostr(Color);
  ExtTextOut(NoteHandle, 5, 15,0,nil,pchar(text),length(text),nil);
  BitBlt( ImageHandle, TempPoint.x + 5, TempPoint.y + 5,147,33,NoteHandle,0,0,SRCCOPY);
  Brush.Color := Color;
  Image.Canvas.Rectangle(TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
//  Rectangle(ImageHandle,TempPoint.x + 123, TempPoint.y + 8, tempPoint.x + 149, temppoint.y + 34);
  TheChangingEvent(Sender);
  StretchBlt(ImageHandle,TempPoint.x + 95, TempPoint.y + 9, 24,24, BitmapHandle, TempPoint.x - 1, TempPoint.y-1,3,3, SRCCOPY);
  TheChangedEvent(Sender);
  Oldx := TempPoint.x;
  Oldy := TempPoint.y;
  Timor.Enabled:= False;
end;

procedure TMColorPicker.ColorPickDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
begin;
  Color:=  WidgetSet.DCGetPixel(Image.Canvas.Handle,x,y);
  Self.Colorx := x;
  Self.Colory := y;
  Timor.enabled := false;
  if OnPick <> nil then
    Onpick(Sender,Color,x,y);
  Form.Close;
end;

end.