home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Source / DXPictEdit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  9.9 KB  |  395 lines
  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.         DIB.LoadFromClipboardFormat(CF_DIB, Clipboard.GetAsHandle(CF_DIB), 0);
  352.         ViewBox.Picture.Graphic := DIB;
  353.       finally
  354.         DIB.Free;
  355.       end;
  356.     except
  357.       ViewBox.Picture.Assign(Clipboard);
  358.       ConvertToDIBClick(nil);
  359.     end;                     
  360.   end else
  361.   begin
  362.     FChanged := True;
  363.     ViewBox.Picture.Assign(Clipboard);
  364.   end;
  365.  
  366.   UpdateData;
  367. end;
  368.  
  369. procedure TDelphiXPictureEditForm.PopupMenu1Popup(Sender: TObject);
  370. var
  371.   i: Integer;
  372. begin
  373.   if DIBClassOnly then
  374.   begin
  375.     gePaste.Enabled := False;
  376.     for i:=0 to Clipboard.FormatCount-1 do
  377.       if Clipboard.Formats[i]=CF_DIB then
  378.       begin
  379.         gePaste.Enabled := True;
  380.         Break;
  381.       end;
  382.   end else
  383.   begin
  384.     gePaste.Enabled := False;
  385.     for i:=0 to Clipboard.FormatCount-1 do
  386.       if ViewBox.Picture.SupportsClipboardFormat(Clipboard.Formats[i]) then
  387.       begin
  388.         gePaste.Enabled := True;
  389.         Break;
  390.       end;
  391.   end;
  392. end;
  393.  
  394. end.
  395.