📄 gr32_dsgn_bitmap.pas
字号:
InvertRGB(CurrentImage.Bitmap, CurrentImage.Bitmap);
end;
procedure TPictureEditorForm.FormCreate(Sender: TObject);
begin
MagnCombo.ItemIndex := 2;
{$IFDEF CLX}
OpenDialog.Filter := GraphicFilter(TGraphic, True);
SaveDialog.Filter := GraphicFilter(TGraphic, True);
{$ELSE}
OpenDialog.Filter := GraphicFilter(TGraphic);
SaveDialog.Filter := GraphicFilter(TGraphic);
{$ENDIF}
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 CLX}
OpenDialog := TOpenDialog.Create(Self);
SaveDialog := TSaveDialog.Create(Self);
{$ELSE}
OpenDialog := TOpenPictureDialog.Create(Self);
SaveDialog := TSavePictureDialog.Create(Self);
{$ENDIF}
end;
{ TBitmap32Editor }
constructor TBitmap32Editor.Create(AOwner: TComponent);
begin
inherited;
FBitmap32 := TBitmap32.Create;
FPicDlg := TPictureEditorForm.Create(Self);
end;
destructor TBitmap32Editor.Destroy;
begin
FBitmap32.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));
Designer.Modified;
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
{$IFDEF DELPHI5}
inherited
{$ELSE}
DefaultPropertyDrawValue(Self, Canvas, ARect)
{$ENDIF}
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;
{$IFDEF DELPHI5}
inherited PropDrawValue(Canvas, R, ASelected);
{$ELSE}
DefaultPropertyDrawValue(Self, Canvas, R);
{$ENDIF}
end;
end;
{$IFDEF COMPILER6}
procedure TBitmap32Property.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
begin
DefaultPropertyDrawName(Self, ACanvas, ARect);
end;
{$ENDIF}
{$IFDEF COMPILER2005}
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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -