fthimage.pas

Gestione Cellulari Nokia

{*******************************************************}
{                                                       }
{       4th GUI Library for Delphi                      }
{       FourthImage Unit                                }
{                                                       }
{       Copyright (c) 1996,2001 Sergey S. Tkachenko     }
{       e-mail: [e-mail]               }
{          Web: www.4thfebruary.f2s.com                 }
{                                                       }
{*******************************************************}

unit FthImage;

{$I FTHVER.INC}

interface

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

type

{ TFourthImage }

  TFourthImageOptions = class(TPersistent)
  private
    FAutoChangePictures: Boolean;
    FDisabledPicture: TPicture;
    FDownPicture: TPicture;
    FEnabledPicture: TPicture;
    FHotPicture: TPicture;
    FOnChange: TNotifyEvent;
    FUpPicture: TPicture;
    procedure SetAutoChangePictures(Value: Boolean);
    procedure SetDisabledPicture(Value: TPicture);
    procedure SetDownPicture(Value: TPicture);
    procedure SetEnabledPicture(Value: TPicture);
    procedure SetHotPicture(Value: TPicture);
    procedure SetUpPicture(Value: TPicture);
  protected
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create;
  published
    property AutoChangePictures: Boolean read FAutoChangePictures write SetAutoChangePictures;
    property DisabledPicture: TPicture read FDisabledPicture write SetDisabledPicture;
    property DownPicture: TPicture read FDownPicture write SetDownPicture;
    property EnabledPicture: TPicture read FEnabledPicture write SetEnabledPicture;
    property HotPicture: TPicture read FHotPicture write SetHotPicture;
    property UpPicture: TPicture read FUpPicture write SetUpPicture;
  end;

  TFourthImage = class(TImage)
  private
    FMouseInControl: Boolean;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FOptions: TFourthImageOptions;
    FPosX: Integer;
    FPosY: Integer;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure OptionsChange(Sender: TObject);
    property Picture;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property MouseInControl: Boolean read FMouseInControl;
    property PosX: Integer read FPosX;
    property PosY: Integer read FPosY;
  published
    property Options: TFourthImageOptions read FOptions write FOptions;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

implementation

{ TFourthImageOptions }

constructor TFourthImageOptions.Create;
begin
  FAutoChangePictures := True;
  FDisabledPicture := TPicture.Create;
  FDownPicture := TPicture.Create;
  FEnabledPicture := TPicture.Create;
  FHotPicture := TPicture.Create;
  FUpPicture := TPicture.Create;
end;

procedure TFourthImageOptions.SetAutoChangePictures(Value: Boolean);
begin
  if FAutoChangePictures <> Value then
  begin
    FAutoChangePictures := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthImageOptions.SetDisabledPicture(Value: TPicture);
begin
  FDisabledPicture.Assign(Value);
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TFourthImageOptions.SetDownPicture(Value: TPicture);
begin
  FDownPicture.Assign(Value);
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TFourthImageOptions.SetEnabledPicture(Value: TPicture);
begin
  FEnabledPicture.Assign(Value);
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TFourthImageOptions.SetHotPicture(Value: TPicture);
begin
  FHotPicture.Assign(Value);
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TFourthImageOptions.SetUpPicture(Value: TPicture);
begin
  FUpPicture.Assign(Value);
  if Assigned(FOnChange) then FOnChange(Self);
end;

{ TFourthImage }

constructor TFourthImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csCaptureMouse, csReplicatable];
  FMouseInControl := False;
  FPosX := 0;
  FPosY := 0;
  FOptions := TFourthImageOptions.Create;
  FOptions.OnChange := OptionsChange;
  Height := 105;
  Width := 105;
end;

destructor TFourthImage.Destroy;
begin
  FOptions.Free;
  inherited Destroy;
end;

procedure TFourthImage.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FPosX := X;
  FPosY := Y;
  if (FOptions.AutoChangePictures) and (FOptions.DownPicture <> nil) and
    Enabled then
      Picture.Assign(FOptions.DownPicture);
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TFourthImage.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  FPosX := X;
  FPosY := Y;
  inherited MouseMove(Shift, X, Y);
end;

procedure TFourthImage.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  FPosX := X;
  FPosY := Y;
  if (FOptions.AutoChangePictures) and (FOptions.UpPicture <> nil) and
    Enabled then
      Picture.Assign(FOptions.UpPicture);
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TFourthImage.CMEnabledChanged(var Message: TMessage);
begin
  if Enabled then
  begin
    if (FOptions.AutoChangePictures) and (FOptions.EnabledPicture <> nil) then
      Picture.Assign(FOptions.EnabledPicture);
  end else
  begin
    if (FOptions.AutoChangePictures) and (FOptions.DisabledPicture <> nil) then
      Picture.Assign(FOptions.DisabledPicture);
  end;
end;

procedure TFourthImage.CMMouseEnter(var Message:TMessage);
begin
  if not FMouseInControl then
  begin
    FMouseInControl := True;
    if Enabled then
      if (FOptions.AutoChangePictures) and (FOptions.HotPicture <> nil) then
        Picture.Assign(FOptions.HotPicture);
  end;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TFourthImage.CMMouseLeave(var Message: TMessage);
begin
  if FMouseInControl then
  begin
    FMouseInControl := False;
    if Enabled then
      if (FOptions.AutoChangePictures) and (FOptions.EnabledPicture <> nil) then
        Picture.Assign(FOptions.EnabledPicture);
  end;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TFourthImage.OptionsChange(Sender: TObject);
begin
  { Nothing. DO NOT REMOVE THIS PROCEDURE !!! }
end;

end.