jvqimagesviewer.pas

East make Tray Icon in delphi

procedure TJvImageItem.ReduceMemoryUsage;
begin
  inherited ReduceMemoryUsage;
  if FileName <> '' then // release image if we can recreate it from it's filename
    Picture := nil;
end;

//=== TJvImagesViewer ========================================================

constructor TJvImagesViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //  FDirectory := GetCurrentDir;
  
  
  FFileMask := QGraphics.GraphicFileMask(TGraphic);
  
  Color := clWindow;
end;

function TJvImagesViewer.ScaleRect(ARect, RefRect: TRect): TRect;
var
  w, h, cw, ch: Integer;
  XYAspect: Double;
begin
  w := ARect.Right - ARect.Left;
  h := ARect.Bottom - ARect.Top;
  cw := RefRect.Right - RefRect.Left;
  ch := RefRect.Bottom - RefRect.Top;

  if (w > cw) or (h > ch) then
  begin
    if (w > 0) and (h > 0) then
    begin
      XYAspect := w / h;
      if w > h then
      begin
        w := cw;
        h := Trunc(cw / XYAspect);
        if h > ch then
        begin
          h := ch;
          w := Trunc(ch * XYAspect);
        end;
      end
      else
      begin
        h := ch;
        w := Trunc(ch * XYAspect);
        if w > cw then
        begin
          w := cw;
          h := Trunc(cw / XYAspect);
        end;
      end;
    end
    else
    begin
      w := cw;
      h := ch;
    end;
  end;

  with Result do
  begin
    Left := 0;
    Top := 0;
    Right := w;
    Bottom := h;
  end;
end;

procedure TJvImagesViewer.DrawItem(Index: Integer; State: TCustomDrawState;
  Canvas: TCanvas; ItemRect, TextRect: TRect);
var
  ImageRect: TRect;
  TotalPadding, BottomRightShift: Integer;
  AItem: TJvImageItem;
  S: string;

  procedure ModifyRect(var R:TRect; ALeft, ATop, ARight, ABottom: Integer);
  begin
    Inc(R.Left, ALeft);
    Inc(R.Top, ATop);
    Inc(R.Right, ARight);
    Inc(R.Bottom, ABottom);
  end;

begin
  inherited DrawItem(Index, State, Canvas, ItemRect, TextRect);
  {$IFDEF MSWINDOWS}
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    BottomRightShift := 1
  else
  {$ENDIF MSWINDOWS}
    BottomRightShift := 0;
  AItem := Items[Index];
  Canvas.Font := Font;
  Canvas.Brush.Color := Color;
  Canvas.Pen.Color := Font.Color;
  TotalPadding := Options.ImagePadding;
  if Options.ShowCaptions then
  begin
    Dec(ImageRect.Bottom, 2);
    Inc(TextRect.Top, 2);
    S := AItem.Caption;
    if (S = '') then
      S := ExtractFileName(AItem.FileName);
  end;

  if cdsHot in State then
  begin
    Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
    Canvas.Font.Color := clHighlight;
    Canvas.Pen.Color := Options.HotColor;
    Canvas.Pen.Width := Options.HotFrameSize;
    Canvas.Brush.Style := bsClear;
    ModifyRect(ItemRect,Options.HotFrameSize div 2,Options.HotFrameSize div 2,
      -Options.HotFrameSize div 2 + BottomRightShift,-Options.HotFrameSize div 2 + BottomRightShift);
    Canvas.Rectangle(ItemRect);
    ModifyRect(ItemRect,-Options.HotFrameSize div 2,-Options.HotFrameSize div 2,
      Options.HotFrameSize div 2 - BottomRightShift,Options.HotFrameSize div 2 - BottomRightShift);
    Canvas.Brush.Style := bsSolid;
    SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
    Canvas.Pen.Width := 1;
  end;
  if cdsSelected in State then
  begin
    Canvas.Pen.Color := clBtnFace;
    Canvas.Brush.Color := clHighlight;
    if Options.BrushPattern.Active then
      Canvas.Brush.Bitmap := Options.BrushPattern.GetBitmap
    else
      Canvas.Brush.Color := Options.BrushPattern.OddColor;
    Canvas.Rectangle(ItemRect);
    Canvas.Brush.Bitmap := nil;
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Color := Options.HotColor;
    Canvas.Pen.Width := Options.HotFrameSize;
    ModifyRect(ItemRect,Options.HotFrameSize div 2, Options.HotFrameSize div 2,
      -Options.HotFrameSize div 2 + BottomRightShift, -Options.HotFrameSize div 2 + BottomRightShift);
    Canvas.Rectangle(ItemRect);
    ModifyRect(ItemRect,-Options.HotFrameSize div 2, -Options.HotFrameSize div 2,
      Options.HotFrameSize div 2 - BottomRightShift, Options.HotFrameSize div 2 - BottomRightShift);
    Canvas.Font.Color := clHighlightText;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clHighlight;
    Canvas.Pen.Width := 1;
  end
  else
  if (Options.FrameColor <> clNone) and not (cdsHot in State) then
  begin
    Canvas.Brush.Color := Options.FrameColor;
    Canvas.FrameRect(ItemRect);
    SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
  end;
  // make space around image
  InflateRect(ItemRect, -TotalPadding, -TotalPadding);
  if AItem.Picture <> nil then // access Picture to load image
  begin
    ImageRect := Rect(0, 0, AItem.Picture.Width, AItem.Picture.Height);
    ImageRect := CenterRect(ScaleRect(ImageRect, ItemRect), ItemRect);
    if (RectWidth(ImageRect) > 0) and (RectHeight(ImageRect) > 0) then
      if AItem.Picture.Graphic is TIcon then
        //        and (RectWidth(ImageRect) < RectWidth(R)) and (RectHeight(ImageRect) < RectHeight(R))  then
        with ImageRect do // TIcon doesn't scale it's content
          DrawIconEx(Canvas.Handle, Left, Top, AItem.Picture.Icon.Handle, Right - Left, Bottom - Top, 0, 0, DI_NORMAL)
      else
        Canvas.StretchDraw(ImageRect, AItem.Picture.Graphic);
  end;

  if Options.ShowCaptions and (S <> '') then
  begin
    if Options.Layout = tlCenter then
      S := ' ' + S + ' ';
    ViewerDrawText(Canvas, PChar(S), Length(S),
      TextRect, DT_END_ELLIPSIS or DT_EDITCONTROL, Options.Alignment, tlCenter, False);
  end;
end;

function TJvImagesViewer.GetItems(Index: Integer): TJvImageItem;
begin
  Result := TJvImageItem(inherited Items[Index]);
end;

function TJvImagesViewer.GetItemClass: TJvViewerItemClass;
begin
  Result := TJvImageItem;
end;

function TJvImagesViewer.LoadImages: Boolean;
var
  I, J: Integer;
  F: TSearchRec;
  Files, FileMasks: TStringList;
  TmpDir: string;
begin
  BeginUpdate;
  try
    Count := 0;
    TmpDir := ExpandUNCFileName(Directory);
    FileMasks := TStringList.Create;
    try
      FileMasks.Sorted := True; // make sure no duplicates are added
      ExpandFileMask(Filemask, FileMasks);
      if TmpDir <> '' then
        TmpDir := IncludeTrailingPathDelimiter(TmpDir);
      DoLoadBegin;
      Files := TStringList.Create;
      try
        Files.Sorted := True;
        for I := 0 to FileMasks.Count - 1 do
        begin
          if SysUtils.FindFirst(TmpDir + FileMasks[I], faAnyFile, F) = 0 then
          try
            repeat
              if F.Attr and faDirectory = 0 then
                Files.Add(TmpDir + F.Name);
            until SysUtils.FindNext(F) <> 0;
            Count := Files.Count;
            J := 0;
            while J < Files.Count do
            begin
              Items[J].FileName := Files[J];
              Inc(J);
            end;
          finally
            SysUtils.FindClose(F);
          end;
        end;
      finally
        Files.Free;
      end;
      DoLoadEnd;
    finally
      FileMasks.Free;
    end;
    Result := Count > 0;
  finally
    EndUpdate;
  end;
end;

procedure TJvImagesViewer.SetDirectory(const Value: string);
begin
  if FDirectory <> Value then
  begin
    FDirectory := Value;
    LoadImages;
  end;
end;

procedure TJvImagesViewer.SetFileMask(const Value: string);
begin
  if FFileMask <> Value then
  begin
    FFileMask := Value;
    LoadImages;
  end;
end;

procedure TJvImagesViewer.ExpandFileMask(const Mask: string;
  Strings: TStrings);
var
  Start, Current: PChar;
  TmpChar: Char;
begin
  Current := PChar(Mask);
  Start := Current;
  while (Current <> nil) and (Current^ <> #0) do
  begin
    if Current^ in [',', ';'] then
    begin
      TmpChar := Current^;
      Current^ := #0;
      if Start <> '' then
        Strings.Add(Start);
      Current^ := TmpChar;
      Start := Current + 1;
    end;
    Inc(Current);
  end;
  if Start <> '' then
    Strings.Add(Start);
end;

function TJvImagesViewer.LoadErrorHandled(E: Exception; const FileName: string): Boolean;
begin
  Result := False;
  if Assigned(FOnLoadError) then
    FOnLoadError(Self, E, FileName, Result);
end;

procedure TJvImagesViewer.DoLoadBegin;
begin
  if Assigned(FOnLoadBegin) then
    FOnLoadBegin(Self);
end;

procedure TJvImagesViewer.DoLoadProgress(Item: TJvImageItem;
  Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean;
  const R: TRect; const Msg: string);
begin
  if Assigned(FOnLoadProgress) then
    FOnLoadProgress(Self, Item, Stage, PercentDone, ReDrawNow, R, Msg);
end;

procedure TJvImagesViewer.DoLoadEnd;
begin
  if Assigned(FOnLoadEnd) then
    FOnLoadEnd(Self);
end;

function TJvImagesViewer.GetOptionsClass: TJvItemViewerOptionsClass;
begin
  Result := TJvImageViewerOptions;
end;

function TJvImagesViewer.GetOptions: TJvImageViewerOptions;
begin
  Result := TJvImageViewerOptions(inherited Options);
end;

procedure TJvImagesViewer.SetOptions(const Value: TJvImageViewerOptions);
begin
  inherited Options := Value;
end;

end.