You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
541 lines
15 KiB
Plaintext
541 lines
15 KiB
Plaintext
unit GR32_Dsgn_Bitmap;
|
|
|
|
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1 or LGPL 2.1 with linking exception
|
|
*
|
|
* 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.
|
|
*
|
|
* Alternatively, the contents of this file may be used under the terms of the
|
|
* Free Pascal modified version of the GNU Lesser General Public License
|
|
* Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
|
|
* of this license are applicable instead of those above.
|
|
* Please see the file LICENSE.txt for additional information concerning this
|
|
* 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-2009
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
interface
|
|
|
|
{$I GR32.inc}
|
|
|
|
uses
|
|
{$IFDEF FPC}
|
|
LCLIntf, LCLType, RtlConsts, Buttons, LazIDEIntf, PropEdits,
|
|
ComponentEditors,
|
|
{$ELSE}
|
|
Windows, ExtDlgs, ToolWin, Registry, ImgList, Consts, DesignIntf,
|
|
DesignEditors, VCLEditors,
|
|
{$ENDIF}
|
|
Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Graphics, Dialogs, Menus,
|
|
SysUtils, Classes, Clipbrd, GR32, GR32_Image, GR32_Layers, GR32_Filters;
|
|
|
|
type
|
|
TPictureEditorForm = class(TForm)
|
|
AlphaSheet: TTabSheet;
|
|
Bevel1: TBevel;
|
|
Cancel: TButton;
|
|
Clear: TToolButton;
|
|
Copy: TToolButton;
|
|
ImageList: TImageList;
|
|
ImageSheet: TTabSheet;
|
|
Label1: TLabel;
|
|
Load: TToolButton;
|
|
MagnCombo: TComboBox;
|
|
mnClear: TMenuItem;
|
|
mnCopy: TMenuItem;
|
|
mnInvert: TMenuItem;
|
|
mnLoad: TMenuItem;
|
|
mnPaste: TMenuItem;
|
|
mnSave: TMenuItem;
|
|
mnSeparator: TMenuItem;
|
|
mnSeparator2: TMenuItem;
|
|
OKButton: TButton;
|
|
PageControl: TPageControl;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
Paste: TToolButton;
|
|
PopupMenu: TPopupMenu;
|
|
Save: TToolButton;
|
|
Timer: TTimer;
|
|
ToolBar: TToolBar;
|
|
ToolButton2: TToolButton;
|
|
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 MagnComboChange(Sender: TObject);
|
|
protected
|
|
{$IFDEF PLATFORM_INDEPENDENT}
|
|
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}
|
|
, ICustomPropertyDrawing
|
|
{$IFDEF COMPILER2005_UP}, 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}
|
|
{ ICustomPropertyDrawing }
|
|
procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
|
procedure PropDrawValue(Canvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
|
{$IFDEF COMPILER2005_UP}
|
|
{ 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;
|
|
|
|
{$IFDEF FPC}
|
|
{$R *.lfm}
|
|
{$ELSE}
|
|
{$R *.dfm}
|
|
{$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);
|
|
Picture.Bitmap.PixelFormat := pf24Bit;
|
|
|
|
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
|
|
if Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE) then
|
|
CurrentImage.Bitmap.Assign(Clipboard);
|
|
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;
|
|
|
|
Paste.Enabled := Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE);
|
|
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;
|
|
mnPaste.Enabled := Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE);
|
|
end;
|
|
|
|
procedure TPictureEditorForm.mnInvertClick(Sender: TObject);
|
|
begin
|
|
InvertRGB(CurrentImage.Bitmap, CurrentImage.Bitmap);
|
|
end;
|
|
|
|
procedure TPictureEditorForm.MagnComboChange(Sender: TObject);
|
|
const
|
|
MAGN: array[0..6] of Integer = (25, 50, 100, 200, 400, 800, -1);
|
|
var
|
|
S: Integer;
|
|
begin
|
|
S := MAGN[MagnCombo.ItemIndex];
|
|
if S = -1 then
|
|
begin
|
|
RGBChannels.ScaleMode := smResize;
|
|
AlphaChannel.ScaleMode := smResize;
|
|
end
|
|
else
|
|
begin
|
|
RGBChannels.ScaleMode := smScale;
|
|
RGBChannels.Scale := S / 100;
|
|
AlphaChannel.ScaleMode := smScale;
|
|
AlphaChannel.Scale := S / 100;
|
|
end;
|
|
end;
|
|
|
|
constructor TPictureEditorForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
RGBChannels := TImage32.Create(Self);
|
|
RGBChannels.Parent := ImageSheet;
|
|
RGBChannels.Align := alClient;
|
|
RGBChannels.OnMouseMove := RGBChannelsMouseMove;
|
|
AlphaChannel := TImage32.Create(Self);
|
|
AlphaChannel.Parent := AlphaSheet;
|
|
AlphaChannel.Align := alClient;
|
|
AlphaChannel.OnMouseMove := AlphaChannelMouseMove;
|
|
{$IFDEF PLATFORM_INDEPENDENT}
|
|
OpenDialog := TOpenDialog.Create(Self);
|
|
SaveDialog := TSaveDialog.Create(Self);
|
|
{$ELSE}
|
|
OpenDialog := TOpenPictureDialog.Create(Self);
|
|
SaveDialog := TSavePictureDialog.Create(Self);
|
|
{$ENDIF}
|
|
MagnCombo.ItemIndex := 2;
|
|
OpenDialog.Filter := GraphicFilter(TGraphic);
|
|
SaveDialog.Filter := GraphicFilter(TGraphic);
|
|
end;
|
|
|
|
|
|
{ TBitmap32Editor }
|
|
|
|
constructor TBitmap32Editor.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FBitmap32 := TBitmap32.Create;
|
|
FPicDlg := TPictureEditorForm.Create(Self);
|
|
end;
|
|
|
|
destructor TBitmap32Editor.Destroy;
|
|
begin
|
|
FBitmap32.Free;
|
|
FPicDlg.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TBitmap32Editor.Execute: Boolean;
|
|
var
|
|
B: TBitmap32;
|
|
begin
|
|
FPicDlg.RGBChannels.Bitmap := FBitmap32;
|
|
AlphaToGrayscale(FPicDlg.AlphaChannel.Bitmap, FBitmap32);
|
|
Result := (FPicDlg.ShowModal = mrOK);
|
|
if Result then
|
|
begin
|
|
FBitmap32.Assign(FPicDlg.RGBChannels.Bitmap);
|
|
FBitmap32.ResetAlpha;
|
|
if not FBitmap32.Empty and not FPicDlg.AlphaChannel.Bitmap.Empty then
|
|
begin
|
|
B := TBitmap32.Create;
|
|
try
|
|
B.SetSize(FBitmap32.Width, FBitmap32.Height);
|
|
FPicDlg.AlphaChannel.Bitmap.DrawTo(B, Rect(0, 0, B.Width, B.Height));
|
|
IntensityToAlpha(FBitmap32, B);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TBitmap32Editor.SetBitmap32(Value: TBitmap32);
|
|
begin
|
|
try
|
|
FBitmap32.Assign(Value);
|
|
except
|
|
on E: Exception do ShowMessage(E.Message);
|
|
end;
|
|
end;
|
|
|
|
{ TBitmap32Property }
|
|
|
|
procedure TBitmap32Property.Edit;
|
|
var
|
|
BitmapEditor: TBitmap32Editor;
|
|
begin
|
|
try
|
|
BitmapEditor := TBitmap32Editor.Create(nil);
|
|
try
|
|
BitmapEditor.Bitmap32 := TBitmap32(Pointer(GetOrdValue));
|
|
if BitmapEditor.Execute then
|
|
begin
|
|
SetOrdValue(Longint(BitmapEditor.Bitmap32));
|
|
{$IFNDEF FPC} Designer.Modified; {$ENDIF}
|
|
end;
|
|
finally
|
|
BitmapEditor.Free;
|
|
end;
|
|
except
|
|
on E: Exception do ShowMessage(E.Message);
|
|
end;
|
|
end;
|
|
|
|
function TBitmap32Property.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
Result := [paDialog, paSubProperties];
|
|
end;
|
|
|
|
function TBitmap32Property.GetValue: string;
|
|
var
|
|
Bitmap: TBitmap32;
|
|
begin
|
|
try
|
|
Bitmap := TBitmap32(GetOrdValue);
|
|
if (Bitmap = nil) or Bitmap.Empty then Result := srNone
|
|
else Result := Format('%s [%d,%d]', [Bitmap.ClassName, Bitmap.Width, Bitmap.Height]);
|
|
except
|
|
on E: Exception do ShowMessage(E.Message);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF EXT_PROP_EDIT}
|
|
procedure TBitmap32Property.PropDrawValue(Canvas: TCanvas;
|
|
const ARect: TRect; ASelected: Boolean);
|
|
var
|
|
Bitmap32: TBitmap32;
|
|
TmpBitmap: TBitmap32;
|
|
R: TRect;
|
|
begin
|
|
Bitmap32 := TBitmap32(GetOrdValue);
|
|
if Bitmap32.Empty then
|
|
DefaultPropertyDrawValue(Self, Canvas, ARect)
|
|
else
|
|
begin
|
|
R := ARect;
|
|
R.Right := R.Left + R.Bottom - R.Top;
|
|
|
|
TmpBitmap := TBitmap32.Create;
|
|
TmpBitmap.Width := R.Right - R.Left;
|
|
TmpBitmap.Height := R.Bottom - R.Top;
|
|
TDraftResampler.Create(TmpBitmap);
|
|
TmpBitmap.Draw(TmpBitmap.BoundsRect, Bitmap32.BoundsRect, Bitmap32);
|
|
TmpBitmap.DrawTo(Canvas.Handle, R, TmpBitmap.BoundsRect);
|
|
TmpBitmap.Free;
|
|
|
|
R.Left := R.Right;
|
|
R.Right := ARect.Right;
|
|
DefaultPropertyDrawValue(Self, Canvas, R);
|
|
end;
|
|
end;
|
|
|
|
procedure TBitmap32Property.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
|
|
begin
|
|
DefaultPropertyDrawName(Self, ACanvas, ARect);
|
|
end;
|
|
|
|
{$IFDEF COMPILER2005_UP}
|
|
function TBitmap32Property.PropDrawNameRect(const ARect: TRect): TRect;
|
|
begin
|
|
Result := ARect;
|
|
end;
|
|
|
|
function TBitmap32Property.PropDrawValueRect(const ARect: TRect): TRect;
|
|
begin
|
|
if TBitmap32(GetOrdValue).Empty then
|
|
Result := ARect
|
|
else
|
|
Result := Rect(ARect.Left, ARect.Top, (ARect.Bottom - ARect.Top) + ARect.Left, ARect.Bottom);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TBitmap32Property.SetValue(const Value: string);
|
|
begin
|
|
if Value = '' then SetOrdValue(0);
|
|
end;
|
|
|
|
{ TImage32Editor }
|
|
|
|
procedure TImage32Editor.ExecuteVerb(Index: Integer);
|
|
var
|
|
Img: TCustomImage32;
|
|
BitmapEditor: TBitmap32Editor;
|
|
begin
|
|
Img := Component as TCustomImage32;
|
|
if Index = 0 then
|
|
begin
|
|
BitmapEditor := TBitmap32Editor.Create(nil);
|
|
try
|
|
BitmapEditor.Bitmap32 := Img.Bitmap;
|
|
if BitmapEditor.Execute then
|
|
begin
|
|
Img.Bitmap := BitmapEditor.Bitmap32;
|
|
Designer.Modified;
|
|
end;
|
|
finally
|
|
BitmapEditor.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TImage32Editor.GetVerb(Index: Integer): string;
|
|
begin
|
|
if Index = 0 then Result := 'Bitmap32 Editor...';
|
|
end;
|
|
|
|
function TImage32Editor.GetVerbCount: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
procedure TPictureEditorForm.AlphaChannelMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
if AlphaChannel.Bitmap <> nil then
|
|
begin
|
|
P := AlphaChannel.ControlToBitmap(Point(X, Y));
|
|
X := P.X;
|
|
Y := P.Y;
|
|
if (X >= 0) and (Y >= 0) and (X < AlphaChannel.Bitmap.Width) and
|
|
(Y < AlphaChannel.Bitmap.Height) then
|
|
Panel2.Caption := 'Alpha: $' +
|
|
IntToHex(AlphaChannel.Bitmap[X, Y] and $FF, 2) +
|
|
Format(' '#9'X: %d'#9'Y: %d', [X, Y])
|
|
else
|
|
Panel2.Caption := '';
|
|
end
|
|
else Panel2.Caption := '';
|
|
end;
|
|
|
|
procedure TPictureEditorForm.RGBChannelsMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
|
|
var
|
|
P: TPoint;
|
|
begin
|
|
if RGBChannels.Bitmap <> nil then
|
|
begin
|
|
P := RGBChannels.ControlToBitmap(Point(X, Y));
|
|
X := P.X;
|
|
Y := P.Y;
|
|
if (X >= 0) and (Y >= 0) and (X < RGBChannels.Bitmap.Width) and
|
|
(Y < RGBChannels.Bitmap.Height) then
|
|
Panel2.Caption := 'RGB: $' +
|
|
IntToHex(RGBChannels.Bitmap[X, Y] and $00FFFFFF, 6) +
|
|
Format(#9'X: %d'#9'Y: %d', [X, Y])
|
|
else
|
|
Panel2.Caption := '';
|
|
end
|
|
else Panel2.Caption := '';
|
|
end;
|
|
|
|
end.
|