Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/Sources/formale Sprachen/Delphi/Autor 0.7/ (Columbo Version 0.7^©) Datei vom 12.1.2008 mit Größe 33 kB

Quellcode-Bibliothek main.pas Sprache: Delphi

unit main;
interface
//------------------------------------------------------------------------------
//        Uses
//------------------------------------------------------------------------------
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, StdCtrls, ComCtrls, BandActn, StdActns, ExtActns,
  ActnList, ToolWin, ExtCtrls, ActnMan, ActnCtrls, ActnMenus, Lizenz,
  XPStyleActnCtrls, StdStyleActnCtrls, OleCtrls, SHDocVw, jpeg, Buttons,
  UtilitiesOwn, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdFTP, rtf2html, Strutils, richedit, Optionclass, xmldom, XMLIntf, msxmldom,
  XMLDoc, AboutBox, dateuTILS, Printers, GIFImage, Utilities, Math, ShellApi,
  IdExplicitTLSClientServerBase;
//------------------------------------------------------------------------------
//      Const
//------------------------------------------------------------------------------
const
  Filters:array [0..0] of String=
   ('Bilddateien (*.jpg;*.gif;*.bmp)|*.jpg;*.gif;*.bmp');
//------------------------------------------------------------------------------
//        Type
//------------------------------------------------------------------------------
type
  TForm1 = class(TForm)
    ActionMainMenuBar1: TActionMainMenuBar;
    ToolActionBar1: TActionToolBar;
    ToolActionBar2: TActionToolBar;
    ToolActionBar3: TActionToolBar;
    Artikeltext: TRichEdit;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    LinksHotImages: TImageList;
    LinksImages: TImageList;
    NavigatorHotImages: TImageList;
    NavigatorImages: TImageList;
    WebBrowser1: TWebBrowser;
    VerticalSplitter: TSplitter;
    Artikelbild: TImage;
    Ueberschrift: TRichEdit;
    HorizontalSplitter: TSplitter;
    ComboBox1: TComboBox;
    IdFTP1: TIdFTP;
    XMLDoc: TXMLDocument;
    ActionManager1: TActionManager;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    EditSelectAll1: TEditSelectAll;
    EditUndo1: TEditUndo;
    EditDelete1: TEditDelete;
    RichEditBold1: TRichEditBold;
    RichEditItalic1: TRichEditItalic;
    RichEditUnderline1: TRichEditUnderline;
    RichEditStrikeOut1: TRichEditStrikeOut;
    RichEditBullets1: TRichEditBullets;
    RichEditAlignLeft1: TRichEditAlignLeft;
    RichEditAlignRight1: TRichEditAlignRight;
    RichEditAlignCenter1: TRichEditAlignCenter;
    FileOpen1: TFileOpen;
    FileSaveAs1: TFileSaveAs;
    FileRun1: TFileRun;
    FileExit1: TFileExit;
    SearchFind1: TSearchFind;
    SearchFindNext1: TSearchFindNext;
    SearchReplace1: TSearchReplace;
    SearchFindFirst1: TSearchFindFirst;
    CustomizeActionBars1: TCustomizeActionBars;
    StdStyleActn: TAction;
    XPStyleActn: TAction;
    ShadowActn: TAction;
    FilePageSetup1: TFilePageSetup;
    Browse: TAction;
    Transfer: TAction;
    Hilfe: TAction;
    Optionen: TAction;
    Drucken: TAction;
    Ueber: TAction;
    Support: TAction;
    Donation: TAction;
    PrintDialog1: TPrintDialog;
    function  LoadImage(s:String;a:ArticleType):boolean;
    procedure SaveArticle(a:ArticleType);
    procedure SaveRtfArticle(a:ArticleType);
    procedure LoadArticle(a:ArticleType);
    procedure LoadTextArticle(a:ArticleType);
    procedure LoadXMLArticle(a:ArticleType);
    function  ExtractXMLPicture(a:ArticleType):String;
    procedure SaveXMLArticle(a:ArticleType);
    procedure FileOpen1Accept(Sender: TObject);
    procedure FileSaveAs1Accept(Sender: TObject);
    procedure ActionManager1StateChange(Sender: TObject);
    procedure StdStyleActnExecute(Sender: TObject);
    procedure XPStyleActnExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ShadowActnExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ArtikelbildDblClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure BrowseExecute(Sender: TObject);
    procedure ReplaceRemoteFile(Remote,Local:String);
    procedure ReplaceLocalFile(Local,remote:String);
    procedure ReplaceLocalPicture(Local,remote:String);
    procedure InboundTransferExecute(Sender: TObject);
    procedure OutboundTransferExecute(Sender: TObject);
    procedure HilfeExecute(Sender: TObject);
    procedure OptionenExecute(Sender: TObject);
    procedure DruckenExecute(Sender: TObject);
    procedure ArtikelbildMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ArtikeltextMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure UeberExecute(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SupportExecute(Sender: TObject);
    procedure DonationExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
//------------------------------------------------------------------------------
//        Var
//------------------------------------------------------------------------------
var
  Form1: TForm1;
  AktBild:String;
  AktBildSize:longint;
  Pageseen:boolean;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
//        constructor create form
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  XPStyleActn.Checked  := ActionManager1.Style = XPStyle;
  StdStyleActn.Checked := ActionManager1.Style = StandardStyle;
  Pageseen:=false;
  if (Opt.r.ActualArticle<Angebote) or (Opt.r.ActualArticle>Vorgestern) then
    opt.r.ActualArticle:=Angebote;
end;
//------------------------------------------------------------------------------
//        FormShow
//------------------------------------------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
var a:ArticleType;
begin
  checklicense();
  //
  Width              := Opt.r.Width;
  Height             := Opt.r.Height;
  Top                := Opt.r.top;
  Left               := Opt.r.Left;
  Artikeltext.Height := Height-Opt.r.Horsplitter;
  Artikeltext.Width  := Width-Opt.r.VerSplitter;
  Artikelbild.Height := Opt.r.Horsplitter;
  Artikelbild.Width  := Opt.r.VerSplitter;
  for a:=low(ArticleType) to high(ArticleType) do
    ComboBox1.AddItem(Opt.r.name[a],nil);
  InboundTransferExecute(Sender);
  WebBrowser1.Visible:=false;
end;
//------------------------------------------------------------------------------
//        constructor create form
//------------------------------------------------------------------------------
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key=Key_Escape then begin
    Width:=Screen.Width div 2;
    Height:=Screen.Height div 2;
    top:=Screen.Height div 2-Height div 2;
    Left:=Screen.Width div 2 -Width div 2;
    Opt.r.Width:=Width;Opt.r.BWidth:=Width;
    Opt.r.Height:=Height;Opt.r.BHeight:=Height;
  end;
end;
//------------------------------------------------------------------------------
//             ftp  put
//------------------------------------------------------------------------------
procedure TForm1.ReplaceRemoteFile(Remote,Local:String);
begin
  //if IdFTP1.ChangeDir(Remote,false)<>0 then
  try
  IdFTP1.Delete(remote);
  finally
  IdFTP1.Put(Local,remote)
  end;
end;
//------------------------------------------------------------------------------
//             ftp get
//------------------------------------------------------------------------------
procedure TForm1.ReplaceLocalFile(Local,Remote:String);
begin
  Local:=StringReplace(Local,'/','\',[rfReplaceAll]);
  if not DirectoryExists(ExtractFileDir(Local)) then
    createdir(ExtractFileDir(Local));
  DeleteFile(Local);
  try
  IdFTP1.get(remote,Local,true);
  finally
  end;
end;
//------------------------------------------------------------------------------
//             ftp get Picture
//------------------------------------------------------------------------------
procedure TForm1.ReplaceLocalPicture(Local,Remote:String);
begin
  Local:=StringReplace(Local,'/','\',[rfReplaceAll]);
  if not DirectoryExists(ExtractFileDir(Local)) then
    createdir(ExtractFileDir(Local));
  DeleteFile(Local);
  try
  IdFTP1.get(remote,Local,true);
  finally
  end;
end;
//------------------------------------------------------------------------------
//             ftp transfer
//------------------------------------------------------------------------------
procedure TForm1.InboundTransferExecute(Sender: TObject);
var a,act:ArticleType;Pic:String;
begin
  IdFTP1.Host:=Opt.r.Ftpsite;
  IdFTP1.Username:=opt.r.ftpuser;
  IdFTP1.Password:=opt.r.ftppassword;
  if not DirectoryExists(Opt.R.LocalDir) then
    createdir(Opt.R.LocalDir);
  try
    IdFTP1.Connect;
    if IdFTP1.Connected then begin
      IdFTP1.ChangeDir(Opt.r.RemoteDir);
      act:=Opt.r.ActualArticle;
      for a:=low(ArticleType) to high(ArticleType) do begin
        ReplaceLocalFile(Opt.R.LocalDir+Opt.r.xmlfile[a],Opt.r.xmlfile[a]);
        Pic:=ExtractXMLPicture(a);
        if Pic<>'' then ReplaceLocalPicture(Opt.R.LocalDir+Pic,Pic);
        LoadArticle(a);
      end;
      LoadArticle(act);
    end;
  finally
    if idftp1.Connected then
    IdFTP1.Disconnect;
  end;
end;
//------------------------------------------------------------------------------
//             ftp transfer
//------------------------------------------------------------------------------
procedure TForm1.OutboundTransferExecute(Sender: TObject);
var a:ArticleType;ok:boolean;
begin
  if      (Lengthrtf(Opt.r.RtfText[Angebote])<5)   then ShowMessage('Angebot fehlt')
  else if (Lengthrtf(Opt.r.RtfText[Aktuelles])<5)  then ShowMessage('Aktuelles fehlt')
  else if (Lengthrtf(Opt.r.RtfText[Empfehlung])<5) then ShowMessage('Empfehlung fehlt')
  else begin
  screen.Cursor:=crHourGlass;
  SaveArticle(Opt.r.ActualArticle);
  IdFTP1.Host:=Opt.r.Ftpsite;
  IdFTP1.Username:=opt.r.ftpuser;
  IdFTP1.Password:=opt.r.ftppassword;
  ok:=true;
  if not DirectoryExists(Opt.R.LocalDir) then
    createdir(Opt.R.LocalDir);
  try
    IdFTP1.Connect;
    if IdFTP1.Connected then begin
      IdFTP1.ChangeDir(Opt.r.RemoteDir);
      for a:=Angebote to Empfehlung do begin
        if FileExists(Opt.R.LocalDir+Opt.r.xmlfile[a]) then begin
          ReplaceRemoteFile(Opt.r.xmlfile[a],Opt.R.LocalDir+Opt.r.xmlfile[a]);
          if Opt.r.Bild[a]<>'' then begin
            ReplaceRemoteFile(Opt.r.RemotePicSmallDir+ExtractFileName(Opt.r.bild[a]),Opt.r.bild[a]);
            ReplaceRemoteFile(Opt.r.RemotePicBigDir+ExtractFileName(Opt.r.bild[a]),Opt.r.bild[a])
          end
        end
      end;
      LoadArticle(Opt.r.ActualArticle);
  end except
    ok:=false;
  end;
  if idftp1.Connected then
    IdFTP1.Disconnect;
  if Ok then begin
    StatusBar1.SimpleText:='Alle Artikel �bertragen';
    StatusBar1.Font.Color:=clBlue;
  end else begin
    StatusBar1.SimpleText:='Verbindungsfehler - nicht alle �berttragen!';
    StatusBar1.Font.Color:=clRed;
  end;
  screen.Cursor:=crDefault;
  end;
end;
//------------------------------------------------------------------------------
//             �ber
//------------------------------------------------------------------------------
procedure TForm1.UeberExecute(Sender: TObject);
var dd:integer;
begin
  About:=TAboutBox.create(Self);
  if Opt.r.Activated then
    About.Produkt.Caption:=MidStr(Opt.r.WindowsProductId,11,100)
  else begin
    DD := Opt.R.DaysUsed;
    DD := EvaluationPeriod-DD;
    About.Produkt.Caption:='Noch '+inttostr(DD)+' Tage nutzbar.';
  end;
  About.showmodal;
  About.free;
end;
//------------------------------------------------------------------------------
//                browser/editor wechsel
//------------------------------------------------------------------------------
procedure TForm1.BrowseExecute(Sender: TObject);
var Flags: OLEVariant; URL:String;
begin
  Flags := 0;
  WebBrowser1.Visible  := not WebBrowser1.Visible;
  Ueberschrift.Visible := not Ueberschrift.Visible;
  Artikeltext.Visible  := not Artikeltext.Visible;
  ComboBox1.Visible    := not ComboBox1.Visible;
  Artikelbild.Visible  := not Artikelbild.Visible;
  if WebBrowser1.Visible then begin
    Transfer.Enabled:=false;
    screen.Cursor:=crHourGlass;
    Opt.r.Width:=Width;
    opt.r.Height:=Height;
    Top:=max(0,abs(Top+Height div 2-Opt.r.BHeight div 2));
    Left:=max(0,abs(Left+Width div 2-Opt.r.BWidth div 2));
    Width:=Opt.r.BWidth;
    Height:=Opt.r.BHeight;
    URL:='http://'+Opt.r.internetsite;
    if (WebBrowser1.LocationURL=URL) and Pageseen then
       WebBrowser1.Refresh
    else
       WebBrowser1.Navigate(WideString(URL),navNoReadFromCache);
    Pageseen:=true;
    Browse.Caption:='Artikel';
    ComboBox1.Visible:=false;
    Screen.Cursor:=crDefault;
  end else begin
    Transfer.Enabled:=true;
    Opt.r.BWidth:=Width;
    opt.r.BHeight:=Height;
    Top:=min(Screen.Height,abs(Top+Height div 2-Opt.r.Height div 2));
    Left:=min(screen.Width,abs(Left+Width div 2-Opt.r.Width div 2));
    Width:=Opt.r.Width;
    Height:=opt.r.Height;
    ComboBox1.Visible:=true;
    Browse.Caption:='Netz';
  end;
end;
//------------------------------------------------------------------------------
//                donation article
//------------------------------------------------------------------------------
procedure TForm1.DonationExecute(Sender: TObject);
Var Site,Count:String;
begin
  Count:=InttoStr(SysLocale.PriLangID);
  Site:= 'http://www.tdh.de';
  ShellExecute(Handle, 'open',PChar(Site),nil,nil, SW_SHOWNORMAL);
end;
//------------------------------------------------------------------------------
//                print article
//------------------------------------------------------------------------------
procedure TForm1.DruckenExecute(Sender: TObject);
var cmd,res:TOleEnum;
begin
  if PrintDialog1.Execute then begin
     Screen.Cursor:=crHourGlass;
     if WebBrowser1.Visible then begin
      cmd:=OLECMDID_PRINT;
      res:=WebBrowser1.QueryStatusWB(cmd);
      if res<>0  then
        WebBrowser1.ExecWB(cmd,cmd);
    end else begin
      Printer.Title:=Opt.r.Headline+' - '+DateToStr(Now);
      Artikeltext.Print('Artikel');
    end;
     Screen.Cursor:=crDefault;
  end;
end;
//------------------------------------------------------------------------------
//                save article
//------------------------------------------------------------------------------
procedure TForm1.SaveRtfArticle(a:ArticleType);
var Output:String;RTFString: TStringStream;
begin
  RTFString := TStringStream.Create(Output);
  RTFString.Position := 0;
  Ueberschrift.Lines.SaveToStream(RTFString);
  StrPCopy(Opt.r.ueberschrift[a],RTFString.DataString);
  RichEditToHTML(Ueberschrift,OutPut);
  // correct <p></p>
  if MidStr(Output,1,3)='

then begin
Output:=StringReplace(Output,'

,[rfReplaceAll]);
Output:=MidStr(Output,1,Length(Output)-4)+'

';
  end;
  StrPCopy(Opt.r.ueberschriftxml[a],Output);
  RTFString.Position := 0;
  Artikeltext.Lines.SaveToStream(RTFString);
  if length(RTFString.DataString)<KeyMaxLong then
    StrPCopy(Opt.r.RtfText[a],RTFString.DataString)
  else showmessage('Artikel zu lang');
  RichEditToHTML(Artikeltext,Output);
  // correct <p></p>
  if MidStr(Output,1,3)='

then begin
Output:=StringReplace(Output,'

,[rfReplaceAll]);
Output:=MidStr(Output,1,Length(Output)-4)+'

';
  end;
  StrPCopy(Opt.r.textxml[a],Output);
  RTFString.free;
end;
{------------------------------------------------------------------}
{-                                                                -}
{-   copy string to stream                                        -}
{-                                                                -}
{------------------------------------------------------------------}
procedure CopyStream(streamin:String;var streamout:TMemoryStream);
var p:integer;
begin
  streamout.SetSize(length(streamin)+8);
  streamout.Position := 0;
  streamout.Clear;
  p:=1;
  while p<=Length(streamin) do begin
    streamout.WriteBuffer(streamin[p], 1);
    p:=p+1
  end
end;
//------------------------------------------------------------------------------
//              load article
//------------------------------------------------------------------------------
procedure TForm1.LoadArticle(a:ArticleType);
begin
  Aktbild:='';
  LoadXMLArticle(a);
  Opt.r.ActualArticle:=a;
  ComboBox1.ItemIndex:=ord(a);
end;
//------------------------------------------------------------------------------
//              save article
//------------------------------------------------------------------------------
procedure TForm1.SaveArticle(a:ArticleType);
begin
  if a<=Empfehlung then begin
    SaveRtfArticle(a);
    SaveXMLArticle(a)
  end;
end;
//------------------------------------------------------------------------------
//              load text article
//------------------------------------------------------------------------------
procedure TForm1.LoadTextArticle(a:ArticleType);
var streamatt:TMemoryStream;
begin
  streamatt:=TMemoryStream.Create;
  // Ueberschrift
  Ueberschrift.ReadOnly := false;
  Ueberschrift.Lines.Clear;
  Artikeltext.ReadOnly := false;
  Artikeltext.Lines.Clear;
  if (Length(Opt.r.Ueberschrift)>0)  and (Length(Opt.r.RtfText)>0) then begin
    Ueberschrift.PlainText   := false;
    CopyStream(Opt.r.ueberschrift[a],streamatt);
    streamatt.Position:=0;
    Ueberschrift.Lines.LoadFromStream(streamatt);   // must be twice
    Ueberschrift.Paragraph.Alignment:=taCenter;
    // Bild
    if not FileExists(Opt.r.bild[a]) then Opt.r.bild[a]:='';
    LoadImage('',a);
    // Artikel
    Artikeltext.PlainText   := false;
    CopyStream(Opt.r.RtfText[a],streamatt);
    streamatt.Position:=0;
    Artikeltext.Lines.LoadFromStream(streamatt);   // must be twice  RTFString.Position := 0;
    streamatt.Free;
  end;
  Ueberschrift.Modified := false;
  Artikeltext.Modified  := false;
end;
//------------------------------------------------------------------------------
//              load xml document
//------------------------------------------------------------------------------
procedure TForm1.LoadXMLArticle(a:ArticleType);
var N,M:IXMLNode;Abstrakt,Pic,Head,Text,Overhead,Filnam:String;
begin
  Filnam:=Opt.R.LocalDir+Opt.r.xmlfile[a];
  if FileExists(Filnam) then begin
    XMLDoc.LoadFromFile(Filnam);
    if XMLDoc<>nil then begin
      M:=XMLDoc.DocumentElement;
      M:=M.ChildNodes.First;
      while M<>nil do begin
        N:=M.ChildNodes.First;
        while N<>nil do begin
          if      N.NodeName=xmlTags[2] then Head:=N.Text
          else if N.NodeName=xmlTags[1] then Overhead:=N.Text
          else if N.NodeName=xmlTags[4] then Abstrakt:=N.Text
          else if N.NodeName=xmlTags[5] then Text:=N.Text
          else if N.NodeName=xmlTags[9] then Pic:=N.Text;
          N:=N.NextSibling
        end;
        M:=M.NextSibling
      end;
      Artikeltext.ReadOnly:=false;
      Ueberschrift.ReadOnly:=false;
      Ueberschrift.Lines.Clear;
      RemoveLineBreak(Overhead);
      RemoveLineBreak(Head);
      HTMLToRichEdit(Overhead+Head,Ueberschrift);
      head:=Ueberschrift.Lines.GetText;
      Ueberschrift.SelectAll;
      Ueberschrift.Paragraph.Alignment:=taCenter;
      Ueberschrift.SelLength:=0;
      LoadImage(Opt.r.LocalDir+Pic,a);
      Artikeltext.Lines.Clear;
      Artikeltext.DefAttributes.Style:=[];
      HTMLToRichEdit(Abstrakt,Artikeltext);
      Artikeltext.Lines.Add('');
      HTMLToRichEdit(Text,Artikeltext);
      //
      Artikeltext.ReadOnly:=opt.r.readonly[a];
      Ueberschrift.ReadOnly:=opt.r.readonly[a];
    end
  end;
end;
//------------------------------------------------------------------------------
//              extract picture
//------------------------------------------------------------------------------
function TForm1.ExtractXMLPicture(a:ArticleType):String;
var N,M:IXMLNode;pic,f:String;
begin
  Pic:='';
  f:=Opt.R.LocalDir+Opt.r.xmlfile[a];
  if FileExists(f) then begin
   XMLDoc.LoadFromFile(f);
   if XMLDoc<>nil then begin
    M:=XMLDoc.DocumentElement;
    M:=M.ChildNodes.First;
    while M<>nil do begin
      N:=M.ChildNodes.First;
      while N<>nil do begin
        if N.NodeName='PICSMALL' then Pic:=N.Text;
        N:=N.NextSibling
      end;
      M:=M.NextSibling
    end;
   end
  end;
  ExtractXMLPicture:=Pic;
end;
//------------------------------------------------------------------------------
//              extract picture
//------------------------------------------------------------------------------
procedure TForm1.SaveXMLArticle(a:ArticleType);
var f:TextFile;d,m,y,s:String;i:integer;
procedure stael(s:string); begin write(f,'<'+s+'>'); end;
procedure endel(s:string); begin writeln(f,'+s+'>');end;
begin
  D:=IntToStr(DayOf(now));M:=IntToStr(MonthOf(Now));y:=IntToStr(YearOf(now));
  if not DirectoryExists(Opt.r.LocalDir) then
    CreateDir(Opt.r.LocalDir);
  AssignFile(F,Opt.R.LocalDir+Opt.r.xmlfile[a]);
  Rewrite(f);
  writeln(f,'');
  writeln(f,'+Opt.R.DocumentName+' [');
  writeln(f,'+Opt.r.DocumentName+' ('+Opt.r.Groupname+')+>');
  write  (f,'+Opt.r.Groupname+' (');
  s:='';
  for i:=1 to Length(XMLTags) do begin
    write  (f,s+XMLTags[i]+'?'); s:=', ';
end;
  writeln(f,')>');
  s:='';
  for i:=1 to Length(XMLTags) do begin
    write(f,');
    write(f,XMLTags[i]);
    writeln(f,' (#PCDATA)>');
  end;
  writeln(f,']>');
  stael(opt.r.DocumentName);
  stael(Opt.r.Groupname);
  writeln(f);
  for i:=1 to 9 do begin
    stael(opt.r.ElementName[i]);
    write(f,');                              // CDATA
    if      i=1 then write(f,Opt.R.Overhead)           // OVERHEAD
    else if i=2 then write(f,Opt.r.Ueberschriftxml[a]) // HEADLINE
    else if i=3 then write(f,d+'.'+m+'.'+y)            // DATE
    else if i=4 then write(f,'')                       // ABSTRACT
    else if i=5 then write(f,Opt.r.TextXML[a])         // TEXT
    else if i=6 then write(f,'Context IT')             // AUTHOR
    else if i=7 then begin                             // PICBIG
      s:=ExtractFileName(opt.r.Bild[a]);
      if s<>'' then s:=Opt.R.RemotePicBigDir+s;
      write(f,s);
    end else if i=8 then write(f,'Unbekannt')          // PICCREDIT
    else if i=9 then begin                             // PICSMALL
      s:=ExtractFileName(opt.r.Bild[a]);
      if s<>'' then s:=Opt.R.RemotePicSmallDir+s;
      write(f,s);
    end;
    write(f,']]>');                                   // END CDATA
    endel(opt.r.ElementName[i]);
  end;
  endel(Opt.r.Groupname);
  endel(opt.r.DocumentName);
  CloseFile(f);
end;
//------------------------------------------------------------------------------
//              optionen
//------------------------------------------------------------------------------
procedure TForm1.OptionenExecute(Sender: TObject);
var a:ArticleType;
begin
  with  Opt do begin
    Caption:=Title+Version;
    Top         := top;
    Left        := Left;
    Width       := width;
    Height      := Height;
    Edit1.Text  := Opt.R.HTMLPrefix;
    Edit2.Text  := Opt.R.HTMLSuffix;
    Edit3.Text  := Opt.R.Internetsite;
    Edit4.Text  := Opt.R.Ftpuser;
    Edit5.Text  := Opt.R.Ftppassword;
    Edit6.text  := Opt.r.LocalDir;
    Edit7.Text  := Opt.R.remoteDir;
    Edit8.Text  := Opt.R.Overhead;
    Etag1.Text  := XMLTags[1];
    Etag2.Text  := XMLTags[2];
    Etag3.Text  := XMLTags[3];
    Etag4.Text  := XMLTags[4];
    Etag5.Text  := XMLTags[5];
    Etag6.Text  := XMLTags[6];
    Etag7.Text  := XMLTags[7];
    Etag8.Text  := XMLTags[8];
    Etag9.Text  := XMLTags[9];
    Etag1.Enabled := false;
    Etag2.Enabled := false;
    Etag3.Enabled := false;
    Etag4.Enabled := false;
    Etag5.Enabled := false;
    Etag6.Enabled := false;
    Etag7.Enabled := false;
    Etag8.Enabled := false;
    Etag9.Enabled := false;
    try
      ShowModal
    except
      On E:Exception do error(em+92,'Fehler beim �ffnen, '+E.Message);
    end;
    // set libs
    StrPCopy(Opt.R.HTMLPrefix,Edit1.Text);
    StrPCopy(Opt.R.HTMLSuffix,Edit2.Text);
    Opt.R.Internetsite := Edit3.Text;
    Opt.R.Ftpuser      := Edit4.Text;
    Opt.R.Ftppassword  := Edit5.Text;
    Opt.r.LocalDir     := Edit6.text;
    Opt.R.remoteDir    := Edit7.Text;
    Opt.R.Overhead     := Edit8.Text;
    Opt.r.LocalDir:=Stringreplace(Opt.r.LocalDir,'\','/',[rfReplaceAll]);
    Opt.r.RemoteDir:=Stringreplace(Opt.r.RemoteDir,'\','/',[rfReplaceAll]);
    for a:=Angebote to Empfehlung do
      SaveArticle(a);
  end
end;
//------------------------------------------------------------------------------
//            get image
//------------------------------------------------------------------------------
function TForm1.LoadImage(s:string;a:ArticleType):boolean;
var ll:longint;ok:boolean;TG:TGIFImage;
begin
ok:=false;
if S<>'' then begin
   S:=Stringreplace(S,'/','\',[rfReplaceAll]);
   if FileExists(s) then begin
     ll:=getFileLength(S);
     if (ExtractFileExt(s)='.gif') then begin
       TG:=TGIFImage.Create;
       TG.LoadFromFile(s);
       Artikelbild.Picture.Bitmap:=TG.Bitmap
     end else
       Artikelbild.Picture.LoadFromFile(Trim(S));
     StatusBar1.Font.Color:=clBlue;
     StatusBar1.SimpleText:='Bildgr��e='+IntToStr(ll div 1024)+'k';
     AktBild:=S;AktBildSize:=LL;
     ok:=true
   end else Artikelbild.Picture:=nil
end else if a<=Empfehlung then begin
   S:=opt.r.bild[a];
   if FileExists(s) then begin
     ll:=getFileLength(S);
     if  ll<50000 then begin
       Artikelbild.Picture.LoadFromFile(Trim(S));
       StatusBar1.Font.Color:=clWindowText;
       if ll<25000 then StatusBar1.Font.Color:=clWindowText
       else             StatusBar1.Font.Color:=clRed;
       StatusBar1.Font.Color:=clBlue;
       StatusBar1.SimpleText:='Bildgr��e='+IntToStr(ll div 1024)+'k';
       AktBild:=S;AktBildSize:=LL;
       ok:=true
     end else begin
       showmessage('Datei ist zu gro� ('+IntToStr(ll div 1024)+'k) f�r das Internet');
       ok:=false
     end
   end else begin
     Artikelbild.Picture:=nil;
     ok:=false
   end
end;
LoadImage:=ok
end;
//------------------------------------------------------------------------------
//            bild click
//------------------------------------------------------------------------------
procedure TForm1.ArtikelbildDblClick(Sender: TObject);
var OpenDialog: TOpenDialog;S:String;i:integer;ok:boolean;
var lo:boolean;
begin
if (opt.r.ActualArticle<=Empfehlung) then begin
   lo:=false;
   if AktBild<>'' then begin
     if Application.MessageBox('Bild l�schen?','Autor Nachfrage',MB_YESNO)=IDYES then begin
        AktBild:='';
        Artikelbild.Picture:=nil;
        opt.r.Bild[opt.r.ActualArticle]:='';
        lo:=true;
     end;
   end;
   if not lo then begin
     OpenDialog              := TOpenDialog.Create(Self);
     if opt.r.Bild[opt.r.ActualArticle]<>'' then
       OpenDialog.InitialDir := ExtractFileDir(Opt.R.Bild[Opt.r.ActualArticle])
     else
       Opendialog.InitialDir:=ExtractFilePath(OptionsFilename(Title))+picsmalldir;
     OpenDialog.Options      := [ofReadOnly, ofFileMustExist];
     OpenDialog.Filter       := '';
     S:='';for i:=0 to Length(Filters)-1 do begin
       OpenDialog.Filter  := OpenDialog.Filter+S+Filters[i];
       S:='|';
     end;
     ok:=false;
     while not ok and OpenDialog.Execute do begin
       ok:=LoadImage(OpenDialog.FileName,Opt.r.ActualArticle);
     end;
     if ok then opt.r.Bild[opt.r.ActualArticle]:=trim(OpenDialog.FileName)
     else       opt.r.Bild[opt.r.ActualArticle]:='';
     OpenDialog.Destroy;
   end
end;
end;
//------------------------------------------------------------------------------
//              image info
//------------------------------------------------------------------------------
procedure TForm1.ArtikelbildMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   StatusBar1.Font.Color:=clBlack;
   StatusBar1.SimpleText:='Bildgr��e='+IntToStr(AktBildSize div 1024)+'k';
end;
//------------------------------------------------------------------------------
//              text info
//------------------------------------------------------------------------------
procedure TForm1.ArtikeltextMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   StatusBar1.Font.Color:=clBlack;
   StatusBar1.SimpleText:='Anzahl Textzeilen='+IntToStr(Artikeltext.Lines.count);
end;
//------------------------------------------------------------------------------
//              comobobx change
//------------------------------------------------------------------------------
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  if (Opt.r.ActualArticle<=Empfehlung)
  and ((length(Artikeltext.lines.Text)<5) or (Artikelbild.Picture=nil)) then begin
    ShowMessage('Es wurde kein Text eingegeben...');
    ComboBox1.ItemIndex:=Ord(Opt.r.ActualArticle)
  end else begin
    SaveArticle(Opt.r.ActualArticle);
    LoadArticle(Articletype(ComboBox1.ItemIndex));
  end;
  Opt.r.ActualArticle:=ArticleType(ComboBox1.ItemIndex);
checklicense()
end;
//------------------------------------------------------------------------------
//           file open
//------------------------------------------------------------------------------
procedure TForm1.FileOpen1Accept(Sender: TObject);
begin
  Artikeltext.Lines.LoadFromFile(FileOpen1.Dialog.FileName);
end;
//------------------------------------------------------------------------------
//           file save as
//------------------------------------------------------------------------------
procedure TForm1.FileSaveAs1Accept(Sender: TObject);
begin
  Artikeltext.Lines.SaveToFile(FileSaveAs1.Dialog.FileName);
end;
//------------------------------------------------------------------------------
//          action manager
//------------------------------------------------------------------------------
procedure TForm1.HilfeExecute(Sender: TObject);
begin
  WinHelp(0,PChar(Application.helpfile),HELP_CONTENTS,0);
end;
//------------------------------------------------------------------------------
//         action manager
//------------------------------------------------------------------------------
procedure TForm1.ActionManager1StateChange(Sender: TObject);
begin
  Artikeltext.ReadOnly := ActionManager1.State <> asNormal;
end;
//------------------------------------------------------------------------------
//         action manager
//------------------------------------------------------------------------------
procedure TForm1.StdStyleActnExecute(Sender: TObject);
begin
  ActionManager1.Style := StandardStyle;
end;
//------------------------------------------------------------------------------
//         support click
//------------------------------------------------------------------------------
procedure TForm1.SupportExecute(Sender: TObject);
var Site,Count:String;
begin
  Count:=InttoStr(SysLocale.PriLangID);
  Site:= 'http://www.cococo.de/index.jsp?content=autor&country='+Count;
  ShellExecute(Handle, 'open',PChar(Site),nil,nil, SW_SHOWNORMAL);
end;
//------------------------------------------------------------------------------
//          action manager
//------------------------------------------------------------------------------
procedure TForm1.XPStyleActnExecute(Sender: TObject);
begin
  ActionManager1.Style := XPStyle;
end;
//------------------------------------------------------------------------------
//          resize
//------------------------------------------------------------------------------
procedure TForm1.FormResize(Sender: TObject);
begin
  Opt.r.Horsplitter:=Height div 3;
  Opt.r.VerSplitter:=Width div 3;
  Artikeltext.Height:=height-Opt.r.Horsplitter;
  Artikeltext.Width:=Width-Opt.r.VerSplitter;
  Artikelbild.Height:=Opt.r.Horsplitter;
  Artikelbild.Width:=Opt.r.VerSplitter;
  checklicense()
end;
//------------------------------------------------------------------------------
//          close
//------------------------------------------------------------------------------
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if WebBrowser1.Visible then begin
    Opt.r.BWidth:=Width;
    Opt.r.BHeight:=height
  end else begin
    Opt.r.Width:=Width;
    Opt.r.Height:=height
  end;
  if not WebBrowser1.Visible then begin
    Opt.r.top:=Top;
    opt.r.Left:=Left;
  end;
  if Opt.r.ActualArticle <= Empfehlung then begin
    SaveRtfArticle(opt.r.ActualArticle);
    SaveXMLArticle(opt.r.ActualArticle)
  end;
  Opt.r.Horsplitter:=HorizontalSplitter.top;
  Opt.r.VerSplitter:=VerticalSplitter.Left;
  SaveArticle(Opt.r.ActualArticle);
  checklicense()
end;
//------------------------------------------------------------------------------
//         action manager
//------------------------------------------------------------------------------
procedure TForm1.ShadowActnExecute(Sender: TObject);
begin
  ActionMainMenuBar1.Shadows := ShadowActn.Checked;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
end.

quality92%

¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.22Bemerkung: (vorverarbeitet) ¤

*Bot Zugriff

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.