jvgutils.pas

East make Tray Icon in delphi

      if PointDepth <> 0 then
        Result := Result / (10.0 * PointDepth);
    end
    else
    begin
      case CurrChar of
        '-':
          begin
            NextChar;
            Result := -1.0 * Result;
          end;
        '(':
          begin
            Inc(BracketsCount);
            NextChar;
            Result := Expression;
            while CurrChar = ' ' do
              NextChar;
            if CurrChar <> ')' then
            begin
              raise Exception.CreateRes(@RsERightBracketsNotFound);
              CalcResult := False;
              Result := 0;
            end
            else
              NextChar;
          end;
        // '.': Point := True;
        // ',': Point := True;
      end;
    end;
    if CurrChar = ')' then
    begin
      Dec(BracketsCount);
      if BracketsCount < 0 then
        raise Exception.CreateResFmt(@RsERightBracketHavntALeftOnePosd, [ExpressionPtr - 1]);
    end;
  end;

  function TestForMulDiv: Single;
  var
    Denominator: Single;
  begin
    Result := DigitsToValue; // . . .test For digits, signs And brackets
    while True do
    begin
      case CurrChar of
        //  Case "-":    NextChar
        '*':
          begin
            NextChar;
            Result := Result * DigitsToValue;
          end;
        '/':
          begin
            NextChar;
            Denominator := DigitsToValue;
            if Denominator <> 0 then
              Result := Result / Denominator
            else
            begin
              CalcResult := False;
              raise Exception.CreateRes(@RsEDivideBy);
            end;
          end;
      else
        Break;
      end;
    end;
  end;

  function Expression: Single;
  begin
    Result := TestForMulDiv; //...test for '*' and '/'
    while True do
      case CurrChar of //...TestFor_AddSub
        ' ':
          NextChar;
        '+':
          begin
            NextChar;
            if CurrChar in ['+', '-', '/', '*'] then
              raise Exception.CreateResFmt(@RsEDuplicateSignsAtPos , [ExpressionPtr - 1]);
            Result := Result + TestForMulDiv;
          end;
        '-':
          begin
            NextChar;
            if CurrChar in ['+', '-', '/', '*'] then
              raise Exception.CreateResFmt(@RsEDuplicateSignsAtPos, [ExpressionPtr - 1]);
            Result := Result - TestForMulDiv;
          end;
      else
        Break;
      end;
  end;

begin
  ExpressionPtr := 0;
  BracketsCount := 0;
  AExpression := Trim(AExpression);

  ExpressionLength := Length(AExpression);
  if ExpressionLength = 0 then
    raise Exception.CreateRes(@RsEExpressionStringIsEmpty);
  CalcResult := True;
  NextChar;
  Result := Expression;
end;

{ Ternary operator: X ? Y : Z }

function IIF(AExpression: Boolean; IfTrue, IfFalse: Variant): Variant; overload;
begin
  if AExpression then
    Result := IfTrue
  else
    Result := IfFalse;
end;

function IIF(AExpression: Boolean; const IfTrue, IfFalse: string): string; overload;
begin
  if AExpression then
    Result := IfTrue
  else
    Result := IfFalse;
end;

{ Returns colour of Leftmost/Rightmost Top/Bottom pixel of bitmap  }

function GetTransparentColor(Bitmap: TBitmap; AutoTrColor: TglAutoTransparentColor): TColor;
var
  X, Y: Integer;
begin
  if (AutoTrColor = ftcUser) or not IsItAFilledBitmap(Bitmap) then
    Result := 0
  else
  begin
    case AutoTrColor of
      ftcLeftTopPixel:
        begin
          X := 0;
          Y := 0;
        end;
      ftcLeftBottomPixel:
        begin
          X := 0;
          Y := Bitmap.Height - 1;
        end;
      ftcRightTopPixel:
        begin
          X := Bitmap.Width - 1;
          Y := 0;
        end;
    else {ftcRightBottomPixel}
      begin
        X := Bitmap.Width - 1;
        Y := Bitmap.Height - 1;
      end;
    end;
    Result := GetPixel(Bitmap.Canvas.Handle, X, Y);
  end;
end;

procedure TypeStringOnKeyboard(const S: string);
var
  I: Integer;
  VK: Byte;
begin
  for I := 1 to Length(S) do
  begin
    if Ord(S[I]) > 32 then
      VK := Ord(S[I]) - 32
    else
      VK := Ord(S[I]);
    keybd_event(VK, 0, 0, 0);
    keybd_event(VK, 0, KEYEVENTF_KEYUP, 0);
  end;
end;

{function NextStringGridCell( Grid: TStringGrid ): Boolean;
var
  R: TRect;
  I: Integer;
begin
  with Grid do
  begin
    if Cols[Selection.Left][Selection.Top]='' then
    begin Result := True; Exit; end;
    Result := not ((Grid.Selection.Top = RowCount-1)and(Grid.Selection.Left =
    if Result then
    if Selection.Top = RowCount-1 then
    begin
      Perform( wM_KEYDOWN, VK_TAB, 1);
      for I:=1 to RowCount-FixedRows-1 do Perform( wM_KEYDOWN, VK_UP, 1);
    end
    else
    begin Perform( wM_KEYDOWN, VK_DOWN, 1); end;
//    Grid.SetFocus;
     Grid.EditorMode:=False;
     Grid.EditorMode:=True;
  end;
end;
}

procedure DrawTextExtAligned(Canvas: TCanvas; const Text: string; R: TRect; Alignment: TglAlignment; WordWrap: Boolean);
const
  Alignments: array [TglAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER, 0);
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);
var
  DrawPos, Pos1, Pos2, LineWidth, LineNo, LexemCount, TextHeight: Integer;
  Width: Integer;
  Lexem: string;
  Size: TSize;
  Stop, BroadwiseLine: Boolean;

  function GetNextLexem(var Pos1, Pos2: Integer; TrimLeft: Boolean): string;
  var
    Pos: Integer;
  begin
    Pos := Pos1;
    if Text[Pos] = ' ' then
      repeat
        Inc(Pos);
      until (Pos > Length(Text)) or (Text[Pos] <> ' ');
    Pos2 := Pos;
    if TrimLeft and (LineNo > 0) then
      Pos1 := Pos;
    repeat
      Inc(Pos2);
    until (Pos2 > Length(Text)) or (Text[Pos2] = ' ');

    Result := Copy(Text, Pos1, Pos2 - Pos1);
  end;

  procedure DrawLine(AdditSpace: Cardinal);
  var
    I, DrawPos1, DrawPos2: Integer;
    Lexem: string;
    Size: TSize;
    X, X1: Single;
  begin
    DrawPos1 := DrawPos;
    DrawPos2 := DrawPos;
    X := 0;
    X1 := 0;
    LineWidth := 0;
    for I := 1 to LexemCount do
    begin
      Lexem := GetNextLexem(DrawPos1, DrawPos2, I = 1);
      //      if LexemCount=1 then Lexem:=Lexem+' ';
      GetTextExtentPoint32(Canvas.Handle, PChar(Lexem), Length(Lexem), Size);
      Inc(LineWidth, Trunc(X));
      X := X + Size.cx;
      if (Trunc(X) > Width) and (LexemCount > 1) then
        Exit;

      if (LexemCount > 1) and BroadwiseLine then
        X := X + AdditSpace / (LexemCount - 1);
      TextOut(Canvas.Handle, R.Left + Trunc(X1), R.Top + LineNo * TextHeight, PChar(Lexem), Length(Lexem));
      X1 := X;
      DrawPos1 := DrawPos2;
    end;
  end;

begin
  if Text = '' then
    Exit;
  if Alignment <> ftaBroadwise then
  begin
    Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), R,
      DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment]);
    Exit;
  end;
  Width := R.Right - R.Left; {Height := R.Bottom - R.Top;}
  LineWidth := 0;
  LineNo := 0;
  DrawPos := 1;
  Pos1 := 1;
  Pos2 := 1;
  LexemCount := 0;
  TextHeight := 0;
  Stop := False;
  BroadwiseLine := True;
  repeat
    Lexem := GetNextLexem(Pos1, Pos2, LexemCount = 0);
    //    if LexemCount=0 then Lexem:=Lexem+' ';
    GetTextExtentPoint32(Canvas.Handle, PChar(Lexem), Length(Lexem), Size);
    Inc(LineWidth, Size.cx);
    Inc(LexemCount);
    if TextHeight < Size.cy then
      TextHeight := Size.cy;
    if (LineWidth > Width) or (Pos2 >= Length(Text)) then
    begin
      if LineWidth > Width then
      begin
        if LexemCount = 1 then
          Pos1 := Pos2;
        if LexemCount > 1 then
          Dec(LexemCount);
        DrawLine(Width - (LineWidth - Size.cx));
        DrawPos := Pos1;
        Inc(LineNo);
        LexemCount := 0;
        LineWidth := 0;
        Stop := Pos1 > Length(Text);
      end
      else
      begin
        BroadwiseLine := False; //ftoBroadwiseLastLine;
        DrawLine(Width - LineWidth);
        Inc(LineNo);
        Stop := True;
      end;
    end
    else
      Pos1 := Pos2;
  until Stop;
  //  if FAutoSize then Height := Max( 12, LineNo*TextHeight );
end;

{ Deserialization: loading component from text file }

procedure LoadComponentFromTextFile(Component: TComponent; const FileName: string);
var
  MemStream: TMemoryStream;
  FileStream: TFileStream;
begin
  MemStream := TMemoryStream.Create;
  FileStream := TFileStream.Create(FileName, fmOpenRead);
  try
    ObjectTextToBinary(FileStream, MemStream);
    MemStream.Position := 0;
    MemStream.ReadComponent(Component);
  finally
    MemStream.Free;
    FileStream.Free;
  end;
end;

{ Serializing component to string }

function ComponentToString(Component: TComponent): string;
var
  MemStream: TMemoryStream;
  StringStream: TStringStream;
begin
  StringStream := TStringStream.Create(' ');
  MemStream := TMemoryStream.Create;
  try
    MemStream.WriteComponent(Component);
    MemStream.Position := 0;
    ObjectBinaryToText(MemStream, StringStream);
    StringStream.Position := 0;
    Result := StringStream.DataString;
  finally
    MemStream.Free;
    StringStream.Free;
  end;
end;

{ Serialization: writing component to text file }

procedure SaveComponentToTextFile(Component: TComponent; const FileName: string);
var
  MemStream: TMemoryStream;
  FileStream: TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmCreate or fmOpenWrite);
  try
    MemStream := TMemoryStream.Create;
    try
      MemStream.WriteComponent(Component);
      MemStream.Position := 0;
      ObjectBinaryToText(MemStream, FileStream);
    finally
      MemStream.Free;
    end;
  finally
    FileStream.Free;
  end;
end;

{ Deserializing component from string }

procedure StringToComponent(Component: TComponent; const Value: string);
var
  StrStream: TStringStream;
  MemStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    MemStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, MemStream);

      MemStream.Position := 0;
      MemStream.ReadComponent(Component);
      //      Result := BinStream.ReadComponent(nil);
    finally
      MemStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end;

{ Plays WAV resource }

function PlayWaveResource(const ResName: string): Boolean;
var
  WaveHandle: THandle;
  WavePointer: Pointer;
begin
  Result := False;
  WaveHandle := FindResource(HInstance, PChar(ResName), RT_RCDATA);
  if WaveHandle <> 0 then
  begin
    WaveHandle := LoadResource(HInstance, WaveHandle);
    if WaveHandle <> 0 then
    begin
      WavePointer := LockResource(WaveHandle);
      Result := sndPlaySound(WavePointer, SND_MEMORY or SND_ASYNC);
      UnlockResource(WaveHandle);
      FreeResource(WaveHandle);
    end;
  end;
end;

{ User name for current thread }

// JVCL4: Should go to JvJCLUtils.pas as "GetUserName: string"
function UserName: string;
var
  Name: array [0..127] of Char;
  Len: DWORD;
begin
  Len := SizeOf(Name);
  GetUserName(Name, Len);
  Result := Name;
end;

{ PC name }

// JVCL4: Should go to JvJCLUtils.pas as "GetComputerName: string"
function ComputerName: string;
var
  Name: array [0..127] of Char;
  Len: DWORD;
begin
  Len := SizeOf(Name);
  GetComputerName(Name, Len);
  Result := Name;
end;

{$IFDEF COMPILER5}
// JVCL4: Use the JvJCLUtils.pas implementation
function SameFileName(const Fn1, Fn2: string): Boolean;
begin
  Result := CompareText(Fn1, Fn2) <> 0;
end;
{$ENDIF COMPILER5}

{ Creates ini-file with the same name to project's file - use ChangeFileExt }

function CreateIniFileName: string;
begin
  Result := ParamStr(0);
  SetLength(Result, Length(Result) - Length(ExtractFileExt(Result)));
  Result := Result + '.ini';
end;

{ Expands string with spaces up to given Length }

function ExpandString(const Str: string; Len: Integer): string;
var
  I: Integer;
begin
  Result := Str;
  if Length(Result) >= Len then
    Exit;
  SetLength(Result, Len);

  for I := 1 to Length(Result) do
    if I <= Length(Str) then
      Result[I] := Str[I]
    else
      Result[I] := ' ';
end;

{ Transliterating string Rus <-> Lat }

function Transliterate(const Str: string; RusToLat: Boolean): string;
const
  LAT: string = 'ABVGDEGZIIKLMNOPRSTUFHC___"Y''EUYabvgdegziiklmnoprstufhc___"y''euy+';
  RUS: string = '懒旅呐魄壬仕掏蜗醒矣哉重仝圮蒉哙徕沅彐玷殛腱眍镳耱篝貊