source: trunk/Packages/Graphics32/GR32_Dsgn_Bitmap.pas

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