framview.pas

查看html文件的控件

ParentColor := True;
end;

{----------------TSubFrameSet.ClearFrameNames}
procedure TSubFrameSet.ClearFrameNames;
var
  I, J: integer;
begin
for J := 0 to List.Count-1 do
  if (TFrameBase(List[J]) is TfvFrame) then
    begin   
    with TfvFrame(List[J]) do
      if Assigned(MasterSet) and (WinName <> '')
            and Assigned(MasterSet.FrameNames)
              and MasterSet.FrameNames.Find(WinName, I) then
                MasterSet.FrameNames.Delete(I);
    end
  else if (TFrameBase(List[J]) is TSubFrameSet) then
    TSubFrameSet(List[J]).ClearFrameNames;
end;

{----------------TSubFrameSet.AddFrameNames}
procedure TSubFrameSet.AddFrameNames;         
var
  J: integer;
  Frame: TfvFrame;
begin
for J := 0 to List.Count-1 do
  if (TFrameBase(List[J]) is TfvFrame) then
    begin
    Frame := TfvFrame(List[J]);
    with Frame do
      if Assigned(MasterSet) and (WinName <> '')
            and Assigned(MasterSet.FrameNames) then
              begin
              MasterSet.FrameNames.AddObject(Uppercase(WinName), Frame);
              end;
    end
  else if (TFrameBase(List[J]) is TSubFrameSet) then
    TSubFrameSet(List[J]).AddFrameNames;
end;

{----------------TSubFrameSet.Destroy}
destructor TSubFrameSet.Destroy;
begin
List.Free;
List := Nil;
RefreshTimer.Free;
inherited Destroy;
end;

{----------------TSubFrameSet.AddFrame}
function TSubFrameSet.AddFrame(Attr: TAttributeList; const FName: string): TfvFrame;
{called by the parser when <Frame> is encountered within the <Frameset>
 definition}
begin
Result := TfvFrame.CreateIt(Self, Attr, MasterSet, ExtractFilePath(FName));
List.Add(Result);
Result.SetBounds(OuterBorder, OuterBorder, Width-2*OuterBorder, Height-2*OuterBorder);  
InsertControl(Result);
end;

{----------------TSubFrameSet.DoAttributes}
procedure TSubFrameSet.DoAttributes(L: TAttributeList);
{called by the parser to process the <Frameset> attributes}
var
  T: TAttribute;
  S: string;
  Numb: string[20];

  procedure GetDims;
  const
    EOL = ^M;
  var
    Ch: char;
    I, N: integer;

    procedure GetCh;
    begin
    if I > Length(S) then Ch := EOL
    else
      begin
      Ch := S[I];
      Inc(I);
      end;
    end;

  begin
  if Name = '' then S := T.Name
  else Exit;
  I := 1;   DimCount := 0;
  repeat
    Inc(DimCount);
    Numb := '';
    GetCh;
    while not (Ch in ['0'..'9', '*', EOL, ',']) do GetCh;
    if Ch in ['0'..'9'] then
      begin
      while Ch in ['0'..'9'] do
        begin
        Numb := Numb+Ch;
        GetCh;
        end;
      N := IntMax(1, StrToInt(Numb));   {no zeros}
      while not (Ch in ['*', '%', ',', EOL]) do GetCh;
      if ch = '*' then
        begin
        Dim[DimCount] := -IntMin(99, N);{store '*' relatives as negative, -1..-99}
        GetCh;
        end
      else if Ch = '%' then
        begin  {%'s stored as -(100 + %),  i.e. -110 is 10% }
        Dim[DimCount] := -IntMin(1000, N+100);  {limit to 900%}
        GetCh;
        end
      else Dim[DimCount] := IntMin(N, 5000);  {limit absolute to 5000}
      end
    else if Ch in ['*', ',', EOL] then
      begin
      Dim[DimCount] := -1;
      if Ch = '*' then GetCh;
      end;
    while not (Ch in [',', EOL]) do GetCh;
  until (Ch = EOL) or (DimCount = 20);
  end;

begin
{read the row or column widths into the Dim array}
If L.Find(RowsSy, T) then
  begin
  Rows := True;
  GetDims;
  end;
if L.Find(ColsSy, T) and (DimCount <=1) then
  begin
  Rows := False;
  DimCount := 0;
  GetDims;
  end;
if (Self = MasterSet) and not (fvNoBorder in MasterSet.FrameViewer.FOptions) then
                               {BorderSize already defined as 0}  
  if L.Find(BorderSy, T) or L.Find(FrameBorderSy, T)then
    begin
    BorderSize := T.Value;
    OuterBorder := IntMax(2-BorderSize, 0);
    if OuterBorder >= 1 then
      begin
      BevelWidth := OuterBorder;
      BevelOuter := bvLowered;        
      end; 
    end
  else BorderSize := 2;  
end;

{----------------TSubFrameSet.LoadFiles}
procedure TSubFrameSet.LoadFiles;
var
  I: integer;
  Item: TFrameBase;
begin
for I := 0 to List.Count-1 do
  begin
  Item := TFrameBase(List.Items[I]);
  Item.LoadFiles(Nil);
  end;
end;

{----------------TSubFrameSet.ReloadFiles}
procedure TSubFrameSet.ReloadFiles(APosition: integer);
var
  I: integer;
  Item: TFrameBase;
begin
for I := 0 to List.Count-1 do
  begin
  Item := TFrameBase(List.Items[I]);
  Item.ReloadFiles(APosition);
  end;
if (FRefreshDelay > 0) and Assigned(RefreshTimer) then
  SetRefreshTimer;
Unloaded := False;
end;

{----------------TSubFrameSet.UnloadFiles}
procedure TSubFrameSet.UnloadFiles;
var
  I: integer;
  Item: TFrameBase;
begin
if Assigned(RefreshTimer) then
  RefreshTimer.Enabled := False;
for I := 0 to List.Count-1 do
  begin
  Item := TFrameBase(List.Items[I]);
  Item.UnloadFiles;
  end;
if Assigned(MasterSet.FrameViewer.FOnSoundRequest) then
  MasterSet.FrameViewer.FOnSoundRequest(MasterSet, '', 0, True);
Unloaded := True;
end;

{----------------TSubFrameSet.EndFrameSet}
procedure TSubFrameSet.EndFrameSet;
{called by the parser when </FrameSet> is encountered}
var
  I: integer;
begin
if List.Count > DimCount then  {a value left out}
  begin  {fill in any blanks in Dim array}
  for I := DimCount+1 to List.Count do
    begin
    Dim[I] := -1;      {1 relative unit}
    Inc(DimCount);
    end;
  end
else while DimCount > List.Count do  {or add Frames if more Dims than Count}
  AddFrame(Nil, '');
if ReadHTML.Base <> '' then      
  FBase := ReadHTML.Base
else FBase := MasterSet.FrameViewer.FBaseEx;
FBaseTarget := ReadHTML.BaseTarget;
end;

{----------------TSubFrameSet.InitializeDimensions}
procedure TSubFrameSet.InitializeDimensions(X, Y, Wid, Ht: integer);
var
  I, Total, PixTot, PctTot, RelTot, Rel, Sum,
  Remainder, PixDesired, PixActual: integer;

begin
if Rows then
  Total := Ht
else Total := Wid;
PixTot := 0;  RelTot := 0;  PctTot := 0; DimFTot := 0;
for I := 1 to DimCount do   {count up the total pixels, %'s and relatives}
  if Dim[I] >= 0 then
    PixTot := PixTot + Dim[I]
  else if Dim[I] <= -100 then
    PctTot :=  PctTot + (-Dim[I]-100)
  else RelTot := RelTot - Dim[I];
Remainder := Total - PixTot;
if Remainder <= 0 then
  begin    {% and Relative are 0, must scale absolutes}
  for I := 1 to DimCount do
    begin
    if Dim[I] >= 0 then
      DimF[I] := MulDiv(Dim[I], Total, PixTot)  {reduce to fit}
    else DimF[I] := 0;
    Inc(DimFTot, DimF[I]);
    end;
  end
else    {some remainder left for % and relative}
  begin
  PixDesired := MulDiv(Total, PctTot, 100);
  if PixDesired > Remainder then
    PixActual := Remainder
  else PixActual := PixDesired;
  Dec(Remainder, PixActual);   {Remainder will be >= 0}
  if RelTot > 0 then
    Rel := Remainder div RelTot  {calc each relative unit}
  else Rel := 0;
  for I := 1 to DimCount do  {calc the actual pixel widths (heights) in DimF}
    begin
    if Dim[I] >= 0 then
      DimF[I] := Dim[I]
    else if Dim[I] <= -100 then
      DimF[I] := MulDiv(-Dim[I]-100, PixActual, PctTot)
    else DimF[I] := -Dim[I] * Rel;
    Inc(DimFTot, DimF[I]);
    end;
  end;

Sum := 0;
for I := 0 to List.Count-1 do  {intialize the dimensions of contained items}
  begin
  if Rows then
    TFrameBase(List.Items[I]).InitializeDimensions(X, Y+Sum, Wid, DimF[I+1])
  else
    TFrameBase(List.Items[I]).InitializeDimensions(X+Sum, Y, DimF[I+1], Ht);
  Sum := Sum+DimF[I+1];
  end;
end;

{----------------TSubFrameSet.CalcSizes}
{OnResize event comes here}
procedure TSubFrameSet.CalcSizes(Sender: TObject);
var
  I, Step, Sum, ThisTotal: integer;
  ARect: TRect;
begin
{Note: this method gets called during Destroy as it's in the OnResize event.
 Hence List may be Nil.}
if Assigned(List) and (List.Count > 0) then
  begin
  ARect := ClientRect;
  InflateRect(ARect, -OuterBorder, -OuterBorder);      
  Sum := 0;
  if Rows then ThisTotal := ARect.Bottom - ARect.Top
  else ThisTotal := ARect.Right-ARect.Left;
  for I := 0 to List.Count-1 do
    begin
    Step := MulDiv(DimF[I+1], ThisTotal, DimFTot);
    if Rows then
      TFrameBase(List.Items[I]).SetBounds(ARect.Left, ARect.Top+Sum, ARect.Right-ARect.Left, Step)
    else
      TFrameBase(List.Items[I]).SetBounds(ARect.Left+Sum, ARect.Top, Step, ARect.Bottom-Arect.Top);
    Sum := Sum+Step;
    Lines[I+1] := Sum;
    end;
  end;
end;

{----------------TSubFrameSet.NearBoundary}
function TSubFrameSet.NearBoundary(X, Y: integer): boolean;
begin
Result := (Abs(X) < 4) or (Abs(X - Width) < 4) or
             (Abs(Y) < 4) or (Abs(Y-Height) < 4);
end;

{----------------TSubFrameSet.GetRect}
function TSubFrameSet.GetRect: TRect;
{finds the FocusRect to draw when draging boundaries}
var
  Pt, Pt1, Pt2: TPoint;
begin
Pt1 := Point(0, 0);
Pt1 := ClientToScreen(Pt1);
Pt2 := Point(ClientWidth, ClientHeight);
Pt2 := ClientToScreen(Pt2);
GetCursorPos(Pt);
if Rows then
  Result := Rect(Pt1.X, Pt.Y-1, Pt2.X, Pt.Y+1)
else
  Result := Rect(Pt.X-1, Pt1.Y, Pt.X+1, Pt2.Y);
OldRect := Result;
end;

{----------------DrawRect}
procedure DrawRect(ARect: TRect);
{Draws a Focus Rect}
var
  DC: HDC;
begin
DC := GetDC(0);
DrawFocusRect(DC, ARect);
ReleaseDC(0, DC);
end;

{----------------TSubFrameSet.FVMouseDown}
procedure TSubFrameSet.FVMouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
var
  ACursor: TCursor;
  RP: record
      case boolean of
        True: (P1, P2: TPoint);
        False:(R: TRect);
        end;
begin
if Button <> mbLeft then Exit;
if NearBoundary(X, Y) then
  begin
  if Parent is TFrameBase then
    (Parent as TFrameBase).FVMouseDown(Sender, Button, Shift, X+Left, Y+Top)
  else
    Exit;
  end
else
  begin
  ACursor := (Sender as TFrameBase).Cursor;
  if (ACursor = crVSplit) or(ACursor = crHSplit) then
    begin
    MasterSet.HotSet := Self;
    with RP do
      begin   {rest