Subversion Repositories spacemission

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 daniel-mar 1
unit DXPictEdit;
2
 
3
interface
4
 
5
uses
6
  Windows, SysUtils, Classes, Forms, Dialogs, Controls, StdCtrls, ExtCtrls,
7
  ExtDlgs, DIB, Menus, Graphics, Clipbrd;
8
 
9
type
10
 
11
  {  TDelphiXDIBEditForm  }
12
 
13
  TDelphiXPictureEditForm = class(TForm)
14
    LoadButton: TButton;
15
    SaveButton: TButton;
16
    ClearButton: TButton;
17
    OKButton: TButton;
18
    CancelButton: TButton;
19
    Panel1: TPanel;
20
    Bevel1: TBevel;
21
    NoneLabel: TLabel;
22
    Shape: TShape;
23
    SizeLabel: TLabel;
24
    BitCountLabel: TLabel;
25
    Bevel2: TBevel;
26
    OpenDialog: TOpenPictureDialog;
27
    SaveDialog: TSavePictureDialog;
28
    BitSizeLabel: TLabel;
29
    ViewBox: TImage;
30
    ConvertToDIB: TButton;
31
    ClassNameLabel: TLabel;
32
    PopupMenu1: TPopupMenu;
33
    geConvertColor: TMenuItem;
34
    N15: TMenuItem;
35
    N41: TMenuItem;
36
    N21: TMenuItem;
37
    N22: TMenuItem;
38
    geGreyscale: TMenuItem;
39
    N11: TMenuItem;
40
    N12: TMenuItem;
41
    N13: TMenuItem;
42
    N14: TMenuItem;
43
    geNegative: TMenuItem;
44
    N1: TMenuItem;
45
    geCompress: TMenuItem;
46
    geDecompress: TMenuItem;
47
    N3: TMenuItem;
48
    geCopy: TMenuItem;
49
    gePaste: TMenuItem;
50
    procedure OKButtonClick(Sender: TObject);
51
    procedure CancelButtonClick(Sender: TObject);
52
    procedure LoadButtonClick(Sender: TObject);
53
    procedure SaveButtonClick(Sender: TObject);
54
    procedure ClearButtonClick(Sender: TObject);
55
    procedure FormShow(Sender: TObject);
56
    procedure geGreyscaleClick(Sender: TObject);
57
    procedure geNegativeClick(Sender: TObject);
58
    procedure geConvertColorClick(Sender: TObject);
59
    procedure geCompressClick(Sender: TObject);
60
    procedure geDecompressClick(Sender: TObject);
61
    procedure ConvertToDIBClick(Sender: TObject);
62
    procedure geCopyClick(Sender: TObject);
63
    procedure gePasteClick(Sender: TObject);
64
    procedure PopupMenu1Popup(Sender: TObject);
65
  private
66
    FChanged: Boolean;
67
    procedure UpdateData;
68
  public
69
    DIBClassOnly: Boolean;
70
  end;
71
 
72
var
73
  DelphiXPictureEditForm: TDelphiXPictureEditForm;
74
 
75
implementation
76
 
77
uses DXConsts;
78
 
79
{$R *.DFM}
80
 
81
{  TDelphiXDIBEditForm  }
82
 
83
procedure TDelphiXPictureEditForm.FormShow(Sender: TObject);
84
begin
85
  ConvertToDIB.Visible := not DIBClassOnly;
86
  UpDateData;
87
  CancelButton.SetFocus;
88
end;
89
 
90
procedure TDelphiXPictureEditForm.OKButtonClick(Sender: TObject);
91
begin
92
  if FChanged then
93
    Tag := 1;
94
  Close;
95
end;
96
 
97
procedure TDelphiXPictureEditForm.CancelButtonClick(Sender: TObject);
98
begin
99
  Close;
100
end;
101
 
102
procedure TDelphiXPictureEditForm.ClearButtonClick(Sender: TObject);
103
begin
104
  FChanged := True;
105
 
106
  ViewBox.Picture.Graphic := nil;
107
  UpDateData;
108
end;
109
 
110
procedure TDelphiXPictureEditForm.LoadButtonClick(Sender: TObject);
111
var
112
  DIB: TDIB;
113
begin
114
  if DIBClassOnly then
115
  begin
116
    OpenDialog.Filter := GraphicFilter(TGraphic);
117
 
118
    if OpenDialog.Execute then
119
    begin
120
      FChanged := True;
121
 
122
      try
123
        DIB := TDIB.Create;
124
        try
125
          DIB.LoadFromFile(OpenDialog.FileName);
126
          ViewBox.Picture.Graphic := DIB;
127
        finally
128
          DIB.Free;
129
        end;
130
      except
131
        ViewBox.Picture.LoadFromFile(OpenDialog.FileName);
132
        ConvertToDIBClick(nil);
133
      end;
134
 
135
      UpDateData;
136
    end;
137
  end else
138
  begin
139
    OpenDialog.Filter := GraphicFilter(TGraphic);
140
 
141
    if OpenDialog.Execute then
142
    begin
143
      FChanged := True;
144
 
145
      try
146
        DIB := TDIB.Create;
147
        try
148
          DIB.LoadFromFile(OpenDialog.FileName);
149
          ViewBox.Picture.Graphic := DIB;
150
        finally
151
          DIB.Free;
152
        end;
153
      except
154
        ViewBox.Picture.LoadFromFile(OpenDialog.FileName);
155
      end;
156
 
157
      UpDateData;
158
    end;
159
  end;
160
end;
161
 
162
procedure TDelphiXPictureEditForm.SaveButtonClick(Sender: TObject);
163
begin
164
  if ViewBox.Picture.Graphic is TDIB then
165
  begin
166
    SaveDialog.Filter := 'Bitmap file(*.bmp;*.dib)|*.bmp;*.dib';
167
    SaveDialog.DefaultExt := 'bmp';
168
  end else
169
  begin
170
    SaveDialog.Filter := GraphicFilter(TGraphicClass(ViewBox.Picture.Graphic.ClassType));
171
    SaveDialog.DefaultExt := GraphicExtension(TGraphicClass(ViewBox.Picture.Graphic.ClassType));
172
  end;
173
 
174
  if SaveDialog.Execute then
175
    ViewBox.Picture.SaveToFile(SaveDialog.FileName);
176
end;
177
 
178
procedure TDelphiXPictureEditForm.ConvertToDIBClick(Sender: TObject);
179
var
180
  DIB: TDIB;
181
begin                                
182
  if (ViewBox.Picture.Graphic<>nil) and (not (ViewBox.Picture.Graphic is TDIB)) then
183
  begin
184
    DIB := TDIB.Create;
185
    try
186
      DIB.Assign(ViewBox.Picture.Graphic);
187
      ViewBox.Picture.Graphic := DIB;
188
    finally
189
      DIB.Free;
190
    end;
191
 
192
    UpdateData;
193
  end;
194
end;
195
 
196
procedure TDelphiXPictureEditForm.UpdateData;
197
 
198
  procedure Draw2(Width, Height: Integer);
199
  begin
200
    ViewBox.Stretch := True;
201
    ViewBox.Left := 6 + -(Width-ViewBox.Width) div 2;
202
    ViewBox.Top := 6 + -(Height-ViewBox.Height) div 2;
203
    ViewBox.Width := Width;
204
    ViewBox.Height := Height;
205
  end;
206
 
207
var
208
  i: Integer;
209
  r, r2: Double;
210
  DIB: TDIB;
211
begin
212
  if (ViewBox.Picture.Graphic<>nil) and (not ViewBox.Picture.Graphic.Empty) and
213
    (ViewBox.Picture.Width>0) and (ViewBox.Picture.Height>0) then
214
  begin
215
    SizeLabel.Caption := Format(SDIBSize, [ViewBox.Picture.Width, ViewBox.Picture.Height]);
216
 
217
    ClassNameLabel.Caption := ViewBox.Picture.Graphic.ClassName;
218
 
219
    if ViewBox.Picture.Graphic is TDIB then
220
    begin
221
      i := (ViewBox.Picture.Graphic as TDIB).BitCount;
222
      if i=32 then i := 32;
223
      BitCountLabel.Caption := Format(SDIBColor, [1 shl i]);
224
 
225
      DIB := ViewBox.Picture.Graphic as TDIB;
226
 
227
      if DIB.BitmapInfo.bmiHeader.biSizeImage>100*1024 then
228
        BitSizeLabel.Caption := Format(SDIBBitSize_K, [DIB.BitmapInfo.bmiHeader.biSizeImage div 1024])
229
      else
230
        BitSizeLabel.Caption := Format(SDIBBitSize, [DIB.BitmapInfo.bmiHeader.biSizeImage]);
231
    end else
232
    begin
233
      BitCountLabel.Caption := '';
234
      BitSizeLabel.Caption := '';
235
    end;
236
 
237
    ConvertToDIB.Enabled := not (ViewBox.Picture.Graphic is TDIB);
238
 
239
    NoneLabel.Visible := True;
240
    ClearButton.Enabled := True;
241
    NoneLabel.Visible := False;
242
    SaveButton.Enabled := True;
243
 
244
    ViewBox.Width := 228;
245
    ViewBox.Height := 228;
246
 
247
    if (ViewBox.Picture.Width>ViewBox.Width) or (ViewBox.Picture.Height>ViewBox.Height) then
248
    begin
249
      r := ViewBox.Width/ViewBox.Picture.Width;
250
      r2 := ViewBox.Height/ViewBox.Picture.Height;
251
      if r>r2 then
252
        r := r2;
253
      Draw2(Round(r*ViewBox.Picture.Width), Round(r*ViewBox.Picture.Height));
254
    end else
255
      Draw2(ViewBox.Picture.Width, ViewBox.Picture.Height);
256
 
257
    for i:=0 to PopupMenu1.Items.Count-1 do
258
      if PopupMenu1.Items[i].Tag<>0 then
259
        PopupMenu1.Items[i].Enabled := True;
260
  end else
261
  begin
262
    SizeLabel.Caption := '';
263
    BitCountLabel.Caption := '';
264
    BitSizeLabel.Caption := '';
265
    ClassNameLabel.Caption := '';
266
 
267
    NoneLabel.Visible := False;
268
    ClearButton.Enabled := False;
269
    NoneLabel.Visible := True;
270
    SaveButton.Enabled := False;
271
 
272
    ConvertToDIB.Enabled := False;
273
 
274
    for i:=0 to PopupMenu1.Items.Count-1 do
275
      if PopupMenu1.Items[i].Tag<>0 then
276
        PopupMenu1.Items[i].Enabled := False;
277
  end;
278
 
279
  PaletteChanged(True);
280
  ViewBox.Invalidate;
281
end;
282
 
283
procedure TDelphiXPictureEditForm.geConvertColorClick(Sender: TObject);
284
begin
285
  ConvertToDIBClick(nil);
286
  FChanged := True;
287
  (ViewBox.Picture.Graphic as TDIB).PixelFormat := MakeDIBPixelFormat(8, 8, 8);
288
  (ViewBox.Picture.Graphic as TDIB).BitCount := TMenuItem(Sender).Tag;
289
  UpdateData;
290
end;
291
 
292
procedure TDelphiXPictureEditForm.geGreyscaleClick(Sender: TObject);
293
begin
294
  ConvertToDIBClick(nil);
295
  FChanged := True;
296
  (ViewBox.Picture.Graphic as TDIB).PixelFormat := MakeDIBPixelFormat(8, 8, 8);
297
  (ViewBox.Picture.Graphic as TDIB).Greyscale(TMenuItem(Sender).Tag);
298
  UpdateData;
299
end;
300
 
301
procedure TDelphiXPictureEditForm.geNegativeClick(Sender: TObject);
302
begin
303
  ConvertToDIBClick(nil);
304
  FChanged := True;
305
  (ViewBox.Picture.Graphic as TDIB).Negative;
306
  UpdateData;
307
end;
308
 
309
procedure TDelphiXPictureEditForm.geCompressClick(Sender: TObject);
310
begin
311
  ConvertToDIBClick(nil);
312
  FChanged := True;
313
  (ViewBox.Picture.Graphic as TDIB).Compress;
314
  UpdateData;
315
end;
316
 
317
procedure TDelphiXPictureEditForm.geDecompressClick(Sender: TObject);
318
begin
319
  ConvertToDIBClick(nil);
320
  FChanged := True;
321
  (ViewBox.Picture.Graphic as TDIB).Decompress;
322
  UpdateData;
323
end;
324
 
325
procedure TDelphiXPictureEditForm.geCopyClick(Sender: TObject);
326
var
327
  AFormat: Word;
328
  AData: THandle;
329
  APalette: HPALETTE;
330
begin
331
  Clipboard.Open;
332
  try
333
    ViewBox.Picture.Graphic.SaveToClipboardFormat(AFormat, AData, APalette);
334
    Clipboard.SetAsHandle(AFormat, AData);
335
  finally                                
336
    Clipboard.Close;
337
  end;
338
end;
339
 
340
procedure TDelphiXPictureEditForm.gePasteClick(Sender: TObject);
341
var
342
  DIB: TDIB;
343
begin
344
  if DIBClassOnly then
345
  begin
346
    FChanged := True;
347
 
348
    try
349
      DIB := TDIB.Create;
350
      try
351
        Clipboard.Open;
352
        try
353
          DIB.LoadFromClipboardFormat(CF_DIB, Clipboard.GetAsHandle(CF_DIB), 0);
354
        finally
355
          Clipboard.Close;
356
        end;
357
        ViewBox.Picture.Graphic := DIB;
358
      finally
359
        DIB.Free;
360
      end;
361
    except
362
      ViewBox.Picture.Assign(Clipboard);
363
      ConvertToDIBClick(nil);
364
    end;
365
  end else
366
  begin
367
    FChanged := True;
368
    ViewBox.Picture.Assign(Clipboard);
369
  end;
370
 
371
  UpdateData;
372
end;
373
 
374
procedure TDelphiXPictureEditForm.PopupMenu1Popup(Sender: TObject);
375
var
376
  i: Integer;
377
begin
378
  if DIBClassOnly then
379
  begin
380
    gePaste.Enabled := False;
381
    for i:=0 to Clipboard.FormatCount-1 do
382
      if Clipboard.Formats[i]=CF_DIB then
383
      begin
384
        gePaste.Enabled := True;
385
        Break;
386
      end;
387
  end else
388
  begin
389
    gePaste.Enabled := False;
390
    for i:=0 to Clipboard.FormatCount-1 do
391
      if ViewBox.Picture.SupportsClipboardFormat(Clipboard.Formats[i]) then
392
      begin
393
        gePaste.Enabled := True;
394
        Break;
395
      end;
396
  end;
397
end;
398
 
399
end.