jvglabel.pas

East make Tray Icon in delphi

  CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color, Colors);
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetDirection(Value: TglLabelDir);
begin
  FDirection := Value;
  CreateLabelFont;
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetFontWeight(Value: TFontWeight);
begin
  if FFontWeight = Value then
    Exit;
  FFontWeight := Value;
  FUFontWeight := Word(Value) * 100;
  CreateLabelFont;
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetOptions(Value: TglLabelOptions);
begin
  if FOptions = Value then
    Exit;
  FOptions := Value;
  ActiveWhileControlFocused := floActiveWhileControlFocused in Options;
  if floTransparentFont in Options then
    Options := Options + [floBufferedDraw];
  CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color, Colors);
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetTexture(Value: TBitmap);
begin
  if Assigned(FTexture) then
    FTexture.Free;
  FTexture := nil;
  if (Value <> nil) and (Value.Handle <> 0) then
  begin
    FTexture := TBitmap.Create;
    FTexture.Assign(Value);
    FTextureBmp := FTexture;
  end
  else
  if Assigned(FTextureImage) then
    FTextureBmp := FTextureImage.Picture.Bitmap
  else
    FTextureBmp := nil;
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetBackground(Value: TBitmap);
begin
  if Assigned(FBackground) then
    FBackground.Free;
  FBackground := nil;
  if (Value <> nil) and (Value.Handle <> 0) then
  begin
    FBackground := TBitmap.Create;
    FBackground.Assign(Value);
    FBackgroundBmp := FBackground;
  end
  else
  if FBackgroundImage <> nil then
    FBackgroundBmp := FBackgroundImage.Picture.Bitmap
  else
    FBackgroundBmp := nil;
  InvalidateLabel(True);
end;

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

function TJvgLabel.GetBackground: TBitmap;
begin
  if not Assigned(FBackground) then
    FBackground := TBitmap.Create;
  Result := FBackground;
end;

procedure TJvgLabel.SetTextureImage(Value: TImage);
begin
  FTextureImage := Value;
  //mb  if (not IsItAFilledBitmap(FTexture)) and Assigned(Value) then
  if Value <> nil then
  begin
    FTextureBmp := FTextureImage.Picture.Bitmap;
  end
  else
  if FTexture <> nil then
    FTextureBmp := FTexture
  else
    FTextureBmp := nil;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetBackgroundImage(Value: TImage);
begin
  FBackgroundImage := Value;
  //mb  if (not IsItAFilledBitmap(FBackground)) and Assigned(Value) then
  if Value <> nil then
  begin
    FBackgroundBmp := FBackgroundImage.Picture.Bitmap;
    InvalidateLabel(True);
  end
  else
  if FBackground <> nil then
    FBackgroundBmp := FBackground
  else
    FBackgroundBmp := nil;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  Invalidate;
end;

//=== { TJvgStaticTextLabel } ================================================

constructor TJvgStaticTextLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveColor := clWhite;
  FAlignment := ftaBroadwise;
  FOptions := [ftoActiveWhileControlFocused];
  FWordWrap := True;
  Width := 100;
  Height := 16;
end;

{$IFDEF USEJVCL}
procedure TJvgStaticTextLabel.MouseEnter(Control: TControl);
begin
  if (ftoIgnoreMouse in Options) or FShowAsActiveWhileControlFocused then
    Exit;
  FActiveNow := True;
  Repaint;
  inherited MouseEnter(Control);
end;

procedure TJvgStaticTextLabel.MouseLeave(Control: TControl);
begin
  if (ftoIgnoreMouse in Options) or FShowAsActiveWhileControlFocused then
    Exit;
  FActiveNow := False;
  if ftoUnderlinedActive in Options then
    Invalidate
  else
    Repaint;
  inherited MouseLeave(Control);
end;

{$ENDIF USEJVCL}

procedure TJvgStaticTextLabel.Paint;
const
  Alignments: array [TglAlignment] of Word =
    (DT_LEFT, DT_RIGHT, DT_CENTER, 0);
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);
var
  LAlignment: TglAlignment;
  FTargetCanvas: TCanvas;
  Rect: TRect;
begin
  //inherited;
  if Caption = '' then
    Exit;

  if Assigned(ExternalCanvas) then
    FTargetCanvas := ExternalCanvas
  else
    FTargetCanvas := Canvas;
  FTargetCanvas.Font.Assign(Font);
  LAlignment := FAlignment;
  SetBkMode(FTargetCanvas.Handle, Integer(FTransparent));

  {  if FActiveNow and(ftoUnderlinedActive in Options) then
      FTargetCanvas.Font.Style := Font.Style + [fsUnderline]
    else
      FTargetCanvas.Font.Style := Font.Style - [fsUnderline];
  }
  if FActiveNow then
    SetTextColor(FTargetCanvas.Handle, ColorToRGB(ActiveColor))
  else
    SetTextColor(FTargetCanvas.Handle, ColorToRGB(Font.Color));

  //  TextOut( FTargetCanvas.Handle, 0, 0, 'lpszString', 10);
  //  BitBlt( FTargetCanvas.Handle, 0, 0, Width, Height, Image.FTargetCanvas.Handle, Width, Height, SRCCOPY );
  if Alignment = ftaBroadwise then
  begin
    if FWordWrap then
    begin
      DrawTextBroadwise(FTargetCanvas);
      Exit;
    end
    else
      LAlignment := ftaLeftJustify;
  end;
  Rect := ClientRect;
  Windows.DrawText(FTargetCanvas.Handle, PChar(Caption), Length(Caption), Rect,
    DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[LAlignment]);
end;

procedure TJvgStaticTextLabel.DrawTextBroadwise(Canvas: TCanvas);
var
  DrawPos, Pos1, Pos2, LineWidth, LineNo, LexemCount, TextHeight: Integer;
  Lexem: string;
  Size: TSize;
  LStop, LBroadwiseLine: Boolean;

  function GetNextLexem(var Pos1, Pos2: Integer; ATrimLeft: Boolean): string;
  var
    Pos: Integer;
  begin
    Pos := Pos1;
    if Caption[Pos] = ' ' then
      repeat
        Inc(Pos);
      until (Pos > Length(Caption)) or (Caption[Pos] <> ' ');
    Pos2 := Pos;
    if ATrimLeft and (LineNo > 0) then
      Pos1 := Pos;
    repeat
      Inc(Pos2);
    until (Pos2 > Length(Caption)) or (Caption[Pos2] = ' ');

    Result := Copy(Caption, Pos1, Pos2 - Pos1);
  end;

  procedure DrawLine(AdditSpace: Cardinal);
  var
    I, DrawPos1, DrawPos2: Integer;
    Lexem: string;
    Size: TSize;
    X, X1: Single;
  begin
    DrawPos1 := DrawPos;
    DrawPos2 := DrawPos;
    X := 0;
    X1 := 0;
    LineWidth := 0;
    for I := 1 to LexemCount do
    begin
      Lexem := GetNextLexem(DrawPos1, DrawPos2, I = 1);
      //      if LexemCount=1 then Lexem:=Lexem+' ';
      GetTextExtentPoint32(Canvas.Handle, PChar(Lexem), Length(Lexem), Size);
      Inc(LineWidth, Trunc(X));
      X := X + Size.cx;
      if (Trunc(X) > Width) and (LexemCount > 1) then
        Exit;

      if (LexemCount > 1) and LBroadwiseLine then
        X := X + AdditSpace / (LexemCount - 1);
      TextOut(Canvas.Handle, Trunc(X1), LineNo * TextHeight, PChar(Lexem),
        Length(Lexem));
      X1 := X;
      DrawPos1 := DrawPos2;
    end;
  end;

begin
  if Text = '' then
    Exit;
  LineWidth := 0;
  LineNo := 0;
  DrawPos := 1;
  Pos1 := 1;
  Pos2 := 1;
  LexemCount := 0;
  TextHeight := 0;
  LStop := False;
  LBroadwiseLine := True;
  repeat
    Lexem := GetNextLexem(Pos1, Pos2, LexemCount = 0);
    //    if LexemCount=0 then Lexem:=Lexem+' ';
    GetTextExtentPoint32(Canvas.Handle, PChar(Lexem), Length(Lexem), Size);
    Inc(LineWidth, Size.cx);
    Inc(LexemCount);
    if TextHeight < Size.cy then
      TextHeight := Size.cy;
    if (LineWidth > Width) or (Pos2 >= Length(Caption)) then
    begin
      if LineWidth > Width then
      begin
        if LexemCount = 1 then
          Pos1 := Pos2;
        if LexemCount > 1 then
          Dec(LexemCount);
        DrawLine(Width - (LineWidth - Size.cx));
        DrawPos := Pos1;
        Inc(LineNo);
        LexemCount := 0;
        LineWidth := 0;
        LStop := Pos1 > Length(Caption);
      end
      else
      begin
        LBroadwiseLine := ftoBroadwiseLastLine in Options;
        DrawLine(Width - LineWidth);
        Inc(LineNo);
        LStop := True;
      end;
    end
    else
      Pos1 := Pos2;
  until LStop;
  if FAutoSize then
    Height := Max(12, LineNo * TextHeight);
end;

procedure TJvgStaticTextLabel.AdjustBounds;
const
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
begin
  if not (csReading in ComponentState) and FAutoSize then
  begin
    Rect := ClientRect;
    DC := GetDC(HWND_DESKTOP);
    Canvas.Handle := DC;
    Windows.DrawText(Canvas.Handle, PChar(Caption), Length(Caption), Rect,
      DT_EXPANDTABS or DT_CALCRECT or WordWraps[FWordWrap]);
    Canvas.Handle := 0;
    ReleaseDC(HWND_DESKTOP, DC);
    X := Left;
    if FAlignment = ftaRightJustify then
      Inc(X, Width - Rect.Right);
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
end;

procedure TJvgStaticTextLabel.SetAlignment(Value: TglAlignment);
begin
  FAlignment := Value;
  Invalidate;
end;

procedure TJvgStaticTextLabel.SetOptions(Value: TglStaticTextOptions);
begin
  FOptions := Value;
  ActiveWhileControlFocused := ftoActiveWhileControlFocused in Options;
  Invalidate;
end;

procedure TJvgStaticTextLabel.SetWordWrap(Value: Boolean);
begin
  FWordWrap := Value;
  Invalidate;
end;

procedure TJvgStaticTextLabel.SetAutoSize(Value: Boolean);
begin
  inherited AutoSize := Value;
  AdjustBounds;
end;

function TJvgStaticTextLabel.GetAutoSize: Boolean;
begin
  Result := inherited AutoSize;
end;

//=== { TJvgGlyphLabel } =====================================================

constructor TJvgGlyphLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csOpaque,
    csClickEvents, csSetCaption, csReplicatable];
end;

destructor TJvgGlyphLabel.Destroy;
begin
  FGlyphOn.Free;
  FGlyphOff.Free;
  FGlyphDisabled.Free;
  inherited Destroy;
end;

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

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

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

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

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

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

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

procedure TJvgGlyphLabel.SetGlyphKind(Value: TglGlyphKind);
begin
  if FGlyphKind <> Value then
    FGlyphKind := Value;
  if (FGlyphKind = fgkCustom) and (csReading in ComponentState) then
  begin
    GlyphOn := nil;
    GlyphOff := nil;
    GlyphDisabled := nil;
  end
  else
  begin
    FGlyphOn.LoadFromResourceName(HInstance, 'JvgON');
    FGlyphOff.LoadFromResourceName(HInstance, 'JvgOFF');
    FGlyphDisabled := TBitmap.Create;
    FGlyphDisabled.LoadFromResourceName(HInstance, 'JvgDISABLED');
  end;
end;

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

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

end.