teeexport.pas

Delphi TeeChartPro.6.01的源代码

      tmp.IncFileFilterIndex(tmpFilter);

      With ADialog do
      begin
        if Filter<>'' then Filter:=Filter+'|';
        {$IFDEF CLX}
        i:=Pos('|',tmp.FileFilter);
        if i=0 then Filter:=Filter+tmp.FileFilter
               else Filter:=Filter+Copy(tmp.FileFilter,1,i-1);
        {$ELSE}
        Filter:=Filter+tmp.FileFilter;
        {$ENDIF}
      end;

      if Assigned(AItems) then
         AItems.AddObject(ReplaceChar(tmp.Description,'&'),tmp)
      else
         tmp.Free;
    end;
  end;
end;

procedure TTeeExportFormBase.PrepareOnShow;
begin
  TabData.TabVisible:=False;
  CBNativeData.Visible:=False;
end;

procedure TTeeExportFormBase.FormShow(Sender: TObject);
begin
  RGText.ItemIndex:=0; // 6.01

  with SaveDialogData do Options:=Options+[ofEnableSizing];
  with SaveDialogPicture do Options:=Options+[ofEnableSizing];
  with SaveDialogNative do Options:=Options+[ofEnableSizing];

  if Tag<>0 then ExportPanel:=TCustomTeePanel(Tag);

  if Assigned(ExportPanel) then
  begin
    ChangingSize:=True;
    With ExportPanel do
    begin
      UDWidth.Position :=Width;
      UDHeight.Position:=Height;
      IAspect:=Width/Height;
    end;

    PrepareOnShow;

    FreeExportFormats;
    TeeFillPictureDialog(SaveDialogPicture,ExportPanel,LBFormat.Items);

    CBDelim.ItemIndex:=1;
    LBFormat.ItemIndex:=0;
    RGFormatClick(Self);
    EnableButtons;
    ChangingSize:=False;
  end;

  TeeTranslateControl(Self);
end;

Function TTeeExportFormBase.CanChangeSize:Boolean;
begin
  result:=Showing and (not ChangingSize) and
          CBAspect.Checked and (IAspect<>0);
end;

procedure TTeeExportFormBase.EWidthChange(Sender: TObject);
begin
  if CanChangeSize then
  begin
    ChangingSize:=True;
    if Sender=EWidth then
       UDHeight.Position:=Round(UDWidth.Position/IAspect)
    else
       UDWidth.Position:=Round(UDHeight.Position*IAspect);
    ChangingSize:=False;
  end;
end;

procedure TTeeExportFormBase.PageControl1Change(Sender: TObject);
begin
  {$IFDEF CLX}
  if Showing then
  {$ENDIF}
     EnableButtons;
end;

{$IFNDEF LINUX}
var IsMapiInstalled : Integer=-1;
{$ENDIF}

Function MapiInstalled:Boolean;
{$IFNDEF LINUX}
var tmp : Integer;
{$ENDIF}
begin
  {$IFNDEF LINUX}
  if IsMapiInstalled=-1 then
  begin
    tmp:=TeeLoadLibrary('Mapi32.dll');
    if tmp>0 then
    begin
      IsMapiInstalled:=1;
      TeeFreeLibrary(tmp);
    end
    else IsMapiInstalled:=0;
  end;

  result:=IsMapiInstalled=1;

  {$ELSE}
 
  result:=False;

  {$ENDIF}
end;

Function TTeeExportFormBase.ExistData:Boolean;
begin
  result:=False;
end;

Function TTeeExportFormBase.NativeAsText:Boolean;
begin
  result:=CBNativeFormat.ItemIndex=1;
end;

procedure TTeeExportFormBase.EnableButtons;
begin
  BCopy.Enabled:=(PageControl1.ActivePage=TabPicture)
                 or
                 ((PageControl1.ActivePage=TabData) and ExistData)
                 or
                 ((PageControl1.ActivePage=TabNative) and NativeAsText);

  BSave.Enabled:=BCopy.Enabled or (PageControl1.ActivePage=TabNative);

  if (PageControl1.ActivePage=TabData) and (RGText.ItemIndex=3) then
     BCopy.Enabled:=False;

  BSend.Enabled:=BSave.Enabled and MapiInstalled;
end;

procedure TTeeExportFormBase.RGTextClick(Sender: TObject);
begin
  CBDelim.Enabled:=RGText.ItemIndex=0;
  ECustom.Enabled:=CBDelim.Enabled;
//  6.0   CBHeader.Enabled:=RGText.ItemIndex<>1; { 5.02 }
  EnableButtons;
end;

Function TTeeExportFormBase.CreateNativeStream:TStream;
begin
  result:=TMemoryStream.Create;
  SaveTeeToStream(ExportPanel,result);
end;

procedure TTeeExportFormBase.CBFileSizeClick(Sender: TObject);
begin
  if CBFileSize.Checked then
  with CreateNativeStream do
  try
    LabelSize.Caption:=Format(TeeMsg_FileSize,[Size]);
  finally
    Free;
  end
  else LabelSize.Caption:='?';
end;

procedure TTeeExportFormBase.CBNativeDataClick(Sender: TObject);
begin
  CBFileSizeClick(Self);
end;

procedure TTeeExportFormBase.CBDelimChange(Sender: TObject);
begin
  ECustom.Enabled:=CBDelim.ItemIndex=4;
  if ECustom.Enabled then ECustom.SetFocus;
end;

Procedure TTeeExportFormBase.FreeExportFormats;
var t: Integer;
begin
  if TeeExportFormats<>nil then
     for t:=0 to LBFormat.Items.Count-1 do
         TTeeExportFormat(LBFormat.Items.Objects[t]).Free;
  LBFormat.Items.Clear;
end;

procedure TTeeExportFormBase.FormDestroy(Sender: TObject);
begin
  FreeExportFormats;
end;

function TTeeExportFormBase.PictureFormat: TTeeExportFormat;
begin
  result:=TTeeExportFormat(LBFormat.Items.Objects[LBFormat.ItemIndex]);
end;

type TPathName=Array[0..MAX_PATH] of Char;

procedure TTeeExportFormBase.BSendClick(Sender: TObject);
{$IFNDEF LINUX}
var tmpPath      : TPathName;
    tmpName      : TPathName;

  Procedure AdjustExtension(Const Extension:String);
  begin
    StrPCopy(tmpName,ChangeFileExt(tmpName,'.'+Extension));
  end;

  Function GetDataExtension(Index:Integer):String;
  var t  : Integer;
      i  : Integer;
      St : String;
  begin
    St:=SaveDialogData.Filter;
    for t:=1 to (2*Index)-1 do
    begin
      i:=Pos('|',St);
      if i>0 then Delete(St,1,i);
    end;
    i:=Pos('|',St);
    if i>0 then Delete(St,i,Length(St));
    i:=Pos('.',St);
    if i>0 then Delete(St,1,i);
    result:=St;
  end;

{$ENDIF}
begin
{$IFNDEF LINUX}
  if GetTempPath(MAX_PATH,tmpPath)=0 then
     Raise Exception.Create(TeeMsg_CanNotFindTempPath);

  StrPCopy(tmpName,StrPas(tmpPath)+'\'+EmailName);

  if PageControl1.ActivePage=TabPicture then
  begin
    AdjustExtension(PictureFormat.FileExtension);
    SavePictureToFile(tmpName);
  end
  else
  if PageControl1.ActivePage=TabNative then
  begin
    AdjustExtension(NativeExtension);
    SaveNativeToFile(tmpName);
  end
  else
  if PageControl1.ActivePage=TabData then
  begin
    AdjustExtension(GetDataExtension(GetDataFilterIndex));
    SaveDataToFile(tmpName);
  end;

  InternalTeeEmailFile(tmpName,EmailName);
  DeleteFile(tmpName);
{$ENDIF}
end;

{ TTeeExportFormat }
Constructor TTeeExportFormat.Create;
begin { dummy constructor, to allow overriding it in derived classes }
  inherited;
end;

procedure TTeeExportFormat.CopyToClipboard;
begin
  if Assigned(Panel) then
  begin
    Options;
    CheckSize;
    DoCopyToClipboard;
  end
  else raise Exception.Create(TeeMsg_ExportPanelNotSet);
end;

Destructor TTeeExportFormat.Destroy;
begin
  if Assigned(Options(False)) then Options.Free;
  inherited;
end;

function TTeeExportFormat.FileFilterIndex: Integer;
begin
  result:=FFilterIndex;
end;

procedure TTeeExportFormat.IncFileFilterIndex(var FilterIndex: Integer);
begin
  Inc(FilterIndex);
  FFilterIndex:=FilterIndex;
end;

function TTeeExportFormat.Options(Check:Boolean=True):TForm;
begin
  result:=nil;
end;

procedure TTeeExportFormat.SaveToFile(const FileName: String);
var tmpStream : TStream;
begin
  if Assigned(Panel) then
  begin
    {$IFNDEF TEEOCX} // Revise for 5.04
    Options;
    {$ENDIF}

    CheckSize;
    tmpStream:=TFileStream.Create(Filename, fmCreate);
    try
      SaveToStream(tmpStream);
    finally
      tmpStream.Free;
    end;
  end
  else raise Exception.Create(TeeMsg_ExportPanelNotSet);
end;

Procedure TTeeExportFormat.CheckSize;
begin
  if Width=0 then Width:=Panel.Width;
  if Height=0 then Height:=Panel.Height;
end;

{ TTeeExportFormats }
function TTeeExportFormats.Get(Index: Integer): TTeeExportFormatClass;
begin
  result:=TTeeExportFormatClass(Items[Index]);
end;

{ Tools }
Procedure RegisterTeeExportFormat(AFormat:TTeeExportFormatClass);
begin
  if TeeExportFormats=nil then
     TeeExportFormats:=TTeeExportFormats.Create;
  TeeExportFormats.Add(AFormat);
end;

Procedure UnRegisterTeeExportFormat(AFormat:TTeeExportFormatClass);
begin
  if Assigned(TeeExportFormats) then TeeExportFormats.Remove(AFormat);
end;

Procedure TeeExportSavePanel(AFormat:TTeeExportFormatClass; APanel:TCustomTeePanel);
begin
  With AFormat.Create do
  try
    Panel:=APanel;
    With TSaveDialog.Create(nil) do
    try
      Filter:=FileFilter;
      DefaultExt:=FileExtension;
      Options:=Options+[ofOverwritePrompt];
      if Execute then SaveToFile(FileName);
    finally
      Free;
    end;
  finally
    Free;
  end;
end;

Procedure InternalTeeEmailFile(Const FileName:String; Const Subject:String='TeeChart');
{$IFNDEF LINUX}
var tmpName2     : TPathName;
    MapiMessage  : TMapiMessage;
    MapiFileDesc : TMapiFileDesc;
    MError       : Cardinal;
{$ENDIF}
begin
 {$IFNDEF LINUX}
  With MapiFileDesc do
  begin
    ulReserved:=0;
    flFlags:=0;
    nPosition:=Cardinal(-1);
    lpszPathName:=PChar(FileName);
    StrPCopy(tmpName2,ExtractFileName(FileName));
    lpszFileName:=tmpName2;
    lpFileType:=nil;
  end;

  with MapiMessage do
  begin
    ulReserved := 0;
    lpszSubject := PChar(Subject);
    lpszNoteText := nil;
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    nRecipCount := 0;
    lpRecips := nil;
    nFileCount := 1;
    lpFiles := @MapiFileDesc;
  end;

  MError:=MapiSendMail(0, {$IFDEF CLX}0{$ELSE}Application.Handle{$ENDIF},
    MapiMessage,
    MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0);

  if MError<>0 then
     Raise Exception.CreateFmt(TeeMsg_CanNotEmailChart,[MError]);
  {$ENDIF}
end;

Function GetRegistryHelpPath(Const HelpFile:String):String;
Const WindowsHelp='SOFTWARE\Microsoft\Windows\Help';
begin
  result:='';
  {$IFNDEF LINUX}
  With TRegistry.Create do
  try
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKeyReadOnly(WindowsHelp) then
       result:=ReadString(HelpFile)+'\'+HelpFile;
  finally
    Free;
  end;
  {$ENDIF}
end;

procedure TTeeExportFormBase.CBNativeFormatChange(Sender: TObject);
begin
  EnableButtons;
  CBFileSizeClick(Self);
end;

initialization
finalization
  FreeAndNil(TeeExportFormats);
end.