home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Anthology
/
aDELPHI.iso
/
Runimage
/
Delphi50
/
Demos
/
Midas
/
InternetExpress
/
InetXCustom
/
querycomps.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1999-08-11
|
9KB
|
353 lines
unit QueryComps;
interface
uses Classes, HTTPApp, Db, DbClient, Midas,
WebComp, MidItems;
procedure Register;
type
TQueryPassword = class(TWebTextInput, IQueryField)
protected
function ControlContent(Options: TWebContentOptions): string; override;
function GetText: string;
procedure SetText(const Value: string);
public
class function IsQueryField: Boolean; override;
published
property ParamName;
property DisplayWidth;
property Caption;
property CaptionAttributes;
property CaptionPosition;
property FieldName;
property TabIndex;
property Style;
property Custom;
property StyleRule;
end;
TQueryHiddenText = class(TWebTextInput, IQueryField)
private
FText: string;
protected
function ControlContent(Options: TWebContentOptions): string; override;
function GetText: string;
procedure SetText(const Value: string);
procedure AddAttributes(var Attrs: string); override;
function ImplContent(Options: TWebContentOptions;
ParentLayout: TLayout): string; override;
public
class function IsQueryField: Boolean; override;
published
property ParamName;
property FieldName;
property Text: string read GetText write SetText;
end;
TSubmitValueButton = class(TQueryButton)
private
FValueName: string;
FValue: string;
procedure SetValue(const Value: string);
procedure SetValueName(const Value: string);
protected
function EventContent(Options: TWebContentOptions): string; override;
function GetHTMLControlName: string; override;
function GetValue: string;
function GetValueName: string;
function GetInputType: string; override;
function IsSubmitType: Boolean;
function ImplContent(Options: TWebContentOptions;
ParentLayout: TLayout): string; override;
public
constructor Create(AOwner: TComponent); override;
published
property Value: string read GetValue write SetValue;
property ValueName: string read GetValueName write SetValueName;
end;
TPromptQueryButton = class(TQueryButton, IScriptComponent)
private
FLines: TStrings;
FHiddenInputName: string;
protected
procedure SetLines(const Value: TStrings);
function GetPromptMessage: string;
function ImplContent(Options: TWebContentOptions;
ParentLayout: TLayout): string; override;
function EventContent(Options: TWebContentOptions): string; override;
function GetHiddenInputName: string;
{ IScriptComponent }
procedure AddElements(AddIntf: IAddScriptElements); virtual;
function GetSubComponents: TObject;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property HiddenInputName: string read GetHiddenInputName write FHiddenInputName;
property Lines: TStrings read FLines write SetLines;
end;
implementation
uses sysutils;
resourcestring
sPromptQuery = 'Prompt...';
sSubmitValue = 'Submit Value';
const
sPromptFunctionName = 'PromptSetField';
sPromptFunction =
'function %0:s(input, msg)' + #13#10 +
'{' + #13#10 +
' var v = prompt(msg);' + #13#10 +
' if (v == null || v == "")' + #13#10 +
' return false;' + #13#10 +
' input.value = v' + #13#10 +
' return true;' + #13#10 +
'}' + #13#10;
constructor TPromptQueryButton.Create(AOwner: TComponent);
begin
inherited;
DefaultCaption := sPromptQuery;
InputType := 'BUTTON';
FLines := TStringList.Create;
end;
function TPromptQueryButton.EventContent(
Options: TWebContentOptions): string;
var
HTMLForm: IHTMLForm;
HTMLFormVarName: string;
begin
HTMLForm := GetHTMLForm;
if Assigned(HTMLForm) then
HTMLFormVarName := HTMLForm.HTMLFormVarName;
Result :=
Format(' onclick=''if (%0:s(%1:s, %2:s)) %3:s.submit();''',
[sPromptFunctionName, HiddenInputName, GetPromptMessage,
HTMLFormVarName]);
end;
function TPromptQueryButton.GetPromptMessage: string;
var
I: Integer;
begin
Result := '';
for I := 0 to Lines.Count - 1 do
begin
Result := Format('%s"%s\n"', [Result, Lines[I]]);
if I < Lines.Count - 1 then Result := Result + ' +';
Result := Result + #13#10;
end;
end;
procedure TPromptQueryButton.SetLines(const Value: TStrings);
begin
FLines.Assign(Value);
end;
function TPromptQueryButton.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
begin
Result :=
Format('<INPUT TYPE=HIDDEN NAME=%0:s>'#13#10,
[HiddenInputName]);
Result := Result + inherited ImplContent(Options, ParentLayout);
end;
destructor TPromptQueryButton.Destroy;
begin
FLines.Free;
inherited;
end;
procedure TPromptQueryButton.AddElements(AddIntf: IAddScriptElements);
begin
inherited;
AddIntf.AddFunction(sPromptFunctionName, Format(sPromptFunction, [sPromptFunctionName]));
end;
function TPromptQueryButton.GetHiddenInputName: string;
begin
if FHiddenInputName = '' then
Result := Format('_%s', [Self.Name])
else
Result := FHiddenInputName;
end;
{ TSubmitValueButton }
constructor TSubmitValueButton.Create(AOwner: TComponent);
begin
inherited;
DefaultCaption := sSubmitValue;
InputType := 'BUTTON';
end;
function TSubmitValueButton.EventContent(
Options: TWebContentOptions): string;
var
HTMLForm: IHTMLForm;
HTMLFormVarName: string;
begin
if IsSubmitType then
// No code necessary. Use default submit button behavior
Result := ''
else
begin
HTMLForm := GetHTMLForm;
if Assigned(HTMLForm) then
HTMLFormVarName := HTMLForm.HTMLFormVarName;
Result :=
Format(' onclick=''%0:s.value="%1:s";%2:s.submit();''',
[ValueName, Value,
HTMLFormVarName]);
end;
end;
function TSubmitValueButton.GetHTMLControlName: string;
begin
Result := Name;
end;
function TSubmitValueButton.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
begin
Result := '';
if not IsSubmitType then
Result :=
Format('<INPUT TYPE=HIDDEN NAME=%0:s>'#13#10,
[ValueName]);
Result := Result + inherited ImplContent(Options, ParentLayout);
end;
function TSubmitValueButton.IsSubmitType: Boolean;
begin
// Can use submit button to send value. The value
// with be the VALUE attributes and the value name will by the
// NAME attribute.
Result := (FValue <> '') and (FValueName <> '');
end;
function TSubmitValueButton.GetInputType: string;
begin
if IsSubmitType then
Result := 'SUBMIT'
else
Result := 'BUTTON';
end;
function TSubmitValueButton.GetValue: string;
begin
Result := FValue;
if Result = '' then
Result := Caption;
end;
function TSubmitValueButton.GetValueName: string;
begin
Result := FValueName;
if Result = '' then
Result := GetHTMLControlName;
end;
procedure TSubmitValueButton.SetValue(const Value: string);
begin
if Value = Caption then
FValue := ''
else
FValue := Value;
end;
procedure TSubmitValueButton.SetValueName(const Value: string);
begin
if Value = GetHTMLControlName then
FValueName := ''
else
FValueName := Value;
end;
{ Register procedure }
procedure Register;
begin
RegisterWebComponents([
TPromptQueryButton, TSubmitValueButton]);
end;
{ TQueryPassword }
function TQueryPassword.ControlContent(
Options: TWebContentOptions): string;
var
Attrs: string;
Events: string;
begin
AddAttributes(Attrs);
if (not (coNoScript in Options.Flags)) then
Events := EventContent(Options);
Result := Format('<INPUT TYPE=PASSWORD %0:s%1:s>', [Attrs, Events]);
end;
function TQueryPassword.GetText: string;
begin
Result := ''; // Not supported
end;
class function TQueryPassword.IsQueryField: Boolean;
begin
Result := True;
end;
procedure TQueryPassword.SetText(const Value: string);
begin
end;
{ TQueryHiddenText }
function TQueryHiddenText.ControlContent(
Options: TWebContentOptions): string;
var
Attrs: string;
begin
AddAttributes(Attrs);
Result := Format('<INPUT TYPE=HIDDEN %0:s>', [Attrs]);
end;
function TQueryHiddenText.GetText: string;
begin
Result := FText;
end;
class function TQueryHiddenText.IsQueryField: Boolean;
begin
Result := True;
end;
procedure TQueryHiddenText.SetText(const Value: string);
begin
FText := Value;
end;
procedure TQueryHiddenText.AddAttributes(var Attrs: string);
begin
Inherited;
AddQuotedAttrib(Attrs, 'VALUE', Text);
end;
function TQueryHiddenText.ImplContent(Options: TWebContentOptions; ParentLayout: TLayout): string;
begin
Result := ControlContent(Options);
end;
function TPromptQueryButton.GetSubComponents: TObject;
begin
Result := nil;
end;
end.