jvgimage.pas

East make Tray Icon in delphi

  Pt: TPoint;
  //  BmpInfo: Windows.TBitmap;
begin
  if (FBitmapOption = fwoStretch) or (FBitmapOption = fwoPropStretch) or
    (FBitmapOption = fwoTile) then
  begin
    FResBitmap.Width := Width;
    FResBitmap.Height := Height;
  end
  else
  begin
    FResBitmap.Width := FBmp.Width;
    FResBitmap.Height := FBmp.Height;
  end;

  with FResBitmap do
  begin
    // if FTransparent then Canvas.Brush.Color := FTransparentColor
    Canvas.Brush.Color := clBtnFace;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(Bounds(0, 0, Width, Height));
  end;

  Pt := CalcAlignOffset;
  if FTransparent then
    GetParentImageRect(Self, Bounds(Left + Pt.X, Top + Pt.Y, FResBitmap.Width,
      FResBitmap.Height),
      FResBitmap.Canvas.Handle);
  //BringParentWindowToTop(parent);
//    BitBlt( FResBitmap.Canvas.Handle, 0,0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);

  CreateBitmapExt(FResBitmap.Canvas.Handle, FBmp, ClientRect, 0, 0,
    FBitmapOption, FDrawState,
    FTransparent, FTransparentColor, FDisabledMaskColor);

  if FMasked then
    ChangeBitmapColor(FResBitmap, FMaskedColor, FMaskedToColor);

  {  GetObject( FResBitmap.Handle, SizeOf(Windows.TBitmap), @BmpInfo );
    if BmpInfo.bmBitsPixel >= 8 then
    with FResBitmap,BmpInfo do
    begin
      for i := 1 to bmWidth*bmHeight*(bmBitsPixel div 8)-1 do
        begin
   asm
    inc BmpInfo.bmBits
   end;
   Byte(bmBits^):=1;
        end;
    end;}
end;

procedure TJvgBitmapImage.Changed;
begin
  FChanged := True;
  if Assigned(OnChangeParams) then
    OnChangeParams(Self);
end;

procedure TJvgBitmapImage.SmthChanged(Sender: TObject);
begin
  Changed;
  Invalidate;
end;

function TJvgBitmapImage.CalcAlignOffset: TPoint;
var
  D, D1: Double;
  Pt: TPoint;
begin
  Result.X := 0;
  Result.Y := 0;
  if (FBitmapOption = fwoNone) or (FBitmapOption = fwoPropStretch) then
  begin
    Pt.X := FBmp.Width;
    Pt.Y := FBmp.Height;
    if FBitmapOption = fwoPropStretch then
    begin
      D1 := Width / Pt.X;
      D := Height / Pt.Y;
      if D > D1 then
        D := D1; //...D == Min
      Pt.X := Trunc(Pt.X * D);
      Pt.Y := Trunc(Pt.Y * D);
    end;
    case ImageAlign.Horizontal of
      fhaCenter:
        Result.X := Max(0, (Width - Pt.X) div 2);
      fhaRight:
        Result.X := Max(0, Width - Pt.X);
    end;
    case ImageAlign.Vertical of
      fvaCenter:
        Result.Y := Max(0, (Height - Pt.Y) div 2);
      fvaBottom:
        Result.Y := Max(0, Height - Pt.Y);
    end;
  end;
end;

procedure TJvgBitmapImage.SetAutoSize(Value: Boolean);
begin
  if (FAutoSize = Value) or not Assigned(FBmp) then
    Exit;
  FAutoSize := Value;
  if FAutoSize and (FBitmapOption = fwoNone) and
    // (rom) strange  this evaluates to FBmp.Width <> FBmp.Height
    ((FBmp.Width and FBmp.Height) <> 0) then
  begin
    Width := FBmp.Width;
    Height := FBmp.Height;
    Changed;
    Invalidate;
  end;
end;

function TJvgBitmapImage.GetBitmap: TBitmap;
begin
  if not Assigned(FBitmap) then
    FBitmap := TBitmap.Create;
  Result := FBitmap;
end;

procedure TJvgBitmapImage.SetBitmap(Value: TBitmap);
begin
  FBitmap.Free;
  FBitmap := TBitmap.Create;
  FBitmap.Assign(Value);
  if Assigned(Value) then
    FBmp := FBitmap
  else
  if Assigned(FImage) and Assigned(FImage.Picture) and
    Assigned(FImage.Picture.Bitmap) then
    FBmp := FImage.Picture.Bitmap
  else
    FBmp := nil;
  SetAutoTransparentColor(FAutoTransparentColor);
  Changed;
  Invalidate;
end;

procedure TJvgBitmapImage.SetImage(Value: TImage);
begin
  FImage := Value;
  if Assigned(FImage) and Assigned(FImage.Picture) and
    Assigned(FImage.Picture.Bitmap) then
    FBmp := FImage.Picture.Bitmap
  else
  if Assigned(FBitmap) then
    FBmp := FBitmap
  else
    FBmp := nil;
  SetAutoTransparentColor(FAutoTransparentColor);
  Changed;
  Invalidate;
end;

procedure TJvgBitmapImage.SetBitmapOption(Value: TglWallpaperOption);
begin
  if FBitmapOption <> Value then
  begin
    FBitmapOption := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetDrawState(Value: TglDrawState);
begin
  if FDrawState <> Value then
  begin
    FDrawState := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetTransparentColor(Value: TColor);
begin
  if (FAutoTransparentColor <> ftcUser) or (FTransparentColor = Value) then
    Exit;
  FTransparentColor := Value;
  Changed;
  Invalidate;
end;

procedure TJvgBitmapImage.SetMasked(Value: Boolean);
begin
  if FMasked <> Value then
  begin
    FMasked := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetMaskedColor(Value: TColor);
begin
  if FMaskedColor <> Value then
  begin
    FMaskedColor := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetMaskedToColor(Value: TColor);
begin
  if FMaskedToColor <> Value then
  begin
    FMaskedToColor := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetDisabledMaskColor(Value: TColor);
begin
  if FDisabledMaskColor <> Value then
  begin
    FDisabledMaskColor := Value;
    Changed;
    Invalidate;
  end;
end;

procedure TJvgBitmapImage.SetAutoTransparentColor(Value: TglAutoTransparentColor);
begin
  FAutoTransparentColor := Value;
  if not Assigned(FBmp) then
    Exit;
  if Value <> ftcUser then
    FTransparentColor := GetTransparentColor(FBmp, Value);
  Changed;
  Invalidate;
end;

procedure TJvgBitmapImage.SetFastDraw(Value: Boolean);
begin
  if FFastDraw <> Value then
  begin
    FFastDraw := Value;
    Changed;
    Invalidate;
  end;
end;

{procedure TJvgBitmapImage.SetWidth(Value: Integer);
begin
  if FWidth = Value then Exit;
  FWidth := Value; Invalidate;
end;

procedure TJvgBitmapImage.SetHeight(Value: Integer);
begin
  if FHeight = Value then Exit;
  FHeight := Value; Invalidate;
end;}

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.