frambrwz.pas

来自「查看html文件的控件」· PAS 代码 · 共 2,106 行 · 第 1/5 页

inherited Destroy;
end;

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

{----------------TbrSubFrameSet.DoAttributes}
procedure TbrSubFrameSet.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;

{----------------TbrSubFrameSet.LoadBrzFiles}
procedure TbrSubFrameSet.LoadBrzFiles;
var
  I: integer;
  Item: TbrFrameBase;
begin
for I := 0 to List.Count-1 do
  begin
  Item := TbrFrameBase(List.Items[I]);
  Item.LoadBrzFiles;
  end;
end;

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

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

{----------------TbrSubFrameSet.EndFrameSet}
procedure TbrSubFrameSet.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;

{----------------TbrSubFrameSet.InitializeDimensions}
procedure TbrSubFrameSet.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
    TbrFrameBase(List.Items[I]).InitializeDimensions(X, Y+Sum, Wid, DimF[I+1])
  else
    TbrFrameBase(List.Items[I]).InitializeDimensions(X+Sum, Y, DimF[I+1], Ht);
  Sum := Sum+DimF[I+1];
  end;
end;

{----------------TbrSubFrameSet.CalcSizes}
{OnResize event comes here}
procedure TbrSubFrameSet.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
      TbrFrameBase(List.Items[I]).SetBounds(ARect.Left, ARect.Top+Sum, ARect.Right-ARect.Left, Step)
    else
      TbrFrameBase(List.Items[I]).SetBounds(ARect.Left+Sum, ARect.Top, Step, ARect.Bottom-Arect.Top);
    Sum := Sum+Step;
    Lines[I+1] := Sum;
    end;
  end;
end;

{----------------TbrSubFrameSet.NearBoundary}
function TbrSubFrameSet.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;

{----------------TbrSubFrameSet.GetRect}
function TbrSubFrameSet.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;

{----------------TbrSubFrameSet.FVMouseDown}
procedure TbrSubFrameSet.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 TbrFrameBase then
    (Parent as TbrFrameBase).FVMouseDown(Sender, Button, Shift, X+Left, Y+Top)
  else
    Exit;
  end
else
  begin
  ACursor := (Sender as TbrFrameBase).Cursor;
  if (ACursor = crVSplit) or(ACursor = crHSplit) then
    begin
    MasterSet.HotSet := Self;
    with RP do
      begin   {restrict cursor to lines on both sides}
      if Rows then
        R := Rect(0, Lines[LineIndex-1]+1, ClientWidth, Lines[LineIndex+1]-1)
      else
        R := Rect(Lines[LineIndex-1]+1, 0, Lines[LineIndex+1]-1, ClientHeight);
      P1 := ClientToScreen(P1);
      P2 := ClientToScreen(P2);
      ClipCursor(@R);
      end;
    DrawRect(GetRect);
    end;
  end;
end;

{----------------TbrSubFrameSet.FindLineAndCursor}
procedure TbrSubFrameSet.FindLineAndCursor(Sender: TObject; X, Y: integer);
var
  ACursor: TCursor;
  Gap, ThisGap, Line, I: integer;
begin
if  not Assigned(MasterSet.HotSet) then
  begin  {here we change the cursor as mouse moves over lines,button up or down}
  if Rows then Line := Y else Line := X;
  Gap := 9999;
  for I := 1 to DimCount-1 do
    begin
    ThisGap := Line-Lines[I];
    if Abs(ThisGap) < Abs(Gap) then
      begin
      Gap := Line - Lines[I];
      LineIndex := I;
      end
    else if Abs(ThisGap) = Abs(Gap) then  {happens if 2 lines in same spot}
      if ThisGap >= 0 then  {if Pos, pick the one on right (bottom)}
        LineIndex := I;
    end;

  if (Abs(Gap) <= 4) and not Fixed[LineIndex] then
    begin
    if Rows then
      ACursor := crVSplit
    else ACursor := crHSplit;
    (Sender as TbrFrameBase).Cursor := ACursor;
    end
  else (Sender as TbrFrameBase).Cursor := MasterSet.FrameViewer.Cursor;
  end
else
  with TbrSubFrameSet(MasterSet.HotSet) do
    begin
    DrawRect(OldRect);
    DrawRect(GetRect);
    end;
end;

{----------------TbrSubFrameSet.FVMouseMove}
procedure TbrSubFrameSet.FVMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if NearBoundary(X, Y) then
  (Parent as TbrFrameBase).FVMouseMove(Sender, Shift, X+Left, Y+Top)
else
  FindLineAndCursor(Sender, X, Y);
end;

{----------------TbrSubFrameSet.FVMouseUp}
procedure TbrSubFrameSet.FVMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
var
  I: integer;
begin
if Button <> mbLeft then Exit;
if MasterSet.HotSet = Self then
    begin
    MasterSet.HotSet := Nil;
    DrawRect(OldRect);
    ClipCursor(Nil);
    if Rows then
      Lines[LineIndex] := Y else Lines[LineIndex] := X;
    for I := 1 to DimCount do
      if I = 1 then DimF[1] := MulDiv(Lines[1], DimFTot, Lines[DimCount])
      else DimF[I] := MulDiv((Lines[I] - Lines[I-1]), DimFTot, Lines[DimCount]);
    CalcSizes(Self);
    Invalidate;           
    end
else if (Parent is TbrFrameBase) then  
  (Parent as TbrFrameBase).FVMouseUp(Sender, Button, Shift, X+Left, Y+Top);
end;

{----------------TbrSubFrameSet.CheckNoResize}
function TbrSubFrameSet.CheckNoResize(var Lower, Upper: boolean): boolean;
var
  Lw, Up: boolean;
  I: integer;
begin
Result := False; Lower := False;  Upper := False;
for I := 0 to List.Count-1 do