📄 gr32_dsgn_bitmap.pas
字号:
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 + -