imageplus.pas

TImagePlus是加强版的TImage构件

{IMAGEPLUS Version 2.0

 ImagePlus is a TImage descendant with the following additional
 procedures:
           SaveWithText(FileName:TFileName;Text:TStrings)  This is used to
 save a graphic and selected text in a single modified graphic file.
           LoadWithText(FileName:TFileName;Text:TStrings)  This is used to
 load the graphic and text saved in the modified graphic file.
           Adjust;  This will adjust the loaded image depending on the
 proportional properties.

 The new properties are:
            Proportional - Boolean; Whether or not the picture should be
 displayed in its correct proportion.  If Proportional = TRUE, AutoSize
 will be changed to FALSE or ignored.  Stretch will be set to TRUE or ignored.
            Axis - raVertical,raHorizontal; If Proportional = TRUE, Axis dictates
 which axis remains as set in design mode.  eg raVertical will mean the width of the
 display will be adjusted so that the picture is proportionally displayed with the
 height set at design time.
 The properties vHeight and vWidth are used in proportioning and cannot be separately set.

 The modified graphic file can be opened as normal in any graphic editor or loaded
 into a graphic component without showing the text, without any apparent problem.

 PS.  If you find the component throws up rubbish as text, try changing the Marker
 constant.  @||@ seems to work OK for me but....

 I use Delphi 3 but I presume it will work with D2 and D4.

 This component is "FREEWARE". The Author specifically disclaims all warranties,
 express or implied, including but not limited to, implied warranties of
 merchantability and fitness for a particular purpose, with regard to the Software.
 By using this component you do so at your own risk.

 If you have comments or suggestions, let me know, particularly on code improvement
 as I'm still finding my way!

 Brian Shepherd. [e-mail]

 }

UNIT ImagePlus;

INTERFACE

USES
  Windows, Messages, Classes, SysUtils, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

CONST
  Marker = '@||@';

TYPE
  TAxis = (axVertical, axHorizontal);
  TImagePlus = CLASS(TImage)

  private
    fRatio: Boolean;
    fAxis: TAxis;
    fHeight, fWidth: integer;

    PROCEDURE SetProportional(value: Boolean);
    PROCEDURE SetRatio(value: Boolean);
    PROCEDURE SetAxis(value: TAxis);
    FUNCTION GetHeight: integer;
    PROCEDURE SetHeight(value: integer);
    FUNCTION GetWidth: integer;
    PROCEDURE SetWidth(value: integer);
             { Private declarations }
  protected

               { Protected declarations }
  public

    CONSTRUCTOR Create(AOwner: TComponent); override;
    DESTRUCTOR Destroy; override;


    PROCEDURE SaveWithText(FileName: TFileName; Text: TStrings);
    PROCEDURE LoadWithText(FileName: TFileName; Text: TStrings);
    PROCEDURE Adjust;
    { Public declarations }
  published
    PROPERTY Proportional: Boolean read fRatio write SetRatio;
    PROPERTY Axis: TAxis read fAxis write SetAxis;
    PROPERTY vHeight: integer read GetHeight write SetHeight;
    PROPERTY vWidth: integer read GetWidth write SetWidth;

  END;

PROCEDURE Register;

IMPLEMENTATION
{$R *.DCR}

CONSTRUCTOR TImagePlus.Create(AOwner: TComponent);
BEGIN
  INHERITED Create(AOwner);
END;

DESTRUCTOR TImagePlus.Destroy;
BEGIN
  INHERITED Destroy;
END;

FUNCTION TImagePlus.GetHeight: integer;
BEGIN
  Result := Height;
END;

PROCEDURE TImagePlus.SetHeight(value: integer);
BEGIN
  IF fHeight <> value THEN
    fHeight := value;
END;

FUNCTION TImagePlus.GetWidth: integer;
BEGIN
  Result := Width;
END;

PROCEDURE TImagePlus.SetWidth(value: integer);
BEGIN
  IF fWidth <> value THEN
    fWidth := value;
END;

PROCEDURE TIMagePlus.SetRatio(value: Boolean);
BEGIN
  IF value THEN
  BEGIN
    AutoSize := FALSE;
    Stretch := TRUE
  END;
  IF FRatio <> value THEN
    FRatio := Value;
END;

PROCEDURE TImagePlus.SetAxis(value: TAxis);
BEGIN
  IF FAxis <> value THEN
    FAxis := value;
END;

PROCEDURE TIMagePlus.Adjust;
BEGIN
  SetProportional(Proportional);
  Invalidate;
END;

PROCEDURE TImagePlus.SaveWithText(FileName: TFileName; Text: TStrings);
VAR
  AStream: TStream;
BEGIN
  TRY
    TRY
      AStream := TFileStream.Create(FileName, fmCreate);
      Picture.Graphic.SaveToStream(AStream);
      AStream.Write(Marker, 4);
      Text.SaveToStream(AStream);
    FINALLY
      AStream.Free;
    END
  EXCEPT
    ON EAccessViolation DO
      ShowMessage('You must have a graphic loaded...');
  END;
END;

PROCEDURE TImagePlus.SetProportional(value: Boolean);
VAR
  V: variant;
BEGIN
  IF value THEN
  BEGIN
    CASE Axis OF
      axVertical:
        BEGIN
          V := Picture.Width / (Picture.Height / fHeight);
          Height := fHeight;
          Width := Round(V);
        END;
      axHorizontal:
        BEGIN
          V := Picture.Height / (Picture.Width / fWidth);
          Width := fWidth;
          Height := Round(V);
        END;
    END;
  END
  ELSE
  BEGIN
    Height := fHeight;
    Width := fWidth;
  END;

END;

PROCEDURE TImagePlus.LoadWithText(FileName: TFileName; Text: TStrings);
VAR
  AStream: TStream;
  Bfr: STRING;
  P: integer;

BEGIN
  TRY
    Picture.LoadFromFile(FileName);
    SetProportional(Proportional);
    AStream := TFileStream.Create(FileName, fmOpenRead);
    Setlength(Bfr, AStream.Size);
    AStream.Read(Bfr[1], AStream.Size);
    P := Pos(Marker, Bfr);

    IF P > 0 THEN
    BEGIN
      AStream.Position := P + 3;
      Text.LoadFromStream(AStream);
    END
    ELSE
      Text.Add('No text found...');

  FINALLY
    AStream.Free;
  END;
END;

PROCEDURE Register;
BEGIN
  RegisterComponents('Standard', [TImagePlus]);
END;

END.