home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_Dsgn_Bitmap.pas < prev    next >
Pascal/Delphi Source File  |  2004-12-19  |  14KB  |  515 lines
  1. unit GR32_Dsgn_Bitmap;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *
  26.  * ***** END LICENSE BLOCK ***** *)
  27.  
  28. interface
  29.  
  30. {$I GR32.inc}
  31.  
  32. uses
  33. {$IFDEF CLX}
  34.   {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  35.   {$IFDEF LINUX}Libc,{$ENDIF}
  36.   QT, QGraphics, QControls, QForms, QDialogs, QExtCtrls, QStdCtrls, QComCtrls,
  37.   QMenus, QImgList, QTypes, QClipbrd,
  38. {$ELSE}
  39.   Windows, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ExtDlgs,
  40.   ComCtrls, Menus, ToolWin, Registry, ImgList, Clipbrd,
  41. {$ENDIF}
  42.   SysUtils, Classes, Consts,
  43.   GR32, GR32_Image, GR32_Layers, GR32_Filters,
  44. {$IFDEF COMPILER6}
  45.   DesignIntf, DesignEditors
  46. {$ELSE}
  47.   DsgnIntf
  48. {$ENDIF};
  49.  
  50. type
  51.   TPictureEditorForm = class(TForm)
  52.     ToolBar1: TToolBar;
  53.     Load: TToolButton;
  54.     Save: TToolButton;
  55.     ImageList: TImageList;
  56.     Clear: TToolButton;
  57.     ToolButton2: TToolButton;
  58.     Copy: TToolButton;
  59.     Paste: TToolButton;
  60.     Timer: TTimer;
  61.     PageControl: TPageControl;
  62.     ImageSheet: TTabSheet;
  63.     AlphaSheet: TTabSheet;
  64.     // TODO: Remove
  65.     //OpenDialog: TOpenPictureDialog;
  66.     //SaveDialog: TSavePictureDialog;
  67.     OpenDialog: TOpenDialog;
  68.     SaveDialog: TSaveDialog;
  69.     PopupMenu: TPopupMenu;
  70.     mnSave: TMenuItem;
  71.     mnSeparator: TMenuItem;
  72.     mnCopy: TMenuItem;
  73.     mnPaste: TMenuItem;
  74.     mnClear: TMenuItem;
  75.     Load1: TMenuItem;
  76.     mnSeparator2: TMenuItem;
  77.     mnInvert: TMenuItem;
  78.     Panel1: TPanel;
  79.     OKButton: TButton;
  80.     Cancel: TButton;
  81.     Label1: TLabel;
  82.     MagnCombo: TComboBox;
  83.     Panel2: TPanel;
  84.     Bevel1: TBevel;
  85.     procedure LoadClick(Sender: TObject);
  86.     procedure SaveClick(Sender: TObject);
  87.     procedure ClearClick(Sender: TObject);
  88.     procedure CopyClick(Sender: TObject);
  89.     procedure PasteClick(Sender: TObject);
  90.     procedure TimerTimer(Sender: TObject);
  91.     procedure PopupMenuPopup(Sender: TObject);
  92.     procedure mnInvertClick(Sender: TObject);
  93.     procedure FormCreate(Sender: TObject);
  94.     procedure MagnComboChange(Sender: TObject);
  95.   protected
  96.     AlphaChannel: TImage32;
  97.     RGBChannels: TImage32;
  98.     procedure AlphaChannelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  99.     procedure RGBChannelsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  100.     function CurrentImage: TImage32;
  101.   public
  102.     constructor Create(AOwner: TComponent); override;
  103.   end;
  104.  
  105.   TBitmap32Editor = class(TComponent)
  106.   private
  107.     FBitmap32: TBitmap32;
  108.     FPicDlg: TPictureEditorForm;
  109.     procedure SetBitmap32(Value: TBitmap32);
  110.   public
  111.     constructor Create(AOwner: TComponent); override;
  112.     destructor Destroy; override;
  113.     function Execute: Boolean;
  114.     property Bitmap32: TBitmap32 read FBitmap32 write SetBitmap32;
  115.   end;
  116.  
  117.   TBitmap32Property = class(TClassProperty)
  118.   public
  119.     procedure Edit; override;
  120.     function GetAttributes: TPropertyAttributes; override;
  121.     function GetValue: string; override;
  122.     procedure SetValue(const Value: string); override;
  123. {$IFDEF EXT_PROP_EDIT}
  124.     procedure PropDrawValue(Canvas: TCanvas; const ARect: TRect; Selected: Boolean); override;
  125. {$ENDIF}
  126.   end;
  127.  
  128.   TImage32Editor = class(TComponentEditor)
  129.   public
  130.     procedure ExecuteVerb(Index: Integer); override;
  131.     function GetVerb(Index: Integer): string; override;
  132.     function GetVerbCount: Integer; override;
  133.   end;
  134.  
  135. implementation
  136.  
  137. {$IFDEF CLX}
  138. {$R *.xfm}
  139. {$ELSE}
  140. {$R *.dfm}
  141. {$ENDIF}
  142.  
  143. { TPictureEditorForm }
  144.  
  145. procedure TPictureEditorForm.LoadClick(Sender: TObject);
  146. var
  147.   Picture: TPicture;
  148.   DoAlpha: Boolean;
  149.   S: string;
  150. begin
  151.   if OpenDialog.Execute then
  152.   begin
  153.     Picture := TPicture.Create;
  154.     try
  155.       Picture.LoadFromFile(OpenDialog.Filename);
  156.       DoAlpha := False;
  157.       if (Picture.Graphic is TBitmap) and (Picture.Bitmap.PixelFormat = pf32Bit) then
  158.       begin
  159.         S := ExtractFileName(OpenDialog.FileName);
  160.         S := '''' + S + ''' file contains RGB and Alpha channels.'#13#10 +
  161.           'Do you want to load all channels?';
  162.         case MessageDlg(S, mtConfirmation, mbYesNoCancel, 0) of
  163.           mrYes: DoAlpha := True;
  164.           mrCancel: Exit;
  165.         end;
  166.       end;
  167.  
  168.       if DoAlpha then
  169.       begin
  170.         RGBChannels.Bitmap.Assign(Picture.Bitmap);
  171.         AlphaToGrayscale(AlphaChannel.Bitmap, RGBChannels.Bitmap);
  172.         RGBChannels.Bitmap.ResetAlpha;
  173.       end
  174.       else with CurrentImage do
  175.       begin
  176.         Bitmap.Assign(Picture);
  177.         if CurrentImage = AlphaChannel then ColorToGrayscale(Bitmap, Bitmap);
  178.       end;
  179.     finally
  180.       Picture.Free;
  181.     end;
  182.   end;
  183. end;
  184.  
  185. procedure TPictureEditorForm.SaveClick(Sender: TObject);
  186. var
  187.   Picture: TPicture;
  188. begin
  189.   Picture := TPicture.Create;
  190.   try
  191.     Picture.Bitmap.Assign(CurrentImage.Bitmap);
  192. {$IFDEF CLX}
  193.     Picture.Bitmap.PixelFormat := pf32Bit;
  194. {$ELSE}
  195.     Picture.Bitmap.PixelFormat := pf24Bit;
  196. {$ENDIF}
  197.  
  198.     if Picture.Graphic <> nil then
  199.     begin
  200.       with SaveDialog do
  201.       begin
  202.         DefaultExt := GraphicExtension(TGraphicClass(Picture.Graphic.ClassType));
  203.         Filter := GraphicFilter(TGraphicClass(Picture.Graphic.ClassType));
  204.         if Execute then Picture.SaveToFile(Filename);
  205.       end;
  206.     end;
  207.   finally
  208.     Picture.Free;
  209.   end;
  210. end;
  211.  
  212. procedure TPictureEditorForm.ClearClick(Sender: TObject);
  213. begin
  214.   CurrentImage.Bitmap.Delete;
  215. end;
  216.  
  217. procedure TPictureEditorForm.CopyClick(Sender: TObject);
  218. begin
  219.   Clipboard.Assign(CurrentImage.Bitmap);
  220. end;
  221.  
  222. procedure TPictureEditorForm.PasteClick(Sender: TObject);
  223. begin
  224. {$IFDEF CLX}
  225.   if Clipboard.Provides('image/delphi.bitmap') or
  226.      Clipboard.Provides('image/delphi.picture') then
  227.      CurrentImage.Bitmap.Assign(Clipboard);
  228. {$ELSE}
  229.   if Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE) then
  230.     CurrentImage.Bitmap.Assign(Clipboard);
  231. {$ENDIF}
  232.   if CurrentImage = AlphaChannel then
  233.     ColorToGrayscale(CurrentImage.Bitmap, CurrentImage.Bitmap);
  234. end;
  235.  
  236. procedure TPictureEditorForm.TimerTimer(Sender: TObject);
  237. begin
  238.   Save.Enabled := not CurrentImage.Bitmap.Empty;
  239.   Clear.Enabled := Save.Enabled;
  240.   Copy.Enabled := Save.Enabled;
  241.  
  242. {$IFDEF CLX}
  243.   Paste.Enabled := Clipboard.Provides('image/delphi.bitmap') or
  244.     Clipboard.Provides('image/delphi.picture');
  245. {$ELSE}
  246.   Paste.Enabled := Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE);
  247. {$ENDIF}
  248. end;
  249.  
  250. function TPictureEditorForm.CurrentImage: TImage32;
  251. begin
  252.   if PageControl.ActivePage = ImageSheet then Result := RGBChannels
  253.   else Result := AlphaChannel;
  254. end;
  255.  
  256. procedure TPictureEditorForm.PopupMenuPopup(Sender: TObject);
  257. begin
  258.   mnSave.Enabled := not CurrentImage.Bitmap.Empty;
  259.   mnClear.Enabled := Save.Enabled;
  260.   mnCopy.Enabled := Save.Enabled;
  261.   mnInvert.Enabled := Save.Enabled;
  262. {$IFDEF CLX}
  263.   mnPaste.Enabled := Clipboard.Provides('image/delphi.bitmap') or
  264.     Clipboard.Provides('image/delphi.picture');
  265. {$ELSE}
  266.   mnPaste.Enabled := Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_PICTURE);
  267. {$ENDIF}
  268. end;
  269.  
  270. procedure TPictureEditorForm.mnInvertClick(Sender: TObject);
  271. begin
  272.   InvertRGB(CurrentImage.Bitmap, CurrentImage.Bitmap);
  273. end;
  274.  
  275. procedure TPictureEditorForm.FormCreate(Sender: TObject);
  276. begin
  277.   MagnCombo.ItemIndex := 2;
  278. {$IFDEF CLX}
  279.   OpenDialog.Filter := GraphicFilter(TGraphic, True);
  280.   SaveDialog.Filter := GraphicFilter(TGraphic, True);
  281. {$ELSE}
  282.   OpenDialog.Filter := GraphicFilter(TGraphic);
  283.   SaveDialog.Filter := GraphicFilter(TGraphic);
  284. {$ENDIF}
  285. end;
  286.  
  287. procedure TPictureEditorForm.MagnComboChange(Sender: TObject);
  288. const
  289.   MAGN: array[0..6] of Integer = (25, 50, 100, 200, 400, 800, -1);
  290. var
  291.   S: Integer;
  292. begin
  293.   S := MAGN[MagnCombo.ItemIndex];
  294.   if S = -1 then
  295.   begin
  296.     RGBChannels.ScaleMode := smResize;
  297.     AlphaChannel.ScaleMode := smResize;
  298.   end
  299.   else
  300.   begin
  301.     RGBChannels.ScaleMode := smScale;
  302.     RGBChannels.Scale := S / 100;
  303.     AlphaChannel.ScaleMode := smScale;
  304.     AlphaChannel.Scale := S / 100;
  305.   end;
  306. end;
  307.  
  308. constructor TPictureEditorForm.Create(AOwner: TComponent);
  309. begin
  310.   inherited;
  311.   RGBChannels := TImage32.Create(Self);
  312.   RGBChannels.Parent := ImageSheet;
  313.   RGBChannels.Align := alClient;
  314.   RGBChannels.OnMouseMove := RGBChannelsMouseMove;
  315.   AlphaChannel := TImage32.Create(Self);
  316.   AlphaChannel.Parent := AlphaSheet;
  317.   AlphaChannel.Align := alClient;
  318.   AlphaChannel.OnMouseMove := AlphaChannelMouseMove;
  319. end;
  320.  
  321.  
  322. { TBitmap32Editor }
  323.  
  324. constructor TBitmap32Editor.Create(AOwner: TComponent);
  325. begin
  326.   inherited;
  327.   FBitmap32 := TBitmap32.Create;
  328.   FPicDlg := TPictureEditorForm.Create(Self);
  329. end;
  330.  
  331. destructor TBitmap32Editor.Destroy;
  332. begin
  333.   FBitmap32.Free;
  334.   inherited;
  335. end;
  336.  
  337. function TBitmap32Editor.Execute: Boolean;
  338. var
  339.   B: TBitmap32;
  340. begin
  341.   FPicDlg.RGBChannels.Bitmap := FBitmap32;
  342.   AlphaToGrayscale(FPicDlg.AlphaChannel.Bitmap, FBitmap32);
  343.   Result := (FPicDlg.ShowModal = mrOK);
  344.   if Result then
  345.   begin
  346.     FBitmap32.Assign(FPicDlg.RGBChannels.Bitmap);
  347.     FBitmap32.ResetAlpha;
  348.     if not FBitmap32.Empty and not FPicDlg.AlphaChannel.Bitmap.Empty then
  349.     begin
  350.       B := TBitmap32.Create;
  351.       try
  352.         B.SetSize(FBitmap32.Width, FBitmap32.Height);
  353.         FPicDlg.AlphaChannel.Bitmap.DrawTo(B, Rect(0, 0, B.Width, B.Height));
  354.         IntensityToAlpha(FBitmap32, B);
  355.       finally
  356.         B.Free;
  357.       end;
  358.     end;
  359.   end;
  360. end;
  361.  
  362. procedure TBitmap32Editor.SetBitmap32(Value: TBitmap32);
  363. begin
  364.   try
  365.   FBitmap32.Assign(Value);
  366.   except
  367.     on E: Exception do ShowMessage(E.Message);
  368.   end;
  369. end;
  370.  
  371. { TBitmap32Property }
  372.  
  373. procedure TBitmap32Property.Edit;
  374. var
  375.   BitmapEditor: TBitmap32Editor;
  376. begin
  377.   try
  378.     BitmapEditor := TBitmap32Editor.Create(nil);
  379.     try
  380.       BitmapEditor.Bitmap32 := TBitmap32(Pointer(GetOrdValue));
  381.       if BitmapEditor.Execute then
  382.       begin
  383.         SetOrdValue(Longint(BitmapEditor.Bitmap32));
  384.         Designer.Modified;
  385.       end;
  386.     finally
  387.       BitmapEditor.Free;
  388.     end;
  389.   except
  390.     on E: Exception do ShowMessage(E.Message);
  391.   end;
  392. end;
  393.  
  394. function TBitmap32Property.GetAttributes: TPropertyAttributes;
  395. begin
  396.   Result := [paDialog, paSubProperties];
  397. end;
  398.  
  399. function TBitmap32Property.GetValue: string;
  400. var
  401.   Bitmap: TBitmap32;
  402. begin
  403.   try
  404.     Bitmap := TBitmap32(GetOrdValue);
  405.     if (Bitmap = nil) or Bitmap.Empty then Result := srNone
  406.     else Result := Format('%s [%d,%d]', [Bitmap.ClassName, Bitmap.Width, Bitmap.Height]);
  407.   except
  408.     on E: Exception do ShowMessage(E.Message);
  409.   end;
  410. end;
  411.  
  412. {$IFDEF EXT_PROP_EDIT}
  413. procedure TBitmap32Property.PropDrawValue(Canvas: TCanvas;
  414.   const ARect: TRect; Selected: Boolean);
  415. var
  416.   Bitmap32: TBitmap32;
  417.   R: TRect;
  418. begin
  419.   Bitmap32 := TBitmap32(GetOrdValue);
  420.   if Bitmap32.Empty then inherited
  421.   else
  422.   begin
  423.     R := ARect;
  424.     R.Right := R.Left + R.Bottom - R.Top;
  425.     Bitmap32.DrawTo(Canvas.Handle, R, Classes.Rect(0, 0, Bitmap32.Width, Bitmap32.Height));
  426.     R.Left := R.Right;
  427.     R.Right := ARect.Right;
  428.     inherited PropDrawValue(Canvas, R, Selected);
  429.   end;
  430. end;
  431. {$ENDIF}
  432.  
  433. procedure TBitmap32Property.SetValue(const Value: string);
  434. begin
  435.   if Value = '' then SetOrdValue(0);
  436. end;
  437.  
  438. { TImage32Editor }
  439.  
  440. procedure TImage32Editor.ExecuteVerb(Index: Integer);
  441. var
  442.   Img: TCustomImage32;
  443.   BitmapEditor: TBitmap32Editor;
  444. begin
  445.   Img := Component as TCustomImage32;
  446.   if Index = 0 then
  447.   begin
  448.     BitmapEditor := TBitmap32Editor.Create(nil);
  449.     try
  450.       BitmapEditor.Bitmap32 := Img.Bitmap;
  451.       if BitmapEditor.Execute then
  452.       begin
  453.         Img.Bitmap := BitmapEditor.Bitmap32;
  454.         Designer.Modified;
  455.       end;
  456.     finally
  457.       BitmapEditor.Free;
  458.     end;
  459.   end;
  460. end;
  461.  
  462. function TImage32Editor.GetVerb(Index: Integer): string;
  463. begin
  464.   if Index = 0 then Result := 'Bitmap32 Editor...';
  465. end;
  466.  
  467. function TImage32Editor.GetVerbCount: Integer;
  468. begin
  469.   Result := 1;
  470. end;
  471.  
  472. procedure TPictureEditorForm.AlphaChannelMouseMove(Sender: TObject;
  473.   Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  474. var
  475.   P: TPoint;
  476. begin
  477.   if AlphaChannel.Bitmap <> nil then
  478.   begin
  479.     P := AlphaChannel.ControlToBitmap(Point(X, Y));
  480.     X := P.X;
  481.     Y := P.Y;
  482.     if (X >= 0) and (Y >= 0) and (X < AlphaChannel.Bitmap.Width) and
  483.       (Y < AlphaChannel.Bitmap.Height) then
  484.       Panel2.Caption := 'Alpha: $' +
  485.         IntToHex(AlphaChannel.Bitmap[X, Y] and $FF, 2) +
  486.         Format('     '#9'X: %d'#9'Y: %d', [X, Y])
  487.     else
  488.       Panel2.Caption := '';
  489.   end
  490.   else Panel2.Caption := '';
  491. end;
  492.  
  493. procedure TPictureEditorForm.RGBChannelsMouseMove(Sender: TObject;
  494.   Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  495. var
  496.   P: TPoint;
  497. begin
  498.   if RGBChannels.Bitmap <> nil then
  499.   begin
  500.     P := RGBChannels.ControlToBitmap(Point(X, Y));
  501.     X := P.X;
  502.     Y := P.Y;
  503.     if (X >= 0) and (Y >= 0) and (X < RGBChannels.Bitmap.Width) and
  504.       (Y < RGBChannels.Bitmap.Height) then
  505.       Panel2.Caption := 'RGB: $' +
  506.         IntToHex(RGBChannels.Bitmap[X, Y] and $00FFFFFF, 6) +
  507.         Format(#9'X: %d'#9'Y: %d', [X, Y])
  508.     else
  509.       Panel2.Caption := '';
  510.   end
  511.   else Panel2.Caption := '';
  512. end;
  513.  
  514. end.
  515.