un_css.~pas

realworld source code

unit UN_CSS;

interface
uses
 Classes,SysUtils,Forms,XMLDoc,xmldom, XMLIntf, msxmldom,Variants,
 Dialogs,windows,CommCtrl,StdCtrls,Graphics,Messages;
    procedure SaveTempHTML(A1:TstringList;B1:TstringList;C1:TstringList;D1:TstringList;TitleName:string;Counts:integer);
    procedure SaveTempHTML2(A2:TstringList;B2:TstringList;C2:TstringList;D2:TstringList;TitleName2:string;Counts2:integer);
    procedure SaveTempHTML3(A3:TstringList;B3:TstringList;C3:TstringList;D3:TstringList;TitleName3:string;Counts3:integer);
    procedure SaveTempHTML4(A4:TstringList;B4:TstringList;C4:TstringList;D4:TstringList;TitleName4:string;Counts4:integer);
    procedure SaveTempHTML5(A5:TstringList;B5:TstringList;C5:TstringList;D5:TstringList;TitleName5:string;Counts5:integer);
    procedure SaveTempHTML6(A6:TstringList;B6:TstringList;C6:TstringList;D6:TstringList;TitleName6:string;Counts6:integer);
    procedure SaveTempHTML7(A7:TstringList;B7:TstringList;C7:TstringList;D7:TstringList;TitleName7:string;Counts7:integer);
    procedure SaveTempHTML8(A8:TstringList;B8:TstringList;C8:TstringList;D8:TstringList;TitleName8:string;Counts8:integer);
    procedure SaveTempHTML9(A9:TstringList;B9:TstringList;C9:TstringList;D9:TstringList;TitleName9:string;Counts9:integer);
    procedure SaveTempHTML10(A10:TstringList;B10:TstringList;C10:TstringList;D10:TstringList;TitleName10:string;Counts10:integer);
    procedure CSSMenu();
    procedure CreateToolTips(hWnd: Cardinal);
    procedure AddToolTip(hwnd: dword; lpti: PToolInfo; IconType: Integer; Text, Title: PChar;
              BackColor,TextColor:TColor);
    function RStringList1(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
    function RStringList2(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
    function RStringList3(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
    function RStringList4(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
    function RStringList5(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
    function CutString(sLine:string):String;
const
 TTS_BALLOON    = $40;
 TTM_SETTITLE = (WM_USER + 32);
var
 hTooltip: Cardinal;
 ti: TToolInfo;
 buffer : array[0..255] of char;
implementation
uses
 FM_RSS;
function CutString(sLine:string):String;
Var
 sCuted{ 按固定长度分割出来的部分字符串 },Lines: string;
 iCutLength{ 按固定长度分割出来的部分字符串的长度 },j,CutLengthOfLine: integer;
 bIsDBCS{ 是否是汉字的前半字节 }: boolean;
begin
 CutLengthOfLine:=13;
 Lines:=sLine;
 if Length(Lines)=0 then
 else
 // repeat //开始处理字符串
   iCutLength := CutLengthOfLine;
   sCuted := Copy(Lines, 1, iCutLength);//从头取出 iCutLength 长的字符串
   bIsDBCS := False;//先假设没有半个字符串
   for j := 1 to iCutLength do //从头到尾逐个检查
    begin
     if bIsDBCS then  //如果上一个字节是汉字的前半部分
      bIsDBCS := False //则此时本字节是汉字的后半部分，    //所以将是否前半个汉字检测标志设为假
     else
      if Windows.IsDBCSLeadByte(byte(sCuted[j])) then
         bIsDBCS := True;//否则检查本字节，并根据结果设置标志
    end;  //end of for
      if bIsDBCS then
        Dec(iCutLength);
    Result:=Copy(Lines,1,iCutLength);
   // Lines:= Copy(Lines, 1, Length(Lines) - iCutLength);
   // until Length(Lines) <= 0;

end;
function RStringList1(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
begin
try
 if LowerCase(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeName)='title' then
    begin
     if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Count<>0 then
      begin
       if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue=null then
           TitleName1.Add(' ')
       else
           TitleName1.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue);
      end
     else
      begin
       if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue=null then
           TitleName1.Add(' ')
       else
           TitleName1.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue);
      end;
    end;
except
 TitleName1.Add(' ');
end;
 Result:=TitleName1;
end;
function RStringList2(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
begin
try
   if LowerCase(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeName)='pubdate' then
    begin
     if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Count<>0 then
      begin
       if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue=null then
           TitleName2.Add(' ')
       else
           TitleName2.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue);
      end
     else
      begin
       if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue=null then
           TitleName2.Add(' ')
       else
           TitleName2.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue);
       end ;
     end;
except
 TitleName2.Add(' ');
end;
 Result:=TitleName2;
end;
function RStringList3(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
begin
try
      if LowerCase(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeName)='link' then
         begin
          if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Count<>0 then
            begin
             if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue=null then
                TitleName3.Add(' ')
             else
                TitleName3.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue);
             end
          else
            begin
             if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue=null then
                TitleName3.Add(' ')
             else
                TitleName3.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue);
            end ;
         end;
except
 TitleName3.Add(' ');
end;
 Result:=TitleName3;
end;
function RStringList4(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
begin
try
 if LowerCase(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeName)='description' then
         begin
          if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Count<>0 then
            begin
             if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue=null then
                TitleName4.Add(' ')
             else
                TitleName4.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].ChildNodes.Nodes[0].NodeValue);
             end
          else
            begin
             if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue=null then
                TitleName4.Add(' ')
             else
                TitleName4.Add(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue);
             end ;
        end;
except
TitleName4.Add(' ');
end;
 Result:=TitleName4;
end;
function RStringList5(XMLNode:IXMLNode;inode:integer;jnode:integer;SList:TStringList):TStringList;
begin
try
 if LowerCase(XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeName)='read' then
  if XMLNode.ChildNodes.Nodes[inode].ChildNodes.Nodes[jnode].NodeValue='Y' then
     TitleName5.Add('Y')
  else
     TitleName5.Add('N');
except
 TitleName5.Add('N');
end;
 Result:=TitleName5;
end;
procedure CSSMenu();
begin
 if FMRSS.N11.Checked Then
   SaveTempHTML(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N12.Checked then
   SaveTempHTML2(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N13.Checked then
   SaveTempHTML3(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 If FMRSS.n14.Checked then
   SaveTempHTML4(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N15.Checked then
   SaveTempHTML5(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N16.Checked then
   SaveTempHTML6(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N17.Checked then
   SaveTempHTML7(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N18.Checked then
   SaveTempHTML8(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N19.Checked then
   SaveTempHTML9(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
 if FMRSS.N20.Checked then
   SaveTempHTML10(TitleName1,TitleName2,TitleName4,TitleName3,T_Name,Cou);
end;
procedure SaveTempHTML(A1, B1, C1, D1: TstringList;TitleName:string;Counts:integer);
var
 SHtmlFile:TStringList;
 i:integer;
begin
 SHtmlFile:=TStringList.Create ;
 SHtmlFile.Clear;
 SHtmlFile.Add('<html><head><title>频道简报列表</title><meta http-equiv="Content-Type" content="text/html; charset=gb2312">');
 SHtmlFile.Add('<style type="text/css">');
 SHtmlFile.Add('       td,p,li,input,select,div,span {font-size:12px;}');
 SHtmlFile.Add('       table,td,img,div,span{border: none;margin: 0px 0px 0px 0px;padding: 0px 0px 0px 0px;}');
 SHtmlFile.Add('       .f10 {font-size: 10px;}');
 SHtmlFile.Add('       .f12 {font-size: 12px;}');
 SHtmlFile.Add('       .f14 {font-size: 14px;}');
 SHtmlFile.Add('       .f16 {font-size: 16px;}');
 SHtmlFile.Add('       .lh17 {line-height:17px;}');
 SHtmlFile.Add('       .lh19 {line-height:19px;}');
 SHtmlFile.Add('       A:link {color:#00f;}');
 SHtmlFile.Add('       A:visited {color:#800080;}');
 SHtmlFile.Add('       A:active {color:#f00;}');
 SHtmlFile.Add('       A:hover {color:#f00;}');
 SHtmlFile.Add('       .tree a:link {text-decoration: none;color:#003398;font-weight: bold;}');
 SHtmlFile.Add('       .tree a:visited {text-decoration: none;color:#003398;font-weight: normal;}');
 SHtmlFile.Add('       .tree a:active,.tree a:hover {text-decoration: none;color:#FD0100;}');
 SHtmlFile.Add('       .tree {color:#222;line-height:19px;width:96%;text-align:left;}');
 SHtmlFile.Add('       .tree #channel{font-size:16px;font-weight:bold;color:#013299;text-align:center;padding:5px 0 10px 0;border-bottom:2px solid #005FA9;clear:both;margin-bottom:8px;margin-top:8px;}');