{ 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 . 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; box : TBox; SS : TShiftState; p : TPoint; {$IFNDEF PICKER_CLIENT} {$IFDEF LINUX} OldWindow: TWindow; {$ELSE} OldWindow: HWND; {$ENDIF} {$ENDIF} bmp: TMufasaBitmap; InputWindow: TMWindow; begin { Disable both of the color pick buttons } InputWindow := TMWindow.Create; InputWindow.SetWindow(Self.Window); { If the Window is not valid, set it to the desktop } if not InputWindow.TargetValid then InputWindow.SetDesktop; Input := TMInput.Create(InputWindow); 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); { if Window.GetDimensionBox(box) then begin; targetleft := box.x1; targettop := box.y1; end else begin; targetleft := 0; targettop := 0; end; } {$IFNDEF PICKER_CLIENT} {$IFDEF LINUX} OldWindow := Window.CurWindow; {$ELSE} OldWindow := Window.TargetHandle; {$ENDIF} Window.SetDesktop; {$ENDIF} w := 0; h := 0; { Get the dimensions of the screen } Window.GetDimensions(w, h); { 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(Window, 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; {$IFNDEF PICKER_CLIENT} {$IFDEF LINUX} Window.SetTarget(OldWindow); {$ELSE} Window.SetTarget(OldWindow, w_Window); {$ENDIF} {$ENDIF} { Free forms and images } ImageMain.Free; ImageInfo.Free; InfoForm.Free; ScreenForm.Free; Input.Free; InputWindow.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; Data : TRetData; 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); Self.Colorx := x; Self.Colory := y; 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.