jvqjvclutils.pas

East make Tray Icon in delphi

  TransparentColor: TColor);
begin
  with SrcRect do
    StretchBitmapTransparent(Dest, Bitmap, TransparentColor,
      DstX, DstY, DstW, DstH, Left, Top, Right - Left, Bottom - Top);
end;

procedure DrawBitmapRectTransparent(Dest: TCanvas; DstX, DstY: Integer;
  SrcRect: TRect; Bitmap: TBitmap; TransparentColor: TColor);
begin
  with SrcRect do
    StretchBitmapTransparent(Dest, Bitmap, TransparentColor,
      DstX, DstY, Right - Left, Bottom - Top, Left, Top, Right - Left,
      Bottom - Top);
end;

procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer;
  Bitmap: TBitmap; TransparentColor: TColor);
begin
  StretchBitmapTransparent(Dest, Bitmap, TransparentColor, DstX, DstY,
    Bitmap.Width, Bitmap.Height, 0, 0, Bitmap.Width, Bitmap.Height);
end;


function CreateMonoBitmap(FOriginal: TBitmap; BackColor: TColor): TBitmap;
var
  Img: QImageH;
  tmp: TBitmap;
begin
  Img := QImage_create;
  tmp := TBitmap.Create;
  if BackColor = clNone then
    tmp.Assign(FOriginal)
  else
    with tmp do
    begin
      Width := FOriginal.width;
      Height := FOriginal.Height;
      if BackColor = clDefault then
        BackColor := FOriginal.Canvas.Pixels[0, Height-1];
      with Canvas do
      begin
        Start;
        Brush.Color := clWhite;
        FillRect(Rect(0,0, Width, Height));
        DrawBitmapTransparent(Canvas, 0, 0, FOriginal, BackColor);
        Stop;
      end;
    end;
  QPixmap_convertToImage(tmp.Handle, Img);
  try
    Result := TBitmap.Create;
    try
      Result.Handle := QPixmap_create(FOriginal.Width, FOriginal.Width, -1, QPixmapOptimization_NoOptim);
      QPixmap_convertFromImage(Result.Handle, Img,  Integer(ImageConversionFlags_MonoOnly) +
        Integer(ImageConversionFlags_ThresholdDither) + Integer(ImageConversionFlags_AvoidDither));
      Result.TransparentColor := clWhite;
      Result.Transparent := True;
    except
      Result.Free;
      Result := nil;
    end;
  finally
    tmp.Free;
    QImage_destroy(Img);
  end;
end;

procedure MakeBitmapMonochrome(Bmp: TBitmap);
var
  Tmp: TBitmap;
begin
  Tmp := CreateMonoBitmap(Bmp, clBlack);
  Bmp.Assign(Tmp);
  Tmp.Free;
end;

function CreateDisabledBitmap(FOriginal: TBitmap): TBitmap;
var
  IconSet: QIconSetH;
  MonoBmp: TBitmap;
begin
  Result := TBitmap.Create;
  MonoBmp := CreateMonoBitmap(FOriginal);
  try
    IconSet := QIconSet_create(MonoBmp.Handle, QIconSetSize_Small);
    try
      Result.Handle := QPixmap_create;
      QIconSet_pixmap(IconSet, Result.Handle, QIconSetSize_Small, False);
    finally
      QIconSet_destroy(IconSet);
    end;
  except
    Result.Free;
    Result := nil;
  end;
  MonoBmp.Free;
end;


{ CreateDisabledBitmap. Creating TBitmap object with disable button glyph
  image. You must destroy it outside by calling TBitmap.Free method. }

function CreateDisabledBitmap_NewStyle(FOriginal: TBitmap; BackColor: TColor):
  TBitmap;
var
  MonoBmp: TBitmap;
  R: TRect;
  DestDC, SrcDC: HDC;
begin
  R := Rect(0, 0, FOriginal.Width, FOriginal.Height);
  Result := TBitmap.Create;
  try
    Result.Width := FOriginal.Width;
    Result.Height := FOriginal.Height;
    Result.Canvas.Brush.Color := BackColor;
    Result.Canvas.FillRect(R);

    MonoBmp := TBitmap.Create;
    try
      MonoBmp.Width := FOriginal.Width;
      MonoBmp.Height := FOriginal.Height;
      MonoBmp.Canvas.Brush.Color := clWhite;
      MonoBmp.Canvas.FillRect(R);
      DrawBitmapTransparent(MonoBmp.Canvas, 0, 0, FOriginal, BackColor);
      MonoBmp.Monochrome := True;

      SrcDC := MonoBmp.Canvas.Handle;
      { Convert Black to clBtnHighlight }
      Result.Canvas.Brush.Color := clBtnHighlight;
      DestDC := Result.Canvas.Handle;
      SetTextColor(DestDC, clWhite);
      SetBkColor(DestDC, clBlack);
      BitBlt(DestDC, 1, 1, FOriginal.Width, FOriginal.Height, SrcDC, 0, 0,
        ROP_DSPDxax);
      { Convert Black to clBtnShadow }
      Result.Canvas.Brush.Color := clBtnShadow;
      DestDC := Result.Canvas.Handle;
      SetTextColor(DestDC, clWhite);
      SetBkColor(DestDC, clBlack);
      BitBlt(DestDC, 0, 0, FOriginal.Width, FOriginal.Height, SrcDC, 0, 0,
        ROP_DSPDxax);
    finally
      MonoBmp.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function CreateDisabledBitmapEx(FOriginal: TBitmap; OutlineColor, BackColor,
  HighLightColor, ShadowColor: TColor; DrawHighlight: Boolean): TBitmap;
var
  MonoBmp: TBitmap;
  IRect: TRect;
begin
  IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
  Result := TBitmap.Create;
  try
    Result.Width := FOriginal.Width;
    Result.Height := FOriginal.Height;
    MonoBmp := TBitmap.Create;
    try
      with MonoBmp do
      begin
        Width := FOriginal.Width;
        Height := FOriginal.Height;
        Canvas.CopyRect(IRect, FOriginal.Canvas, IRect); 
        Canvas.Brush.Color := OutlineColor;
        if Monochrome then
        begin
          Canvas.Font.Color := clWhite;
          Monochrome := False;
          Canvas.Brush.Color := clWhite;
        end;
        Monochrome := True;
      end;
      with Result.Canvas do
      begin
        Brush.Color := BackColor;
        FillRect(IRect); 
        MonoBmp.Canvas.Start;
        Start;
        try 
          if DrawHighlight then
          begin
            Brush.Color := HighLightColor;
            SetTextColor(Handle, clBlack);
            SetBkColor(Handle, clWhite);
            BitBlt(Handle, 1, 1, RectWidth(IRect), RectHeight(IRect),
              MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
          end;
          Brush.Color := ShadowColor;
          SetTextColor(Handle, clBlack);
          SetBkColor(Handle, clWhite);
          BitBlt(Handle, 0, 0, RectWidth(IRect), RectHeight(IRect),
            MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax); 
        finally
          Stop;
          MonoBmp.Canvas.Stop;
        end; 
      end;
    finally
      MonoBmp.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor):
  TBitmap;
begin  
  Result := CreateDisabledBitmapEx(FOriginal, OutlineColor,
//    clBtnFace, clBtnHighlight, clBtnShadow, True);
    clDark, clLight, clBtnShadow, True); 
end;

{ ChangeBitmapColor. This function creates a new TBitmap object.
  You must destroy it outside by calling TBitmap.Free method. }

function ChangeBitmapColor(Bitmap: TBitmap; Color, NewColor: TColor): TBitmap;
var
  R: TRect;
begin
  Result := TBitmap.Create;
  try
    with Result do
    begin
      Height := Bitmap.Height;
      Width := Bitmap.Width;
      R := Bounds(0, 0, Width, Height);
      with Canvas do
      begin
        Brush.Color := NewColor;
        FillRect(R);
        BrushCopy( Canvas,  R, Bitmap, R, Color);
      end;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure ImageListDrawDisabled(Images: TCustomImageList; Canvas: TCanvas;
  X, Y, Index: Integer; HighLightColor, GrayColor: TColor;
  DrawHighlight: Boolean);
var
  Bmp: TBitmap;
  SaveColor: TColor;
begin
  SaveColor := Canvas.Brush.Color;
  Bmp := TBitmap.Create;
  try
    Bmp.Width := Images.Width;
    Bmp.Height := Images.Height;
    with Bmp.Canvas do
    begin
      Brush.Color := clWhite;
      FillRect(Rect(0, 0, Images.Width, Images.Height));  
      Images.Draw(Bmp.Canvas, 0, 0, Index, itMask); 
    end;
    Bmp.Monochrome := True;
    if DrawHighlight then
    begin
      Canvas.Brush.Color := HighLightColor;
      SetTextColor(Canvas.Handle, clWhite);
      SetBkColor(Canvas.Handle, clBlack);
      BitBlt(Canvas.Handle, X + 1, Y + 1, Images.Width,
        Images.Height, Bmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
    end;
    Canvas.Brush.Color := GrayColor;
    SetTextColor(Canvas.Handle, clWhite);
    SetBkColor(Canvas.Handle, clBlack);
    BitBlt(Canvas.Handle, X, Y, Images.Width,
      Images.Height, Bmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
  finally
    Bmp.Free;
    Canvas.Brush.Color := SaveColor;
  end;
end;

{ Brush Pattern }

function CreateTwoColorsBrushPattern(Color1, Color2: TColor): TBitmap;
var
  X, Y: Integer;
begin
  Result := TBitmap.Create;
  Result.Width := 8;
  Result.Height := 8;
  with Result.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := Color1;
    FillRect(Rect(0, 0, Result.Width, Result.Height));
    for Y := 0 to 7 do
      for X := 0 to 7 do
        if (Y mod 2) = (X mod 2) then { toggles between even/odd pixles }
          Pixels[X, Y] := Color2; { on even/odd rows }
  end;
end;

{ Icons }

function MakeIcon(ResID: PChar): TIcon;
begin
  Result := MakeModuleIcon(HInstance, ResID);
end;

function MakeIconID(ResID: Word): TIcon;
begin
  Result := MakeModuleIcon(HInstance, MakeIntResource(ResID));
end;

function MakeModuleIcon(Module: THandle; ResID: PChar): TIcon;
begin
  Result := TIcon.Create;  
  try
    Result.LoadFromResourceName(HInstance, ResID);
  except
    Result.Free;
    Result := nil;
  end; 
end;

{ Create TBitmap object from TIcon }

function CreateBitmapFromIcon(Icon: TIcon; BackColor: TColor): TBitmap;
var
  IWidth, IHeight: Integer;
begin
  IWidth := Icon.Width;
  IHeight := Icon.Height;
  Result := TBitmap.Create;
  try
    Result.Width := IWidth;
    Result.Height := IHeight;
    with Result.Canvas do
    begin
      Brush.Color := BackColor;
      FillRect(Rect(0, 0, IWidth, IHeight));
      Draw(0, 0, Icon);
    end;
    Result.TransparentColor := BackColor;
    Result.Transparent := True;
  except
    Result.Free;
    raise;
  end;
end;

function CreateIconFromBitmap(Bitmap: TBitmap; TransparentColor: TColor): TIcon;

var
  Bmp: TBitmap;

begin
  with TImageList.CreateSize(Bitmap.Width, Bitmap.Height) do
  try
    if TransparentColor = clDefault then
      TransparentColor := Bitmap.TransparentColor; 
    AddMasked(Bitmap, TransparentColor);
    Result := TIcon.Create;
    try  
      Bmp := TBitmap.Create;
      try
        GetBitmap(0, Bmp);
        Result.Assign(Bmp);
      finally
        Bmp.Free;
      end; 
    except
      Result.Free;
      raise;
    end;
  finally
    Free;
  end;
end;

type
  TCustomControlAccessProtected = class(TCustomControl);




procedure DrawInvertFrame(ScreenRect: TRect; Width: Integer);
var
  Canvas: TJvDeskTopCanvas;
  I: Integer;
begin
  Canvas := TJvDeskTopCanvas.Create;
  with Canvas do
    try
      StartPaint;
      try
        for I := 1 to Width do
        begin
          DrawFocusRect(ScreenRect);
          InflateRect(ScreenRect, -1, -1);
        end;
      finally
        StopPaint;
      end;
    finally
      Free;
    end;
end;

procedure PaintInverseRect(const RectOrg, RectEnd: TPoint);
var
  Canvas: TJvDeskTopCanvas;
  R: TRect;
begin
  Canvas := TJvDeskTopCanvas.Create;
  with Canvas do
    try
      StartPaint;
      try
        R := Rect(RectOrg.X, RectOrg.Y, RectEnd.X, RectEnd.Y);
        QWindows.InvertRect(Handle, R);
      finally
        StopPaint;
      end;
    finally
      Free;
    end;
end;