⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gr32_dsgn_bitmap.pas

📁 skin components for design of your applicastions
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit GR32_Dsgn_Bitmap;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * 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/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is Graphics32
 *
 * The Initial Developer of the Original Code is
 * Alex A. Denisov
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2006
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

interface

{$I GR32.inc}

uses
{$IFDEF CLX}
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  {$IFDEF LINUX}Libc,{$ENDIF}
  QT, QGraphics, QControls, QForms, QDialogs, QExtCtrls, QStdCtrls, QComCtrls,
  QMenus, QImgList, QTypes, QClipbrd,
{$ELSE}
  Windows, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ExtDlgs,
  ComCtrls, Menus, ToolWin, Registry, ImgList, Clipbrd,
{$ENDIF}
  SysUtils, Classes, Consts,
  GR32, GR32_Image, GR32_Layers, GR32_Filters,
{$IFDEF COMPILER6}
  DesignIntf, DesignEditors, VCLEditors
{$ELSE}
  DsgnIntf
{$ENDIF};

type
  TPictureEditorForm = class(TForm)
    ToolBar1: TToolBar;
    Load: TToolButton;
    Save: TToolButton;
    ImageList: TImageList;
    Clear: TToolButton;
    ToolButton2: TToolButton;
    Copy: TToolButton;
    Paste: TToolButton;
    Timer: TTimer;
    PageControl: TPageControl;
    ImageSheet: TTabSheet;
    AlphaSheet: TTabSheet;
    PopupMenu: TPopupMenu;
    mnSave: TMenuItem;
    mnSeparator: TMenuItem;
    mnCopy: TMenuItem;
    mnPaste: TMenuItem;
    mnClear: TMenuItem;
    Load1: TMenuItem;
    mnSeparator2: TMenuItem;
    mnInvert: TMenuItem;
    Panel1: TPanel;
    OKButton: TButton;
    Cancel: TButton;
    Label1: TLabel;
    MagnCombo: TComboBox;
    Panel2: TPanel;
    Bevel1: TBevel;
    procedure LoadClick(Sender: TObject);
    procedure SaveClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure CopyClick(Sender: TObject);
    procedure PasteClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure PopupMenuPopup(Sender: TObject);
    procedure mnInvertClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MagnComboChange(Sender: TObject);
  protected
{$IFDEF CLX}
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
{$ELSE}
    OpenDialog: TOpenPictureDialog;
    SaveDialog: TSavePictureDialog;
{$ENDIF}
    AlphaChannel: TImage32;
    RGBChannels: TImage32;
    procedure AlphaChannelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure RGBChannelsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    function CurrentImage: TImage32;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TBitmap32Editor = class(TComponent)
  private
    FBitmap32: TBitmap32;
    FPicDlg: TPictureEditorForm;
    procedure SetBitmap32(Value: TBitmap32);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
    property Bitmap32: TBitmap32 read FBitmap32 write SetBitmap32;
  end;

  TBitmap32Property = class(TClassProperty
{$IFDEF EXT_PROP_EDIT}
    {$IFDEF COMPILER6}, ICustomPropertyDrawing{$ENDIF}
    {$IFDEF COMPILER2005}, ICustomPropertyDrawing80{$ENDIF}
{$ENDIF}
  )
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
{$IFDEF EXT_PROP_EDIT}
  {$IFDEF DELPHI5}
    procedure PropDrawValue(Canvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
  {$ENDIF}
  {$IFDEF COMPILER6}
    { ICustomPropertyDrawing }
    procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
    procedure PropDrawValue(Canvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  {$ENDIF}
  {$IFDEF COMPILER2005}
    { ICustomPropertyDrawing80 }
    function PropDrawNameRect(const ARect: TRect): TRect;
    function PropDrawValueRect(const ARect: TRect): TRect;
  {$ENDIF}
{$ENDIF}
  end;

  TImage32Editor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

implementation

uses
  GR32_Resamplers;

{$IFNDEF CLX}
{$R *.dfm}
{$ELSE}
{$R *.xfm}
{$ENDIF}

{ TPictureEditorForm }

procedure TPictureEditorForm.LoadClick(Sender: TObject);
var
  Picture: TPicture;
  DoAlpha: Boolean;
  S: string;
begin
  if OpenDialog.Execute then
  begin
    Picture := TPicture.Create;
    try
      Picture.LoadFromFile(OpenDialog.Filename);
      DoAlpha := False;
      if (Picture.Graphic is TBitmap) and (Picture.Bitmap.PixelFormat = pf32Bit) then
      begin
        S := ExtractFileName(OpenDialog.FileName);
        S := '''' + S + ''' file contains RGB and Alpha channels.'#13#10 +
          'Do you want to load all channels?';
        case MessageDlg(S, mtConfirmation, mbYesNoCancel, 0) of
          mrYes: DoAlpha := True;
          mrCancel: Exit;
        end;
      end;

      if DoAlpha then
      begin
        RGBChannels.Bitmap.Assign(Picture.Bitmap);
        AlphaToGrayscale(AlphaChannel.Bitmap, RGBChannels.Bitmap);
        RGBChannels.Bitmap.ResetAlpha;
      end
      else with CurrentImage do
      begin
        Bitmap.Assign(Picture);
        if CurrentImage = AlphaChannel then ColorToGrayscale(Bitmap, Bitmap);
      end;
    finally
      Picture.Free;
    end;
  end;
end;

procedure TPictureEditorForm.SaveClick(Sender: TObject);
var
  Picture: TPicture;
begin
  Picture := TPicture.Create;
  try
    Picture.Bitmap.Assign(CurrentImage.Bitmap);
{$IFDEF CLX}
    Picture.Bitmap.PixelFormat := pf32Bit;
{$ELSE}
    Picture.Bitmap.PixelFormat := pf24Bit;
{$ENDIF}

    if Picture.Graphic <> nil then
    begin
      with SaveDialog do
      begin
        DefaultExt := GraphicExtension(TGraphicClass(Picture.Graphic.ClassType));
        Filter := GraphicFilter(TGraphicClass(Picture.Graphic.ClassType));
        if Execute then Picture.SaveToFile(Filename);
      end;
    end;
  finally
    Picture.Free;
  end;
end;

procedure TPictureEditorForm.ClearClick(Sender: TObject);
begin
  CurrentImage.Bitmap.Delete;
end;

procedure TPictureEditorForm.CopyClick(Sender: TObject);
begin
  Clipboard.Assign(CurrentImage.Bitmap);
end;

procedure TPictureEditorForm.PasteClick(Sender: TObject);
begin
{$IFDEF CLX}
  if Clipboard.Provides('image/delphi.bitmap') or
     Clipboard.Provides('image/delphi.picture') then
     CurrentImage.Bitmap.Assign(Clipboard);
{$ELSE}
  if Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE) then
    CurrentImage.Bitmap.Assign(Clipboard);
{$ENDIF}
  if CurrentImage = AlphaChannel then
    ColorToGrayscale(CurrentImage.Bitmap, CurrentImage.Bitmap);
end;

procedure TPictureEditorForm.TimerTimer(Sender: TObject);
begin
  Save.Enabled := not CurrentImage.Bitmap.Empty;
  Clear.Enabled := Save.Enabled;
  Copy.Enabled := Save.Enabled;

{$IFDEF CLX}
  Paste.Enabled := Clipboard.Provides('image/delphi.bitmap') or
    Clipboard.Provides('image/delphi.picture');
{$ELSE}
  Paste.Enabled := Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE);
{$ENDIF}
end;

function TPictureEditorForm.CurrentImage: TImage32;
begin
  if PageControl.ActivePage = ImageSheet then Result := RGBChannels
  else Result := AlphaChannel;
end;

procedure TPictureEditorForm.PopupMenuPopup(Sender: TObject);
begin
  mnSave.Enabled := not CurrentImage.Bitmap.Empty;
  mnClear.Enabled := Save.Enabled;
  mnCopy.Enabled := Save.Enabled;
  mnInvert.Enabled := Save.Enabled;
{$IFDEF CLX}
  mnPaste.Enabled := Clipboard.Provides('image/delphi.bitmap') or
    Clipboard.Provides('image/delphi.picture');
{$ELSE}
  mnPaste.Enabled := Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE);
{$ENDIF}
end;

procedure TPictureEditorForm.mnInvertClick(Sender: TObject);
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -