Check-in [1d07ee6f91]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Implemented several zooming features (keep proportions). Use TWICImage instead of TOleGraphic as fallback.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1d07ee6f917ba5076fd93e19c66e2c6395c73d87
User & Date: tinus 2015-02-03 13:24:11
Context
2015-02-03
13:24
Read PNG files as well as JPG. Show some basic info of selected image. Leaf check-in: 3a643621eb user: tinus tags: trunk
13:24
Implemented several zooming features (keep proportions). Use TWICImage instead of TOleGraphic as fallback. check-in: 1d07ee6f91 user: tinus tags: trunk
13:22
Report False when we couldn't read the image size from a valid JPG image. check-in: 979234fb70 user: tinus tags: trunk
Changes

Changes to src/U_WPImages.pas.

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
..
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
107
108
109
110
111
112
113
114
115


116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

131


132
133
134
135










136











137
138




139


140

















141



142


143
144
145
146
147

148
149
150
151
152
153
154
155
156
157
158
159
160
161
    property Source: TSource      read FSource  write FSource;
  end;

implementation

uses
  System.SysUtils,
  Vcl.AxCtrls,
  ImgSize, Winapi.Windows;

{ TWPImage }

constructor TWPImage.Create(const Path: string);
var
  FS: TFileStream;
  W, H: Word;
  FB: TFreeBitmap;
  OG: TOleGraphic;
begin
  FPath := Path;

  FS := TFileStream.Create(Path, fmOpenRead or fmShareDenyNone);
  try
    // Try to identify the image type by its signature, and retrieve the image dimensions
    if GetJPGSize(FS, W, H) or GetPNGSize(FS, W, H) or GetGIFSize(FS, W, H) then begin
................................................................................
      FB := TFreeBitmap.Create();
      try
        if FB.LoadU(Path) then begin
          Width := FB.GetWidth;
          Height := FB.GetHeight;
        end else begin
          // All else has failed; see if Windows recognizes it
          OG := TOleGraphic.Create;
          try
            OG.LoadFromStream(FS);
            Width := OG.Width;
            Height := OG.Height;
          finally
            OG.Free;
          end;
        end;
      finally
        FB.Free;
      end;
    end;
  finally
................................................................................
  inherited;
end;

procedure TWPImage.Draw(const Canvas: TCanvas; const Rect: TRect;
                        Zoom: TWPImageZoom; HorizontalAlignment: TAlignment;
                        VerticalAlignment: TVerticalAlignment);
var
  RectRatio: Double;
  BkColor: TRGBQuad;


begin
  if (Rect.Width = 0) or (Rect.Height = 0) then
    Exit;

  if not Assigned(FFreeBitmap) and not Assigned(FGraphic) then begin
    FFreeBitmap := TFreeWinBitmap.Create();
    if not FFreeBitmap.LoadU(Path) then begin
      FreeAndNil(FFreeBitmap);
      FGraphic := LoadGraphic;
    end;
  end;

  if Zoom = Default then
    Zoom := Self.Zoom;


  RectRatio := Rect.Width / Rect.Height;


  case Zoom of
    FitHorizontal: ;
    FitVertical: ;
    FitLargest: ;










    FitSmallest: ;











    else begin // Align





    end;


  end;





















  if Assigned(FFreeBitmap) then begin


    FFreeBitmap.DrawEx(Canvas.Handle, Rect, False, @BkColor);
  end else if Assigned(FGraphic) then begin
    Canvas.StretchDraw(Rect, FGraphic);
  end;
end;


function TWPImage.GetRatio: Double;
begin
  Result := Width / Height;
end {TWPImage.GetRatio};

function TWPImage.LoadGraphic: TGraphic;
begin
  Result := TOleGraphic.Create;
  Result.LoadFromFile(Path);
end {TWPImage.LoadGraphic};


end.







<
|








|







 







|

|
|
|

|







 







|

>
>











<



>
|
>
>



|
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>

<
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>

>
>
|

|

<
>








|





48
49
50
51
52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
...
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
    property Source: TSource      read FSource  write FSource;
  end;

implementation

uses
  System.SysUtils,

  ImgSize, Winapi.Windows, FreeImage;

{ TWPImage }

constructor TWPImage.Create(const Path: string);
var
  FS: TFileStream;
  W, H: Word;
  FB: TFreeBitmap;
  G: TGraphic;
begin
  FPath := Path;

  FS := TFileStream.Create(Path, fmOpenRead or fmShareDenyNone);
  try
    // Try to identify the image type by its signature, and retrieve the image dimensions
    if GetJPGSize(FS, W, H) or GetPNGSize(FS, W, H) or GetGIFSize(FS, W, H) then begin
................................................................................
      FB := TFreeBitmap.Create();
      try
        if FB.LoadU(Path) then begin
          Width := FB.GetWidth;
          Height := FB.GetHeight;
        end else begin
          // All else has failed; see if Windows recognizes it
          G := TWICImage.Create;
          try
            G.LoadFromStream(FS);
            Width := G.Width;
            Height := G.Height;
          finally
            G.Free;
          end;
        end;
      finally
        FB.Free;
      end;
    end;
  finally
................................................................................
  inherited;
end;

procedure TWPImage.Draw(const Canvas: TCanvas; const Rect: TRect;
                        Zoom: TWPImageZoom; HorizontalAlignment: TAlignment;
                        VerticalAlignment: TVerticalAlignment);
var
  TargetRatio, SourceRatio: Double;
  BkColor: TRGBQuad;
  R, Cut: TRect;
  Paste: TFreeWinBitmap;
begin
  if (Rect.Width = 0) or (Rect.Height = 0) then
    Exit;

  if not Assigned(FFreeBitmap) and not Assigned(FGraphic) then begin
    FFreeBitmap := TFreeWinBitmap.Create();
    if not FFreeBitmap.LoadU(Path) then begin
      FreeAndNil(FFreeBitmap);
      FGraphic := LoadGraphic;
    end;
  end;

  if Zoom = Default then
    Zoom := Self.Zoom;

  OutputDebugString(PChar(Format('Image: %dx%d; Rect: %dx%d', [Self.Width, Self.Height, Rect.Width, Rect.Height])));
  TargetRatio := Rect.Width / Rect.Height;
  SourceRatio := Self.Width / Self.Height;
  R := Rect;
  case Zoom of
    FitHorizontal: ;
    FitVertical: ;
    FitLargest: begin
      if TargetRatio > SourceRatio then begin
        // Rect is wider than image
        R.Width := MulDiv(R.Height, Self.Width, Self.Height);
        R.Left := R.Left + (Rect.Width - R.Width) div 2;
      end else if TargetRatio < SourceRatio then begin
        // Image is wider than rect
        R.Height := MulDiv(R.Width, Self.Height, Self.Width);
        R.Top := R.Top + (Rect.Height - R.Height) div 2;
      end;
    end;
    FitSmallest: begin
      OutputDebugString(PChar(Format('Source: %n; Target: %n', [SourceRatio, TargetRatio])));
      if TargetRatio > SourceRatio then begin
        // Rect is wider than image
        R.Height := MulDiv(R.Width, Self.Height, Self.Width);
        R.Top := R.Top + (Rect.Height - R.Height) div 2;
      end else if TargetRatio < SourceRatio then begin
        // Image is wider than rect
        R.Width := MulDiv(R.Height, Self.Width, Self.Height);
        R.Left := R.Left + (Rect.Width - R.Width) div 2;
      end;
    end;
    else begin // Align

      // TODO: if it's in preview, scale image proportionately to the screen?
      case HorizontalAlignment of
        taLeftJustify: begin
          R.Right := R.Left + Self.Width;
        end;
        taRightJustify: begin
          R.Left := R.Right - Self.Width;
        end;
        taCenter: begin
          R.Left := R.CenterPoint.X - (Self.Width div 2);
        end;
      end;
      case VerticalAlignment of
        taAlignTop: begin
          R.Bottom := R.Top + Self.Height;
        end;
        taAlignBottom: begin
          R.Top := R.Bottom - Self.Height;
        end;
        taVerticalCenter: begin
          R.Top := R.CenterPoint.Y - (Self.Height div 2);
        end;
      end;
    end;
  end;

  // TODO: cut off the image if R falls outside Rect
//  Cut := TRect.Intersect(R, Rect);

  if Assigned(FFreeBitmap) then begin
//    Paste := TFreeWinBitmap.Create(FIT_BITMAP, Cut.Width, Cut.Height, 32);
//    FFreeBitmap.CopySubImage(R.Left, R.Top, R.Right, R.Bottom, Paste);
    FFreeBitmap.DrawEx(Canvas.Handle, R, False, @BkColor);
  end else if Assigned(FGraphic) then begin
    Canvas.StretchDraw(R, FGraphic);
  end;

end {TWPImage.Draw};

function TWPImage.GetRatio: Double;
begin
  Result := Width / Height;
end {TWPImage.GetRatio};

function TWPImage.LoadGraphic: TGraphic;
begin
  Result := TWICImage.Create;
  Result.LoadFromFile(Path);
end {TWPImage.LoadGraphic};


end.