jvgutils.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvgUtils.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].
Burov Dmitry, translation of russian text.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgUtils.pas,v 1.44 2005/02/17 10:21:21 marquardt Exp $

unit JvgUtils;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, Graphics, ExtCtrls,
  SysUtils, Classes, Controls, Forms, MMSystem,
  JvgTypes, JvgCommClasses, Jvg3DColors;

type
  TJvgPublicWinControl = class(TWinControl)
  public
    procedure PaintWindow(DC: HDC); override;
    procedure RecreateWnd;
    property Font;
    property OnEnter;
    property OnExit;
    property Color;
  end;

function IsEven(I: Integer): Boolean;
function InchesToPixels(DC: HDC; Value: Single; IsHorizontal: Boolean): Integer;
function CentimetersToPixels(DC: HDC; Value: Single; IsHorizontal: Boolean): Integer;

procedure SwapInt(var I1, I2: Integer);
function Spaces(Count: Integer): string;
function DupStr(const Str: string; Count: Integer): string;
function DupChar(C: Char; Count: Integer): string;
procedure Msg(const AMsg: string);
function RectW(R: TRect): Integer;
function RectH(R: TRect): Integer;
function IncColor(AColor: Longint; AOffset: Byte): Longint;
function DecColor(AColor: Longint; AOffset: Byte): Longint;
function IsItAFilledBitmap(Bmp: TBitmap): Boolean;
procedure DrawTextInRectWithAlign(DC: HDC; R: TRect; const Text: string;
  HAlign: TglHorAlign; VAlign: TglVertAlign;
  Style: TglTextStyle; Fnt: TFont; Flags: UINT);

procedure DrawTextInRect(DC: HDC; R: TRect; const Text: string;
  Style: TglTextStyle; Fnt: TFont; Flags: UINT);

procedure ExtTextOutExt(DC: HDC; X, Y: Integer; R: TRect; const Text: string;
  Style: TglTextStyle; ADelineated, ASupress3D: Boolean;
  FontColor, DelinColor, HighlightColor, ShadowColor: TColor;
  Illumination: TJvgIllumination; Gradient: TJvgGradient; Font: TFont);

procedure DrawBox(DC: HDC; var R: TRect; Style: TglBoxStyle;
  BackgrColor: Longint; ATransparent: Boolean);

function DrawBoxEx(DC: HDC; ARect: TRect; Borders: TglSides;
  BevelInner, BevelOuter: TPanelBevel; Bold: Boolean; BackgrColor: Longint;
  ATransparent: Boolean): TRect;

procedure GradientBox(DC: HDC; R: TRect; Gradient: TJvgGradient;
  PenStyle, PenWidth: Integer);

procedure ChangeBitmapColor(Bitmap: TBitmap; FromColor, ToColor: TColor);

procedure DrawBitmapExt(DC: HDC; { DC - background & result}
  SourceBitmap: TBitmap; R: TRect;
  X, Y: Integer; //...X,Y _in_ rect!
  BitmapOption: TglWallpaperOption; DrawState: TglDrawState;
  ATransparent: Boolean; TransparentColor: TColor; DisabledMaskColor: TColor);

procedure CreateBitmapExt(DC: HDC; { DC - background & result}
  SourceBitmap: TBitmap; R: TRect;
  X, Y: Integer; //...X,Y _in_ rect!
  BitmapOption: TglWallpaperOption; DrawState: TglDrawState;
  ATransparent: Boolean; TransparentColor: TColor; DisabledMaskColor: TColor);

procedure BringParentWindowToTop(Wnd: TWinControl);
function GetParentForm(Control: TControl): TForm;
procedure GetWindowImageFrom(Control: TWinControl; X, Y: Integer; ADrawSelf, ADrawChildWindows: Boolean; DC: HDC);
procedure GetWindowImage(Control: TWinControl; ADrawSelf, ADrawChildWindows: Boolean; DC: HDC);
procedure GetParentImageRect(Control: TControl; Rect: TRect; DC: HDC);
function CreateRotatedFont(F: TFont; Escapement: Integer): HFONT;
function FindMainWindow(const AWndClass, AWndTitle: string): HWND;
procedure CalcShadowAndHighlightColors(BaseColor: TColor; Colors: TJvgLabelColors);

function CalcMathString(AExpression: string): Single;

function IIF(AExpression: Boolean; IfTrue, IfFalse: Variant): Variant; overload;
function IIF(AExpression: Boolean; const IfTrue, IfFalse: string): string; overload;

function GetTransparentColor(Bitmap: TBitmap; AutoTrColor: TglAutoTransparentColor): TColor;
procedure TypeStringOnKeyboard(const S: string);
//function NextStringGridCell( Grid: TStringGrid ): Boolean;
procedure DrawTextExtAligned(Canvas: TCanvas; const Text: string; R: TRect; Alignment: TglAlignment; WordWrap: Boolean);
procedure LoadComponentFromTextFile(Component: TComponent; const FileName: string);
procedure SaveComponentToTextFile(Component: TComponent; const FileName: string);
function ComponentToString(Component: TComponent): string;
procedure StringToComponent(Component: TComponent; const Value: string);
function PlayWaveResource(const ResName: string): Boolean;
function UserName: string;
function ComputerName: string;
function CreateIniFileName: string;
function ExpandString(const Str: string; Len: Integer): string;
function Transliterate(const Str: string; RusToLat: Boolean): string;
function IsSmallFonts: Boolean;
function SystemColorDepth: Integer;
function GetFileType(const FileName: string): TglFileType;
function FindControlAtPt(Control: TWinControl; Pt: TPoint; MinClass: TClass): TControl;
function StrPosExt(const Str1, Str2: PChar; Str2Len: DWORD): PChar; assembler;

{$IFDEF glDEBUG}
function DeleteObject(P1: HGDIOBJ): BOOL; stdcall;
{$ENDIF glDEBUG}

{$IFDEF COMPILER5}
// JVCL4: Use the JvJCLUtils.pas implementation
function SameFileName(const Fn1, Fn2: string): Boolean;
{$ENDIF COMPILER5}

{$IFNDEF USEJVCL}
function DrawText(Canvas: TCanvas; Text: PAnsiChar; Len: Integer;
  var R: TRect; WinFlags: Integer): Integer; overload;
function DrawText(Canvas: TCanvas; const Text: string; Len: Integer; var R: TRect;
  WinFlags: Integer): Integer; overload;
function PtInRectExclusive(R: TRect; Pt: TPoint): Boolean;
function CanvasMaxTextHeight(Canvas: TCanvas): Integer;
{$ENDIF !USEJVCL}

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgUtils.pas,v $';
    Revision: '$Revision: 1.44 $';
    Date: '$Date: 2005/02/17 10:21:21 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF USEJVCL}
  ShlObj, Math,
  JvResources, JvConsts;
  {$ELSE}
  ShlObj, Math;
  {$ENDIF USEJVCL}

{$IFNDEF USEJVCL}

resourcestring
  RsERightBracketsNotFound = 'Right brackets not found';
  RsERightBracketHavntALeftOnePosd = 'Right bracket havn''t a left one. Pos: %d';
  RsEDivideBy = 'Divide by 0';
  RsEDuplicateSignsAtPos = 'Duplicate signs at Pos: %d';
  RsEExpressionStringIsEmpty = 'Expression string is empty.';
  {$IFDEF glDEBUG}
  RsEObjectMemoryLeak = 'object memory leak';
  {$ENDIF glDEBUG}

const
  ROP_DSPDxax = $00E20746;

{$ENDIF !USEJVCL}

{ debug func }
{$IFDEF glDEBUG}
function DeleteObject(P1: HGDIOBJ): BOOL; stdcall;
begin
  Result := Windows.DeleteObject(P1);
  if not Result then
    raise Exception.CreateRes(@RsEObjectMemoryLeak);
end;
{$ENDIF glDEBUG}

procedure TJvgPublicWinControl.PaintWindow(DC: HDC);
begin
  inherited PaintWindow(DC);
end;

procedure TJvgPublicWinControl.RecreateWnd;
begin
  inherited RecreateWnd;
end;

function IsEven(I: Integer): Boolean;
begin
  Result := not Odd(I);
end;

procedure SwapInt(var I1, I2: Integer);
var
  Tmp: Integer;
begin
  Tmp := I1;
  I1 := I2;
  I2 := Tmp;
end;

function Spaces(Count: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Count do
    Result := Result + ' ';
end;

function DupChar(C: Char; Count: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Count do
    Result := Result + C;
end;

function DupStr(const Str: string; Count: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Count do
    Result := Result + Str;
end;

{ Modal window with (i) icon and single OK button }

procedure Msg(const AMsg: string);
begin
  MessageBox(GetForegroundWindow, PChar(AMsg), '',
    MB_APPLMODAL or MB_ICONINFORMATION or MB_OK);
end;

{ Checks if point is inside rect. Rect's borders are not part of rect }
{ // (andreas) make Delphi 5 compiler happy
function IsPointInRect(P: TPoint; R: TRect): Boolean;
begin
  Result := PtInRect(R, P);
//  Result := (P.X > R.Left) and (P.X < R.Right) and (P.Y > R.Top) and (P.Y < R.Bottom);
end;
}

{ Rect's width }

function RectW(R: TRect): Integer;
begin
  Result := R.Right - R.Left;
end;

{ Rect's height }

function RectH(R: TRect): Integer;
begin
  Result := R.Bottom - R.Top;
end;

{ Increases components of the colour with given offset }

function IncColor(AColor: Longint; AOffset: Byte): Longint;
var
  R, G, B: Byte;
begin
  if AColor < 0 then
    AColor := GetSysColor(AColor and $FF);
  R := Min(255, GetRValue(AColor) + AOffset);
  G := Min(255, GetGValue(AColor) + AOffset);
  B := Min(255, GetBValue(AColor) + AOffset);
  Result := RGB(R, G, B);
end;

{ Decreases components of the colour with given offset }

function DecColor(AColor: Longint; AOffset: Byte): Longint;
var
  R, G, B: Byte;
begin
  if AColor < 0 then
    AColor := GetSysColor(AColor and $FF);
  R := Max(0, GetRValue(AColor) - AOffset);
  G := Max(0, GetGValue(AColor) - AOffset);
  B := Max(0, GetBValue(AColor) - AOffset);
  Result := RGB(R, G, B);
end;

function InchesToPixels(DC: HDC; Value: Single; IsHorizontal: Boolean): Integer;
const
  LogPixels: array [Boolean] of Integer = (LOGPIXELSY, LOGPIXELSX);
begin
  Result := Round(Value * GetDeviceCaps(DC, LogPixels[IsHorizontal]));// * 1.541 / 10);
end;

function CentimetersToPixels(DC: HDC; Value: Single; IsHorizontal: Boolean): Integer;
const
  LogPixels: array [Boolean] of Integer = (LOGPIXELSY, LOGPIXELSX);
begin
  Result := Round(Value * GetDeviceCaps(DC, LogPixels[IsHorizontal])/2.54);// * 1.541 / 2.54 / 10);
end;

{ Checks wheter bitmap object is created and is having size }

function IsItAFilledBitmap(Bmp: TBitmap): Boolean;
begin
  with Bmp do
    Result := Assigned(Bmp) and (Width <> 0) and (Height <> 0);
end;


{
  Renders text wth alignment, given style and given font

  DC             - Handle of canvas
  HAlign, VAlign - Alingment horizontal and vertical
  Style          - Style (embossed, with shadow, etc)
  Flags          - Extra parameters for Windows.DrawText
}

procedure DrawTextInRectWithAlign(DC: HDC; R: TRect; const Text: string;
  HAlign: TglHorAlign; VAlign: TglVertAlign;
  Style: TglTextStyle; Fnt: TFont; Flags: UINT);
begin
  case HAlign of
    fhaLeft:
      Flags := Flags or DT_LEFT;
    fhaCenter:
      Flags := Flags or DT_CENTER;
    fhaRight:
      Flags := Flags or DT_RIGHT;
  end;
  case VAlign of
    fvaTop:
      Flags := Flags or DT_TOP;
    fvaCenter:
      Flags := Flags or DT_VCENTER;
    fvaBottom:
      Flags := Flags or DT_BOTTOM;
  end;

  DrawTextInRect(DC, R, Text, Style, Fnt, Flags);
end;


{
  Renders text with alignment, given style and given font

  DC             - Handle of canvas
  Style          - Style (embossed, with shadow, etc)
  Flags          - Extra parameters for Windows.DrawText
}

procedure DrawTextInRect(DC: HDC; R: TRect; const Text: string; Style: TglTextStyle;
  Fnt: TFont; Flags: UINT);
var
  OldBkMode: Integer;
  OldFont: Windows.HFONT;
  FontColor: TColor;
  ShadowColor, HighlightColor: TColor;
begin
  if not Assigned(Fnt) then
    Exit;
  if Flags = 0 then
    Flags := DT_LEFT or DT_VCENTER or DT_SINGLELINE;
  OldBkMode := SetBkMode(DC, Ord(Transparent));
  FontColor := Fnt.Color;

  ShadowColor := clBtnShadow;
  HighlightColor := clBtnHighlight;

  OldFont := SelectObject(DC, Fnt.Handle);
  case Style of
    fstRaised:
      begin
        SetTextColor(DC, ColorToRGB(HighlightColor));
        OffsetRect(R, -1, -1);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
        SetTextColor(DC, ColorToRGB(ShadowColor));
        OffsetRect(R, 2, 2);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
        SetTextColor(DC, ColorToRGB(FontColor));
        OffsetRect(R, -1, -1);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
      end;
    fstRecessed:
      begin
        SetTextColor(DC, ColorToRGB(ShadowColor));
        OffsetRect(R, -1, -1);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
        SetTextColor(DC, ColorToRGB(HighlightColor));
        OffsetRect(R, 2, 2);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
        SetTextColor(DC, ColorToRGB(FontColor));
        OffsetRect(R, -1, -1);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
      end;
    fstPushed:
      begin
        SetTextColor(DC, ColorToRGB(HighlightColor));
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
        SetTextColor(DC, ColorToRGB(ShadowColor));
        OffsetRect(R, -1, -1);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
      end;
    fstShadow:
      begin
        SetTextColor(DC, ColorToRGB(ShadowColor));
        OffsetRect(R, 2, 2);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
        SetTextColor(DC, ColorToRGB(FontColor));
        OffsetRect(R, -2, -2);
        Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
      end;
  else
    begin
      SetTextColor(DC, ColorToRGB(FontColor));
      Windows.DrawText(DC, PChar(Text), Length(Text), R, Flags);
    end;
  end;
  SelectObject(DC, OldFont);
  SetBkMode(DC, OldBkMode);
end;

{
  Renders text wth given style, countouring option and given colours fo 3D effects

  DC             - Handle of canvas
  Style          - Style (embossed, with shadow, etc)
  ADelineated    - Contour of color of DelinColor
  FontColor, DelinColor, HighlightColor, ShadowColor -
                   Colors of font and 3D effects
  Illumination   - Not used
  Gradient       - Gradient for filling letters of text
}

procedure ExtTextOutExt(DC: HDC; X, Y: Integer; R: TRect; const Text: string;
  Style: TglTextStyle; ADelineated, ASupress3D: Boolean;
  FontColor, DelinColor, HighlightColor, ShadowColor: TColor;
  Illumination: TJvgIllumination; Gradient: TJvgGradient; Font: TFont);
var
  OldBkMode, X1, Y1, I, ShadowDepth: Integer;
  OldFont: Windows.HFONT;

  procedure DrawMain(ADelineated: Boolean; S: Integer);
  begin
    if ADelineated then
    begin
      if not ASupress3D then
      begin
        SetTextColor(DC, ColorToRGB(DelinColor));
        ExtTextOut(DC, X + S, Y + S, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        ExtTextOut(DC, X + 2 + S, Y + 2 + S, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        ExtTextOut(DC, X + S, Y + S + 2, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
        ExtTextOut(DC, X + S + 2, Y + S, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
      end;
      SetTextColor(DC, ColorToRGB(FontColor));
      if Assigned(Gradient) then
        Gradient.TextOut(DC, Text, R, X + S + 1, Y + S + 1)
      else
        ExtTextOut(DC, X + S + 1, Y + S + 1, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
    end
    else
    begin
      SetTextColor(DC, ColorToRGB(FontColor));
      if Assigned(Gradient) then
        Gradient.TextOut(DC, Text, R, X + S, Y + S)
      else
        ExtTextOut(DC, X + S, Y + S, ETO_CLIPPED, @R, PChar(Text), Length(Text), nil);
    end;
  end;
begin