⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvthumbnails.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvThumbNail.PAS, released on 2002-07-03.

The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com]
Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  Thumbimage, ThumbNail components
  Thumbimage is a TImage descentant wich passes the control of the mouse events
  to the ThumbNail and have the ability to change an images look by changing
  the rgb values with the changergb,changergbcurve procedures.
  You can have precise control over the images look.
  The changergb procedure just adds the values you pass to its rgb variables to
  the actual values of the image.
  The Changergbcurves procedure just replaces the value of the rgb values
  accordingly with the values that passed in the the arrays.
  e.g.
  the r array in the position 15 has a value of 35 this meens that wherever in
  the Picture there is a pixels which has a red value equall to 15 it will be ]
  replaced with the value 35.

  ThumbNail is what the name says a component to simply shrink an image
  proportionally to fit in a portion of the screen with some extra mouse handling
  to Create a Button like effect. Just give it a FileName and it will do the work
  for you.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvThumbnails.pas,v 1.14 2005/03/09 14:57:31 marquardt Exp $

unit JvThumbnails;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes, Controls, ExtCtrls, SysUtils, Messages, Graphics, Windows, Forms,
  JvThumbImage, JvBaseThumbnail, Dialogs;

const
  TH_IMAGESIZECHANGED = WM_USER + 1;

type
  // (rom) elements renamed
  TTitlePos = (tpUp, tpDown, tpNone);

  TTitleNotify = procedure(Sender: TObject; FileName: string;
    var ThumbnailTitle: string) of object;

  TJvThumbnail = class(TJvBaseThumbnail)
  private
    FTitle: string;
    FTitlePanel: TJvThumbTitle;
    FTitleColor: TColor;
    FTitleFont: TFont;
    FStreamFileKind: TGRFKind;
    FDFileCreated: string;
    FDFileChanged: string;
    FDFileAccessed: string;
    FShowTitle: Boolean;
    FDFileSize: Longint;
    FStream: TStream;
    FImageWidth: Longint;
    FImageHeight: Longint;
    FClientHeight: Word;
    FClientWidth: Word;
    FShadowObj: TShape;
    FUpdated: Boolean;
    FImageReady: Boolean;
    FTitlePlacement: TTitlePos;
    FPhotoName: TFileName;
    FPhoto: TJvThumbImage;
    FOnGetTitle: TTitleNotify;
    FMousePressed: Boolean;
    FDestroying: Boolean;
    FAsButton: Boolean;
    FMinimizeMemory: Boolean;
    FAutoLoad: Boolean; // if True then load the image either from a thumb file or Create it from the FileName
    FShadowColor: TColor;
    FShowShadow: Boolean;
    FHShadowOffset: Word;
    FVShadowOffset: Word;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure PhotoOnProgress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean;
      const R: TRect; const Msg: string);
    procedure RefreshFont(Sender: TObject);
    procedure SetFileName(const AFile: string);
    function LoadFile(AFile: string): string;
    function GetFileName: string;
    procedure CalculateImageSize; virtual;
    procedure SetClientWidth(AWidth: Word);
    procedure SetDummyStr(AStr: string);
    procedure SetMinimizeMemory(Min: Boolean);
    procedure SetDummyCard(AInt: Longint);
    procedure SetClientHeight(AHeight: Word);
    procedure SetShowTitle(const AState: Boolean);
    procedure SetTitlePlacement(const AState: TTitlePos);
    procedure SetTitle(const Value: string);
    procedure SetTitleColor(const Value: TColor);
    procedure SetStream(const AStream: TStream);
    procedure SetTitleFont(const Value: TFont);
    procedure GetFileInfo(AName: string);
    procedure SetShowShadow(Show: Boolean);
//    procedure SetShadowColor(aColor: TColor);
  protected
    procedure THSizeChanged(var Msg: TMessage); message TH_IMAGESIZECHANGED;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure BoundsChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetTitlePanel(ATitle: string; AFont: TFont; AColor: TColor);
    procedure Refresh;
    property Stream: TStream read FStream write SetStream;
    property Photo: TJvThumbImage read FPhoto write FPhoto;
  published
    property FileName: string read GetFileName write SetFileName;
    property Title: string read FTitle write SetTitle;
    property TitleColor: TColor read FTitleColor write SetTitleColor;
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property ImageReady: Boolean read FImageReady;
    property OnGetTitle: TTitleNotify read FOnGetTitle write FOnGetTitle;
    property ClientWidth: Word read FClientWidth write SetClientWidth;
    property ClientHeight: Word read FClientHeight write SetClientHeight;
    { Do not store dummies }
    property FileSize: Longint read FDFileSize write SetDummyCard stored False;
    property FileAccessed: string read FDFileAccessed write SetDummyStr stored False;
    property FileCreated: string read FDFileCreated write SetDummyStr stored False;
    property FileChanged: string read FDFileChanged write SetDummyStr stored False;
    property ImageWidth: Longint read FImageWidth default 0;
    property ImageHeight: Longint read FImageHeight default 0;
    property AsButton: Boolean read FAsButton write FAsButton;
    property MinimizeMemory: Boolean read FMinimizeMemory write SetMinimizeMemory;
    property StreamFileType: TGRFKind read FStreamFileKind write FStreamFileKind;
    property ShowTitle: Boolean read FShowTitle write SetShowTitle;
    property TitlePlacement: TTitlePos read FTitlePlacement write SetTitlePlacement;
    property AutoLoad: Boolean read FAutoLoad write FAutoLoad;
    property ShadowColor: TColor read FShadowColor write FShadowColor;
    property ShowShadow: Boolean read FShowShadow write SetShowShadow;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvThumbnails.pas,v $';
    Revision: '$Revision: 1.14 $';
    Date: '$Date: 2005/03/09 14:57:31 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  jpeg,
  JvThumbViews, JvResources;

constructor TJvThumbnail.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPhotoName := TFileName.Create;
  FHShadowOffset := 3;
  FVShadowOffset := 3;
  FShowShadow := False;
  FShadowColor := clSilver;
  FShadowObj := TShape.Create(Self);
  FShadowObj.Visible := FShowShadow;
  FShadowObj.Brush.Color := FShadowColor;
  FShadowObj.Parent := Self;
  FShadowObj.Pen.Style := psClear;
  Photo := TJvThumbImage.Create(Self);
  Photo.AutoSize := False;
  Photo.Align := alNone;
  Photo.Stretch := True;
  Photo.OnProgress := PhotoOnProgress;

  FShadowObj.Width := Photo.Width;
  FShadowObj.Height := Photo.Height;
  FShadowObj.Left := Photo.Left + FHShadowOffset;
  FShadowObj.Top := Photo.Top + FVShadowOffset;
  FTitlePanel := TJvThumbTitle.Create(Self);
  FTitlePanel.Align := alTop;
  FTitlePanel.Height := 15;
  FTitlePanel.Alignment := taCenter;
  FTitleColor := clBtnFace;
  FTitlePanel.Color := FTitleColor;
  FTitleFont := TFont.Create;
  FTitleFont.OnChange := RefreshFont;
  FTitlePanel.BevelOuter := bvLowered;
  FTitlePanel.ParentColor := True;
  FTitlePanel.Color := Self.Color;
  if FTitlePlacement = tpNone then
    FTitlePanel.Visible := False;
  FTitle := '';
  FUpdated := False;
  InsertControl(Photo);
  InsertControl(FTitlePanel);
  Align := alNone;
  if AOwner is TJvThumbView then
  begin
    Width := TJvThumbView(Owner).MaxWidth;
    Height := TJvThumbView(Owner).MaxHeight;
  end
  else
  begin
    Width := 120;
    Height := 120;
  end;
  FMinimizeMemory := True;
  AsButton := False;
  Left := 10;
  Top := 10;
  Visible := True;
  BevelOuter := bvRaised;
  StreamFileType := grBMP;
  FAutoLoad := True;
end;

destructor TJvThumbnail.Destroy;
begin
  FDestroying := True;
  Photo.OnProgress := nil;
  FPhotoName.Free;
  FTitleFont.OnChange := nil;
  FTitleFont.Free;
  inherited Destroy;
end;

procedure TJvThumbnail.SetShowTitle(const AState: Boolean);
begin
  if AState <> FShowTitle then
  begin
    FShowTitle := AState;
    FTitlePanel.Visible := AState;
  end
end;

procedure TJvThumbnail.BoundsChanged;
begin
  CalculateImageSize;
  inherited BoundsChanged;
end;

procedure TJvThumbnail.SetStream(const AStream: TStream);
var
  Bmp: Graphics.TBitmap;
  Size: TPoint;
  Img2: TJPEGImage;
begin
  case StreamFileType of
    grBMP:
      Photo.Picture.Bitmap.LoadFromStream(AStream);
    grEMF, grWMF:
      Photo.Picture.Metafile.LoadFromStream(AStream);
    grJPG:
      begin
        Img2 := TJPEGImage.Create;
        Img2.LoadFromStream(AStream);
        Photo.Picture.Assign(Img2);
        FreeAndNil(Img2);
      end;
  end;

  if FMinimizeMemory then
  begin
    Bmp := Graphics.TBitmap.Create;
    if Parent is TJvThumbView then
      Size := ProportionalSize(Point(Photo.Picture.Width, Photo.Picture.Height),
        Point(TJvThumbView(Parent).MaxWidth, TJvThumbView(Parent).MaxHeight))
    else
      Size := ProportionalSize(Point(Photo.Picture.Width, Photo.Picture.Height),
        Point(Width, Height));
    Bmp.Width := Size.X;
    Bmp.Height := Size.Y;
    Bmp.handletype := bmDIB;
    Bmp.pixelformat := pf24bit;
    Bmp.Canvas.StretchDraw(rect(0, 0, Bmp.Width, Bmp.Height),
      Photo.Picture.Graphic);
    //Photo.Picture.Graphic.Free; // (rom) not needed
    //Photo.Picture.Graphic := nil;
    Photo.Picture.Assign(Bmp);
    Bmp.Free;
  end;
end;

procedure TJvThumbnail.SetClientWidth(AWidth: Word);
begin
  FClientWidth := (Width - (BorderWidth * 2)) - 8;
end;

procedure TJvThumbnail.SetClientHeight(AHeight: Word);
begin
  if Assigned(FTitlePanel) then
    FClientHeight := Height - (FTitlePanel.Height + 8)
  else
    FClientHeight := Height - 8;
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -