wwexport.pas

InfoPower_Studio 2007 v5.0.1.3 banben

      header:string;
      starthtml,endhtml,startseg,endseg,startpos:Longint;
      function GetPaddedNumber(number:longint;padlength:integer):string;
      var ct,len:integer;
          padstr:string;
      begin
         padstr := inttostr(number);
         len := length(padstr);
         for ct:= len+1 to padlength do
            padstr := '0'+padstr;
         result := padstr;
      end;
    begin
{      if not UseOldClipboardSaving then begin
        clipboard.open;
        try
          clipboard.Clear;
          wwcopyToClipBoard(totalstr,totalstr);
        finally
          clipboard.close;
        end;
        exit;
      end;}
      if UseOldClipboardSaving then begin
         header := 'Version:0.9'+wwCRLF;
         header := header+'StartHTML:0'+wwCRLF;
         header := header+'EndHTML:'+inttostr(Length(totalstr))+wwCRLF;
         header := header+'StartFragment:0'+wwCRLF;
         header := header+'EndFragment:0'+wwCRLF;
         header := header+'StartSelection:0'+wwCRLF;
         header := header+'EndSelection:0'+wwCRLF;
         totalstr := header+totalstr;
      end
      else begin //2/26/2002 - New Style handles all clipboard HTML export formats as it fills all of the header values.
        totalstr := '<!--StartFragment-->'+wwCRLF+totalstr+'<!--EndFragment-->';

        header := 'Version:0.9'+wwCRLF;
        header := header+'StartHTML:0000000000'+wwCRLF;
        header := header+'EndHTML:0000000000'+wwCRLF;
        header := header+'StartFragment:0000000000'+wwCRLF;
        header := header+'EndFragment:0000000000'+wwCRLF;
        header := header+'StartSelection:0000000000'+wwCRLF;
        header := header+'EndSelection:0000000000'+wwCRLF;

        //Fill in Start Offsets of HTML.
        starthtml:=Length(header);
        startPos:= AnsiPos('StartHTML:0000000000', header);
        header := Copy(header,1,startpos+9)+getpaddednumber(starthtml,10)+Copy(header,startpos+20,length(header));

        //Fill in Start Offsets of HTML.
        endhtml := starthtml + length(totalstr);
        startPos:= AnsiPos('EndHTML:0000000000', header);
        header := Copy(header,1,startpos+7)+getpaddednumber(endhtml,10)+Copy(header,startpos+18,length(header));

        totalstr := header + totalstr;
        //Fill in Start Fragment
        StartSeg:= AnsiPos('<!--StartFragment-->', totalstr);
        startPos:= AnsiPos('StartFragment:0000000000', totalstr);
        totalstr := Copy(totalstr,1,startpos+13)+getpaddednumber(startseg,10)+Copy(totalstr,startpos+24,length(totalstr));

        //Fill in End Fragment
        EndSeg:= AnsiPos('<!--EndFragment-->', totalstr);
        startPos:= AnsiPos('EndFragment:0000000000', totalstr);
        totalstr := Copy(totalstr,1,startpos+11)+getpaddednumber(endseg,10)+Copy(totalstr,startpos+22,length(totalstr));

        //Fill in Start Selection
        startPos:= AnsiPos('StartSelection:0000000000', totalstr);
        totalstr := Copy(totalstr,1,startpos+14)+getpaddednumber(startseg,10)+Copy(totalstr,startpos+25,length(totalstr));

        //Fill in End Selection
        startPos:= AnsiPos('EndSelection:0000000000', totalstr);
        totalstr := Copy(totalstr,1,startpos+12)+getpaddednumber(endseg,10)+Copy(totalstr,startpos+23,length(totalstr));
      end;

      CF_HTML := RegisterClipboardFormat('HTML Format');
      with clipboard do begin
         MemHandle := GlobalAlloc( GHND or GMEM_SHARE, Length(totalstr)+1 );
         If MemHandle <> 0 Then Begin
            StrCopy( GlobalLock( MemHandle ), PChar(totalstr));
            GlobalUnlock( MemHandle );
            Open;
            try
              AsText := totalstr;
              SetAsHandle(CF_HTML, MemHandle );
            finally
              Close;
            end;
         End
         Else
           MessageDlg('Global Alloc failed!', mtError, [mbOK], 0 );
      end;
   end;

begin
  grid := TwwDBGrid(Owner);
  if not Grid.Datalink.Active then exit;

  SYLKFontList:= nil;
  SYLKFormatIndex := nil;
  exportfieldList := TStringList.Create;
  SYLKFormatIndex := TStringList.Create;
  try
    with Grid do begin
      TotalPixelCount := 0;
//      if esoShowRecordNo in self.Options then TotalPixelCount := 0;
      // Save columns to export and total pixel width for later use.
      for i:= 0 to Datalink.FieldCount - 1 do begin
         Accept := True;
         DoExportField(Grid,DataLink.Fields[i],Accept);
         if Accept then begin
            exportFieldList.Add('T');
            TotalPixelCount := TotalPixelCount+Grid.ColWidthsPixels[i+xindicatorOffset]+5;
         end
         else exportFieldList.Add('F');
         SYLKFormatIndex.Add('0');
      end;

      //6/13/2001-SYLK format has additional header initialization that needs to be called.
      //7/26/2001-PYW-Handle Header
      if (esoShowHeader in self.options) or (ExportType=wwgetSYLK) or (ExportType=wwgetHTML) then begin
         case ExportType of
           wwgetTxt: totalstr := WriteTextHeader;
           wwgetHTML: totalstr := WriteHTMLHeader;
           wwgetSYLK: totalstr := WriteSYLKHeader;
         end;  //End Case
         if not savetostringfirst then begin
            fs.WriteBuffer(Pointer(totalstr)^, Length(totalstr));
         end
      end;  //End ShowHeader

      currowcount := 0;

      if esoSaveSelectedOnly in self.Options then begin
        Grid.SortSelectedList;
        for i:=0 to Grid.SelectedList.count-1 do begin
           currowcount := i+1;
           DataSource.Dataset.GotoBookmark(SelectedList[i]);
           case ExportType of
             wwgetTxt: recordstr := WriteTextDataRow;
             wwgetHTML: recordstr := WriteHTMLDataRow;
             wwgetSYLK: recordstr := WriteSYLKDataRow
           end;
           if not savetostringfirst then
              fs.WriteBuffer(Pointer(recordstr)^, Length(recordstr))
           else totalstr := totalstr+recordstr;
           Application.ProcessMessages;
        end;
        if SelectedList.Count <= 0 then begin
           if ExportType = wwgetHTML then begin
              recordstr := '<TR '+SetBkGrndColor(TitleColor)+'>'+
                           '<TH colspan='+IntToStr(Grid.DataLink.Fieldcount+XRecNoOffset)+' scope=colgroup>'+
                           'No Records Selected'+'</TH>'+'</TR>'+wwCRLF;

              if not savetostringfirst then
                fs.WriteBuffer(Pointer(recordstr)^,Length(recordstr))
              else totalstr := totalstr+ recordstr;
           end;
        end;
      end
      else begin
        Datasource.Dataset.First;
        while not DataSource.DataSet.EOF do
        begin
           inc(currowcount);
           case ExportType of
             wwgetTxt: recordstr := WriteTextDataRow;
             wwgetHTML: recordstr := WriteHTMLDataRow;
             wwgetSYLK: recordstr := WriteSYLKDataRow
           end;
           if not savetostringfirst then
              fs.WriteBuffer(Pointer(recordstr)^, Length(recordstr))
           else totalstr := totalstr+recordstr;
           Application.ProcessMessages;
           DataSource.DataSet.Next;
        end;
      end;
    end;  // End With Grid

    if ExportType = wwgetHTML then begin
       recordstr := '</TBODY>'+wwCRLF+'</BODY>'+wwCRLF+'</TABLE>'+wwCRLF+'</HTML>'+wwCRLF;
       if not (savetostringfirst) then
          fs.WriteBuffer(Pointer(recordstr)^, Length(recordstr))
       else totalstr := totalstr+recordstr;
    end
    else if ExportType = wwgetSYLK then begin
       recordstr:='E';
       totalstr := totalstr+recordstr;
       startPos:= AnsiPos('B;Y;', totalStr);
       if esoShowHeader in Options then inc(currowcount);
       Fmtstr(totalstr,'%sB;Y%s;%s',[Copy(totalstr,1,startpos-1),inttostr(currowcount),Copy(totalstr,startpos+4,length(totalstr))]);
       startpos := AnsiPos('B;Y',totalstr);
       fontlist:='';
       //6/13/2001-Don't call if this FontList is nil.
       if SYLKFontList <> nil then
         for i:= 0 to SYLKFontList.Count-1 do begin
           fontlist := fontlist+SYLKFontList.Names[i]+wwCRLF;
         end;
       Fmtstr(totalstr,'%s%s%s',[Copy(totalstr,1,startpos-1),fontlist,Copy(totalstr,startpos,length(totalstr))]);

       if not (esoClipboard in Options) then begin
          fs.WriteBuffer(Pointer(totalstr)^, Length(totalstr))
       end;
    end;
    if esoClipboard in Options then begin
       Clipboard.clear;
       if exportType = wwgetSYLK then begin
          SetSYLKToClipboard;
       end
       else if exportType = wwgetTxt then begin
          Clipboard.asText := totalstr;
       end
       else if exportType = wwgetHTML then begin
          SetHTMLToClipboard;
       end;
    end;
  finally
    exportFieldList.Free;
    SYLKFontList.Free;
    SYLKFormatIndex.Free;
  end;
end;

type TwwCheatExportGrid=class(TwwDBGrid);

procedure TwwExportOptions.Save;
var fs:TFileStream;
   curBookmark: TBookmark;
   ScrollCount, currentrow, moveByCount: integer;
   Grid:TwwDBGrid;
begin
   if esoClipboard in Options then
      fs := nil
   else fs := TFileStream.Create(FileName, fmCreate);
   try
      if Owner is TwwDBGrid then begin
         if (Owner <> nil) and (TwwDBGrid(Owner).Datasource <> nil) and
            (TwwDBGrid(Owner).DataSource.Dataset <> nil) then
         begin
            Grid := TwwDBGrid(Owner);
            with Grid,Grid.DataSource.Dataset do begin
               DisableControls;
               curBookmark := GetBookmark;
               currentRow:= Grid.GetActiveRow;
            {Add middle bookmark code.}
               try
                  ExportToStream(fs);
               finally
                  GotoBookmark(CurBookmark);
                  FreeBOokmark(CurBookmark);
                  if GetActiveRow<currentRow then
                  begin
                     ScrollCount:= CurrentRow-GetActiveRow;
                     MoveByCount:= -(GetActiveRow + ScrollCount);
                     if MoveByCount<>0 then begin
                        MoveBy(MoveByCount);
                        SetActiveRow(CurrentRow);
                     end;
                  end
                  else begin
                     ScrollCount:= GetActiveRow-currentRow;
                     MoveByCount:= ((TwwCheatExportGrid(Grid).VisibleRowCount-1)-GetActiveRow) + ScrollCount;
                     If MoveByCount<>0 then begin
                        MoveBy(MoveByCount);
                        SetActiveRow(CurrentRow);
                     end;
                  end;
                  EnableControls;
               end;
            end;
         end
      end
   finally
      if fs <> nil then fs.Free;
   end;
end;

function TwwExportOptions.IsDelimiterStored: boolean;
begin
   if Delimiter = ',' then result:= false
   else result:= True;
end;

end.