htmlsbs1.pas

查看html文件的控件

  Save := IMgr.Width;
  IMgr.Width := 32000;
  Result := inherited DrawLogic(Canvas, X, Y, XRef, YRef, AWidth, AHeight, BlHt, IMgr, Dummy, Curs);
  IMgr.Width := Save;
  MinMaxWidth(Canvas, Dummy, MaxWidth);   {return MaxWidth}
  end
else
  begin
  Result := inherited DrawLogic(Canvas, X, Y, XRef, YRef, AWidth, AHeight, BlHt, IMgr, MaxWidth, Curs);    
  end;
end;

destructor TOptionObj.Destroy;
begin
Attributes.Free;
inherited;
end;

function ThtOptionStringList.GetValue(Index: integer): string;
begin
if (Index >= 0) and (Index < Count) then
  Result := TOptionObj(Objects[Index]).Value
else Result := '';
end;

function ThtOptionStringList.GetSelected(Index: integer): boolean;
begin
if (Index >= 0) and (Index < Count) then
  Result := TOptionObj(Objects[Index]).Selected
else Result := False;
end;

procedure ThtOptionStringList.SetSelected(Index: integer; Value: boolean);
begin
if (Index >= 0) and (Index < Count) then
  TOptionObj(Objects[Index]).Selected := Value;
end;

function ThtOptionStringList.GetAttribute(Index: integer; const AttrName: string): string;
begin
if (Index >= 0) and (Index < Count) and Assigned(TOptionObj(Objects[Index]).Attributes) then
  Result := TOptionObj(Objects[Index]).Attributes.Values[AttrName]
else Result := '';
end;

destructor ThtOptionStringList.Destroy;
var
  I: integer;
begin
for I := 0 to Count-1 do
  TOptionObj(Objects[I]).Free;
inherited;
end;

{----------------TListBoxFormControlObj.Create}
constructor TListBoxFormControlObj.Create(AMasterList: TSectionList;
            Position: integer; L: TAttributeList; Prop: TProperties);
var
  T: TAttribute;
  Multiple: boolean;
  PntPanel: TPaintPanel;
  Tmp: TMyFont;
begin
inherited Create(AMasterList, Position, L);
CodePage := Prop.CodePage;
TheOptions := ThtOptionStringList.Create;
Multiple := L.Find(MultipleSy, T);
if L.Find(SizeSy, T) then
  LBSize := T.Value
else LBSize := -1;
Longest := 3;   {the minimum size}
PntPanel := TPaintPanel(AMasterList.PPanel);
FControl := ThtListbox.Create(PntPanel);
with ThtListbox(FControl) do
  begin
  Left := -4000  ;   {so will be invisible until placed}
  Parent := PntPanel;  
  if (Prop.GetBorderStyle <> bssNone) then
    BorderStyle := bsNone;  
  Tmp := Prop.GetFont;
  Font.Assign(Tmp);
  TheFont := Font;
  Tmp.Free;
  MultiSelect := Multiple;
  ExtendedSelect := Multiple;
  OnEnter := EnterEvent;    
  OnExit := ExitEvent;
  {$ifdef OpOnChange}
  OnClick := OptionalOnChange;   
  {$else}
  OnClick := FormControlClick;
  {$endif}
  OnMouseMove := HandleMouseMove;
  Enabled := not Disabled;   
  end;
end;

destructor TListBoxFormControlObj.Destroy;
begin
TheOptions.Free;
inherited Destroy;
end;

procedure TListboxFormControlObj.ProcessProperties(Prop: TProperties);
begin
inherited;
if BkColor <> clNone then
  TListbox(FControl).Color := BkColor;
end;

procedure TListBoxFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer);
var
  H2, I, Addon: integer;
  LB: ThtListbox;
  ARect: TRect;   
begin
LB := FControl as ThtListbox;  {watch it, TListBox has a canvas too}
if LB.BorderStyle <> bsNone then  
  begin
  FormControlRect(Canvas, X1, Y1, X1+LB.Width, Y1+LB.Height, False, MasterList.PrintMonoBlack, False, TListbox(FControl).Color);  
  Addon := 4;
  end
else
  begin
  FillRectWhite(Canvas, X1, Y1, X1+LB.Width, Y1+LB.Height, TListbox(FControl).Color);
  Addon := 2;
  end;

Canvas.Brush.Style := bsClear;
Canvas.Font := LB.Font;
H2 := Abs(Canvas.Font.Height);
SetTextAlign(Canvas.handle, TA_Left+TA_Top);
ARect := Rect(X1+Addon, Y1+Addon, X1+LB.Width-2*Addon, Y1+LB.Height-2*Addon);
if UnicodeControls then
  for I := LB.TopIndex to IntMin(LB.Items.Count-1, LB.TopIndex+LBSize-1) do
    {$Warnings Off}
    ExtTextOutW(Canvas.Handle, X1+Addon, Y1+Addon+(I-LB.TopIndex)*H2, ETO_CLIPPED, @ARect,
       PWideChar(LB.Items[I]), Length(LB.Items[I]), nil)
    {$Warnings On}
else
  for I := LB.TopIndex to IntMin(LB.Items.Count-1, LB.TopIndex+LBSize-1) do
    Canvas.TextRect(ARect, X1+Addon, Y1+Addon+(I-LB.TopIndex)*H2, LB.Items[I]);
end;

procedure TListBoxFormControlObj.AddStr(const WS: WideString; Selected: boolean;
               Attr: TStringList; CodePage: integer);
var
  Opt: TOptionObj;
  DC: HDC;
  OldFont: THandle;
  ExtS: TSize;
  S1, S2: string;
begin
S1 := WideStringToMultibyte(CodePage, WS);  
if S1 = '' then
  S1 := ' ';
Opt := TOptionObj.Create;
if Assigned(Attr) then
  S2 := Attr.Values['Value']
else S2 := '';
if S2 <> '' then
  Opt.Value := S2
else Opt.Value := S1;

Opt.Selected := Selected;
Opt.Attributes := Attr;
TheOptions.AddObject(S1, Opt);

DC := GetDC(0);
OldFont := SelectObject(DC, TheFont.Handle);
GetTextExtentPoint32(DC, PChar(S1), Length(S1), ExtS);
SelectObject(DC, OldFont);
ReleaseDC(0, DC);
Longest := IntMax(Longest, ExtS.cx);
end;

procedure TListBoxFormControlObj.ResetToValue;
var
  I: Integer;
  Tmp: boolean;
begin
with (FControl as ThtListbox) do
  begin
  Items.Clear;  
  for I := 0 to TheOptions.Count-1 do
    begin
    if UnicodeControls then
      Items.Add(MultibyteToWidestring(CodePage, TheOptions[I]))   
    else
      Items.Add(TheOptions[I]);
    Tmp := TheOptions.Selected[I];
    if MultiSelect then
      Selected[I] := Tmp
    else if Tmp then
      ItemIndex := I;
    end;
  if ItemIndex < 0 then
    ItemIndex := 0;
  TopIndex := 0;
  end;
end;

procedure TListBoxFormControlObj.SetHeightWidth(Canvas: TCanvas);
begin
with ThtListbox(FControl) do
  begin
  Canvas.Font := Font;
  if LBSize = -1 then LBSize := IntMax(1, IntMin(8, TheOptions.Count));
  if FHeight >= 10 then
    ClientHeight := FHeight
  else
    ClientHeight := Canvas.TextHeight('A')*LBSize;
  if not PercentWidth then
    if (FWidth >= 10) then    
      Width := FWidth
    else Width := Longest + GetSystemMetrics(sm_cxvscroll) + 10
  else
    begin
    Left := -4000;   {percent width set later}
    Width := 10;
    end;
  end;
end;

function TListBoxFormControlObj.GetSubmission(Index: integer;
              var S: string): boolean;
begin
with (FControl as ThtListbox) do
  if (Index < Items.Count) then
      begin
      Result := True;
      S := '';
      if MultiSelect and Selected[Index] or
                     not MultiSelect and (ItemIndex = Index) then
        begin
        S := Self.FName+'=';
        S := S + TheOptions.Value[Index];  
        end;
    end
  else Result := False;
end;

procedure TListBoxFormControlObj.SaveContents;
{Save the current value to see if it has changed when focus is lost}
var
  I: integer;
begin
with ThtListbox(FControl) do
  begin
  EnterItems := Items.Count;
  for I := 0 to IntMin(Items.Count-1, 50) do
    EnterSelected[I] := Selected[I];
  end;
end;

procedure TListBoxFormControlObj.DoOnChange;
var
  I: integer;
  Changed: boolean;
begin
Changed := False;
with ThtListbox(FControl) do
  begin
  if Items.Count <> EnterItems then
    Changed := True
  else
    for I := 0 to IntMin(Items.Count-1, 50) do
      if EnterSelected[I] <> Selected[I] then
        begin
        Changed := True;
        Break;
        end;
  end;
if Changed then
  if Assigned(MasterList.ObjectChange) then
    MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage);
end;

{$ifdef OpOnChange}
procedure TListBoxFormControlObj.OptionalOnChange(Sender: TObject);     
var
  Pt: TPoint;
begin
DoOnChange;
SaveContents;
if GetCursorPos(Pt) and (WindowFromPoint(Pt) = TheControl.Handle) then
  FormControlClick(Self);
end;
{$endif}

procedure TListBoxFormControlObj.SetData(Index: integer; const V: String);
var
  I: integer;
  LB: ThtListbox;
begin
LB := FControl as ThtListbox;
if Index = 0 then
  LB.ItemIndex := 0;
for I := 0 to TheOptions.Count-1 do
  begin
  if Index = 0 then
    begin
    with LB do
      if MultiSelect then
        Selected[I] := False;
    end;
  if CompareText(V, TheOptions.Value[I]) = 0 then
    begin
    with LB do
      if MultiSelect then
        Selected[I] := True
      else ItemIndex := I;
    end;
  end;
LB.TopIndex := 0;  
end;

{----------------TComboFormControlObj.Create}
constructor TComboFormControlObj.Create(AMasterList: TSectionList;
            Position: integer; L: TAttributeList; Prop: TProperties);  
var
  PntPanel: TPaintPanel;
  Tmp: TMyFont;
begin
inherited Create(AMasterList, Position, L, Prop);
CodePage := Prop.CodePage;   
PntPanel := TPaintPanel(AMasterList.PPanel);
PntPanel.RemoveControl(FControl);
FControl.Free;   {don't want the inherited one}
FControl := ThtCombobox.Create(PntPanel);
with ThtCombobox(FControl) do
  begin
  Left := -4000  ;   {so will be invisible until placed}
  Tmp := Prop.GetFont; 
  Font.Assign(Tmp);
  TheFont := Font;
  Tmp.Free;
  Style := csDropDownList;
  OnEnter := EnterEvent;
  OnExit := ExitEvent;
  {$ifdef OpOnChange}
  OnChange := OptionalOnChange;  
  {$else}
  OnClick := FormControlClick;
  {$endif}
  {$ifdef UseElpack}    {others don't have onmousemove}
    OnMouseMove := HandleMouseMove;   
  {$endif}
  Enabled := not Disabled;   
  end;
FControl.Parent := PntPanel;
end;

procedure TComboFormControlObj.ResetToValue;
var
  I: Integer;
begin
with (FControl as ThtCombobox) do
  begin
  Items.Clear;  
  for I := 0 to TheOptions.Count-1 do
    begin
    if UnicodeControls then
      Items.Add(MultibyteToWideString(CodePage, TheOptions[I]))  
    else
      Items.Add(TheOptions[I]);
    if TheOptions.Selected[I] then
      ItemIndex := I;
    end;
  if ItemIndex < 0 then
    ItemIndex := 0;
  end;