htmlsbs1.pas

查看html文件的控件

end;

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

procedure TComboFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer);
var
  CB: ThtCombobox;
  ARect: TRect;
begin
CB := FControl as ThtCombobox;  {watch it, TComboBox has a canvas too}
FormControlRect(Canvas, X1, Y1, X1+CB.Width, Y1+CB.Height, False, MasterList.PrintMonoBlack, False, TCombobox(FControl).Color);  
Canvas.Brush.Style := bsClear;
Canvas.Font := CB.Font;
SetTextAlign(Canvas.handle, TA_Left+TA_Top);
ARect := Rect(X1+4, Y1+4, X1+CB.Width-8, Y1+CB.Height-3);  
if UnicodeControls then
  {$Warnings Off}
  ExtTextOutW(Canvas.Handle, X1+4, Y1+4, ETO_CLIPPED, @ARect,
     PWideChar(CB.Items[CB.ItemIndex]), Length(CB.Items[CB.ItemIndex]), nil)
  {$Warnings On}
else
  Canvas.TextRect(ARect, X1+4, Y1+4, CB.Items[CB.ItemIndex]);
end;

procedure TComboFormControlObj.SetHeightWidth(ACanvas: TCanvas);
begin
with ThtCombobox(FControl) do
  begin
  if FHeight >= 10 then
    Height := FHeight;
  if not PercentWidth then
    if (FWidth >= 10) and not PercentWidth then   
      Width := FWidth
    else
      ClientWidth := Longest + GetSystemMetrics(sm_cxvscroll) + 10
  else
    begin
    Left := -4000;  {percent width set later}
    Width := 10;
    end;
  end;
end;

function TComboFormControlObj.GetSubmission(Index: integer;
              var S: string): boolean;
begin
if Index = 0 then
  begin
  Result := True;
  with (FControl as ThtCombobox) do
    if (ItemIndex >= 0) and (ItemIndex <= Items.Count) then
      S := Self.FName+'='+TheOptions.Value[ItemIndex];
  end
else Result := False;
end;

procedure TComboFormControlObj.SetData(Index: integer; const V: String);
var
  CB: ThtCombobox;
  I: integer;
begin
CB := FControl as ThtCombobox;
for I := 0 to TheOptions.Count-1 do
  begin
  if CompareText(V, TheOptions.Value[I]) = 0 then
    CB.ItemIndex := I;
  end;
end;

procedure TComboFormControlObj.SaveContents;
{Save the current value to see if it has changed when focus is lost}
begin
EnterIndex := ThtCombobox(FControl).ItemIndex;
end;

{$ifdef OpOnChange}
procedure TComboFormControlObj.OptionalOnChange(Sender: TObject);   
begin
if ThtCombobox(FControl).ItemIndex <> EnterIndex then
  begin
  SaveContents;
  if Assigned(MasterList.ObjectChange) then
    MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage);
  end;
end;
{$endif}

procedure TComboFormControlObj.DoOnChange;
begin
{$ifndef OpOnChange}
if ThtCombobox(FControl).ItemIndex <> EnterIndex then
  if Assigned(MasterList.ObjectChange) then
    MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage);
{$endif}
end;

{----------------TTextAreaFormControlObj.Create}
constructor TTextAreaFormControlObj.Create(AMasterList: TSectionList;
            Position: integer; L: TAttributeList; Prop: TProperties);
var
  PntPanel: TPaintPanel;
  I: integer;
  SB: TScrollStyle;
  Tmp: TMyFont;
begin
inherited Create(AMasterList, Position, L);
CodePage := Prop.CodePage;     
Rows := 5;
Cols := 30;
Wrap := wrSoft;
SB := StdCtrls.ssVertical;

for I := 0 to L.Count-1 do
  with TAttribute(L[I]) do
    case Which of
      RowsSy: Rows := Value;
      ColsSy: Cols := Value;
      WrapSy:
        if (Lowercase(Name) = 'off') then
          begin
          SB := StdCtrls.ssBoth;
          Wrap := wrOff;
          end
        else if (Lowercase(Name) = 'hard') then
          begin
          Wrap := wrHard;
          end;
      end;

PntPanel := TPaintPanel(AMasterList.PPanel);
FControl := ThtMemo.Create(PntPanel);
with ThtMemo(FControl) do
  begin
  Left := -4000  ;   {so will be invisible until placed}
  if (Prop.GetBorderStyle <> bssNone) then
    BorderStyle := bsNone;  
  Tmp := Prop.GetFont;
  Font.Assign(Tmp);
  Tmp.Free;
  ScrollBars := SB;
  Wordwrap := Wrap in [wrSoft, wrHard];
  OnKeyPress := MyForm.ControlKeyPress;
  OnEnter := EnterEvent;
  OnExit := ExitEvent;
  OnClick := FormControlClick;
  OnMouseMove := HandleMouseMove;
  Enabled := not Disabled;
  ReadOnly := Self.Readonly;
  end;
FControl.Parent := PntPanel;
end;

destructor TTextAreaFormControlObj.Destroy;
begin
inherited Destroy;
end;

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

procedure TTextAreaFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer);
var
  H2, I, Addon: integer;
  ARect: TRect;  
begin
with ThtMemo(FControl) do
  begin
  if BorderStyle <> bsNone then  
    begin
    FormControlRect(Canvas, X1, Y1, X1+Width, Y1+Height, False, MasterList.PrintMonoBlack, False, TMemo(FControl).Color);    
    Addon := 4;  
    end
  else
    begin
    FillRectWhite(Canvas, X1, Y1, X1+Width, Y1+Height, TMemo(FControl).Color);
    Addon := 2;
    end;
  Canvas.Brush.Style := bsClear;
  Canvas.Font := Font;
  H2 := Canvas.TextHeight('A');
  SetTextAlign(Canvas.handle, TA_Left+TA_Top);
  ARect := Rect(X1+Addon, Y1+Addon, X1+Width-2*Addon, Y1+Height-2*Addon);
  if UnicodeControls then
    for I := 0 to IntMin(Lines.Count-1, Rows-1) do
      {$Warnings Off}
      ExtTextOutW(Canvas.Handle, X1+Addon, Y1+Addon+I*H2, ETO_CLIPPED, @ARect,
         PWideChar(Lines[I]), Length(Lines[I]), nil)
      {$Warnings On}
  else
    for I := 0 to IntMin(Lines.Count-1, Rows-1) do
      Canvas.TextRect(ARect, X1+Addon, Y1+Addon+I*H2, Lines[I]);
  end;
end;

procedure TTextAreaFormControlObj.SetHeightWidth(Canvas: TCanvas);
begin
with ThtMemo(FControl) do
  begin
  Canvas.Font := Font;
  if FHeight >= 10 then
    Height := FHeight
  else ClientHeight := Canvas.TextHeight('A')*Rows + 5;
  if not PercentWidth then
    begin
    if (FWidth >= 10) then    {percent width set later}
      Width := FWidth
    else ClientWidth := Canvas.TextWidth('s')*Cols + 5;
    end
  else
    begin
    Left := -4000;
    Width := 50;
    end;
  end;
end;

procedure TTextAreaFormControlObj.AddStr(const S: string);
begin
TheText := TheText+S;   
end;

procedure TTextAreaFormControlObj.ResetToValue;
begin
with (FControl as ThtMemo) do
  begin
  if UnicodeControls then
    Text := MultiByteToWideString(CodePage, TheText)   
  else
    Text := TheText;
  SelStart := 0;
  SelLength := 0;
  end;
end;

function TTextAreaFormControlObj.GetSubmission(Index: integer;
              var S: string): boolean;
var
  I: integer;
begin
if Index = 0 then
  begin
  Result := True;
  S := FName+'=';
  if Wrap in [wrOff, wrSoft] then
    if UnicodeControls then
      S := S+WideStringToMultibyte(CodePage, (FControl as ThtMemo).Text) 
    else
      S := S+(FControl as ThtMemo).Text
  else
    with (FControl as ThtMemo) do
      for I := 0 to Lines.Count-1 do
        begin
        if UnicodeControls then
          S := S + WideStringToMultibyte(CodePage, Lines[I])  
        else
          S := S + Lines[I];
        if (I < Lines.Count-1) then
          S := S + CRLF;
        end;
  end
else Result := False;
end;

procedure TTextAreaFormControlObj.SetData(Index: integer; const V: String);
begin
if UnicodeControls then
  (FControl as ThtMemo).Text := MultiByteToWideString(CodePage, V)  
else
  (FControl as ThtMemo).Text := V;
end;

procedure TTextAreaFormControlObj.SaveContents;
{Save the current value to see if it has changed when focus is lost}
begin
EnterContents := ThtMemo(FControl).Text;
end;

procedure TTextAreaFormControlObj.DoOnChange;
begin
if ThtMemo(FControl).Text <> EnterContents then
  if Assigned(MasterList.ObjectChange) then
    MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage);
end;

function TFormControlList.FindControl(Posn: integer): TFormControlObj;
{find the control at a given character position}
var
  I: integer;
begin
for I := 0 to Count-1 do
  if TFormControlObj(Items[I]).Pos = Posn then
    begin
    Result := Items[I];
    Exit;
    end;
Result := Nil;
end;

function TFormControlList.GetHeightAt(Posn: integer;
              var FormAlign: AlignmentType) : Integer;
var
  Ctrl: TFormControlObj;
begin
Ctrl := FindControl(Posn);
if Assigned(Ctrl) then
  begin
  Result := Ctrl.FControl.Height;
  FormAlign := Ctrl.FormAlign;
  end
else Result := -1;
end;

function TFormControlList.GetWidthAt(Posn: integer; var HSpcL, HSpcR: integer) : integer;
var
  Ctrl: TFormControlObj;
begin
Ctrl := FindControl(Posn);
if Assigned(Ctrl) then
  Begin
  Result := Ctrl.FControl.Width;
  HSpcL := Ctrl.HSpaceL;    
  HSpcR := Ctrl.HSpaceR;
  end
else Result := -1;
end;

function TFormControlList.GetControlCountAt(Posn: integer): integer;
{Return count of chars before the next form control.  0 if at the control,
 9999 if no controls after Posn}
var
  I, Pos: integer;
begin
if Count = 0 then
  begin
  Result := 9999;
  Exit;
  end;
I := 0;
while I < count do
  begin
  Pos := TFormControlObj(Items[I]).Pos;
  if Pos >= Posn then break;
  Inc(I);
  end;
if I = Count then Result := 9999
else
  Result := TFormControlObj(Items[I]).Pos - Posn;
end;

procedure TFormControlList.Decrement(N: integer);   
{called when a character is removed to change the Position figure}
var
  I: integer;
begin
for I := 0 to Count-1 do
  with TFormControlObj(Items[I]) do
    if Pos > N then
      Dec(Pos);
end;

end.