jvgcheckbox.pas

East make Tray Icon in delphi

    begin
      CurrTextStyle := Disabled;
      CurrDelinColor := Delineate;
      FontColor := TextDisabled;
    end;

    if fcoUnderlinedActive in Options then
      if FActiveNow then
        Font.Style := Font.Style + [fsUnderline]
      else
        Font.Style := Font.Style - [fsUnderline];
  end;
  GetTextExtentPoint32(FImg.Canvas.Handle, PChar(Caption),
    length(Caption), Size);
  Y := Max(0, (Height - Size.cy) div 2);
  X := 0;
  if Assigned(FGlyphOn) then
    X := Max(X, FGlyphOn.Width);
  if Assigned(FGlyphOff) then
    X := Max(X, FGlyphOff.Width);
  if Assigned(FGlyphDisabled) then
    X := Max(X, FGlyphDisabled.Width);
  if Assigned(FGlyph) then
    X := Max(X, FGlyph.Width);

  FImg.Width := Width;
  FImg.Height := Height;

  if (not FNeedUpdateOnlyMainText) {and (not Transparent)} then
  begin
    R := GetClientRect;
    if FActiveNow then
      BackBrush := CreateSolidBrush(ColorToRGB(Colors.BackgroundActive))
    else
      BackBrush := CreateSolidBrush(ColorToRGB(Colors.Background));
    FillRect(FImg.Canvas.Handle, R, BackBrush);
    DeleteObject(BackBrush);
  end;

  if FTransparent and (not FNeedUpdateOnlyMainText) then
    if (not (fcoFastDraw in Options)) or FNeedRebuildBackground or (csDesigning
      in ComponentState) then
      GetParentImageRect(Self, Bounds(Left, Top, Width, Height),
        FImg.Canvas.Handle);

  if Alignment = taLeftJustify then
  begin
    X := 0;
    if FGlyph <> nil then
      Inc(X, FGlyph.Width);
  end
  else
    Inc(X, Interspace);

  //...Supress Gradient if needed
  isGradientActive := Gradient.Active;
  if FActiveNow and (Colors.TextActive <> Colors.Text) then
    Gradient.Active := False;

  ExtTextOutExt(FImg.Canvas.Handle, X, Y, GetClientRect, Caption,
    CurrTextStyle, fcoDelineatedText in Options,
    FNeedUpdateOnlyMainText, FontColor, CurrDelinColor,
    Colors.Highlight, Colors.Shadow,
    Illumination, Gradient, Font);

  Gradient.Active := isGradientActive;

  if not FNeedUpdateOnlyMainText then
  begin
    if (not (fcoFastDraw in Options)) or FNeedRebuildBackground or (csDesigning
      in ComponentState) then
    begin
      if FGlyph <> nil then //...TransparentColor -> Left Bottom Pixel
      begin
        if not Transparent then
          ChangeBitmapColor(FGlyph, GetPixel(FGlyph.Canvas.Handle, 0,
            FGlyph.Height - 1), clBtnFace);

        // glyph always left
        CreateBitmapExt(FImg.Canvas.Handle, FGlyph, ClientRect, 0,
          Max(0, (Height - FGlyph.Height) div 2),
          fwoNone, DrawState, Transparent,
          GetPixel(FGlyph.Canvas.Handle, 0, FGlyph.Height - 1)
          {TransparentColor},
          DisabledMaskColor);
      end;
      FNeedRebuildBackground := False;
    end;
    if not Transparent then
      if FActiveNow then
        ChangeBitmapColor(Bitmap, GetPixel(Bitmap.Canvas.Handle, 0,
          Bitmap.Height - 1), Colors.BackgroundActive)
      else
        ChangeBitmapColor(Bitmap, GetPixel(Bitmap.Canvas.Handle, 0,
          Bitmap.Height - 1), Colors.Background);

    if Alignment = taRightJustify then
      X := GlyphShift.X
    else
      X := Width - Bitmap.Width;

    if Assigned(Bitmap) then
      CreateBitmapExt(FImg.Canvas.Handle, Bitmap, ClientRect, X,
        Integer(GlyphShift.Y + Max(0, (Height - Bitmap.Height) div 2)),
        fwoNone, DrawState, Transparent,
        GetPixel(Bitmap.Canvas.Handle, 0, Bitmap.Height - 1),
        DisabledMaskColor);
  end;

{  BitBlt(Canvas.Handle, 0, 0, Img.Width, Img.Height, Img.Canvas.Handle, 0, 0,
    SRCCOPY);}
  FImg.Transparent := True;
  FImg.TransparentMode := tmAuto;
  Canvas.Draw(0, 0, FImg);

  FSuppressCMFontChanged := False;
  FOnlyTextStyleChanged := False;
  FNeedUpdateOnlyMainText := False;
  if Assigned(FAfterPaint) then
    FAfterPaint(Self);
end;

procedure TJvgCheckBox.Notification(AComponent: TComponent; Operation:
  TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FocusControl) and (Operation = opRemove) then
  begin {UnhookFocusControlWndProc;}
    FFocusControl := nil;
  end;
end;

procedure TJvgCheckBox.HookFocusControlWndProc;
var
  P: Pointer;
begin
  P := Pointer(GetWindowLong(FocusControl.Handle, GWL_WNDPROC));
  if (P <> FNewWndProc) then
  begin
    FPrevWndProc := P;
    FNewWndProc := JvMakeObjectInstance(FocusControlWndHookProc);
    SetWindowLong(FocusControl.Handle, GWL_WNDPROC, Longint(FNewWndProc));
  end;
end;

procedure TJvgCheckBox.UnhookFocusControlWndProc;
begin
  //  if not(csDesigning in ComponentState) then Exit;
  if (FNewWndProc <> nil) and (FPrevWndProc <> nil) and
    (Pointer(GetWindowLong(FocusControl.Handle, GWL_WNDPROC)) = FNewWndProc) then
  begin
    SetWindowLong(FocusControl.Handle, GWL_WNDPROC, Longint(FPrevWndProc));
    // (rom) JvFreeObjectInstance call added
    JvFreeObjectInstance(FNewWndProc);
    FNewWndProc := nil;
  end;
end;

procedure TJvgCheckBox.FocusControlWndHookProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_SETFOCUS:
      begin
        {$IFDEF USEJVCL}
        MouseEnter(Self);
        {$ENDIF USEJVCL}
        FShowAsActiveWhileControlFocused := True;
      end;
    WM_KILLFOCUS:
      begin
        FShowAsActiveWhileControlFocused := False;
        {$IFDEF USEJVCL}
        MouseLeave(Self);
        {$ENDIF USEJVCL}
      end;
    WM_DESTROY: {fNeedRehookFocusControl := True};
  end;
  with Msg do
    Result := CallWindowProc(FPrevWndProc, TForm(Owner).Handle, Msg, WParam,
      LParam);
end;

procedure TJvgCheckBox.SetFocusControl(Value: TWinControl);
begin
  if FFocusControl = Value then
    Exit;
  if (fcoActiveWhileControlFocused in Options) and Assigned(FFocusControl) then
    UnhookFocusControlWndProc;
  FFocusControl := Value;
  if (fcoActiveWhileControlFocused in Options) and Assigned(FFocusControl) then
    HookFocusControlWndProc;
end;

procedure TJvgCheckBox.OnGradientChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then
    FNeedUpdateOnlyMainText := True;
  Repaint;
end;

procedure TJvgCheckBox.OnIlluminationChanged(Sender: TObject);
begin
  CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color, Colors);
  Repaint;
end;

function TJvgCheckBox.IsCustomGlyph: Boolean;
begin
  Result := FGlyphKind = fgkCustom;
end;

function TJvgCheckBox.GetCheckedItemInGroup: TJvgCheckBox;
var
  I: Integer;
begin
  if FChecked then
  begin
    Result := Self;
    Exit;
  end;
  Result := nil;
  if GroupIndex <> 0 then
  begin
    for I := 0 to Owner.ComponentCount - 1 do
      if (Owner.Components[I] is TJvgCheckBox) and
        (TJvgCheckBox(Owner.Components[I]).GroupIndex = GroupIndex) and
        (TJvgCheckBox(Owner.Components[I]).Checked) then
      begin
        Result := TJvgCheckBox(Owner.Components[I]);
        Break;
      end;
  end;
end;

procedure TJvgCheckBox.SetCheckedItemInGroup(TagNo: Integer);
var
  I: Integer;
begin
  if GroupIndex <> 0 then
  begin
    for I := 0 to Owner.ComponentCount - 1 do
      if (Owner.Components[I] is TJvgCheckBox) and
        (TJvgCheckBox(Owner.Components[I]).GroupIndex = GroupIndex) and
        (TJvgCheckBox(Owner.Components[I]).Tag = TagNo) then
      begin
        TJvgCheckBox(Owner.Components[I]).Checked := True;
        Break;
      end;
  end;
end;
//...______________________________________________PROPERTIES METHODS

procedure TJvgCheckBox.SetChecked(Value: Boolean);
var
  I: Integer;
begin
  if FChecked = Value then
    Exit;
  FNeedRebuildBackground := True;
  if GroupIndex <> 0 then
  begin
    if not FChecked then
    begin
      for I := 0 to Owner.ComponentCount - 1 do
        if (Owner.Components[I] is TJvgCheckBox) and
          (TJvgCheckBox(Owner.Components[I]).GroupIndex = GroupIndex) and
          (TJvgCheckBox(Owner.Components[I]).Checked) and
          (Owner.Components[I] <> Self) then
        begin
          TJvgCheckBox(Owner.Components[I]).FChecked := False;
          TJvgCheckBox(Owner.Components[I]).FNeedRebuildBackground := True;
          TJvgCheckBox(Owner.Components[I]).Invalidate;
        end;
      FChecked := True;
    end;
  end
  else
    FChecked := Value;
  Invalidate;
end;

procedure TJvgCheckBox.SetGlyph(Value: TBitmap);
begin
  if Assigned(FGlyph) then
    FGlyph.Free;
  FGlyph := TBitmap.Create;
  FGlyph.Assign(Value);
  FNeedRebuildBackground := True;
  Invalidate;
end;

function TJvgCheckBox.GetGlyph: TBitmap;
begin
  if not Assigned(FGlyph) then
    FGlyph := TBitmap.Create;
  Result := FGlyph;
end;

procedure TJvgCheckBox.SetGlyphOn(Value: TBitmap);
begin
  if Assigned(FGlyphOn) then
    FGlyphOn.Free;
  FGlyphOn := TBitmap.Create;
  FGlyphKind := fgkCustom;
  FGlyphOn.Assign(Value);
  Invalidate;
end;

function TJvgCheckBox.GetGlyphOn: TBitmap;
begin
  if not Assigned(FGlyphOn) then
    FGlyphOn := TBitmap.Create;
  Result := FGlyphOn;
end;

procedure TJvgCheckBox.SetGlyphOff(Value: TBitmap);
begin
  if Assigned(FGlyphOff) then
    FGlyphOff.Free;
  FGlyphOff := TBitmap.Create;
  FGlyphKind := fgkCustom;
  FGlyphOff.Assign(Value);
  Invalidate;
end;

function TJvgCheckBox.GetGlyphOff: TBitmap;
begin
  if not Assigned(FGlyphOff) then
    FGlyphOff := TBitmap.Create;
  Result := FGlyphOff;
end;

procedure TJvgCheckBox.SetGlyphDisabled(Value: TBitmap);
begin
  if Assigned(FGlyphDisabled) then
    FGlyphDisabled.Free;
  FGlyphDisabled := TBitmap.Create;
  FGlyphDisabled.Assign(Value);
  Invalidate;
end;

function TJvgCheckBox.GetGlyphDisabled: TBitmap;
begin
  if not Assigned(FGlyphDisabled) then
    FGlyphDisabled := TBitmap.Create;
  Result := FGlyphDisabled;
end;

procedure TJvgCheckBox.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    if FChecked and (Value <> 0) then
    begin
      FChecked := False;
      //    SetChecked( True );
      FChecked := True;
    end;
  end;
end;

procedure TJvgCheckBox.SetOptions(Value: TglCheckBoxOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
    CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color, Colors);
    Invalidate;
  end;
end;

procedure TJvgCheckBox.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    {$IFDEF USEJVCL}
    if FTransparent then
      ExcludeThemeStyle(Self, [csParentBackground])
    else
      IncludeThemeStyle(Self, [csParentBackground]);
    {$ENDIF USEJVCL}
    Repaint;
  end;
end;

procedure TJvgCheckBox.SetDisabledMaskColor(Value: TColor);
begin
  if FDisabledMaskColor <> Value then
  begin
    FDisabledMaskColor := Value;
    FNeedRebuildBackground := True;
    Invalidate;
  end;
end;

procedure TJvgCheckBox.SetInterspace(Value: Integer);
begin
  if FInterspace <> Value then
  begin
    FInterspace := Value;
    FNeedRebuildBackground := True;
    Invalidate;
  end;
end;

procedure TJvgCheckBox.SetGlyphKind(Value: TglGlyphKind);
begin
  FGlyphKind := Value;

  if (FGlyphKind = fgkCustom) and (csReading in ComponentState) then
  begin
    GlyphOn := nil;
    GlyphOff := nil;
    GlyphDisabled := nil;
  end
  else
  //if (csDesigning in ComponentState){and not(csLoading in ComponentState)}then
  begin
    if not Assigned(FGlyphOn) then
      FGlyphOn := TBitmap.Create;
    if not Assigned(FGlyphOff) then
      FGlyphOff := TBitmap.Create;
    if not Assigned(FGlyphDisabled) then
      FGlyphDisabled := TBitmap.Create;
    FGlyphOn.LoadFromResourceName(HInstance, 'JvgON');
    FGlyphOff.LoadFromResourceName(HInstance, 'JvgOFF');
    FGlyphDisabled.LoadFromResourceName(HInstance, 'JvgDISABLED');

    FGlyphOn.Transparent := True;
    FGlyphOn.TransparentMode := tmAuto;
    FGlyphOff.Transparent := True;
    FGlyphOff.TransparentMode := tmAuto;
    FGlyphDisabled.Transparent := True;
    FGlyphDisabled.TransparentMode := tmAuto;
  end;
end;

procedure TJvgCheckBox.SetAlignment(const Value: TLeftRight);
begin
  FAlignment := Value;
  Invalidate;
end;

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

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

end.