Einzelnen Beitrag anzeigen

Benutzerbild von Mackhack
Mackhack

Registriert seit: 29. Nov 2003
Ort: San Diego, CA/USA
1.446 Beiträge
 
Delphi 2006 Architect
 
#2

Re: Maus auf ein Ereignis reagieren lassen

  Alt 15. Apr 2007, 07:51
Hier ein alter Quellcode den ich auf Platte noch hatte. Funktioniert nicht nur in deinem eigenen Window sondern auf allen. Zeigt dir die Koordinaten an, die Farbe, Saettigung und Helligkeit von RGB!

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    DesktopDC: hDC;
    hCross, hSavedCursor : hCURSOR;
    procedure GetPixelFarbe;
    procedure WM_TIMER(var Msg: TMessage); message WM_TIMER;
    procedure RGBtoHSV(const aR, aG, aB: Integer; var zH, zS, zV: Integer);
    function Min(A, B: Integer): Integer;
    function Max(A, B: Integer): Integer;
    function GetHValue(ACol: TColor): Integer;
    function GetSValue(ACol: TColor): Integer;
    function GetVValue(ACol: TColor): Integer;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DesktopDC := GetDC(0);
  SetTimer(Self.Handle, 1, 10, nil);
end;

function TForm1.Min(A, B: Integer): Integer;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

function TForm1.Max(A, B : Integer): Integer;
begin
  if A > B then
    Result := A
  else
    Result := B;
end;

procedure TForm1.RGBToHSV(Const aR, aG, aB: Integer; var zH, zS, zV: Integer);
var
  Delta, Mini: integer;
begin
  Mini := Min(aR, Min(aG, aB));
  zV := Max(aR, Max(aG,aB));
  Delta := zV - Mini;
  // Saturation
  if zV = 0 then
    zS := 0
  else
    zS := (Delta * 255) Div zV;
  if zS = 0 then
    zH := 0
  else
  begin
    if aR = zV then
      zH := ((aG - aB) * 60) Div Delta
    else
    if aG = zV then
      zH := 120 + ((aB - aR) * 60) Div Delta
    else
    if aB = zV then
      zH := 240 + ((aR - aG) * 60) Div Delta;
    if zH <= 0 then
      zH := zH + 360;
  end;
end;

function TForm1.GetHValue(ACol: TColor): Integer;
var
  H, S, V: Integer;
begin
  RGBToHSV(GetRValue(ACol), GetGValue(ACol), GetBValue(ACol), H, S, V);
  Result := H;
end;

function TForm1.GetSValue(ACol: TColor): Integer;
var
  H,S,V: Integer;
begin
  RGBToHSV(GetRValue(ACol), GetGValue(ACol), GetBValue(ACol), H, S, V);
  Result := S;
end;

function TForm1.GetVValue(ACol: TColor): Integer;
var
  H,S,V: Integer;
begin
  RGBToHSV(GetRValue(ACol), GetGValue(ACol), GetBValue(ACol), H, S, V);
  Result := V;
end;

procedure TForm1.GetPixelFarbe;
var
  Pos: TPoint;
  Col: TColor;
begin
  GetCursorPos(Pos);
  if WindowFromPoint(Pos) = Self.Handle then
  begin
    //SetSystemCursor(LoadCursor(hInst, IDC_IBEAM), OCR_IBEAM);
    Exit;
  end
  else
  begin
    hCross := LoadCursor(0, IDC_CROSS);
    SetCursor(hCross);
    Col := GetPixel(DesktopDC, Pos.X, Pos.Y);
    Panel1.Color := Col;
    Panel1.Caption := 'Pixelkoordinate ' + IntToStr(Pos.X) + ':' + IntToStr(Pos.Y);
    Label1.Caption := 'R: ' + IntToStr(GetRValue(Col));
    Label2.Caption := 'G: ' + IntToStr(GetGValue(Col));
    Label3.Caption := 'B: ' + IntToStr(GetBValue(Col));
    Label7.Caption := IntToStr(GetVValue(Col));
    Label9.Caption := IntToStr(GetSValue(Col));
    Label11.Caption := IntToStr(GetHValue(Col));
  end;
end;

procedure TForm1.WM_TIMER(var Msg: TMessage);
begin
  if Msg.WParam = 1 then //TimerID #1
    GetPixelFarbe;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ReleaseDC(Self.Handle, DesktopDC);
end;

end.
Um etwas Neues zu schaffen muss man seine Ohren vor den Nein-sagern verschliessen um seinen Geist öffnen zu können.
(George Lukas)
  Mit Zitat antworten Zitat