jvgcaption.pas

East make Tray Icon in delphi

          TForm(Owner).Left, HiWord(Msg.LParam) - TForm(Owner).Top));
        if PtInRect(FCloseRect, Pt) then
        begin
          Msg.Result := HTCLIENT;
          Exit;
        end;
        {$ENDIF GL_CAPT_BUTTONS}
        DefaultProc;
        if (Msg.Result = HTLEFT) or (Msg.Result = HTRIGHT) or (Msg.Result = HTTOP) or
          (Msg.Result = HTBOTTOM) or (Msg.Result = HTBOTTOMLEFT) or
          (Msg.Result = HTBOTTOMRIGHT) or (Msg.Result = HTTOPLEFT) or
          (Msg.Result = HTTOPRIGHT) then
          DrawCaption(False);
      end;
    // WM_SETTEXT: DrawCaption( False );
    // WM_ACTIVATE: DrawCaption;
    WM_DESTROY:
      begin
        FreeParentWindowHook;
        DefaultProc;
      end;
  else
    DefaultProc;
  end;
end;

procedure TJvgCaption.DrawIcon(DC: HDC; R: TRect);
var
  IconHandle: HICON;
  IconDC: HDC;
  OldIconBMP, IconBMP: HBITMAP;
  Brush, OldBrush: HBRUSH;
begin

  with TForm(Owner) do
    if Icon.Handle <> 0 then
      IconHandle := Icon.Handle
    else
    if Application.Icon.Handle <> 0 then
      IconHandle := Application.Icon.Handle
    else
      IconHandle := LoadIcon(0, IDI_APPLICATION);

  IconDC := CreateCompatibleDC(DC);
  IconBMP := CreateCompatibleBitmap(DC, FCXIcon, FCYIcon);
  OldIconBMP := SelectObject(IconDC, IconBMP);
  Brush := CreateSolidBrush(ColorToRGB(CaptionColor));
  OldBrush := SelectObject(IconDC, Brush);
  //  FillRect( IconDC, R, Brush );
  PatBlt(IconDC, 0, 0, FCXIcon, FCYIcon, PATCOPY);

  Windows.DrawIcon(IconDC, 0, 0, IconHandle);
  StretchBlt(DC, R.Left, R.Top, R.Bottom - R.Top, R.Bottom - R.Top, IconDC,
    0, 0, FCXIcon, FCYIcon, SRCCOPY);

  DeleteObject(SelectObject(IconDC, OldIconBMP));
  DeleteObject(SelectObject(IconDC, OldBrush));
  DeleteDC(IconDC);
end;

function TJvgCaption.DrawCaption(DrawAll: Boolean): TRect;
var
  DC: HDC;
  R, IconR: TRect;
  X, Y, X1, Y1, IWidth, IHeight: Integer;
begin
  DC := GetWindowDC(TForm(Owner).Handle);
  try
    GetWindowRect(TForm(Owner).Handle, R);
    FOwnerWidth := R.Right - R.Left;

    R.Left := FCXFrame - 1;
    R.Top := FCYFrame - 1;
    R.Right := FOwnerWidth - FCXFrame;
    R.Bottom := R.Top + FCYCaption - 1;

    FBtnCount := CountCaptionButtons;
    if (FBtnCount = 0) and (not DrawAll) then
      Exit;
    R := DrawBoxEx(DC, R, FCaptBox.Sides, FCaptBox.Inner, FCaptBox.Outer,
      FCaptBox.Bold, CaptionColor, True);
    if not DrawAll then
      Exit;

    if (not FExcludeIcon) and (biSystemMenu in TForm(Owner).BorderIcons) then
    begin
      IconR := Rect(R.Left, R.Top, R.Left + FCXSMIcon + 3, R.Top + FCYSMIcon);
      IconR := DrawBoxEx(DC, IconR, FIconBox.Sides, FIconBox.Inner,
        FIconBox.Outer, FIconBox.Bold, CaptionColor, False);
      DrawIcon(DC, IconR);
      Inc(R.Left, FCXSMIcon + 4);
    end;

    Dec(R.Right, FBtnCount * (FCXSMIcon + 1));
    if FBtnCount <> 0 then
      Dec(R.Right, 4);
    R := DrawBoxEx(DC, R, FTextBox.Sides, FTextBox.Inner, FTextBox.Outer,
      FTextBox.Bold, CaptionColor, True);

    with TForm(Owner).Canvas do
    begin
      Inc(R.Right);
      Inc(R.Bottom);
      Brush.Color := CaptionColor {clActiveCaption};
      Brush.Style := bsSolid;
      Windows.FillRect(DC, R, Brush.Handle);
    end;
    Inc(R.Left, 2);

    if IsItAFilledBitmap(FBmp) then
    begin
      X := R.Left - 2;
      Y := R.Top;
      IHeight := R.Bottom - R.Top;
      IWidth := R.Right - R.Left;
      X1 := X;
      Y1 := Y;
      {      while X < IWidth do
            begin
       while Y < IHeight do
       begin
         BitBlt(DC, X, Y, Min( IWidth, FBmp.Width ), Min( IHeight, FBmp.Height ), FBmp.Canvas.Handle, 0,0, SRCCOPY );
         Inc(Y, Min( IHeight, FBmp.Height ));
       end;
       Inc(X, Min( IWidth, FBmp.Width ));
       Y:=0;
            end;}
      while X1 < R.Right do
      begin
        //IWidth:=SavedIWidth; SavedIWidth:=IWidth;
        if X1 + IWidth > R.Right then
          IWidth := R.Right - X1;
        while Y1 < R.Bottom do
        begin
          // IHeight := SavedIHeight; SavedIHeight:=IHeight;
          if Y1 + IHeight > R.Bottom then
            IHeight := R.Bottom - Y1;
          BitBlt(DC, X1, Y1, Min(IWidth, FBmp.Width), Min(IHeight,
            FBmp.Height), FBmp.Canvas.Handle, 0, 0, SRCCOPY);
          Inc(Y1, Min(IHeight, FBmp.Height));
        end;
        Inc(X1, Min(IWidth, FBmp.Width));
        Y1 := Y;
      end;
    end;
    //...draw close button
    {$IFDEF GL_CAPT_BUTTONS}
    if (FBtnCount = 0) and (Tag = 1) then
    begin
      FCloseRect := Bounds(R.Right - FGlyphClose.Width - 2, R.Top,
        FGlyphClose.Width, FGlyphClose.Height);
      //      BitBlt( DC, R.Right-FGlyphClose.Width-2, R.Top, FGlyphClose.Width, FGlyphClose.Height, FGlyphClose.Canvas.Handle, 0,0, SRCCOPY );
      CreateBitmapExt(DC, FGlyphClose, R, R.Right - FGlyphClose.Width - 8,
        R.Top - 3,
        fwoNone, fdsDefault, True,
        GetPixel(FGlyphClose.Canvas.Handle, 0, FGlyphClose.Height - 1)
        {TransparentColor},
        0);
    end
    else
      FCloseRect := Rect(0, 0, 0, 0);
    {$ENDIF GL_CAPT_BUTTONS}

    DrawTextInRect(DC, R, TForm(Owner).Caption, FTextStyle, FFont,
      DT_SINGLELINE or DT_VCENTER or DT_LEFT);
  finally
    ReleaseDC(TForm(Owner).Handle, DC);
  end;
  Result := R;
end;

function TJvgCaption.CountCaptionButtons: Integer;
begin
  if not (biSystemMenu in TForm(Owner).BorderIcons) then
  begin
    Result := 0;
    Exit;
  end;
  Result := 1;
  if not (TForm(Owner).BorderStyle in [bsToolWindow, bsSizeToolWin, bsDialog]) then
  begin
    if (biMinimize in TForm(Owner).BorderIcons) or
      (biMaximize in TForm(Owner).BorderIcons) then
      Inc(Result, 2)
    else
    if biHelp in TForm(Owner).BorderIcons then
      Inc(Result);
  end;
end;

procedure TJvgCaption.SmthChanged(Sender: TObject);
begin
  Repaint;
end;

procedure TJvgCaption.Repaint;
var
  RGN: HRGN;
begin
  RGN := CreateRectRgn(0, 0, TForm(Owner).Width, FCYCaption);
  SendMessage(THandle(TForm(Owner).Handle), WM_NCPAINT, HRGN(RGN), 0);
  DeleteObject(RGN);
end;

procedure TJvgCaption.SetExcludeIcon(Value: Boolean);
begin
  FExcludeIcon := Value;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetExcludeButtons(Value: Boolean);
begin
  FExcludeButtons := Value;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetCaptionColor(Value: TColor);
begin
  FCaptionColor := Value;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetTextStyle(Value: TglTextStyle);
begin
  FTextStyle := Value;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetFont(Value: TFont);
begin
  if not Assigned(Value) then
    Exit;
  FFont.Assign(Value);
  Repaint;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetAutoTransparentColor(Value: TglAutoTransparentColor);
begin
  FAutoTransparentColor := Value;
  FTransparentColor := GetTransparentColor(FTexture, Value);
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetTextureTransparent(Value: Boolean);
begin
  if FTextureTransparent = Value then
    Exit;
  FTextureTransparent := Value;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.SetTransparentColor(Value: TColor);
begin
  if FTransparentColor = Value then
    Exit;
  FTransparentColor := Value;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

{procedure TJvgCaption.SetTexture( Value: TBitmap );
begin
  if Assigned(FTexture) then FTexture.Free;
  FTexture := TBitmap.Create;
  FTexture.Assign(Value);
end;}

function TJvgCaption.GetTexture: TBitmap;
begin
  if not Assigned(FTexture) then
    FTexture := TBitmap.Create;
  Result := FTexture;
end;

procedure TJvgCaption.SetTexture(Value: TBitmap);
begin
  FTexture.Free;
  FTexture := TBitmap.Create;
  FTexture.Assign(Value);
  if Assigned(Value) then
    FBmp := FTexture
  else
  if Assigned(FImage) and Assigned(FImage.Picture) and
    Assigned(FImage.Picture.Bitmap) then
    FBmp := FImage.Picture.Bitmap
  else
    FBmp := nil;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

procedure TJvgCaption.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(FTexture) then
    FBmp := FTexture
  else
    FBmp := nil;
  if not (csLoading in ComponentState) then
    DrawCaption(True);
end;

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

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

end.