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.
¤ Dauer der Verarbeitung: 0.16 Sekunden
(vorverarbeitet)
¤
|
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.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
