Форум: "Прочее";
Текущий архив: 2007.09.02;
Скачать: [xml.tar.bz2];

Вниз

Функция IsTrue   Найти похожие ветки 

← →
Инс ©   (2007-08-04 22:19) [0]

Возможно боян, но все же... Дружбан только что показал. Зацените!

function IsTrue(Value: boolean): boolean;
begin
 if Value <> true then result := false
 else if Value <> false then result := true
 else // внимание!
   result := (not true) and (not false);
end;

---

← →
Yanis ©   (2007-08-04 22:27) [1]

> Возможно боян, но все же...

По моему это с этого форума и произошло.

---

← →
{RASkov} ©   (2007-08-04 22:28) [2]

> [0] Инс ©   (04.08.07 22:19)

function IsTrue(const Value: Boolean): Boolean;
begin
 Result:=False xor Value;
end; :)
Уже вроде что-то такое было... хотя может "переворачивали" Value(InvertBoolean).... не помню....
Впрочем я и прошлый раз нифика непонял этого прикола и опять...(
result := (not true) and (not false); нафик так писать? Не проще сразу Fаlse...

---

← →
Инс ©   (2007-08-04 23:00) [3]

> [2] {RASkov} ©   (04.08.07 22:28)


Не, ты не понял немного. Тут думать не надо, всерьез воспринимать - тоже. Прочувствуй :)

---

← →
TUser ©   (2007-08-04 23:22) [4]

Покруче будет вот такой модед у какого-то класса-обертки на boolean

protcedure SetTrueIfFalseAndSetFalseIfTrue;

Кто-то из местных придумал.

---

← →
Gero ©   (2007-08-05 00:25) [5]


(***********************************************************)
(*                                                         *)
(*           TrueChecker.pas — TTrueChecked Component      *)
(*                                        Version 1.0      *)
(*                                                         *)
(*                 Copyright © 2006 by Yanis Prasol      *)
(*                 All rights reserved.                    *)
(*                                                         *)
(***********************************************************)

unit TrueChecker;

interface

uses
Classes, SysUtils;

const
TrueValue = True;
NonTrueValue = not TrueValue;

type
TTrueFalseChanger = class(TObject)
public
 procedure SetTrue(var X: Boolean);
 procedure SetNonTrue(var X: Boolean);
 procedure SetNonTrueIfTrueAndSetTrueIfNonTrue(var X: Boolean);
end;

TTrueChecker = class(TComponent)
private
 FVariable: Boolean;
 function GetIsTrue: Boolean;
 procedure SetVariable(const Value: Boolean);
public
 constructor Create(AOwner: TComponent); override;
published
 property IsTrue: Boolean read GetIsTrue;
 property Variable: Boolean read FVariable write SetVariable default NonTrueValue;
end;

implementation

const
STrueSettingError = "Failed set variable value to true!";
SNonTrueSettingError = "Failed set variable value to non true!";
SNonTrueAndNonFalseError = "Boolean variable value is not true and not false!";
SDontUnderstandingError = "mmmmmmmmmmm&#133?";

{ TTrueFalseChanger }

procedure TTrueFalseChanger.SetTrue(var X: Boolean);
begin
repeat
 if (X <> TrueValue) or (X = NonTrueValue) then
   begin
     SetNonTrueIfTrueAndSetTrueIfNonTrue(X);
   end
 else
   raise Exception.Create(STrueSettingError);
until X = TrueValue;
end;

procedure TTrueFalseChanger.SetNonTrue(var X: Boolean);
begin
repeat
 if (X <> NonTrueValue) or (X = TrueValue) then
   begin
     SetNonTrueIfTrueAndSetTrueIfNonTrue(X);
   end
 else
   raise Exception.Create(SNonTrueSettingError);
until X = NonTrueValue;
end;

procedure TTrueFalseChanger.SetNonTrueIfTrueAndSetTrueIfNonTrue(var X: Boolean);
begin
if (X <> (X and not X)) = TrueValue then
 begin
   X := NonTrueValue;
 end
else if (X xor NonTrueValue) = NonTrueValue then
 begin
   X := TrueValue;
 end
else
 raise Exception.Create(SNonTrueAndNonFalseError);
end;

{ TTrueChecker }

function TTrueChecker.GetIsTrue: Boolean;
label
TrueLabel, FalseLabel;
var
TrueFalseChanger: TTrueFalseChanger;
begin
TrueFalseChanger := TTrueFalseChanger.Create;
try
 try
   if (FVariable = TrueValue) and (FVariable <> NonTrueValue) then
     begin
       goto TrueLabel;
     end
   else
     begin
       if (FVariable = NonTrueValue) and (FVariable <> TrueValue) then
         begin
           goto FalseLabel;
         end
       else
         raise Exception.Create(SDontUnderstandingError);
     end;
   TrueLabel:
   while (Result <> TrueValue) do
     TrueFalseChanger.SetTrue(Result);
   Exit;
   FalseLabel:
   while (Result <> NonTrueValue) do
     TrueFalseChanger.SetNonTrue(Result);
   Exit;
 except
   Result := NonTrueValue;
 end;
finally
 TrueFalseChanger.Free;
end;
raise Exception.Create(STrueSettingError);
end;

constructor TTrueChecker.Create(AOwner: TComponent);
begin
inherited;
FVariable := NonTrueValue;
end;

procedure TTrueChecker.SetVariable(const Value: Boolean);
begin
if FVariable <> Value then
 FVariable := Value;
end;

end.

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
const
TestedValiable = True;
var
TrueChecker: TTrueChecker;
ResultValiable: Boolean;
begin
TrueChecker := TTrueChecker.Create(nil);
try
 TrueChecker.Variable := TestedValiable;
 ResultValiable := TrueChecker.IsTrue;
 if ResultValiable then
   ShowMessage("Variable is True!")
 else
   ShowMessage("Variable is False!");
finally
 TrueChecker.Free;
end;
end;

Предупреждаю сразу, коммерческое использование данного компонента возможно только с моего письменного разрешения после покупки лицензии.

---

← →
{RASkov} ©   (2007-08-05 00:33) [6]

> [3] Инс ©   (04.08.07 23:00)
> Не, ты не понял немного.

Понятно, что Правда Ложной не будет :) и что смысла нет вообще в этой функции, наверное в этом и есть прикол....
Раз так, то:

> result := (not true) and (not false); нафик так писать? Не проще сразу Fаlse...

здесь я загнул, Result должен быть нечто так:
Result:=True and False or not True or not False and True xor False и т.д. и т.п....
Всё понял.... Нужно быть супермастером чтоб написать данную функцию(IsTrue)..... вообщем не каждому дано..:)

---

← →
{RASkov} ©   (2007-08-05 00:45) [7]

> [5] Gero ©   (05.08.07 00:25)

Супер...

> Предупреждаю сразу, коммерческое использование данного компонента возможно только с моего письменного разрешения после покупки лицензии.

...я так и знал, что все это серьезно, а нифика не "прикол".
:о)

---

← →
Dimaxx ©   (2007-08-05 09:43) [8]

Result:=Value - вот и весь текст функции... ;)

---

← →
Zeqfreed ©   (2007-08-05 09:46) [9]

{$DEFINE TRUE_SHORTER_THAN_FALSE}

const
 TRUE_LENGTH = 4;
 FALSE_LENGTH = 5;

function boolToString(value : Boolean) : String;
const
 values : array[0..1] of Strings = ("false", "true");
 true, false : String;
begin
 {$IFDEF MIX_THINGS_UP}
   true := values[0];  
   false := values[1];
 {$ELSEIF}
   false := values[0];  
   true := values[1];
 {$ENDIF}

 if (value) then
   Result := true
 else
   Result := false;
end;

function isReallyTrue(value : Boolean) : Boolean;
var
 s : String;
begin
 s := boolToString(value);
 {$IFDEF TRUE_SHORTER_THAN_FALSE}
   Result := Length(s) < FALSE_LENGTH;
 {$ELSEIF}
   Result := Length(s) < TRUE_LENGTH;
 {$ENDIF}
end;

function isTrue(value : Boolean) : Boolean;
begin
 if (value) then
   Result := isReallyTrue(value)
 else
   Result := not isReallyTrue(value);
end;

Код распространяется по лицензии GPLv3, разумеется ;)

---

← →
VirEx ©   (2007-08-05 10:19) [10]

library GetBool;

uses
 SysUtils,
 Classes,
 windows;

const
TBoolStr : array[0..1] of string=("True","False");

type
TBoolType = (IsBoolean, IsNotBoolean);
TResult   = procedure (result:string) of object;

TBoolParser = class(TObject)
 FBool_:integer;
 constructor create;
 destructor  destroy;
 function GetBoolType:TBoolType;
 property Bool_: integer read FBool_ write FBool_;
end;

type
 TBooler = class(TThread)
 private
 FBool:string;
 //FBoolRes:TBoolStr;
 FParser:TBoolParser;
 FOnResult:TResult;
 protected
  procedure Execute; override;
 public
  constructor Create(s:string);
 published
  property OnResult: TResult read FOnResult write FOnResult;
end;

var
Booler:TBooler;

function IsBooleanOrNotBool(s:string;r:TResult):string;
begin
if Booler<>nil then Booler.Destroy;
Booler:=TBooler.Create(s);
Booler.OnResult:=r;
Booler.Resume;
end;

function IsRealyBoolean(b:boolean;r_:TResult):boolean; export
begin
 IsBooleanOrNotBool(IntToStr(Integer(b)),r_);
end;

constructor TBooler.Create(s: string);
begin
FBool:=s;
FParser:=TBoolParser.create;
with FParser do Bool_:=StrToInt(s);
inherited Create(True);

end;

procedure TBooler.Execute;
begin
 inherited;
 case FParser.GetBoolType of
 IsBoolean   :FOnResult(TBoolStr[0]);
 IsNotBoolean:FOnResult(TBoolStr[1]);
 end;
end;

{ TBoolParser }
constructor TBoolParser.create;
begin
FBool_:=0;
inherited Create;
end;

destructor TBoolParser.destroy;
begin
FBool_:=-1;
end;

function TBoolParser.GetBoolType: TBoolType;
begin
case FBool_ of
1:result:=IsBoolean;
0:result:=IsNotBoolean;
end;
end;

exports
 IsRealyBoolean;

begin

end.


---

← →
Zagaevskiy ©   (2007-08-05 10:21) [11]

library TrueAndFalse;

uses
SysUtils,
Classes,
windows;

const
TBoolStr : array[0..1] of string=("True","False");

type
TBoolType = (IsBoolean, IsNotBoolean);
TResult   = procedure (result:string) of object;

TBoolParser = class(TObject)
FBool_:integer;
constructor create;
destructor  destroy;
function GetBoolType:TBoolType;
property Bool_: integer read FBool_ write FBool_;
end;

type
TBooler = class(TThread)
private
FBool:string;
//FBoolRes:TBoolStr;
FParser:TBoolParser;
FOnResult:TResult;
protected
 procedure Execute; override;
public
 constructor Create(s:string);
published
 property OnResult: TResult read FOnResult write FOnResult;
end;

var
Booler:TBooler;

function IsBooleanOrNotBool(s:string;r:TResult):string;
begin
if Booler<>nil then Booler.Destroy;
Booler:=TBooler.Create(s);
Booler.OnResult:=r;
Booler.Resume;
end;

function IsRealyBoolean(b:boolean;r_:TResult):boolean; export
begin
IsBooleanOrNotBool(IntToStr(Integer(b)),r_);
end;

constructor TBooler.Create(s: string);
begin
FBool:=s;
FParser:=TBoolParser.create;
with FParser do Bool_:=StrToInt(s);
inherited Create(True);

end;

procedure TBooler.Execute;
begin
inherited;
case FParser.GetBoolType of
IsBoolean   :FOnResult(TBoolStr[0]);
IsNotBoolean:FOnResult(TBoolStr[1]);
end;
end;

{ TBoolParser }
constructor TBoolParser.create;
begin
FBool_:=0;
inherited Create;
end;

destructor TBoolParser.destroy;
begin
FBool_:=-1;
end;

function TBoolParser.GetBoolType: TBoolType;
begin
case FBool_ of
1:result:=IsBoolean;
0:result:=IsNotBoolean;
end;
end;

exports
IsRealyBoolean;

begin
procedure TTrueFalseChanger.SetTrue(var X: Boolean);
begin
repeat
if (X <> TrueValue) or (X = NonTrueValue) then
  begin
    SetNonTrueIfTrueAndSetTrueIfNonTrue(X);
  end
else
  raise Exception.Create(STrueSettingError);
until X = TrueValue;
end;

procedure TTrueFalseChanger.SetNonTrue(var X: Boolean);
begin
repeat
if (X <> NonTrueValue) or (X = TrueValue) then
  begin
    SetNonTrueIfTrueAndSetTrueIfNonTrue(X);
  end
else
  raise Exception.Create(SNonTrueSettingError);
until X = NonTrueValue;
end;

procedure TTrueFalseChanger.SetNonTrueIfTrueAndSetTrueIfNonTrue(var X: Boolean);
begin
if (X <> (X and not X)) = TrueValue then
begin
  X := NonTrueValue;
end
else if (X xor NonTrueValue) = NonTrueValue then
begin
  X := TrueValue;
end
else
raise Exception.Create(SNonTrueAndNonFalseError);
end;

{ TTrueChecker }

function TTrueChecker.GetIsTrue: Boolean;
label
TrueLabel, FalseLabel;
var
TrueFalseChanger: TTrueFalseChanger;
begin
TrueFalseChanger := TTrueFalseChanger.Create;
try
try
  if (FVariable = TrueValue) and (FVariable <> NonTrueValue) then
    begin
      goto TrueLabel;
    end
  else
    begin
      if (FVariable = NonTrueValue) and (FVariable <> TrueValue) then
        begin
          goto FalseLabel;
        end
      else
        raise Exception.Create(SDontUnderstandingError);
    end;
  TrueLabel:
  while (Result <> TrueValue) do
    TrueFalseChanger.SetTrue(Result);
  Exit;
  FalseLabel:
  while (Result <> NonTrueValue) do
    TrueFalseChanger.SetNonTrue(Result);
  Exit;
except
  Result := NonTrueValue;
end;
finally
TrueFalseChanger.Free;
end;
raise Exception.Create(STrueSettingError);
end;

constructor TTrueChecker.Create(AOwner: TComponent);
begin
inherited;
FVariable := NonTrueValue;
end;

procedure TTrueChecker.SetVariable(const Value: Boolean);
begin
if FVariable <> Value then
FVariable := Value;
end;

end.

end.



---

← →
VirEx ©   (2007-08-05 10:35) [12]

>  [11] Zagaevskiy ©   (05.08.07 10:21)

плагиат)

---

← →
Dib@zol ©   (2007-08-05 10:36) [13]

И не надоело столь продуктивные (а главное безумно полезные!!!) вещи писать??? =)

---

← →
Zagaevskiy ©   (2007-08-05 10:38) [14]

> VirEx ©   (05.08.07 10:35) [12]
>
> >  [11] Zagaevskiy ©   (05.08.07 10:21)
>
> плагиат)

Да, конечно. Зря я это! Просьба к модераторам : удалите, пожалста [11] !!!

---

Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2007.09.02;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.038 c