frmdocunit.pas

delphi 运行期间窗体设计

unit frmDocUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DB, DBTables, ExtCtrls, QuickRpt, QRCtrls, Menus,
  StdCtrls, LmdDsgDesigner, LMDDsgClass;

type
  TNotifyQuickRep = class(TQuickRep)
  private
    FOnNotification: TLMDDesignerOnNotificationEvent;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    property OnNotification: TLMDDesignerOnNotificationEvent read FOnNotification write FOnNotification;
  end;

  TfrmDoc = class(TForm)
    LMDDesignPanel1: TLMDDesignPanel;
    LMDDesigner1: TLMDDesigner;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure LMDDesigner1KeyPress(Sender: TObject; var Key: Char);
    procedure FormActivate(Sender: TObject);
    procedure LMDDesigner1ChangeSelection(Sender: TObject);
    procedure LMDDesigner1Change(Sender: TObject);
    procedure LMDDesigner1DblClick(Sender: TObject);
    procedure LMDDesigner1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LMDDesigner1ComponentInserted(Sender: TObject);
    procedure LMDDesigner1ComponentInserting(Sender: TObject;
      var AComponentClass: TComponentClass);
    procedure LMDDesigner1ComponentHint(Sender: TObject;
      AComponent: TComponent; var AHint: String);
  private
    { Private declarations }
    FDataSet: TBDEDataSet;
    FReport: TNotifyQuickRep;
    FFileName: string;
    FModified: Boolean;
    procedure SetDataSet(const Value: TBDEDataSet);
    procedure AdjustChangeSelection;
    procedure ReportNotification(Sender: TObject; AnObject: TPersistent;
      Operation: TOperation);
    procedure LoadFromFile(AFileName: string);
    procedure SaveToFile(AFileName: string);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    constructor CreateDocument(AOwner: TComponent; AFileName: string);
    procedure Save;
    procedure SaveAs(AFileName: string);
    procedure Modify;
    property DataSet: TBDEDataSet read FDataSet write SetDataSet;
    property Report: TNotifyQuickRep read FReport;
    property Designer: TLMDDesigner read LMDDesigner1;
    property FileName: string read FFileName;
    property Modified: Boolean read FModified;
  end;

var
  frmDoc: TfrmDoc;
  FormWasClosed: Boolean;

function PackStrings(AValue: TStrings): string;
procedure UnpackStrings(const AValue: string; Result: TStrings);

procedure SaveStringToStream(const AStr: string; AStream: TStream);
function LoadStringFromStream(AStream: TStream): string;

implementation

uses frmMainUnit, frmPropsUnit, dlgFieldsUnit, dlgLinesEditorUnit;

{$R *.dfm}

var
  DocNum: Integer = 1;
  Signature: packed array[0..3] of Char = ('E', 'L', 'R', 'P');

function PackStrings(AValue: TStrings): string;
var
  LI, LC, LL: Longint;
begin
  Result := '';
  with TStringStream.Create('') do
  try
    LC := AValue.Count;
    Write(LC, SIzeOf(Longint));
    for LI := 0 to AValue.Count - 1 do
    begin
      LL := Length(AValue[LI]);
      Write(LL, SizeOf(Longint));
      Write(Pointer(AValue[LI])^, LL);
    end;
    Result := DataString;
  finally
    Free;
  end;
end;

procedure UnpackStrings(const AValue: string; Result: TStrings);
var
  LI, LC, LL: Longint;
  LS: string;
begin
  Result.Clear;
  with TStringStream.Create(AValue) do
  try
    Read(LC, SizeOf(Longint));
    for LI := 0 to LC - 1 do
    begin
      Read(LL, SizeOf(Longint));
      SetString(LS, nil, LL);
      Read(Pointer(LS)^, LL);
      Result.Add(LS);
    end;
  finally
    Free;
  end;
end;

procedure SaveStringToStream(const AStr: string; AStream: TStream);
var
  LC: Longint;
begin
  LC := Length(AStr);
  AStream.Write(LC, SizeOf(Longint));
  if LC > 0 then
    AStream.Write(Pointer(AStr)^, LC);
end;

function LoadStringFromStream(AStream: TStream): string;
var
  LC: Longint;
begin
  AStream.Read(LC, SizeOf(Longint));
  SetLength(Result, LC);
  if LC > 0 then
    AStream.Read(Pointer(Result)^, LC);
end;

procedure TfrmDoc.SetDataSet(const Value: TBDEDataSet);
var
  LI: Integer;
begin
  if FDataSet <> nil then FDataSet.Free;
  FDataSet := Value;
  FReport.DataSet := Value;
  for LI := 0 to FReport.ComponentCount - 1 do
    if FReport.Components[LI] is TQRDBText then
      TQRDBText(FReport.Components[LI]).DataSet := FDataSet;
end;

procedure TfrmDoc.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  if Modified then
    case MessageDlg('Save document "' + Caption + '"?', mtConfirmation,
      [mbYes, mbNo, mbCancel], 0) of
      mrYes:
        if FileName <> '' then
          frmMain.Save(Self)
        else
          if not frmMain.SaveAs(Self) then Action := caNone;
      mrNo: { Do nothind };
      mrCancel: Action := caNone;
    end;
  FormWasClosed := Action = caFree;
  if Action = caFree then
    frmMain.UpdateZoomComboBox(True);
end;

procedure TfrmDoc.FormDestroy(Sender: TObject);
begin
  LMDDesigner1.SelectedComponents.Clear;
  LMDDesigner1.Active := False;
  FReport.Free;
  if frmProps.Doc = Self then frmProps.Doc := nil;
end;

procedure TfrmDoc.LMDDesigner1KeyPress(Sender: TObject; var Key: Char);

  function _SetString(var AStr: string): Boolean;
  begin
    Result := False;
    if Ord(Key) >= 32 then
    begin
      AStr := AStr + Key;
      Result := True;
    end
    else if Ord(Key) = VK_BACK then
    begin
      AStr := Copy(AStr, 1, Length(AStr) - 1);
      Result := True;
    end;
  end;

var
  LC: TComponent;
  LS: string;

begin
  if LMDDesigner1.SelectedComponents.Count = 1 then
    LC := LMDDesigner1.SelectedComponents.DefaultComponent
  else
    LC := nil;
  if LC <> nil then
  begin
    if LC.ClassType = TQRLabel then
    begin
      LS := TQRLabel(LC).Caption;
      if _SetString(LS) then
      begin
        TQRLabel(LC).Caption := LS;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if LC.ClassType = TQRExpr then
    begin
      if Ord(Key) = VK_RETURN then
      begin
        LS := TQRExpr(LC).Expression;
        if dlgLinesEditor.Execute(LS, DataSet) then
        begin
          TQRExpr(LC).Expression := LS;
          frmProps.PropInsp.UpdateContent;
          Modify;
        end;
      end
      else
      begin
        LS := TQRExpr(LC).Expression;
        if _SetString(LS) then
        begin
          TQRExpr(LC).Expression := LS;
          frmProps.PropInsp.UpdateContent;
          Modify;
        end;
      end;
    end else if LC.ClassType = TQRDBText then
    begin
      if Ord(Key) = VK_RETURN then
      begin
        LS := TQRDBText(LC).DataField;
        if dlgFields.Execute(DataSet, LS) then
        begin
          TQRDBText(LC).DataField := LS;
          frmProps.PropInsp.UpdateContent;
          Modify;
        end;
      end
      else
      begin
        LS := TQRDBText(LC).DataField;
        if _SetString(LS) then
        begin
          TQRDBText(LC).DataField := LS;
          frmProps.PropInsp.UpdateContent;
          Modify;
        end;
      end;
    end else if (LC.ClassType = TQRMemo) and (Ord(Key) = VK_RETURN) then
    begin
      if dlgLinesEditor.Execute(TQRMemo(LC).Lines, DataSet) then
      begin
        TQRMemo(LC).Refresh;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end else if (LC.ClassType = TQRExprMemo) and (Ord(Key) = VK_RETURN) then
    begin
      if dlgLinesEditor.Execute(TQRExprMemo(LC).Lines, DataSet) then
      begin
        TQRExprMemo(LC).Refresh;
        frmProps.PropInsp.UpdateContent;
        Modify;
      end;
    end;
  end;
end;

procedure TfrmDoc.FormActivate(Sender: TObject);
begin
  frmProps.Doc := Self;
  AdjustChangeSelection;
  frmMain.UpdateZoomComboBox(False);
end;

procedure TfrmDoc.AdjustChangeSelection;
var
  LObjects: TList;
begin
  if frmProps.Doc = Self then