roberto
f040ff20cd
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@63 05c56307-c608-d34a-929d-697000501d7a
1598 lines
49 KiB
ObjectPascal
1598 lines
49 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressPrinting System(tm) COMPONENT SUITE }
|
|
{ }
|
|
{ Copyright (C) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSPRINTINGSYSTEM AND }
|
|
{ ALL ACCOMPANYING VCL CONTROLS AS PART OF AN }
|
|
{ EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxFEFDlg;
|
|
|
|
interface
|
|
|
|
{$I cxVer.inc}
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtDlgs, Registry,
|
|
StdCtrls, ExtCtrls, ComCtrls, Grids, Forms, Menus, Consts, ImgList, dxPSForm,
|
|
dxBkgnd;
|
|
|
|
type
|
|
TdxFillAs = (faNone, faTexture, faPattern, faPicture);
|
|
|
|
TdxFEFDialog = class(TCustomdxPSForm)
|
|
PageControl1: TPageControl;
|
|
tshTexture: TTabSheet;
|
|
tshPattern: TTabSheet;
|
|
tshPicture: TTabSheet;
|
|
dgTexture: TDrawGrid;
|
|
pnlTextureName: TPanel;
|
|
lblForeground: TLabel;
|
|
lblBackground: TLabel;
|
|
dgPattern: TDrawGrid;
|
|
pnlPatternName: TPanel;
|
|
btnOtherTexture: TButton;
|
|
sbxPicture: TScrollBox;
|
|
pnlPictureName: TPanel;
|
|
btnSelectPicture: TButton;
|
|
cbxPaintMode: TComboBox;
|
|
lblPaintMode: TLabel;
|
|
Bevel4: TBevel;
|
|
pnlPicture: TPanel;
|
|
pbxPicture: TPaintBox;
|
|
btnPreview: TButton;
|
|
btnInvert: TButton;
|
|
bvlForeColorHolder: TBevel;
|
|
bvlBackColorHolder: TBevel;
|
|
pnlPreview: TPanel;
|
|
pbxPreview: TPaintBox;
|
|
lblSample: TLabel;
|
|
btnHelp: TButton;
|
|
btnApply: TButton;
|
|
btnCancel: TButton;
|
|
btnOK: TButton;
|
|
pmPicture: TPopupMenu;
|
|
miCut: TMenuItem;
|
|
miCopy: TMenuItem;
|
|
miPaste: TMenuItem;
|
|
miDelete: TMenuItem;
|
|
miPreview: TMenuItem;
|
|
miLoad: TMenuItem;
|
|
ilMenu: TImageList;
|
|
N2: TMenuItem;
|
|
N3: TMenuItem;
|
|
pnlNoPicture: TPanel;
|
|
procedure dgTextureDrawCell(Sender: TObject; Col, Row: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
procedure dgPatternDrawCell(Sender: TObject; Col, Row: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
procedure SelectPictureClick(Sender: TObject);
|
|
procedure btnOtherTextureClick(Sender: TObject);
|
|
procedure dgTextureClick(Sender: TObject);
|
|
procedure dgPatternClick(Sender: TObject);
|
|
procedure pbxPreviewPaint(Sender: TObject);
|
|
procedure pbxPicturePaint(Sender: TObject);
|
|
procedure cbxColorChange(Sender: TObject);
|
|
procedure PageControl1Change(Sender: TObject);
|
|
procedure PicturePreviewClick(Sender: TObject);
|
|
procedure cbxPaintModeChange(Sender: TObject);
|
|
procedure lblPaintModeClick(Sender: TObject);
|
|
procedure lblForegroundClick(Sender: TObject);
|
|
procedure btnApplyClick(Sender: TObject);
|
|
procedure dgTextureDblClick(Sender: TObject);
|
|
procedure dgPatternDblClick(Sender: TObject);
|
|
procedure dgTextureMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure dgPatternMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure btnInvertClick(Sender: TObject);
|
|
procedure pmPicturePopup(Sender: TObject);
|
|
procedure miCopyClick(Sender: TObject);
|
|
procedure miPasteClick(Sender: TObject);
|
|
procedure miDeleteClick(Sender: TObject);
|
|
procedure miCutClick(Sender: TObject);
|
|
private
|
|
cbxBackColor: TCustomComboBox;
|
|
cbxForeColor: TCustomComboBox;
|
|
FActivePage: Integer;
|
|
FApplied: Boolean;
|
|
FBackground: TdxBackground;
|
|
FbmpPattern: TBitmap;
|
|
FbmpCurrentPattern: TBitmap;
|
|
FbmpTexture: TBitmap;
|
|
FControlsUpdating: Boolean;
|
|
FFirstApplied: Boolean;
|
|
FInitialDir: string;
|
|
FModified: Boolean;
|
|
FOriginalBackground: TdxBackground;
|
|
FOtherPicture: TGraphic;
|
|
FOtherPictureName: string;
|
|
FOtherTexture: TBitmap;
|
|
FOtherTextureName: string;
|
|
FPatternNames: TStringList;
|
|
FPatternWasSelected: Boolean;
|
|
FPicture: TGraphic;
|
|
FPictureExists: Boolean;
|
|
FPreviewWhat: TdxFillAs;
|
|
FTextureWasSelected: Boolean;
|
|
FTextureNames: TStringList;
|
|
FOnApply: TNotifyEvent;
|
|
|
|
function GetBackColor: TColor;
|
|
function GetForeColor: TColor;
|
|
function GetOtherPicture(AGraphicClass: TGraphicClass): TGraphic;
|
|
function GetOtherTexture: TBitmap;
|
|
function GetPaintMode: TdxPicturePaintMode;
|
|
function GetPicture: TGraphic;
|
|
function GetSelectWhat: TdxFillAs;
|
|
procedure SetBackColor(Value: TColor);
|
|
procedure SetBackground(Value: TdxBackground);
|
|
procedure SetForeColor(Value: TColor);
|
|
procedure SetOtherTexture(Value: TBitmap);
|
|
procedure SetPaintMode(Value: TdxPicturePaintMode);
|
|
procedure SetPicture(Value: TGraphic);
|
|
procedure SetSelectWhat(Value: TdxFillAs);
|
|
|
|
procedure AssignPicture(AImage: TGraphic);
|
|
procedure CheckModified;
|
|
function CopyPattern(I, J: Integer): TBitmap;
|
|
function CopyTexture(I, J: Integer): TBitmap;
|
|
procedure CreateControls;
|
|
procedure DrawSelectedFrame(ADrawGrid: TDrawGrid; Rect: TRect);
|
|
procedure DoApply;
|
|
procedure DoInvertColors;
|
|
procedure FreeAndNilResources;
|
|
function InternalLoadImage(var AImage: TGraphic; const AFileName: string): Boolean;
|
|
procedure LoadImage(var AImage: TGraphic; AWhat: Integer);
|
|
procedure LoadResources;
|
|
procedure MapPatternColors;
|
|
procedure PaintPicture;
|
|
procedure PaintPreview;
|
|
procedure StartSetting;
|
|
procedure SetupDialog;
|
|
procedure UpdateControlsState;
|
|
|
|
procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
|
|
procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE;
|
|
|
|
property BackColor: TColor read GetBackColor write SetBackColor;
|
|
property ForeColor: TColor read GetForeColor write SetForeColor;
|
|
property OtherTexture: TBitmap read GetOtherTexture write SetOtherTexture;
|
|
property PaintMode: TdxPicturePaintMode read GetPaintMode write SetPaintMode;
|
|
property Picture: TGraphic read GetPicture write SetPicture;
|
|
property SelectWhat: TdxFillAs read GetSelectWhat write SetSelectWhat;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure Loaded; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function Execute: Boolean;
|
|
|
|
procedure LoadFromRegistry(const APath: string); override;
|
|
procedure SaveToRegistry(const APath: string); override;
|
|
|
|
property Background: TdxBackground read FBackground write SetBackground;
|
|
property OnApply: TNotifyEvent read FOnApply write FOnApply;
|
|
end;
|
|
|
|
function dxFEFDialog(ABackground: TdxBackground): Boolean;
|
|
function StandardGetGraphicClassProc(const AFileName: string): TGraphicClass;
|
|
|
|
type
|
|
TdxGetGraphicClassProc = function(const AFileName: string): TGraphicClass;
|
|
|
|
var
|
|
GetGraphicClassProc: TdxGetGraphicClassProc = StandardGetGraphicClassProc;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
uses
|
|
{$IFDEF USEJPEGIMAGE}
|
|
Jpeg,
|
|
{$ENDIF}
|
|
ClipBrd, cxClasses, cxGraphics, dxPSGlbl, dxExtCtrls, dxPcPrVw, dxPSPopupMan,
|
|
dxPSImgs, dxPSRes, dxPSUtl;
|
|
|
|
type
|
|
TdxBackgroundAccess = class(TdxBackground);
|
|
|
|
const
|
|
PatternCount: TPoint = (X: 8; Y: 6);
|
|
PatternSize: TPoint = (X: 8; Y: 8);
|
|
TextureCount: TPoint = (X: 4; Y: 6);
|
|
TextureSize: TPoint = (X: 64; Y: 64);
|
|
|
|
sdxInitialDir = 'InitialDir'; //Don't Localize
|
|
sdxActivePage = 'ActivePage'; //Don't Localize
|
|
|
|
function dxCreateMappedBmp(ASource: TBitmap; const OldColors, NewColors: array of TColor): TBitmap;
|
|
var
|
|
I, J, K: Integer;
|
|
begin
|
|
Result := TBitmap.Create;
|
|
try
|
|
Result.Width := ASource.Width;
|
|
Result.Height := ASource.Height;
|
|
for I := 0 to ASource.Width - 1 do
|
|
for J := 0 to ASource.Height - 1 do
|
|
for K := Low(OldColors) to High(OldColors) do
|
|
if ASource.Canvas.Pixels[I, J] = OldColors[K] then
|
|
begin
|
|
Result.Canvas.Pixels[I, J] := NewColors[K];
|
|
Break;
|
|
end
|
|
else
|
|
Result.Canvas.Pixels[I, J] := ASource.Canvas.Pixels[I, J];
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function dxFEFDialog(ABackground: TdxBackground): Boolean;
|
|
var
|
|
Dialog: TdxFEFDialog;
|
|
B: TBitmap;
|
|
begin
|
|
Result := False;
|
|
if ABackground = nil then Exit;
|
|
|
|
Dialog := TdxFEFDialog.Create(nil);
|
|
try
|
|
Dialog.Background := ABackground;
|
|
Dialog.FOriginalBackground := ABackground;
|
|
Dialog.OnApply := TdxBackgroundAccess(ABackground).OnApply;
|
|
Result := Dialog.Execute or not Dialog.FFirstApplied; {at least one time button "Apply" was pressed}
|
|
if Dialog.ModalResult <> mrOK then Exit;
|
|
if Result then
|
|
begin
|
|
ABackground.BkColor := Dialog.BackColor;
|
|
ABackground.Brush.Color := Dialog.ForeColor;
|
|
ABackground.Picture := Dialog.Picture;
|
|
case Dialog.SelectWhat of
|
|
faTexture:
|
|
ABackground.Mode := bmBrushBitmap;
|
|
faPattern:
|
|
begin
|
|
B := TBitmap(ABackground.Picture);
|
|
B.Width := PatternSize.X;
|
|
B.Height := PatternSize.Y;
|
|
B.Canvas.Draw(-Dialog.dgPattern.Col * PatternSize.X, -Dialog.dgPattern.Row * PatternSize.Y, Dialog.FbmpCurrentPattern);
|
|
ABackground.Mode := bmBrushBitmap;
|
|
end;
|
|
faPicture:
|
|
begin
|
|
ABackground.Mode := bmPicture;
|
|
ABackground.PictureMode := Dialog.PaintMode;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Dialog.Free;
|
|
end;
|
|
end;
|
|
|
|
function StandardGetGraphicClassProc(const AFileName: string): TGraphicClass;
|
|
var
|
|
Extention: string;
|
|
begin
|
|
Result := nil;
|
|
Extention := ExtractFileExt(AFileName);
|
|
if CompareText(Extention, '.' + GraphicExtension(TBitmap)) = 0 then
|
|
Result := TBitmap
|
|
else
|
|
{$IFDEF USEJPEGIMAGE}
|
|
if CompareText(Extention, '.' + GraphicExtension(TJpegImage)) = 0 then
|
|
Result := TJpegImage
|
|
else
|
|
{$ENDIF}
|
|
if CompareText(Extention, '.' + GraphicExtension(TMetafile)) = 0 then
|
|
Result := TMetafile
|
|
else
|
|
if CompareText(Extention, '.wmf') = 0 then
|
|
Result := TMetafile;
|
|
end;
|
|
|
|
{ TdxFEFDialog }
|
|
|
|
constructor TdxFEFDialog.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
HelpContext := dxhcFEFDlg;
|
|
|
|
FFirstApplied := True;
|
|
CreateControls;
|
|
LoadResources;
|
|
FPreviewWhat := faNone;
|
|
FPatternWasSelected := False;
|
|
FTextureWasSelected := False;
|
|
FPictureExists := False;
|
|
|
|
pmPicture.Images := ilMenu;
|
|
miLoad.ImageIndex := 0;
|
|
miPreview.ImageIndex := 1;
|
|
miCut.ImageIndex := 2;
|
|
miCopy.ImageIndex := 3;
|
|
miPaste.ImageIndex := 4;
|
|
miDelete.ImageIndex := 5;
|
|
|
|
dxPSPopupMenuController.RegisterControl(sbxPicture);
|
|
end;
|
|
|
|
destructor TdxFEFDialog.Destroy;
|
|
begin
|
|
dxPSPopupMenuController.UnregisterControl(sbxPicture);
|
|
FreeAndNil(FPatternNames);
|
|
FreeAndNil(FTextureNames);
|
|
FreeAndNil(FBackground);
|
|
FreeAndNil(FPicture);
|
|
FreeAndNil(FOtherTexture);
|
|
FreeAndNil(FOtherPicture);
|
|
FreeAndNilResources;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.CreateControls;
|
|
|
|
function CreateColorCombo(AParent: TWinControl; ASite: TControl; ALabel: TLabel;
|
|
ATabOrder: Integer): TdxPSColorCombo;
|
|
begin
|
|
Result := TdxPSColorCombo.Create(Self);
|
|
with Result do
|
|
begin
|
|
Parent := AParent;
|
|
BoundsRect := ASite.BoundsRect;
|
|
TabOrder := ATabOrder;
|
|
ColorTypes := [ctPure];
|
|
ShowColorName := True;
|
|
ShowCustomColor := False;
|
|
OnChange := cbxColorChange;
|
|
end;
|
|
ALabel.FocusControl := Result;
|
|
ASite.Visible := False;
|
|
end;
|
|
|
|
begin
|
|
cbxForeColor := CreateColorCombo(tshPattern, bvlForeColorHolder, lblForeground, 1);
|
|
cbxBackColor := CreateColorCombo(tshPattern, bvlBackColorHolder, lblBackground, 2);
|
|
|
|
FBackground := TdxBackground.Create;
|
|
FPicture := TBitmap.Create;
|
|
FPatternNames := TStringList.Create;
|
|
FTextureNames := TStringList.Create;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
Params.WindowClass.Style := Params.WindowClass.Style or CS_SAVEBITS;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
if Screen.PixelsPerInch > 96 then
|
|
begin
|
|
dgTexture.DefaultColWidth := (dgTexture.Width - GetSystemMetrics(SM_CXHSCROLL) - 1) div 4 - 1;
|
|
dgTexture.Width := dgTexture.Width - 1;
|
|
dgTexture.DefaultRowHeight := dgTexture.DefaultColWidth;
|
|
dgTexture.Height := dgTexture.Height - 2;
|
|
dgPattern.Width := dgPattern.Width - dgPattern.Width mod dgPattern.ColCount + 7;
|
|
dgPattern.DefaultColWidth := (dgPattern.Width - 1) div dgPattern.ColCount;
|
|
dgPattern.Height := dgPattern.Height - dgPattern.Height mod dgPattern.RowCount + 11;
|
|
dgPattern.DefaultRowHeight := dgPattern.Height div dgPattern.RowCount;
|
|
end;
|
|
with dgTexture do
|
|
pnlTextureName.SetBounds(Left, BoundsRect.Bottom + 3, Width, pnlTextureName.Height);
|
|
with dgPattern do
|
|
pnlPatternName.SetBounds(Left, BoundsRect.Bottom + 3, Width, pnlPatternName.Height);
|
|
btnInvert.SetBounds(dgPattern.Left, btnInvert.Top, dgPattern.Width, btnInvert.Height);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.CMDialogChar(var Msg: TCMDialogChar);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited;
|
|
with PageControl1 do
|
|
for I := 0 to PageCount - 1 do
|
|
if IsAccel(Msg.CharCode, Pages[I].Caption) then
|
|
begin
|
|
Msg.Result := 1;
|
|
ActivePage := Pages[I];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.WMCancelMode(var Msg: TWMCancelMode);
|
|
begin
|
|
inherited;
|
|
dgPattern.Invalidate;
|
|
dgTexture.Invalidate;
|
|
end;
|
|
|
|
function TdxFEFDialog.Execute: Boolean;
|
|
begin
|
|
StartSetting;
|
|
Result := (ShowModal = mrOk) and FModified;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetBackground(Value: TdxBackground);
|
|
begin
|
|
FBackground.Assign(Value);
|
|
SetupDialog;
|
|
UpdateControlsState;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetupDialog;
|
|
var
|
|
bmp: TBitmap;
|
|
I, J: Integer;
|
|
begin
|
|
FControlsUpdating := True;
|
|
try
|
|
cbxPaintMode.ItemIndex := Integer(Background.PictureMode);
|
|
ForeColor := FBackground.Brush.Color;
|
|
BackColor := FBackground.BkColor;
|
|
if (BackColor = ForeColor) and (ForeColor = clWhite) then
|
|
ForeColor := clBlack;
|
|
MapPatternColors;
|
|
if FBackground.Picture <> nil then
|
|
begin
|
|
case FBackground.Mode of
|
|
bmNone: ;
|
|
bmBrush: ;
|
|
bmBrushBitmap:
|
|
begin
|
|
PageControl1.ActivePage := tshPattern;
|
|
for I := 0 to PatternCount.X - 1 do
|
|
for J := 0 to PatternCount.Y - 1 do
|
|
begin
|
|
bmp := CopyPattern(I, J);
|
|
try
|
|
if dxAreGraphicsEqual(Bmp, FBackground.Picture) then
|
|
begin
|
|
FPatternWasSelected := True;
|
|
dgPattern.Col := I;
|
|
dgPattern.Row := J;
|
|
FPicture.Assign(TBitmap(FBackground.Picture));
|
|
FPreviewWhat := faPattern;
|
|
dgPatternClick(dgPattern);
|
|
end;
|
|
finally
|
|
bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
PageControl1.ActivePage := tshTexture;
|
|
for I := 0 to TextureCount.X - 1 do
|
|
for J := 0 to TextureCount.Y - 1 do
|
|
begin
|
|
bmp := CopyTexture(I, J);
|
|
try
|
|
if dxAreBitmapsEqual(bmp, TBitmap(FBackground.Picture)) then
|
|
begin
|
|
FTextureWasSelected := True;
|
|
dgTexture.Col := I;
|
|
dgTexture.Row := J;
|
|
if (dgTexture.Row > 2) then dgTexture.TopRow := dgTexture.Row - 2;
|
|
FPicture.Assign(TBitmap(FBackground.Picture));
|
|
FPreviewWhat := faTexture;
|
|
dgTextureClick(dgTexture);
|
|
end;
|
|
finally
|
|
bmp.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
bmPicture:
|
|
begin
|
|
FPicture.Assign(TBitmap(FBackground.Picture));
|
|
GetOtherPicture(TGraphicClass(FBackground.Picture.ClassType)).Assign(FBackground.Picture);
|
|
FPictureExists := True;
|
|
FPreviewWhat := faPicture;
|
|
PageControl1.ActivePage := tshPicture;
|
|
PaintPicture;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FControlsUpdating := False;
|
|
end;
|
|
pbxPreview.Invalidate;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.UpdateControlsState;
|
|
var
|
|
b: Boolean;
|
|
begin
|
|
b := FModified and (FPicture <> nil) and not FPicture.Empty;
|
|
|
|
btnApply.Visible := Assigned(OnApply);
|
|
btnApply.Enabled := b and not FApplied;
|
|
// btnOK.Enabled := b;
|
|
btnInvert.Enabled := BackColor <> ForeColor;
|
|
pnlNoPicture.Visible := FOtherPicture = nil;
|
|
btnPreview.Enabled := (FOtherPicture <> nil) and
|
|
((FOtherPicture.Width > sbxPicture.ClientWidth) or
|
|
(FOtherPicture.Height > sbxPicture.ClientHeight));
|
|
cbxPaintMode.Enabled := FOtherPicture <> nil;
|
|
lblPaintMode.Enabled := FOtherPicture <> nil;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.CheckModified;
|
|
begin
|
|
if not FModified then FModified := True;
|
|
FApplied := False;
|
|
UpdateControlsState;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.StartSetting;
|
|
begin
|
|
FModified := False;
|
|
FControlsUpdating := True;
|
|
try
|
|
with PageControl1 do
|
|
ActivePage := Pages[FActivePage];
|
|
btnHelp.Visible := HelpContext <> 0;
|
|
finally
|
|
UpdateControlsState;
|
|
FControlsUpdating := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.LoadResources;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
FbmpPattern := TBitmap.Create;
|
|
FbmpPattern.Width := PatternCount.X * PatternSize.X;
|
|
FbmpPattern.Height := PatternCount.Y * PatternSize.Y;
|
|
Bitmap_LoadFromResourceName(FbmpPattern, IDB_DXPSBKPATTERNS);
|
|
|
|
FbmpTexture := TBitmap.Create;
|
|
FbmpTexture.Width := TextureCount.X * TextureSize.X;
|
|
FbmpTexture.Height := TextureCount.Y * TextureSize.Y;
|
|
Bitmap_LoadFromResourceName(FbmpTexture, IDB_DXPSBKTEXTURES);
|
|
|
|
miLoad.Caption := cxGetResourceString(@sdxMenuLoad);
|
|
miPreview.Caption := cxGetResourceString(@sdxMenuPreview);
|
|
miCut.Caption := cxGetResourceString(@sdxMenuEditCut);
|
|
miCopy.Caption := cxGetResourceString(@sdxMenuEditCopy);
|
|
miPaste.Caption := cxGetResourceString(@sdxMenuEditPaste);
|
|
miDelete.Caption := cxGetResourceString(@sdxMenuEditDelete);
|
|
|
|
tshTexture.Caption := cxGetResourceString(@sdxTexture);
|
|
tshPattern.Caption := cxGetResourceString(@sdxPattern);
|
|
tshPicture.Caption := cxGetResourceString(@sdxPicture);
|
|
|
|
btnOtherTexture.Caption := cxGetResourceString(@sdxBtnOtherTexture);
|
|
lblForeground.Caption := cxGetResourceString(@sdxForeground);
|
|
lblBackground.Caption := cxGetResourceString(@sdxBackground);
|
|
btnInvert.Caption := cxGetResourceString(@sdxBtnInvertColors);
|
|
pnlNoPicture.Caption := cxGetResourceString(@sdxThereIsNoPictureToDisplay);
|
|
btnPreview.Caption := cxGetResourceString(@sdxBtnPreview);
|
|
btnSelectPicture.Caption := cxGetResourceString(@sdxBtnSelectPicture);
|
|
lblPaintMode.Caption := cxGetResourceString(@sdxPaintMode);
|
|
lblSample.Caption := cxGetResourceString(@sdxSample);
|
|
btnOK.Caption := cxGetResourceString(@sdxBtnOK);
|
|
btnCancel.Caption := cxGetResourceString(@sdxBtnCancel);
|
|
btnApply.Caption := cxGetResourceString(@sdxBtnApply);
|
|
Caption := cxGetResourceString(@sdxFEFCaption);
|
|
|
|
Index := cbxPaintMode.ItemIndex;
|
|
with cbxPaintMode do
|
|
begin
|
|
Items.BeginUpdate;
|
|
try
|
|
Items.Clear;
|
|
Items.Add(cxGetResourceString(@sdxPaintModeCenter));
|
|
Items.Add(cxGetResourceString(@sdxPaintModeStretch));
|
|
Items.Add(cxGetResourceString(@sdxPaintModeTile));
|
|
Items.Add(cxGetResourceString(@sdxPaintModeProportional));
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
cbxPaintMode.ItemIndex := Index;
|
|
|
|
with FPatternNames do
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
Add(cxGetResourceString(@sdxPatternGray5));
|
|
Add(cxGetResourceString(@sdxPatternGray10));
|
|
Add(cxGetResourceString(@sdxPatternGray20));
|
|
Add(cxGetResourceString(@sdxPatternGray25));
|
|
Add(cxGetResourceString(@sdxPatternGray30));
|
|
Add(cxGetResourceString(@sdxPatternGray40));
|
|
Add(cxGetResourceString(@sdxPatternGray50));
|
|
Add(cxGetResourceString(@sdxPatternGray60));
|
|
Add(cxGetResourceString(@sdxPatternGray70));
|
|
Add(cxGetResourceString(@sdxPatternGray75));
|
|
Add(cxGetResourceString(@sdxPatternGray80));
|
|
Add(cxGetResourceString(@sdxPatternGray90));
|
|
Add(cxGetResourceString(@sdxPatternLightDownwardDiagonal));
|
|
Add(cxGetResourceString(@sdxPatternLightUpwardDiagonal));
|
|
Add(cxGetResourceString(@sdxPatternDarkDownwardDiagonal));
|
|
Add(cxGetResourceString(@sdxPatternDarkUpwardDiagonal));
|
|
Add(cxGetResourceString(@sdxPatternWideDownwardDiagonal));
|
|
Add(cxGetResourceString(@sdxPatternWideUpwardDiagonal));
|
|
Add(cxGetResourceString(@sdxPatternLightVertical));
|
|
Add(cxGetResourceString(@sdxPatternLightHorizontal));
|
|
Add(cxGetResourceString(@sdxPatternNarrowVertical));
|
|
Add(cxGetResourceString(@sdxPatternNarrowHorizontal));
|
|
Add(cxGetResourceString(@sdxPatternDarkVertical));
|
|
Add(cxGetResourceString(@sdxPatternDarkHorizontal));
|
|
Add(cxGetResourceString(@sdxPatternDashedDownward));
|
|
Add(cxGetResourceString(@sdxPatternDashedUpward));
|
|
Add(cxGetResourceString(@sdxPatternDashedHorizontal));
|
|
Add(cxGetResourceString(@sdxPatternDashedVertical));
|
|
Add(cxGetResourceString(@sdxPatternSmallConfetti));
|
|
Add(cxGetResourceString(@sdxPatternLargeConfetti));
|
|
Add(cxGetResourceString(@sdxPatternZigZag));
|
|
Add(cxGetResourceString(@sdxPatternWave));
|
|
Add(cxGetResourceString(@sdxPatternDiagonalBrick));
|
|
Add(cxGetResourceString(@sdxPatternHorizantalBrick));
|
|
Add(cxGetResourceString(@sdxPatternWeave));
|
|
Add(cxGetResourceString(@sdxPatternPlaid));
|
|
Add(cxGetResourceString(@sdxPatternDivot));
|
|
Add(cxGetResourceString(@sdxPatternDottedGrid));
|
|
Add(cxGetResourceString(@sdxPatternDottedDiamond));
|
|
Add(cxGetResourceString(@sdxPatternShingle));
|
|
Add(cxGetResourceString(@sdxPatternTrellis));
|
|
Add(cxGetResourceString(@sdxPatternSphere));
|
|
Add(cxGetResourceString(@sdxPatternSmallGrid));
|
|
Add(cxGetResourceString(@sdxPatternLargeGrid));
|
|
Add(cxGetResourceString(@sdxPatternSmallCheckedBoard));
|
|
Add(cxGetResourceString(@sdxPatternLargeCheckedBoard));
|
|
Add(cxGetResourceString(@sdxPatternOutlinedDiamond));
|
|
Add(cxGetResourceString(@sdxPatternSolidDiamond));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
with FTextureNames do
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
Add(cxGetResourceString(@sdxTextureNewSprint));
|
|
Add(cxGetResourceString(@sdxTextureGreenMarble));
|
|
Add(cxGetResourceString(@sdxTextureBlueTissuePaper));
|
|
Add(cxGetResourceString(@sdxTexturePapyrus));
|
|
Add(cxGetResourceString(@sdxTextureWaterDroplets));
|
|
Add(cxGetResourceString(@sdxTextureCork));
|
|
Add(cxGetResourceString(@sdxTextureRecycledPaper));
|
|
Add(cxGetResourceString(@sdxTextureWhiteMarble));
|
|
Add(cxGetResourceString(@sdxTexturePinkMarble));
|
|
Add(cxGetResourceString(@sdxTextureCanvas));
|
|
Add(cxGetResourceString(@sdxTexturePaperBag));
|
|
Add(cxGetResourceString(@sdxTextureWalnut));
|
|
Add(cxGetResourceString(@sdxTextureParchment));
|
|
Add(cxGetResourceString(@sdxTextureBrownMarble));
|
|
Add(cxGetResourceString(@sdxTexturePurpleMesh));
|
|
Add(cxGetResourceString(@sdxTextureDenim));
|
|
Add(cxGetResourceString(@sdxTextureFishFossil));
|
|
Add(cxGetResourceString(@sdxTextureOak));
|
|
Add(cxGetResourceString(@sdxTextureStationary));
|
|
Add(cxGetResourceString(@sdxTextureGranite));
|
|
Add(cxGetResourceString(@sdxTextureBouquet));
|
|
Add(cxGetResourceString(@sdxTextureWonenMat));
|
|
Add(cxGetResourceString(@sdxTextureSand));
|
|
Add(cxGetResourceString(@sdxTextureMediumWood));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.FreeAndNilResources;
|
|
begin
|
|
FreeAndNil(FbmpPattern);
|
|
FreeAndNil(FbmpCurrentPattern);
|
|
FreeAndNil(FbmpTexture);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgTextureDrawCell(Sender: TObject;
|
|
Col, Row: Integer; Rect: TRect; State: TGridDrawState);
|
|
var
|
|
DrawGrid: TDrawGrid;
|
|
R: TRect;
|
|
DC: HDC;
|
|
BPP: Integer;
|
|
DoHalftone: Boolean;
|
|
Pt: TPoint;
|
|
ABitmap: Windows.TBitmap;
|
|
BltMode: Integer;
|
|
begin
|
|
DrawGrid := TDrawGrid(Sender);
|
|
DC := DrawGrid.Canvas.Handle;
|
|
R := Rect;
|
|
if not ((gdSelected in State) and FTextureWasSelected) then
|
|
if (FOtherTexture = nil) or ((Row < DrawGrid.RowCount - 1) or (Col = 0)) then
|
|
begin
|
|
DrawEdge(DC, R, EDGE_SUNKEN, BF_RECT);
|
|
InflateRect(R, -2, -2);
|
|
end
|
|
else
|
|
else
|
|
InflateRect(R, -2, -2);
|
|
|
|
BltMode := GetStretchBltMode(DC);
|
|
if (FOtherTexture = nil) or (Row < DrawGrid.RowCount - 1) then
|
|
begin
|
|
BPP := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
|
|
cxGetBitmapData(FbmpTexture.Handle, ABitmap);
|
|
DoHalftone := (BPP <= 8) and (BPP < (ABitmap.bmBitsPixel * ABitmap.bmPlanes));
|
|
if DoHalftone then
|
|
begin
|
|
GetBrushOrgEx(DC, Pt);
|
|
SetStretchBltMode(DC, HALFTONE);
|
|
SetBrushOrgEx(DC, Pt.x, Pt.y, @Pt);
|
|
end
|
|
else
|
|
if not FbmpTexture.Monochrome then
|
|
SetStretchBltMode(DC, STRETCH_DELETESCANS);
|
|
end;
|
|
|
|
if FOtherTexture = nil then
|
|
Windows.StretchBlt(DC, R.Left, R.Top, R.Right - R.Left,
|
|
R.Bottom - R.Top, FbmpTexture.Canvas.Handle, Col * TextureSize.X,
|
|
Row * TextureSize.Y, TextureSize.X, TextureSize.Y, SRCCOPY)
|
|
else
|
|
if Row < DrawGrid.RowCount - 1 then
|
|
Windows.StretchBlt(DC, R.Left, R.Top, R.Right - R.Left,
|
|
R.Bottom - R.Top, FbmpTexture.Canvas.Handle, Col * TextureSize.X,
|
|
Row * TextureSize.Y, TextureSize.X, TextureSize.Y, SRCCOPY)
|
|
else
|
|
if Col = 0 then
|
|
DrawGrid.Canvas.StretchDraw(R, FOtherTexture)
|
|
else
|
|
Windows.FillRect(DC, Rect, hBrush(COLOR_BTNFACE + 1));
|
|
|
|
SetStretchBltMode(DC, BltMode);
|
|
|
|
if gdSelected in State then
|
|
if (FTextureWasSelected and (FOtherTexture = nil)) or
|
|
((FOtherTexture <> nil) and ((Row < DrawGrid.RowCount - 1) or (DrawGrid.Col = 0))) then
|
|
DrawSelectedFrame(DrawGrid, Rect);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgPatternDrawCell(Sender: TObject; Col,
|
|
Row: Integer; Rect: TRect; State: TGridDrawState);
|
|
var
|
|
APrevBrush: TBrush;
|
|
ABrushBitmap: TBitmap;
|
|
Pt: TPoint;
|
|
DC: hDC;
|
|
begin
|
|
DC := TDrawGrid(Sender).Canvas.Handle;
|
|
if not ((gdSelected in State) and FPatternWasSelected) then
|
|
DrawEdge(DC, Rect, EDGE_SUNKEN, BF_RECT);
|
|
InflateRect(Rect, -2, -2);
|
|
|
|
APrevBrush := TBrush.Create;
|
|
try
|
|
APrevBrush.Assign(TDrawGrid(Sender).Canvas.Brush);
|
|
ABrushBitmap := CopyPattern(Col, Row);
|
|
try
|
|
SetBrushOrgEx(DC, Rect.Left, Rect.Top, @Pt);
|
|
with TDrawGrid(Sender).Canvas do
|
|
begin
|
|
Brush.Bitmap := ABrushBitmap;
|
|
FillRect(Rect);
|
|
Brush.Bitmap := nil;
|
|
Brush := APrevBrush;
|
|
end;
|
|
SetBrushOrgEx(DC, Pt.X, Pt.Y, nil);
|
|
finally
|
|
ABrushBitmap.Free;
|
|
end;
|
|
finally
|
|
APrevBrush.Free;
|
|
end;
|
|
|
|
if (gdSelected in State) and FPatternWasSelected then
|
|
begin
|
|
InflateRect(Rect, 2, 2);
|
|
DrawSelectedFrame(TDrawGrid(Sender), Rect);
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.DrawSelectedFrame(ADrawGrid: TDrawGrid; Rect: TRect);
|
|
var
|
|
DC: HDC;
|
|
PrevColor: TColor;
|
|
PrevMode: Integer;
|
|
Points: array of TPoint;
|
|
begin
|
|
with ADrawGrid do
|
|
begin
|
|
DC := Canvas.Handle;
|
|
if (ActiveControl = ADrawGrid) and Focused then
|
|
begin
|
|
//InflateRect(Rect, 2, 2);
|
|
PrevMode := SetBkMode(DC, TRANSPARENT);
|
|
PrevColor := Canvas.Pen.Color;
|
|
Canvas.Pen.Color := clWindowText;
|
|
Canvas.Pen.Style := psDot;
|
|
with Rect do
|
|
begin
|
|
SetLength(Points, 5);
|
|
Points[0] := TopLeft;
|
|
Points[1] := MakePoint(Right - 1, Top);
|
|
Points[2] := MakePoint(Right - 1, Bottom - 1);
|
|
Points[3] := MakePoint(Left, Bottom - 1);
|
|
Points[4] := TopLeft;
|
|
Canvas.Polyline(Points);
|
|
end;
|
|
Canvas.Pen.Style := psSolid;
|
|
Canvas.Pen.Color := PrevColor;
|
|
SetBkMode(DC, PrevMode);
|
|
InflateRect(Rect, -1, -1);
|
|
end;
|
|
DrawEdge(DC, Rect, BDR_SUNKENOUTER, BF_RECT or BF_MONO);
|
|
InflateRect(Rect, -1, -1);
|
|
FrameRect(DC, Rect, GetSysColorBrush(COLOR_BTNHIGHLIGHT));
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.LoadFromRegistry(const APath: string);
|
|
begin
|
|
inherited LoadFromRegistry(APath);
|
|
with TRegistry.Create do
|
|
try
|
|
if OpenKey(APath, False) then
|
|
try
|
|
if ValueExists(sdxInitialDir) then
|
|
FInitialDir := ReadString(sdxInitialDir);
|
|
if ValueExists(sdxActivePage) then
|
|
FActivePage := ReadInteger(sdxActivePage);
|
|
except
|
|
on ERegistryException do
|
|
{ ignore }
|
|
else
|
|
raise;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SaveToRegistry(const APath: string);
|
|
begin
|
|
inherited SaveToRegistry(APath);
|
|
with TRegistry.Create do
|
|
try
|
|
if OpenKey(APath, True) then
|
|
try
|
|
WriteString(sdxInitialDir, FInitialDir);
|
|
WriteInteger(sdxActivePage, PageControl1.ActivePage.PageIndex);
|
|
except
|
|
on ERegistryException do
|
|
{ ignore }
|
|
else
|
|
raise;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SelectPictureClick(Sender: TObject);
|
|
var
|
|
Graphic: TGraphic;
|
|
begin
|
|
Graphic := nil;
|
|
try
|
|
LoadImage(Graphic, 1);
|
|
if Graphic <> nil then AssignPicture(Graphic);
|
|
finally
|
|
if Graphic <> nil then Graphic.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.AssignPicture(AImage: TGraphic);
|
|
begin
|
|
if AImage is TMetafile then
|
|
begin
|
|
FPicture.Free;
|
|
FPicture := TBitmap.Create;
|
|
FPicture.Width := AImage.Width;
|
|
FPicture.Height := AImage.Height;
|
|
TBitmap(FPicture).Palette := AImage.Palette;
|
|
TBitmap(FPicture).Canvas.Draw(0, 0, AImage);
|
|
end
|
|
else
|
|
SetPicture(AImage);
|
|
|
|
GetOtherPicture(TGraphicClass(FPicture.ClassType)).Assign(FPicture);
|
|
PaintPicture;
|
|
CheckModified;
|
|
FPreviewWhat := faPicture;
|
|
pbxPreview.Invalidate;
|
|
FPictureExists := True;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.PaintPicture;
|
|
begin
|
|
if FPicture <> nil then
|
|
begin
|
|
pnlPicture.SetBounds(0, 0, FPicture.Width, FPicture.Height);
|
|
pbxPicture.Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.pbxPicturePaint(Sender: TObject);
|
|
begin
|
|
if FOtherPicture <> nil then
|
|
TPaintBox(Sender).Canvas.Draw(0, 0, FOtherPicture);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.btnOtherTextureClick(Sender: TObject);
|
|
var
|
|
APicture: TGraphic;
|
|
begin
|
|
APicture := nil;
|
|
try
|
|
LoadImage(APicture, 0);
|
|
if APicture <> nil then
|
|
begin
|
|
if APicture is TMetafile then
|
|
begin
|
|
FPicture.Free;
|
|
FPicture := TBitmap.Create;
|
|
FPicture.Width := TextureSize.X;
|
|
FPicture.Height := TextureSize.Y;
|
|
TBitmap(FPicture).Palette := APicture.Palette;
|
|
TBitmap(FPicture).Canvas.Draw(0, 0, APicture);
|
|
end
|
|
else
|
|
SetPicture(APicture);
|
|
|
|
if FOtherTexture = nil then
|
|
dgTexture.RowCount := dgTexture.RowCount + 1;
|
|
OtherTexture.Assign(FPicture);
|
|
dgTexture.Col := 0;
|
|
dgTexture.Row := dgTexture.RowCount - 1;
|
|
if not FTextureWasSelected then
|
|
FTextureWasSelected := True;
|
|
dgTexture.Invalidate;
|
|
CheckModified;
|
|
FPreviewWhat := faTexture;
|
|
pbxPreview.Refresh;
|
|
end;
|
|
finally
|
|
if APicture <> nil then APicture.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.LoadImage(var AImage: TGraphic; AWhat: Integer);
|
|
var
|
|
Registered: Boolean;
|
|
|
|
procedure UnregisterIcon;
|
|
begin
|
|
Registered := Pos('ico', GraphicFilter(TGraphic)) > 0;
|
|
if Registered then TPicture.UnregisterGraphicClass(TIcon);
|
|
end;
|
|
|
|
procedure RegisterIcon;
|
|
begin
|
|
if Registered then
|
|
TPicture.RegisterFileFormat('ico', SVIcons, TIcon);
|
|
end;
|
|
|
|
var
|
|
Dialog: TOpenPictureDialog;
|
|
FileName: string;
|
|
B: TBitmap;
|
|
begin
|
|
UnregisterIcon;
|
|
try
|
|
Dialog := TOpenPictureDialog.Create(nil);
|
|
try
|
|
Dialog.InitialDir := FInitialDir;
|
|
Dialog.Filter := GraphicFilter(TGraphic);
|
|
if Dialog.Execute then
|
|
begin
|
|
if InternalLoadImage(AImage, Dialog.Filename) then
|
|
begin
|
|
FInitialDir := ExtractFileDir(Dialog.Filename);
|
|
FileName := {Dialog.FileName;//}ChangeFileExt(ExtractFileName(Dialog.Filename), '');
|
|
|
|
case AWhat of
|
|
0: // textures
|
|
begin
|
|
FOtherTextureName := FileName;
|
|
pnlTextureName.Caption := FileName;//ChangeFileExt(ExtractFileName(Filename), '');
|
|
if AImage is TMetafile then
|
|
//
|
|
else
|
|
if AImage is TBitmap then
|
|
begin
|
|
AImage.Width := TextureSize.X;
|
|
AImage.Height := TextureSize.Y;
|
|
end
|
|
else
|
|
begin
|
|
B := TBitmap.Create;
|
|
try
|
|
B.Assign(AImage);
|
|
B.Width := TextureSize.X;
|
|
B.Height := TextureSize.Y;
|
|
AImage.Assign(B);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
1: // pictures
|
|
begin
|
|
FOtherPictureName := FileName;
|
|
pnlPictureName.Caption := FileName;//ChangeFileExt(ExtractFileName(FileName), '');
|
|
end;
|
|
end;
|
|
CheckModified;
|
|
end;
|
|
end;
|
|
finally
|
|
Dialog.Free;
|
|
end;
|
|
finally
|
|
RegisterIcon;
|
|
end;
|
|
end;
|
|
|
|
function TdxFEFDialog.InternalLoadImage(var AImage: TGraphic; const AFileName: string): Boolean;
|
|
var
|
|
Picture: TPicture;
|
|
begin
|
|
AImage := nil;
|
|
Picture := TPicture.Create;
|
|
try
|
|
try
|
|
Picture.LoadFromFile(AFileName);
|
|
AImage := dxPSUtl.CreateGraphic(TGraphicClass(Picture.Graphic.ClassType));
|
|
AImage.Assign(Picture.Graphic);
|
|
Result := True;
|
|
except
|
|
FreeAndNil(AImage);
|
|
Result := False;
|
|
end;
|
|
finally
|
|
Picture.Free;
|
|
end;
|
|
end;
|
|
|
|
function TdxFEFDialog.GetPicture: TGraphic;
|
|
begin
|
|
Result := FPicture;
|
|
end;
|
|
|
|
function TdxFEFDialog.GetPaintMode: TdxPicturePaintMode;
|
|
begin
|
|
if cbxPaintMode.ItemIndex > -1 then
|
|
Result := TdxPicturePaintMode(cbxPaintMode.ItemIndex)
|
|
else
|
|
Result := ppmCenter;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetPicture(Value: TGraphic);
|
|
begin
|
|
if FPicture = nil then FPicture := TBitmap.Create;
|
|
FPicture.Assign(Value);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetPaintMode(Value: TdxPicturePaintMode);
|
|
begin
|
|
if PaintMode <> Value then
|
|
cbxPaintMode.ItemIndex := Integer(Value);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.PaintPreview;
|
|
var
|
|
APrevBrush: TBrush;
|
|
ABrushBitmap: TBitmap;
|
|
R: TRect;
|
|
AWidth, AHeight: Integer;
|
|
I, J: Integer;
|
|
begin
|
|
case FPreviewWhat of
|
|
faTexture:
|
|
if FTextureWasSelected then
|
|
begin
|
|
AWidth := Picture.Width;
|
|
AHeight := Picture.Height;
|
|
for i := 0 to pbxPreview.Width div AWidth do
|
|
for j := 0 to pbxPreview.Height div AHeight do
|
|
pbxPreview.Canvas.Draw(i * AWidth, j * AHeight, Picture);
|
|
end;
|
|
|
|
faPattern:
|
|
if FPatternWasSelected then
|
|
begin
|
|
APrevBrush := TBrush.Create;
|
|
try
|
|
APrevBrush.Assign(pbxPreview.Canvas.Brush);
|
|
ABrushBitmap := CopyPattern(dgPattern.Col, dgPattern.Row);
|
|
try
|
|
R := pbxPreview.ClientRect;
|
|
InflateRect(R, 2, 2);
|
|
pbxPreview.Canvas.Brush.Bitmap := ABrushBitmap;
|
|
pbxPreview.Canvas.FillRect(R);
|
|
pbxPreview.Canvas.Brush.Bitmap := nil;
|
|
pbxPreview.Canvas.Brush := APrevBrush;
|
|
finally
|
|
ABrushBitmap.Free;
|
|
end;
|
|
finally
|
|
APrevBrush.Free;
|
|
end;
|
|
end;
|
|
|
|
faPicture:
|
|
if FOtherPicture <> nil then
|
|
begin
|
|
R := pbxPreview.ClientRect;
|
|
InflateRect(R, 2, 2);
|
|
pbxPreview.Canvas.StretchDraw(R, FOtherPicture);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgTextureClick(Sender: TObject);
|
|
var
|
|
DrawGrid: TDrawGrid;
|
|
begin
|
|
DrawGrid := TDrawGrid(Sender);
|
|
if FPicture <> nil then FPicture.Free;
|
|
FPicture := nil;
|
|
|
|
if FOtherTexture <> nil then
|
|
begin
|
|
if (DrawGrid.Row = DrawGrid.RowCount - 1) and (DrawGrid.Col > 0) then
|
|
Exit
|
|
else
|
|
if DrawGrid.Row < DrawGrid.RowCount - 1 then
|
|
FPicture := CopyTexture(DrawGrid.Col, DrawGrid.Row)
|
|
else
|
|
if DrawGrid.Col = 0 then
|
|
SetPicture(OtherTexture);
|
|
end
|
|
else
|
|
FPicture := CopyTexture(DrawGrid.Col, DrawGrid.Row);
|
|
if not FTextureWasSelected then
|
|
begin
|
|
FTextureWasSelected := True;
|
|
DrawGrid.Invalidate;
|
|
end;
|
|
FPreviewWhat := faTexture;
|
|
pbxPreview.Invalidate;
|
|
if (FOtherTexture <> nil) and (DrawGrid.Col = 0) and (DrawGrid.Row = DrawGrid.RowCount - 1) then
|
|
pnlTextureName.Caption := FOtherTextureName
|
|
else
|
|
pnlTextureName.Caption := FTextureNames[DrawGrid.Col * TextureCount.Y + DrawGrid.Row];
|
|
CheckModified;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgPatternClick(Sender: TObject);
|
|
var
|
|
DrawGrid: TDrawGrid;
|
|
begin
|
|
DrawGrid := TDrawGrid(Sender);
|
|
if not FPatternWasSelected then
|
|
begin
|
|
FPatternWasSelected := True;
|
|
DrawGrid.Invalidate;
|
|
end;
|
|
FreeAndNil(FPicture);
|
|
|
|
FPicture := CopyPattern(DrawGrid.Col, DrawGrid.Row);
|
|
FPreviewWhat := faPattern;
|
|
pbxPreview.Refresh;
|
|
pnlPatternName.Caption := FPatternNames[DrawGrid.Col * TextureCount.Y + DrawGrid.Row];
|
|
CheckModified;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.pbxPreviewPaint(Sender: TObject);
|
|
begin
|
|
PaintPreview;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.MapPatternColors;
|
|
begin
|
|
FreeAndNil(FbmpCurrentPattern);
|
|
FbmpCurrentPattern := dxCreateMappedBmp(FbmpPattern, [clWhite, clBlack], [BackColor, ForeColor]);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.cbxColorChange(Sender: TObject);
|
|
begin
|
|
if FControlsUpdating then Exit;
|
|
FPreviewWhat := faPattern;
|
|
MapPatternColors;
|
|
pbxPreview.Invalidate;
|
|
dgPattern.Invalidate;
|
|
if (dgPattern.Col > -1) and (dgPattern.Row > -1) then
|
|
CheckModified;
|
|
end;
|
|
|
|
function TdxFEFDialog.CopyTexture(I, J: Integer): TBitmap;
|
|
begin
|
|
Result := TBitmap.Create;
|
|
with Result do
|
|
try
|
|
Width := TextureSize.X;
|
|
Height := TextureSize.Y;
|
|
Canvas.Draw(-I * TextureSize.X, -J * TextureSize.Y, FbmpTexture);
|
|
except
|
|
Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TdxFEFDialog.CopyPattern(I, J: Integer): TBitmap;
|
|
begin
|
|
Result := TBitmap.Create;
|
|
with Result do
|
|
try
|
|
Width := PatternSize.X;
|
|
Height := PatternSize.Y;
|
|
Canvas.Draw(-I * PatternSize.X, -J * PatternSize.Y, FbmpCurrentPattern);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.PageControl1Change(Sender: TObject);
|
|
begin
|
|
FApplied := False;
|
|
FPreviewWhat := TdxFillAs(TPageControl(Sender).ActivePage.PageIndex + 1);
|
|
FreeAndNil(FPicture);
|
|
|
|
case FPreviewWhat of
|
|
faTexture:
|
|
if FTextureWasSelected then
|
|
if FOtherTexture <> nil then
|
|
begin
|
|
if dgTexture.Row < dgTexture.RowCount - 1 then
|
|
FPicture := CopyTexture(dgTexture.Col, dgTexture.Row)
|
|
else
|
|
if dgTexture.Col = 0 then
|
|
SetPicture(OtherTexture);
|
|
end
|
|
else
|
|
FPicture := CopyTexture(dgTexture.Col, dgTexture.Row);
|
|
faPattern:
|
|
if FPatternWasSelected then
|
|
FPicture := CopyPattern(dgPattern.Col, dgPattern.Row);
|
|
faPicture:
|
|
if FOtherPicture <> nil then SetPicture(FOtherPicture);
|
|
end;
|
|
pbxPreview.Invalidate;
|
|
UpdateControlsState;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.PicturePreviewClick(Sender: TObject);
|
|
begin
|
|
dxShowPicturePreview(Picture);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.cbxPaintModeChange(Sender: TObject);
|
|
begin
|
|
if FControlsUpdating then Exit;
|
|
CheckModified;
|
|
end;
|
|
|
|
function TdxFEFDialog.GetSelectWhat: TdxFillAs;
|
|
begin
|
|
Result := faNone;
|
|
if FTextureWasSelected and (PageControl1.ActivePage.PageIndex = 0) then
|
|
Result := faTexture
|
|
else
|
|
if FPatternWasSelected and (PageControl1.ActivePage.PageIndex = 1) then
|
|
Result := faPattern
|
|
else
|
|
if FPictureExists and (PageControl1.ActivePage.PageIndex = 2) then
|
|
Result := faPicture;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetSelectWhat(Value: TdxFillAs);
|
|
begin
|
|
case Value of
|
|
faNone: ;
|
|
faTexture:
|
|
begin
|
|
FTextureWasSelected := True;
|
|
PageControl1.ActivePage := PageControl1.Pages[0];
|
|
end;
|
|
faPattern:
|
|
begin
|
|
FPatternWasSelected := True;
|
|
PageControl1.ActivePage := PageControl1.Pages[1];
|
|
end;
|
|
faPicture:
|
|
begin
|
|
FPictureExists := True;
|
|
PageControl1.ActivePage := PageControl1.Pages[2];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdxFEFDialog.GetOtherTexture: TBitmap;
|
|
begin
|
|
if FOtherTexture = nil then FOtherTexture := TBitmap.Create;
|
|
Result := FOtherTexture;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetOtherTexture(Value: TBitmap);
|
|
begin
|
|
if Value <> nil then
|
|
GetOtherTexture.Assign(Value)
|
|
else
|
|
if FOtherTexture <> nil then
|
|
begin
|
|
FOtherTexture.Free;
|
|
FOtherTexture := nil;
|
|
end;
|
|
end;
|
|
|
|
function TdxFEFDialog.GetOtherPicture(AGraphicClass: TGraphicClass): TGraphic;
|
|
begin
|
|
FreeAndNil(FOtherPicture);
|
|
|
|
if AGraphicClass <> nil then
|
|
FOtherPicture := dxPSUtl.CreateGraphic(AGraphicClass);
|
|
Result := FOtherPicture;
|
|
end;
|
|
|
|
function TdxFEFDialog.GetForeColor: TColor;
|
|
begin
|
|
Result := TColor(cbxForeColor.Items.Objects[cbxForeColor.ItemIndex]);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetForeColor(Value: TColor);
|
|
begin
|
|
TdxPSColorCombo(cbxForeColor).ColorValue := Value;
|
|
cbxColorChange(cbxForeColor); {???}
|
|
end;
|
|
|
|
function TdxFEFDialog.GetBackColor: TColor;
|
|
begin
|
|
Result := TColor(cbxBackColor.Items.Objects[cbxBackColor.ItemIndex]);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.SetBackColor(Value: TColor);
|
|
begin
|
|
TdxPSColorCombo(cbxBackColor).ColorValue := Value;
|
|
cbxColorChange(cbxBackColor); {???}
|
|
end;
|
|
|
|
procedure TdxFEFDialog.lblPaintModeClick(Sender: TObject);
|
|
begin
|
|
ActiveControl := TLabel(Sender).FocusControl;
|
|
TComboBox(ActiveControl).DroppedDown := True;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.lblForegroundClick(Sender: TObject);
|
|
begin
|
|
ActiveControl := TLabel(Sender).FocusControl;
|
|
TdxPSColorCombo(ActiveControl).DroppedDown := True;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.DoApply;
|
|
var
|
|
B: TBitmap;
|
|
begin
|
|
if Assigned(FOnApply) then
|
|
begin
|
|
Background.BeginUpdate;
|
|
try
|
|
Background.BkColor := BackColor;
|
|
Background.Brush.Color := ForeColor;
|
|
Background.Picture := Picture;
|
|
case SelectWhat of
|
|
faTexture:
|
|
begin
|
|
Background.Picture := Picture;
|
|
Background.Mode := bmBrushBitmap;
|
|
end;
|
|
|
|
faPattern:
|
|
begin
|
|
B := TBitmap(Background.Picture);
|
|
B.Width := PatternSize.X;
|
|
B.Height := PatternSize.Y;
|
|
B.Canvas.Draw(-dgPattern.Col * PatternSize.X, -dgPattern.Row * PatternSize.Y, FbmpCurrentPattern);
|
|
Background.Mode := bmBrushBitmap;
|
|
end;
|
|
|
|
faPicture:
|
|
begin
|
|
Background.Mode := bmPicture;
|
|
Background.PictureMode := PaintMode;
|
|
end;
|
|
end;
|
|
if FOriginalBackground <> nil then FOriginalBackground.Assign(Background);
|
|
FOnApply(Background);
|
|
finally
|
|
Background.EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.btnApplyClick(Sender: TObject);
|
|
begin
|
|
DoApply;
|
|
FApplied := True;
|
|
if FFirstApplied then
|
|
begin
|
|
btnCancel.Caption := cxGetResourceString(@sdxBtnClose);
|
|
FFirstApplied := False;
|
|
end;
|
|
UpdateControlsState;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgTextureDblClick(Sender: TObject);
|
|
begin
|
|
if FPicture <> nil then btnOK.Click;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgPatternDblClick(Sender: TObject);
|
|
begin
|
|
if FPicture <> nil then btnOK.Click;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgTextureMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
const
|
|
ATextureLastCol: Longint = -2;
|
|
ATextureLastRow: Longint = -2;
|
|
var
|
|
Col, Row: Longint;
|
|
S: string;
|
|
begin
|
|
TDrawGrid(Sender).MouseToCell(X, Y, Col, Row);
|
|
|
|
if (Col <> ATextureLastCol) or (Row <> ATextureLastRow) then
|
|
begin
|
|
Application.CancelHint;
|
|
S := '';
|
|
if (Col > -1) and (Row > -1) then
|
|
if FOtherTexture = nil then
|
|
S := FTextureNames[Col * TextureCount.Y + Row]
|
|
else
|
|
if (FOtherTexture <> nil) and (Col = 0) and (Row = TDrawGrid(Sender).RowCount - 1) then
|
|
S := FOtherTextureName
|
|
else
|
|
if Row < TDrawGrid(Sender).RowCount - 1 then
|
|
S := FTextureNames[Col * TextureCount.Y + Row];
|
|
|
|
TDrawGrid(Sender).Hint := S;
|
|
end;
|
|
|
|
ATextureLastCol := Col;
|
|
ATextureLastRow := Row;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.dgPatternMouseMove(Sender: TObject;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
const
|
|
APatternLastCol: Longint = -2;
|
|
APatternLastRow: Longint = -2;
|
|
var
|
|
Col, Row: Longint;
|
|
begin
|
|
TDrawGrid(Sender).MouseToCell(X, Y, Col, Row);
|
|
if (Col <> APatternLastCol) or (Row <> APatternLastRow) then
|
|
begin
|
|
Application.CancelHint;
|
|
if (Col > -1) and (Row > -1) then
|
|
TDrawGrid(Sender).Hint := FPatternNames[Col * PatternCount.Y + Row];
|
|
end;
|
|
|
|
APatternLastCol := Col;
|
|
APatternLastRow := Row;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.btnInvertClick(Sender: TObject);
|
|
begin
|
|
DoInvertColors;
|
|
with dgPattern do
|
|
if (Col > -1) and (Row > -1) then CheckModified;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.DoInvertColors;
|
|
var
|
|
ASaveColor: TColor;
|
|
begin
|
|
dgPattern.Perform(WM_SETREDRAW, WPARAM(False), 0);
|
|
btnInvert.Perform(WM_SETREDRAW, WPARAM(False), 0);
|
|
ASaveColor := ForeColor;
|
|
ForeColor := BackColor;
|
|
BackColor := ASaveColor;
|
|
dgPattern.Perform(WM_SETREDRAW, WPARAM(True), 0);
|
|
dgPattern.Invalidate;
|
|
btnInvert.Perform(WM_SETREDRAW, WPARAM(True), 0);
|
|
btnInvert.Invalidate;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.pmPicturePopup(Sender: TObject);
|
|
begin
|
|
miPreview.Enabled := btnPreview.Enabled;
|
|
miCut.Enabled := FOtherPicture <> nil;
|
|
miCopy.Enabled := FOtherPicture <> nil;
|
|
miPaste.Enabled := ClipBoard.HasFormat(CF_PICTURE);
|
|
miDelete.Enabled := FOtherPicture <> nil;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.miCopyClick(Sender: TObject);
|
|
begin
|
|
ClipBoard.Assign(FOtherPicture);
|
|
end;
|
|
|
|
procedure TdxFEFDialog.miPasteClick(Sender: TObject);
|
|
var
|
|
P: TPicture;
|
|
begin
|
|
P := TPicture.Create;
|
|
try
|
|
P.Assign(Clipboard);
|
|
if (P.Graphic <> nil) and not P.Graphic.Empty then
|
|
AssignPicture(P.Graphic);
|
|
finally
|
|
P.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.miDeleteClick(Sender: TObject);
|
|
begin
|
|
GetOtherPicture(nil);
|
|
pbxPicture.Invalidate;
|
|
pbxPreview.Invalidate;
|
|
end;
|
|
|
|
procedure TdxFEFDialog.miCutClick(Sender: TObject);
|
|
begin
|
|
miCopy.Click;
|
|
miDelete.Click;
|
|
end;
|
|
|
|
end.
|