frxdesgn.pas

Fastreport最新版本的补丁

procedure TfrxDesigner.GetTemplateList(List: TStrings);
var
  sr: TSearchRec;
  dir: String;

  function NormalDir(const DirName: string): string;
  begin
    Result := DirName;
    if (Result <> '') and
      not (Result[Length(Result)] in [':', '\']) then
    begin
      if (Length(Result) = 1) and (UpCase(Result[1]) in ['A'..'Z']) then
        Result := Result + ':\'
      else Result := Result + '\';
    end;
  end;

begin
  List.Clear;
  if Assigned(FOnGetTemplateList) then
    FOnGetTemplateList(List)
  else
  begin
    dir := FTemplateDir;
    if (Trim(dir) = '') or (Trim(dir) = '.') then
      if csDesigning in ComponentState then
        dir := GetCurrentDir
      else
        dir := ExtractFilePath(Application.ExeName);
    dir := NormalDir(dir);
    if FindFirst(dir + '*.fr3', faAnyFile, sr) = 0 then
    begin
      repeat
        List.Add(dir + sr.Name);
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;
end;

{$IFDEF FR_COM}
procedure TfrxDesigner.EventSinkChanged(const Sink: IUnknown; Connecting: Boolean);
begin
  if Connecting
    then FEvent := Sink as IfrxDesignerEvents
  else
    FEvent := nil;
end;


function TfrxDesigner.Set_Standalone(Param: WordBool): HResult; stdcall;
begin
  Standalone := Param;
  Result := S_OK;
end;

function TfrxDesigner.Set_DefaultScriptLanguage(const Value: WideString): HResult; stdcall;
begin
  FDefaultScriptLanguage := Value;
  Result := S_OK;
end;

function TfrxDesigner.Get_EnableStartupWindow(out Value: WordBool): HResult; stdcall;
begin
  Value := FForm.ShowStartup;
  Result := S_OK;
end;

function TfrxDesigner.Set_EnableStartupWindow(Value: WordBool): HResult; stdcall;
begin
  FForm.ShowStartup := Value;
  Result := S_OK;
end;

function TfrxDesigner.Set_EnableLoadEvent(Value: WordBool): HResult; stdcall;
begin
  if Value = True then
    FOnLoadReport := OnLoadReportHandler
  else
    FOnLoadReport := nil;
  Result := S_OK;
end;

function TfrxDesigner.Set_EnableSaveEvent(Value: WordBool): HResult; stdcall;
begin
  if Value = True then
      FOnSaveReport := OnSaveReportHandler
  else
      FOnSaveReport := nil;
  Result := S_OK;
end;

function TfrxDesigner.Get_Restrictions(out Value: frxDesignerRestrictions): HResult; stdcall;
begin
  Value := PInteger( @Restrictions )^;
  Result := S_OK;
end;

function TfrxDesigner.Set_Restrictions(Value: frxDesignerRestrictions): HResult; stdcall;
type
  PfrxDesignerRestrictions = ^ TfrxDesignerRestrictions;
var
  dst: TfrxDesignerRestrictions;
  src:  Integer;
begin
  src := Value;
  dst := PfrxDesignerRestrictions(@src)^;
  Restrictions := dst;
  Result := S_OK;
end;

function TfrxDesigner.Get_TemplateModified(out Value: WordBool): HResult; stdcall;
begin
  if Assigned(FForm) then
    Value := FForm.Modified
  else
    Value := False;
  Result := S_OK;
end;

function TfrxDesigner.Set_TemplateModified(Value: WordBool): HResult; stdcall;
begin
  if Assigned(FForm) then
  begin
    FForm.Modified := Value;
    FForm.UpdateCaption;
  end;
  Result := S_OK;
end;

function TfrxDesigner.ShowWizards(Form: Integer): HResult; stdcall;
var
  DesignerForm: TfrxDesignerForm;
begin
  DesignerForm := TfrxDesignerForm(Pointer(Form));
  with TfrxNewItemForm.Create(DesignerForm) do
    begin
    ShowModal;
    Free;
    end;
  Result := S_OK;
end;

function TfrxDesigner.OpenReport(Form: Integer): HResult; stdcall;
var
  DesignerForm: TfrxDesignerForm;
begin
  DesignerForm := TfrxDesignerForm(Pointer(Form));
  DesignerForm.OpenCmdExecute(Self);
  Result := S_OK;
end;

function TfrxDesigner.OpenLastReport(Form: Integer): HResult; stdcall;
var
  DesignerForm: TfrxDesignerForm;
  RecentList:   TStringList;
  s: String;
begin
  DesignerForm := TfrxDesignerForm(Pointer(Form));
  RecentList := DesignerForm.RecentFiles;
  if RecentList.Count <> 0 then
  begin
    s := RecentList[RecentList.Count - 1];
    DesignerForm.Lock;
    DesignerForm.Report.LoadFromFile(s);
    DesignerForm.ReloadReport;
  end;
  Result := S_OK;
end;

function TfrxDesigner.EditConnectionAliases(Form: Integer): HResult; stdcall;
var
  DesignerForm: TfrxDesignerForm;
begin
  DesignerForm := TfrxDesignerForm(Pointer(Form));
  DesignerForm.ConnectionsMIClick(Self);
  Result := S_OK;
end;

procedure TfrxDesigner.OnDesignerStartupHandler(Sender: TObject);
var
  Enum : IEnumConnections;
  ConnectData : TConnectData;
  Fetched : Longint;
begin
  FForm := TfrxDesignerForm(Sender);

  if FEvent <> nil then
    FEvent.OnDesignerStartup( Integer(Pointer(Sender)), FForm.Handle )
  else
  begin
    OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum));
    while Enum.Next (1, ConnectData, @Fetched) = S_OK do
    begin
      (ConnectData.pUnk as IfrxDesignerEventDispatcher).OnDesignerStartup(
        Integer(Pointer(Sender)),
        FForm.Handle);
      ConnectData.pUnk := nil;
    end;
  end;
end;

function TfrxDesigner.OnLoadReportHandler(Report: TfrxReport): Boolean;
var
  Enum : IEnumConnections;
  ConnectData : TConnectData;
  Fetched : Longint;
begin
  Result := False;
  if FEvent <> nil then FEvent.OnLoadReport(Report) else
  begin
    OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum));
    while Enum.Next (1, ConnectData, @Fetched) = S_OK do
    begin
      (ConnectData.pUnk as IfrxDesignerEventDispatcher).OnLoadReport(Report);
      Result := True;
      ConnectData.pUnk := nil;
    end;
  end;
end;

function TfrxDesigner.OnSaveReportHandler(
  Report: TfrxReport;
  SaveAs: Boolean): Boolean;
var
  Enum : IEnumConnections;
  ConnectData : TConnectData;
  Fetched : Longint;
  Aborted : WordBool;
begin
  Result := False;
  if FEvent <> nil then case FEvent.OnSaveReport(Report, SaveAs, Aborted) of
      S_OK: Result := not Aborted;
    else
      Result := False;
    end
  else
  begin
    OleCheck((FConnectionPoint as IConnectionPoint).EnumConnections(Enum));
    while Enum.Next (1, ConnectData, @Fetched) = S_OK do
    begin
      Aborted := True;
      (ConnectData.pUnk as IfrxDesignerEventDispatcher).OnSaveReport(Report, SaveAs, Aborted);
      Result := not Aborted;
      ConnectData.pUnk := nil;
    end;
  end;
end;

{$ENDIF}

{ TfrxDesignerForm }

{ Form events }
{------------------------------------------------------------------------------}

procedure TfrxDesignerForm.FormShow(Sender: TObject);
begin
{$IFDEF FR_COM}
  Icon.Handle := LoadIcon(hInstance, 'SDESGNICON');
{$ENDIF}
  ReadButtonImages;
  CreateObjectsToolbar;
  CreateWorkspace;
  CreateToolWindows;
  Init;
  CreateExtraToolbar;

  Localize;
  CreateLangMenu;

  with ScaleCB.Items do
  begin
    Clear;
    Add('25%');
    Add('50%');
    Add('75%');
    Add('100%');
    Add('150%');
    Add('200%');
    Add(frxResources.Get('zmPageWidth'));
    Add(frxResources.Get('zmWholePage'));
  end;

  if Screen.PixelsPerInch > 96 then
  begin
    StyleCB.Font.Height := -11;
    FontNameCB.Font.Height := -11;
    FontSizeCB.Font.Height := -11;
    ScaleCB.Font.Height := -11;
    FrameWidthCB.Font.Height := -11;
    LangL.Font.Height := -11;
    LangCB.Font.Height := -11;
  end;

  RestoreState;
  ToolsMI.Visible := ExtraToolsTB.ButtonCount > 0;
  ExtraToolsTB.Visible := ExtraToolsTB.ButtonCount > 0;
  ReloadReport;
  RestoreState(False, True);

  ConnectionsMI.Visible := False;
  if frxDesignerComp <> nil then
  begin
    ConnectionsMI.Visible := frxDesignerComp.Standalone;
    if Assigned(frxDesignerComp.FOnShow) then
      frxDesignerComp.FOnShow(Self);
  end;
end;

procedure TfrxDesignerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SaveState;
  Done;
  Report.Modified := Modified;
  Report.Designer := nil;
  Action := caFree;
end;

procedure TfrxDesignerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  w: Word;
begin
  if FScriptRunning then
  begin
    CanClose := False;
    Exit;
  end;

  CanClose := True;
  Report.ScriptText := CodeWindow.Lines;

  if (frxDesignerComp <> nil) and not frxDesignerComp.CloseQuery then
    Exit;

  if Modified and not (csDesigning in Report.ComponentState) and CheckOp(drDontSaveReport) then
  begin
    w := AskSave;

    if IsPreviewDesigner then
    begin
      if w = mrNo then
        Modified := False
    end
    else if w = mrYes then
      if not SaveFile(False, True) then
        CanClose := False;

    if not IsPreviewDesigner then
    begin
      if w = mrNo then
        Modified := False
      else
        Modified := True;
    end;

    if w = mrCancel then
      CanClose := False;
  end;
end;

procedure TfrxDesignerForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ((FDialogForm <> nil) or (FPage is TfrxDataPage)) and
    (ActiveControl <> FInspector.Edit1) then
    THackControl(FWorkspace).KeyDown(Key, Shift);

  if Key = vk_Return then
    if ActiveControl = FontSizeCB then
      ToolButtonClick(FontSizeCB)
    else if ActiveControl = ScaleCB then
      ScaleCBClick(Self);

  if (Page <> nil) and (ActiveControl <> FInspector.Edit1) then
    if Key = vk_Insert then
      if Shift = [ssShift] then
        PasteCmdExecute(nil)
      else if Shift = [ssCtrl] then
        CopyCmdExecute(nil);

  if (Page <> nil) and (ActiveControl <> FInspector.Edit1) then
    if Key = vk_Delete then
      if Shift = [ssShift] then
        CutCmdExecute(nil);

  if (Key = Ord('E')) and (Shift = [ssCtrl]) then
    Page := nil;

  if ((Key = vk_F4) or (Key = vk_F5)) and (Shift = []) and (Page = nil) then
  begin
    if Key = vk_F4 then
      RunToCursorBClick(nil)
    else
      BreakPointBClick(nil);
  end
  else if (Key = vk_F2) and (Shift = [ssCtrl]) then
    StopScriptBClick(StopScriptB)
  else if (Key = vk_F7) and (Shift = [ssCtrl]) and (Page = nil) then
    EvaluateBClick(EvaluateB)
  else if Key = vk_F9 then
    RunScriptBClick(RunScriptB)
  else if ((Key = vk_F7) or (Key = vk_F8)) and (Page = nil) then
    RunScriptBClick(StepScriptB);
end;

procedure TfrxDesignerForm.CMStartup(var Message: TMessage);
begin
{$IFNDEF FR_COM}
  if FShowStartup then
{$ENDIF}
    if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnShowStartupScreen) then
      frxDesignerComp.FOnShowStartupScreen(Self);
end;

procedure TfrxDesignerForm.WMSysCommand(var Message: TWMSysCommand);
begin
  if (Message.CmdType and $FFF0 = SC_MINIMIZE) and (FormStyle <> fsMDIChild) then
    Application.Minimize
  else
    inherited;
end;

procedure TfrxDesignerForm.DoTopmosts(Enable: Boolean);
var
  fStyle: UINT;

  procedure SetFormStyle(Control: TWinControl);
  begin
    if Control is TToolBar then
      if Control.Floating then
        Control := Control.Parent
      else
        Exit;
    SetWindowPos(Control.Handle, fStyle, 0, 0, 0, 0, SWP_NOMOVE or
      SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
  end;