You've already forked lazarus-ccr
98b7bb2e30
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8692 8e941d3f-bd1b-0410-a28a-d453659cc2b4
828 lines
23 KiB
ObjectPascal
828 lines
23 KiB
ObjectPascal
{*********************************************************}
|
|
{* VPEDFMTLST.PAS 1.03 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* 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. *}
|
|
{* *}
|
|
{* The Original Code is TurboPower Visual PlanIt *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
unit VpEdFmtLst;
|
|
|
|
{$IF FPC_FullVersion >= 30200}
|
|
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
|
|
{$IFEND}
|
|
|
|
{$I vp.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF LCL}
|
|
LCLProc, LCLType, LCLIntf,
|
|
{$ELSE}
|
|
Windows, Messages,
|
|
{$ENDIF}
|
|
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, ExtCtrls, Buttons,
|
|
VpPrtFmt, VpBase, VpBaseDS, VpPrtPrv, VpException, VpSR;
|
|
|
|
const
|
|
UnnamedFile = '<Unnamed>';
|
|
|
|
type
|
|
|
|
{ TfrmPrnFormat }
|
|
|
|
TfrmPrnFormat = class(TForm)
|
|
Bevel1: TBevel;
|
|
btnDeleteElement: TButton;
|
|
btnDeleteFormat: TButton;
|
|
btnEditElement: TButton;
|
|
btnEditFormat: TButton;
|
|
btnLoadFile: TButton;
|
|
btnMoveElementDn: TSpeedButton;
|
|
btnMoveElementUp: TSpeedButton;
|
|
btnNewElement: TButton;
|
|
btnNewFile: TButton;
|
|
btnNewFormat: TButton;
|
|
btnSaveFile: TButton;
|
|
LblPrintPreview: TLabel;
|
|
LblFormats: TLabel;
|
|
LblElements: TLabel;
|
|
lbElements: TListBox;
|
|
lbFormats: TListBox;
|
|
OpenDialog: TOpenDialog;
|
|
ButtonPanel: TPanel;
|
|
PrintPreview: TVpPrintPreview;
|
|
SaveDialog: TSaveDialog;
|
|
btnOk: TButton;
|
|
LblPrintOrder: TLabel;
|
|
procedure btnDeleteElementClick(Sender: TObject);
|
|
procedure btnDeleteFormatClick(Sender: TObject);
|
|
procedure btnEditElementClick(Sender: TObject);
|
|
procedure btnEditFormatClick(Sender: TObject);
|
|
procedure btnLoadFileClick(Sender: TObject);
|
|
procedure btnMoveElementDnClick(Sender: TObject);
|
|
procedure btnMoveElementUpClick(Sender: TObject);
|
|
procedure btnNewElementClick(Sender: TObject);
|
|
procedure btnNewFileClick(Sender: TObject);
|
|
procedure btnNewFormatClick(Sender: TObject);
|
|
procedure btnSaveFileClick(Sender: TObject);
|
|
procedure btnOkClick(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure lbElementsClick(Sender: TObject);
|
|
procedure lbFormatsClick(Sender: TObject);
|
|
procedure lbElementsMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure lbElementsDragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
procedure lbElementsDragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
|
|
private
|
|
FFormatFileName: string;
|
|
FControlLink: TVpControlLink;
|
|
IsDirty: Boolean;
|
|
LastX, LastY: Integer;
|
|
DragItem: Integer;
|
|
FDrawingStyle: TVpDrawingStyle;
|
|
FShowSavePrompt: Boolean;
|
|
procedure PositionControls;
|
|
procedure SetCaptions;
|
|
procedure SetDrawingStyle(const v: TVpDrawingStyle);
|
|
|
|
protected
|
|
function DirtyPrompt: Integer;
|
|
procedure DoEditElement;
|
|
procedure DoEditFormat;
|
|
procedure DoNewElement;
|
|
procedure DoNewFile;
|
|
function DoNewFormat: Integer;
|
|
procedure DoSave;
|
|
procedure EnableElementButtons(Enable: Boolean);
|
|
procedure EnableFormatButtons(Enable: Boolean);
|
|
procedure EnableMoveButtons;
|
|
procedure RebuildPreview;
|
|
procedure SetFormatFileName(const v: string);
|
|
procedure UpdateFormats;
|
|
procedure UpdateCaption;
|
|
procedure UpdatePreview;
|
|
|
|
function GetControlLink: TVpControlLink;
|
|
procedure SetControlLink(const Value: TVpControlLink);
|
|
|
|
public
|
|
function Execute: Boolean;
|
|
property ControlLink: TVpControlLink read FControlLink write SetControlLink;
|
|
property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle;
|
|
property ShowSavePrompt: Boolean read FShowSavePrompt write FShowSavePrompt;
|
|
|
|
published
|
|
property FormatFileName : string read FFormatFileName write SetFormatFileName;
|
|
end;
|
|
|
|
var
|
|
frmPrnFormat: TfrmPrnFormat;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, TypInfo,
|
|
VpMisc, VpEdFmt, VpEdElem;
|
|
|
|
{$IFDEF DELPHI}
|
|
{$R *.dfm}
|
|
{$ELSE}
|
|
{$R *.lfm}
|
|
{$ENDIF}
|
|
|
|
{TfrmPrnFormat}
|
|
|
|
procedure TfrmPrnFormat.FormCreate(Sender: TObject);
|
|
begin
|
|
LoadGlyphFromRCDATA(btnMoveElementUp.Glyph, 'VpUpArrow', -1, 150, 200);
|
|
LoadGlyphFromRCDATA(btnMoveElementDn.Glyph, 'VpDownArrow', -1, 150, 200);
|
|
|
|
OpenDialog.InitialDir := ExtractFilePath(Application.ExeName);
|
|
SaveDialog.InitialDir := ExtractFilePath(Application.ExeName);
|
|
IsDirty := False;
|
|
FShowSavePrompt := true;
|
|
FormatFileName := UnnamedFile;
|
|
|
|
EnableFormatButtons(False);
|
|
EnableElementButtons(False);
|
|
|
|
SetCaptions;
|
|
FixLabels(Self);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.EnableMoveButtons;
|
|
begin
|
|
btnMoveElementUp.Enabled := lbElements.ItemIndex > 0;
|
|
btnMoveElementDn.Enabled := (lbElements.ItemIndex > -1) and (lbElements.ItemIndex < lbElements.Items.Count - 1);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.FormShow(Sender: TObject);
|
|
begin
|
|
PositionControls;
|
|
|
|
PrintPreview.Parent := Self; //PrintPreviewPanel;
|
|
|
|
if ControlLink.Printer.PrintFormats.Count > 0 then begin
|
|
UpdateFormats;
|
|
end
|
|
else begin
|
|
DoNewFile;
|
|
UpdateCaption;
|
|
end;
|
|
btnNewFormat.Enabled := True;
|
|
lbFormats.SetFocus;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnDeleteElementClick(Sender: TObject);
|
|
var
|
|
Format: TVpPrintFormatItem;
|
|
i, idx, n: Integer;
|
|
Item: string;
|
|
begin
|
|
Format := TVpPrintFormatItem(lbFormats.Items.Objects[lbFormats.ItemIndex]);
|
|
Item := '';
|
|
if lbElements.ItemIndex > -1 then
|
|
Item := lbElements.Items[lbElements.ItemIndex];
|
|
|
|
if Item <> '' then begin
|
|
n := Format.Elements.Count;
|
|
idx := lbElements.ItemIndex;
|
|
for i := n-1 downto 0 do begin
|
|
if Format.Elements.Items[i].ElementName = Item then begin
|
|
Format.Elements.Items[i].Free;
|
|
lbElements.Items.Delete(lbElements.ItemIndex);
|
|
if idx = lbElements.Items.Count then
|
|
idx := lbElements.Items.Count-1;
|
|
lbElements.ItemIndex := idx;
|
|
UpdatePreview;
|
|
IsDirty := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
EnableElementButtons(true);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnDeleteFormatClick(Sender: TObject);
|
|
var
|
|
Prn: TVpPrinter;
|
|
Idx, fmtIdx: Integer;
|
|
begin
|
|
Prn := ControlLink.Printer;
|
|
Idx := lbFormats.ItemIndex;
|
|
fmtIdx := Prn.Find(lbFormats.Items[idx]);
|
|
if (fmtIdx < 0) or (fmtIdx >= Prn.PrintFormats.Count) then
|
|
begin
|
|
ShowMessage ('Invalid print format: ' + lbFormats.Items[lbFormats.ItemIndex]);
|
|
exit;
|
|
end;
|
|
Prn.PrintFormats.Items[FmtIdx].Free;
|
|
lbElements.Items.Clear;
|
|
lbFormats.Items.Delete(idx);
|
|
IsDirty := True;
|
|
if idx = lbFormats.Items.Count then
|
|
idx := lbFormats.Items.Count-1;
|
|
if idx >= 0 then
|
|
begin
|
|
lbFormats.ItemIndex := idx;
|
|
fmtIdx := Prn.Find(lbFormats.Items[idx]);
|
|
Prn.CurFormat := fmtIdx;
|
|
UpdatePreview;
|
|
end else
|
|
PrintPreview.ForceUpdate;
|
|
EnableFormatButtons(true);
|
|
EnableElementButtons(true);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnEditElementClick(Sender: TObject);
|
|
begin
|
|
DoEditElement;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnEditFormatClick(Sender: TObject);
|
|
begin
|
|
DoEditFormat;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnLoadFileClick(Sender: TObject);
|
|
var
|
|
Prn: TVpPrinter;
|
|
Rslt: Integer;
|
|
begin
|
|
if IsDirty then begin
|
|
Rslt := DirtyPrompt;
|
|
case Rslt of
|
|
mrYes : DoSave;
|
|
mrNo : ; // nothing
|
|
mrCancel : Exit;
|
|
end;
|
|
end;
|
|
|
|
if OpenDialog.Execute then begin
|
|
FormatFileName := OpenDialog.FileName;
|
|
lbFormats.Items.Clear;
|
|
Prn := ControlLink.Printer;
|
|
Prn.LoadFromFile(FormatFileName, False);
|
|
UpdateFormats;
|
|
UpdateCaption;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnMoveElementDnClick(Sender: TObject);
|
|
var
|
|
E: TVpPrintFormatElementItem;
|
|
begin
|
|
if lbElements.ItemIndex > -1 then begin
|
|
E := TVpPrintFormatElementItem(lbElements.Items.Objects[lbElements.ItemIndex]);
|
|
E.Index := E.Index + 1;
|
|
lbElements.Items.Move(lbElements.ItemIndex, lbElements.ItemIndex + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnMoveElementUpClick(Sender: TObject);
|
|
var
|
|
E : TVpPrintFormatElementItem;
|
|
begin
|
|
if lbElements.ItemIndex > -1 then begin
|
|
E := TVpPrintFormatElementItem(lbElements.Items.Objects[lbElements.ItemIndex]);
|
|
E.Index := E.Index - 1;
|
|
lbElements.Items.Move(lbElements.ItemIndex, lbElements.ItemIndex - 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnNewElementClick(Sender: TObject);
|
|
begin
|
|
DoNewElement;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnNewFormatClick(Sender: TObject);
|
|
var
|
|
NewFormatIdx: Integer;
|
|
i: Integer;
|
|
begin
|
|
NewFormatIdx := DoNewFormat;
|
|
if Assigned(ControlLink) and
|
|
(NewFormatIdx > 0) and (NewFormatIdx < ControlLink.Printer.PrintFormats.Count)
|
|
then
|
|
for i := 0 to lbFormats.Items.Count - 1 do
|
|
if lbFormats.Items[i] = ControlLink.Printer.PrintFormats.Items[NewFormatIdx].FormatName then
|
|
begin
|
|
lbFormats.ItemIndex := i;
|
|
lbFormatsClick(Self);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnNewFileClick(Sender: TObject);
|
|
var
|
|
Rslt: Integer;
|
|
begin
|
|
if IsDirty then begin
|
|
Rslt := DirtyPrompt;
|
|
case Rslt of
|
|
ID_YES:
|
|
begin
|
|
DoSave;
|
|
DoNewFile;
|
|
end;
|
|
ID_NO:
|
|
DoNewFile;
|
|
ID_CANCEL:
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
DoNewFile;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnOkClick(Sender: TObject);
|
|
begin
|
|
ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.btnSaveFileClick(Sender: TObject);
|
|
begin
|
|
DoSave;
|
|
end;
|
|
|
|
function TfrmPrnFormat.DirtyPrompt: Integer;
|
|
var
|
|
msg: String;
|
|
taskDlg: TTaskDialog;
|
|
begin
|
|
if FormatFileName = '' then
|
|
msg := RSSaveFormatChangesToFile
|
|
else
|
|
msg := Format(RSSaveFormatChangesToFilename, [FormatFileName]);
|
|
|
|
taskDlg := TTaskDialog.Create(self);
|
|
taskDlg.Text := msg;
|
|
taskDlg.Caption := RSConfirmation;
|
|
taskDlg.MainIcon := tdiQuestion;
|
|
taskDlg.Title := RSSavePrintFormat;
|
|
taskDlg.CommonButtons := [tcbYes, tcbNo, tcbCancel];
|
|
taskDlg.VerificationText := RSDoNotAskAgain;
|
|
taskDlg.Execute;
|
|
FShowSavePrompt := not (tfVerificationFlagChecked in taskDlg.Flags);
|
|
Result := taskDlg.ModalResult;
|
|
taskDlg.Free;
|
|
|
|
//Result := MessageDlg(msg, mtConfirmation, [mbYes, mbNo, mbCancel], 0);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.DoEditElement;
|
|
var
|
|
E: TVpPrintFormatElementItem;
|
|
frmEditElement: TfrmEditElement;
|
|
begin
|
|
if lbElements.ItemIndex > -1 then begin
|
|
frmEditElement := TfrmEditElement.Create(nil);
|
|
try
|
|
E := TVpPrintFormatElementItem(lbElements.Items.Objects[lbElements.ItemIndex]);
|
|
if frmEditElement.Execute(E) then
|
|
IsDirty := True;
|
|
UpdatePreview;
|
|
finally
|
|
frmEditElement.Free;
|
|
end;
|
|
end
|
|
else begin
|
|
DoNewElement;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.DoEditFormat;
|
|
var
|
|
AFormat: TVpPrintFormatItem;
|
|
frmEditFormat: TfrmEditFormat;
|
|
oldFormatName: String;
|
|
begin
|
|
if lbFormats.ItemIndex > -1 then begin
|
|
Application.CreateForm(TfrmEditFormat, frmEditFormat);
|
|
AFormat := TVpPrintFormatItem(lbFormats.Items.Objects[lbFormats.ItemIndex]);
|
|
oldFormatName := AFormat.FormatName;
|
|
if frmEditFormat.Execute(AFormat) then begin
|
|
IsDirty := True;
|
|
if AFormat.FormatName <> oldFormatName then
|
|
begin
|
|
lbFormats.Items.Delete(lbFormats.ItemIndex);
|
|
lbFormats.Items.AddObject(AFormat.FormatName, AFormat);
|
|
lbFormats.ItemIndex := lbFormats.Items.IndexOf(Aformat.FormatName);
|
|
end;
|
|
end;
|
|
frmEditFormat.Free;
|
|
|
|
UpdatePreview;
|
|
end
|
|
else begin
|
|
DoNewFormat;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.DoNewElement;
|
|
var
|
|
Format: TVpPrintFormatItem;
|
|
E: TVpPrintFormatElementItem;
|
|
Unique, Cancelled: Boolean;
|
|
frmEditElement: TfrmEditElement;
|
|
begin
|
|
Format := TVpPrintFormatItem(lbFormats.Items.Objects[lbFormats.ItemIndex]);
|
|
|
|
Unique := False;
|
|
|
|
frmEditElement := TfrmEditElement.Create(nil);
|
|
try
|
|
repeat
|
|
E := TVpPrintFormatElementItem.Create(Format.Elements);
|
|
|
|
// Edit element
|
|
Cancelled := not frmEditElement.Execute(E);
|
|
|
|
if not Cancelled then begin
|
|
if lbElements.Items.IndexOf(E.ElementName) > -1 then
|
|
begin
|
|
MessageDlg(SysUtils.Format(RSElementAlreadyExists, [E.ElementName]), mtError, [mbOK], 0);
|
|
// Dump empty element
|
|
Format.Elements.Items[E.Index].Free;
|
|
Unique := False;
|
|
end
|
|
else begin
|
|
lbElements.Items.AddObject(E.ElementName, E);
|
|
lbElements.ItemIndex := E.Index;
|
|
IsDirty := True;
|
|
Unique := True;
|
|
UpdatePreview;
|
|
end;
|
|
end else
|
|
// Dump empty element
|
|
Format.Elements.Items[E.Index].Free;
|
|
// ...until element name is unique or operation is cancelled
|
|
until Unique or Cancelled;
|
|
|
|
EnableElementButtons(true);
|
|
finally
|
|
frmEditElement.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.DoNewFile;
|
|
var
|
|
Prn: TVpPrinter;
|
|
begin
|
|
Prn := ControlLink.Printer;
|
|
Prn.PrintFormats.Clear;
|
|
lbFormats.Clear;
|
|
lbElements.Clear;
|
|
FormatFileName := UnnamedFile;
|
|
IsDirty := False;
|
|
PrintPreview.ControlLink := nil;
|
|
EnableFormatButtons(False);
|
|
btnNewFormat.Enabled := True;
|
|
EnableElementButtons(False);
|
|
end;
|
|
|
|
function TfrmPrnFormat.DoNewFormat: Integer;
|
|
var
|
|
AFormat: TVpPrintFormatItem;
|
|
Prn: TVpPrinter;
|
|
Unique, Cancelled: Boolean;
|
|
frmEditFormat: TfrmEditFormat;
|
|
begin
|
|
Result := -1;
|
|
frmEditFormat := TfrmEditFormat.Create(nil);
|
|
try
|
|
Prn := ControlLink.Printer;
|
|
Unique := False;
|
|
repeat
|
|
AFormat := TVpPrintFormatItem.Create(Prn.PrintFormats);
|
|
// Edit format
|
|
Cancelled := not frmEditFormat.Execute(AFormat);
|
|
|
|
if not Cancelled then begin
|
|
if lbFormats.Items.IndexOf(AFormat.FormatName) > -1 then begin
|
|
MessageDlg(Format(RSPrintFormatAlreadyExists, [AFormat.FormatName]), mtError, [mbOK], 0);
|
|
// Dump empty format
|
|
Prn.PrintFormats.Items[AFormat.Index].Free;
|
|
Unique := False;
|
|
end
|
|
else begin
|
|
lbFormats.Items.AddObject(AFormat.FormatName, AFormat);
|
|
lbFormats.ItemIndex := AFormat.Index;
|
|
UpdatePreview;
|
|
IsDirty := True;
|
|
Unique := True;
|
|
end;
|
|
end else
|
|
// Dump empty format
|
|
Prn.PrintFormats.Items[AFormat.Index].Free;
|
|
// ... until format name is Unique or operation cancelled
|
|
until Unique or Cancelled;
|
|
|
|
if not Cancelled then
|
|
Result := AFormat.Index;
|
|
|
|
EnableFormatButtons(true);
|
|
EnableElementButtons(true);
|
|
finally
|
|
frmEditFormat.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.DoSave;
|
|
begin
|
|
if FormatFileName <> UnnamedFile then
|
|
SaveDialog.FileName := FormatFileName
|
|
else
|
|
SaveDialog.FileName := 'Unnamed.xml';
|
|
if SaveDialog.Execute then
|
|
begin
|
|
FormatFileName := SaveDialog.FileName;
|
|
ControlLink.Printer.SaveToFile(FormatFileName);
|
|
IsDirty := False;
|
|
UpdateCaption;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.EnableElementButtons(Enable: Boolean);
|
|
begin
|
|
btnNewElement.Enabled := Enable and (lbFormats.ItemIndex > -1);
|
|
btnEditElement.Enabled := btnNewElement.Enabled and (lbElements.ItemIndex > -1);
|
|
btnDeleteElement.Enabled := btnEditElement.Enabled;
|
|
EnableMoveButtons;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.EnableFormatButtons(Enable: Boolean);
|
|
begin
|
|
btnNewFormat.Enabled := Enable;
|
|
btnEditFormat.Enabled := Enable and (lbFormats.ItemIndex > -1);
|
|
btnDeleteFormat.Enabled := Enable and (lbFormats.ItemIndex > -1);
|
|
end;
|
|
|
|
function TfrmPrnFormat.Execute: Boolean;
|
|
begin
|
|
if not Assigned (ControlLink) then
|
|
raise EVpPrintFormatEditorError.Create(RSNoControlLink);
|
|
|
|
Result := ShowModal = mrOk;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.FormCloseQuery(Sender: TObject;
|
|
var CanClose: Boolean);
|
|
begin
|
|
CanClose := True;
|
|
if IsDirty and FShowSavePrompt then begin
|
|
case DirtyPrompt of
|
|
mrYes: DoSave;
|
|
mrNo: ;
|
|
mrCancel: CanClose := false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrmPrnFormat.GetControlLink: TVpControlLink;
|
|
begin
|
|
Result := FControlLink;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.lbFormatsClick(Sender: TObject);
|
|
var
|
|
E: TVpPrintFormatElementItem;
|
|
Prn: TVpPrinter;
|
|
i, Idx: Integer;
|
|
begin
|
|
if LbFormats.ItemIndex = -1 then
|
|
exit;
|
|
|
|
lbElements.Items.Clear;
|
|
Prn := ControlLink.Printer;
|
|
Idx := Prn.Find(lbFormats.Items[lbFormats.ItemIndex]);
|
|
|
|
Prn.CurFormat := Idx;
|
|
|
|
if PrintPreview.ControlLink <> ControlLink then
|
|
PrintPreview.ControlLink := ControlLink
|
|
else
|
|
RebuildPreview;
|
|
|
|
for i := 0 to Pred(Prn.PrintFormats.Items[Idx].Elements.Count) do begin
|
|
E := Prn.PrintFormats.Items[Idx].Elements.Items[i];
|
|
lbElements.Items.AddObject(E.ElementName, E);
|
|
end;
|
|
|
|
//UpdatePreview;
|
|
|
|
EnableElementButtons(False);
|
|
btnNewElement.Enabled := True;
|
|
EnableFormatButtons(True);
|
|
EnableMoveButtons;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.lbElementsClick(Sender: TObject);
|
|
begin
|
|
EnableElementButtons(True);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.lbElementsMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
Unused(Button, Shift);
|
|
LastX := X;
|
|
LastY := Y;
|
|
DragItem := (Sender as TListBox).ItemAtPos(Point(LastX, LastY), True);
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.lbElementsDragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
var
|
|
lb: TListBox;
|
|
Dest: Integer;
|
|
E: TVpPrintFormatElementItem;
|
|
begin
|
|
lb := Source as TListBox;
|
|
Dest := lb.ItemAtPos(Point(X, Y), True);
|
|
lb.Items.Move(DragItem, Dest);
|
|
E := TVpPrintFormatElementItem(lbElements.Items.Objects[Dest]);
|
|
E.Index := Dest;
|
|
lb.ItemIndex := Dest;
|
|
EnableMoveButtons;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.lbElementsDragOver(Sender, Source: TObject; X,Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
var
|
|
lb: TListBox;
|
|
begin
|
|
Unused(State);
|
|
lb := (Source as TListBox);
|
|
lb.Canvas.DrawFocusRect(lb.ItemRect(lb.ItemAtPos(Point(LastX, LastY), True)));
|
|
lb.Canvas.DrawFocusRect(lb.ItemRect(lb.ItemAtPos(Point(X, Y), True)));
|
|
LastX := X;
|
|
LastY := Y;
|
|
Accept := True;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.RebuildPreview;
|
|
begin
|
|
PrintPreview.ForceUpdate;
|
|
PrintPreview.FirstPage;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.SetControlLink(const Value: TVpControlLink);
|
|
begin
|
|
if FControlLink <> Value then begin
|
|
FControlLink := Value;
|
|
if Assigned (FControlLink) then
|
|
FFormatFileName := FControlLink.Printer.DefaultXMLFileName;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.SetCaptions;
|
|
begin
|
|
Caption := RSPrintFormatDesigner;
|
|
LblFormats.Caption := RSFormats;
|
|
LblElements.Caption := RSElements;
|
|
lblPrintOrder.Caption := RSPrintOrder;
|
|
LblPrintPreview.Caption := RSDlgPrintPreview;
|
|
btnOK.Caption := RSOKBtn;
|
|
btnNewFormat.Caption := RSNewBtn;
|
|
btnEditFormat.Caption := RSEditBtn;
|
|
btnDeleteFormat.Caption := RSDeleteBtn;
|
|
btnNewElement.Caption := RSNewBtn;
|
|
btnEditElement.Caption := RSEditBtn;
|
|
btnDeleteElement.Caption := RSDeleteBtn;
|
|
btnNewFile.Caption := RSNewFileBtn;
|
|
btnLoadFile.Caption := RSLoadFileBtn;
|
|
btnSaveFile.Caption := RSSaveFileBtn;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.PositionControls;
|
|
var
|
|
w: Integer;
|
|
begin
|
|
btnNewFormat.AutoSize := true;
|
|
btnEditFormat.AutoSize := true;
|
|
btnDeleteFormat.AutoSize := true;
|
|
btnNewElement.AutoSize := true;
|
|
btnEditElement.AutoSize := true;
|
|
btnDeleteElement.AutoSize := true;
|
|
|
|
w := MaxValue([
|
|
btnNewFormat.Width, btnEditFormat.Width, btnDeleteFormat.Width,
|
|
btnNewElement.Width, btnEditElement.Width, btnDeleteElement.Width,
|
|
LblPrintOrder.Width
|
|
]);
|
|
|
|
btnNewFormat.Constraints.MinWidth := w;
|
|
btnEditFormat.Constraints.MinWidth := w;
|
|
btnDeleteFormat.Constraints.MinWidth := w;
|
|
btnNewElement.Constraints.MinWidth := w;
|
|
btnEditElement.Constraints.MinWidth := w;
|
|
btnDeleteElement.Constraints.MinWidth := w;
|
|
|
|
if LblPrintOrder.Top < BottomOf(btnDeleteElement) + 16 then
|
|
Height := Height + BottomOf(btnDeleteElement) + 16 - LblPrintOrder.Top;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.SetDrawingStyle(const v: TVpDrawingStyle);
|
|
begin
|
|
FDrawingStyle := v;
|
|
if FDrawingStyle = dsNoBorder then
|
|
PrintPreview.BorderStyle := bsNone
|
|
else
|
|
PrintPreview.BorderStyle := bsSingle;
|
|
PrintPreview.DrawingStyle := FDrawingStyle;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.SetFormatFileName(const v: string);
|
|
begin
|
|
if v <> FFormatFileName then begin
|
|
FFormatFileName := v;
|
|
if Assigned(FControlLink) then
|
|
FControlLink.Printer.DefaultXMLFileName := v;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.UpdateCaption;
|
|
begin
|
|
Caption := RSPrintFormatDesigner + ' - ' + FormatFileName;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.UpdateFormats;
|
|
var
|
|
i: Integer;
|
|
Prn: TVpPrinter;
|
|
w: Integer;
|
|
cnv: TControlCanvas;
|
|
begin
|
|
Prn := ControlLink.Printer;
|
|
for i := 0 to Pred(Prn.PrintFormats.Count) do
|
|
lbFormats.Items.AddObject(Prn.PrintFormats.Items[i].FormatName, Prn.PrintFormats.Items[i]);
|
|
|
|
// Show a horizontal scrollbar if list items are too wide
|
|
w := 0;
|
|
cnv := TControlCanvas.Create;
|
|
try
|
|
cnv.Control := lbFormats;
|
|
cnv.Font := lbFormats.Font;
|
|
w := 0;
|
|
for i:=0 to lbFormats.Items.Count-1 do
|
|
w := Max(w, cnv.TextWidth(lbFormats.Items[i]));
|
|
lbFormats.ScrollWidth := w + 8;
|
|
|
|
w := 0;
|
|
for i:=0 to lbElements.Items.Count-1 do
|
|
w := Max(w, cnv.TextWidth(lbElements.Items[i]));
|
|
lbElements.ScrollWidth := w + 8;
|
|
finally
|
|
cnv.Free;
|
|
end;
|
|
|
|
EnableMoveButtons;
|
|
end;
|
|
|
|
procedure TfrmPrnFormat.UpdatePreview;
|
|
var
|
|
Prn: TVpPrinter;
|
|
Idx: Integer;
|
|
begin
|
|
Prn := ControlLink.Printer;
|
|
if lbFormats.ItemIndex > -1 then begin
|
|
Idx := Prn.Find(lbFormats.Items[lbFormats.ItemIndex]);
|
|
if Idx > - 1 then
|
|
Prn.CurFormat := Idx;
|
|
end;
|
|
Prn.NotifyLinked;
|
|
EnableMoveButtons;
|
|
RebuildPreview;
|
|
end;
|
|
|
|
end.
|
|
|