dibeditor.pas

Delphi控件

unit DIBEditor;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: DIBEditor.PAS, released August 28, 2000.

The Initial Developer of the Original Code is Peter Morris ([e-mail]),
Portions created by Peter Morris are Copyright (C) 2000 Peter Morris.
All Rights Reserved.

Purpose of file:
Editor for DIBs, load / save / import mask etc.

Contributor(s):
None as yet


Last Modified: August 31, 2000

You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
or at http://www.stuckindoors.com/dib


Known Issues:
Add an Eyedropper for chosing transparent colour.
Status bar does not reflect actual display name.


Date : 31 - Aug, 2000 :
By :[e-mail]
Changes
Made TxxxxxxEditor to TxxxxxxxProperty to comply with VCL standards.
Made sure all unit names start with DIB to avoice conflicts with other people's
component packs.

Date : 14 NOV 2001
By   : [e-mail] (CAM Moorman)
Removed:
  unused TImageList.
Add:
  Work around for bug in spin edit, if user removes all text in editor
  Reworked tools UI to be much like Adobe/Corel rollups
  Toolbox window, Image Properties, and Export Functionality
  Scrollbars when needed for large images.
  Added Dropper Transparent Color selector
  Coolbar is required to allow the Toolbar images to behave properly on a white background
  Added Image from Clipboard. (Mask cannot be handled this way)
-----------------------------------------------------------------------------}

interface

{$i OpenSource/dfs.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  cDIBControl, cDIBImage, StdCtrls, cDIBPanel, ExtCtrls, Menus, ExtDlgs,
  {$IFDEF DFS_NO_DSGNINTF}
  DesignEditors, DesignIntf,
  {$ELSE}
  DsgnIntf,
  {$ENDIF}
  Spin, jpeg, ComCtrls, TypInfo, cDIB, cDIBImageList,
  Buttons, ActnList, cDIBSlider, cDIBFormShaper, cDIBDial, ImgList, ToolWin;

type
  TAbstractSuperDIBProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  TScale = 1..1000;
  TImageTransparencyMode = (itmNone, itmAuto, itmFixed);

  TfmDIBEditor = class(TForm)
    opd1: TOpenPictureDialog;
    cdColor: TColorDialog;
    DIBImageList1: TDIBImageList;
    dicRender: TDIBImageContainer;
    DIBImage1: TDIBImage;
    stbStatus: TStatusBar;
    spd1: TSavePictureDialog;
    pmImgOpt: TPopupMenu;
    Actions: TActionList;
    actImageFromFile: TAction;
    actMaskFromFile: TAction;
    actExportImage: TAction;
    actCloseOK: TAction;
    pmOpenImage: TMenuItem;
    pmExportImage: TMenuItem;
    DIBILParts: TDIBImageList;
    DIBImageOptions: TDIBImageContainer;
    ScaleSlider: TDIBSlider;
    OpacitySlider: TDIBSlider;
    cbTransparentMode: TComboBox;
    shTransparentColor: TShape;
    cbMasked: TCheckBox;
    lblColor: TLabel;
    Skinner: TDIBFormShaper;
    sbTransparent: TSpeedButton;
    sbAngle: TSpeedButton;
    sbScale: TSpeedButton;
    sbOpacity: TSpeedButton;
    lblTransMode: TLabel;
    lblMasked: TLabel;
    udScale: TUpDown;
    lblScale: TLabel;
    udAngle: TUpDown;
    lblAngle: TLabel;
    udOpacity: TUpDown;
    lblOpacity: TLabel;
    AngleDial: TDIBDial;
    actImageFromClipboard: TAction;
    pmAcquireImage: TMenuItem;
    FromClipboard1: TMenuItem;
    pmAcquireMask: TMenuItem;
    actCloseCancel: TAction;
    actExportMask: TAction;
    pmExport: TMenuItem;
    pmExportMask: TMenuItem;
    actRevertImage: TAction;
    VScroller: TDIBSlider;
    HScroller: TDIBSlider;
    sbDropper: TSpeedButton;
    tbMain: TToolBar;
    ilTBAlive: TImageList;
    tbLoad: TToolButton;
    tbLoadClipboard: TToolButton;
    tbLoadMask: TToolButton;
    ToolButton6: TToolButton;
    tbUndo: TToolButton;
    ToolButton8: TToolButton;
    tbCancel: TToolButton;
    tbAccept: TToolButton;
    ToolButton11: TToolButton;
    ilTBDead: TImageList;
    cbMain: TCoolBar;
    ToolButton12: TToolButton;
    tbSave: TToolButton;
    tbSaveMask: TToolButton;
    edScale: TEdit;
    edOpacity: TEdit;
    edAngle: TEdit;
    procedure cbMaskedClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cbTransparentModeChange(Sender: TObject);
    procedure shTransparentColorMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnImageImportClick(Sender: TObject);
    procedure btnMaskImportClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure DIBImageOptionsMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OpacitySliderChange(Sender: TObject);
    procedure ScaleSliderChange(Sender: TObject);
    procedure AngleDialChange(Sender: TObject);
    procedure stbStatusResize(Sender: TObject);
    procedure Resized(Sender: TObject);
    procedure ToolBoxButtonClick(Sender: TObject);
    procedure actExportImageExecute(Sender: TObject);
    procedure actCloseCancelExecute(Sender: TObject);
    procedure actExportMaskExecute(Sender: TObject);
    procedure actExportMaskUpdate(Sender: TObject);
    procedure actExportImageUpdate(Sender: TObject);
    procedure actMaskFromFileUpdate(Sender: TObject);
    procedure actCloseOKUpdate(Sender: TObject);
    procedure stbStatusDrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure HScrollerChange(Sender: TObject);
    procedure NeedScrollbars(Sender: TObject);
    procedure VScrollerChange(Sender: TObject);
    procedure sbDropperClick(Sender: TObject);
    procedure actRevertImageExecute(Sender: TObject);
    procedure actRevertImageUpdate(Sender: TObject);
    procedure actImageFromClipboardExecute(Sender: TObject);
    procedure actImageFromClipboardUpdate(Sender: TObject);
    procedure DIBImage1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DIBImage1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure DIBImage1MouseLeave(Sender: TObject);
    procedure udAngleChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udOpacityChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udScaleChanging(Sender: TObject; var AllowChange: Boolean);
  private
    fModified: Boolean;
    { Private declarations }
    procedure UpdateStatusBar;
    function GetImageAngle: Extended;
    function GetImageOpacity: Byte;
    function GetImageScale: TScale;
    procedure SetImageAngle(const Value: Extended);
    procedure SetImageOpacity(const Value: Byte);
    procedure SetImageScale(const Value: TScale);
    function GetImageMasked: Boolean;
    function GetTransColor: TColor;
    function GetTransMode: TImageTransparencyMode;
    procedure SetImageMasked(const Value: Boolean);
    procedure SetTransColor(const Value: TColor);
    procedure SetTransMode(const Value: TImageTransparencyMode);
    procedure SetModified(const Value: Boolean);
    procedure ToolboxEnable(State: Boolean);
    procedure UpdateGUI;
  protected
    property ImageOpacity: Byte read GetImageOpacity write SetImageOpacity;
    property ImageScale: TScale read GetImageScale write SetImageScale;
    property ImageAngle: Extended read GetImageAngle write SetImageAngle;
    property ImageMasked: Boolean read GetImageMasked write SetImageMasked;
    property ImageTransparencyMode: TImageTransparencyMode 
      read GetTransMode write SetTransMode;
    property ImageTransparentColor: TColor read GetTransColor write SetTransColor;
    property Modified: Boolean read fModified write SetModified;
  public
    { Public declarations }
    FCurrentImage: TMemoryDIB;
  end;

implementation

uses 
  ClipBrd;
{$R *.DFM}
{$R DIBCursors.res}
const
  crDropper = 10;

  { TAbstractSuperDIBProperty }

procedure TAbstractSuperDIBProperty.Edit;
var
  EdForm: TfmDIBEditor;
begin
  EdForm := TfmDIBEditor.Create(Application);
  with EdForm do
    try
      FCurrentImage := DIBImageList1.DIBImages[0].DIB;
      FCurrentImage.Assign(TAbstractSuperDIB(GetOrdValue));
      UpdateStatusBar;
      ShowModal;

      if ModalResult = mrOk then
        with TAbstractSuperDIB(GetOrdValue) do
        begin
          Assign(FCurrentImage);
          Self.Designer.Modified;
        end
      else
        Self.Revert;
    finally
      EdForm.Release;
    end;
end;

function TAbstractSuperDIBProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paReadOnly, paDialog];
end;

{ TfmDIBEditor }

procedure TfmDIBEditor.UpdateStatusBar;
const
  MODTXT: array[Boolean] of String = ('', 'Modified');
begin
  with stbStatus do
  begin
    Panels[0].Text := MODTXT[fModified];
    if (FCurrentImage.Height > 1) and (FCurrentImage.Width > 1) then
      Panels[2].Text := IntToStr(FCurrentImage.Width) + ' X ' + IntToStr(FCurrentImage.Height)
    else
      Panels[2].Text := 'No Image Selected';
    Invalidate;  //force the OwnerDraw Panels
  end;
end;

procedure TfmDIBEditor.FormCreate(Sender: TObject);
begin
  try
    Screen.Cursors[crDropper] := LoadCursor(HInstance, 'DROPPER');
  except
  end;
  fModified := False;
  FCurrentImage := DIBImageList1.DIBImages[0].DIB;
  DIBImage1.DIBImageList := DIBImageList1;
  DIBImage1.IndexMain.DIBIndex := 0;
  // AZZA
  UpdateStatusBar;
end;

// AZZA
procedure TfmDIBEditor.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Ord(Key) = VK_ESCAPE) then
    Close;
end;

procedure TfmDIBEditor.cbMaskedClick(Sender: TObject);
begin
  ImageMasked := cbMasked.Checked;
end;

procedure TfmDIBEditor.cbTransparentModeChange(Sender: TObject);
begin
  ImageTransparencyMode := TImageTransparencyMode(cbTransparentMode.ItemIndex);
end;

procedure TfmDIBEditor.shTransparentColorMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ImageTransparencyMode <> itmNone then
    if cdColor.Execute then ImageTransparentColor := cdColor.Color;
end;

procedure TfmDIBEditor.btnImageImportClick(Sender: TObject);
begin
  with opd1 do
  begin
    Title := 'Open Image';
    if Execute then
    begin
      FCurrentImage.ImportPicture(Filename);
      Modified := True;
    end;
  end;
end;

procedure TfmDIBEditor.btnMaskImportClick(Sender: TObject);
begin
  with opd1 do
  begin
    Title := 'Open Image Mask';
    if Execute then
    begin
      FCurrentImage.ImportMask(Filename);
      Modified := True;
    end;
  end;
end;

procedure TfmDIBEditor.btnOkClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TfmDIBEditor.DIBImageOptionsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  MinMaxBtnRect: TRect = (Left: 180 - 12; Top: 0; Right: 180; Bottom: 12);
  TitleBarRect: TRect = (Left: 0; Top: 0; Right: 180; Bottom: 12);
begin
  if (Button <> mbLeft) then Exit;

  //Min/Max button?
  if PtInRect(MinMaxBtnRect, Point(X, Y)) then
  begin
    Skinner.Active := not Skinner.Active;
    Exit;
  end;
  //Title Bar?
  if PtInRect(TitleBarRect, Point(X, Y)) then
  begin
    ReleaseCapture;
    (Sender as TControl).Perform(WM_SYSCOMMAND, $F012, 0);
  end;
end;

function TfmDIBEditor.GetImageAngle: Extended;
begin
  Result := FCurrentImage.Angle;
end;

function TfmDIBEditor.GetImageOpacity: Byte;
begin
  Result := FCurrentImage.Opacity;
end;

function TfmDIBEditor.GetImageScale: TScale;
begin
  Result := Trunc(FCurrentImage.Scale);
end;

procedure TfmDIBEditor.SetImageAngle(const Value: Extended);
begin
  if Value <> FCurrentImage.Angle then
  begin
    FCurrentImage.Angle := Value;
    DIBImage1.Angle := Value;
    udAngle.Position := Trunc(Value);
    AngleDial.Position := Trunc(Value);
    Modified := True;
  end;
end;

procedure TfmDIBEditor.SetImageOpacity(const Value: Byte);
begin
  if Value <> FCurrentImage.Opacity then
  begin
    FCurrentImage.Opacity := Value;
    DIBImage1.Opacity := Value;
    udOpacity.Position := Value;
    OpacitySlider.Position := Value;
    Modified := True;
  end;
end;

procedure TfmDIBEditor.SetImageScale(const Value: TScale);
begin
  if Value <> FCurrentImage.Scale then
  begin
    FCurrentImage.Scale := Value;
    DIBImage1.Scale := Value;
    udScale.Position := Value;
    ScaleSlider.Position := Value;
    Modified := True;
  end;
end;

procedure TfmDIBEditor.OpacitySliderChange(Sender: TObject);
begin
  ImageOpacity := OpacitySlider.Position;
end;

procedure TfmDIBEditor.ScaleSliderChange(Sender: TObject);
begin
  ImageScale := ScaleSlider.Position;
end;

procedure TfmDIBEditor.AngleDialChange(Sender: TObject);
begin